/PIP FOR BLEEP MONITOR
IFNDEF JCA <XLIST>
/EQUIVALENCES FOR GENERAL CHARACTER I/O ROUTINES

OUBUF=0	/MUST BE LOWER THAN INBUF
OUCTL=5400	/OUTPUT BUFFER OF 3000 WORDS
OUDEVH=7200	/PROVIDE ROOM FOR TWO-PAGE HANDLERS
INBUF=3000
INCTL=1600	/INPUT BUFFER OF 3400 WORDS
INRECS=7
INDEVH=6600

/PAGE 6400 IS FREE

/EQUIVALENCES NECESSARY TO INTERFACE WITH MONITOR
DCB=7760
MPARAM=7643	/CD PARAMETER AREA
OLDDIR=7	/POINTER TO MONITOR VARIABLE "OLDT9"
MTEMP=27	/MONITOR SCRATCH AREA ON "SYS" 
/		 ***VOLATILE***
PTP=20	/INTERNAL TYPE CODE FOR PAPER TAPE PUNCH
XR=10
TEMP=20
CHAR=21
INFPTR=22
INEOF=23

ABUF=6601	/LINE BUFFER - 150 CHARACTERS LONG
SQBUF1=6600	/DIRECTORY BUFFER FOR "SQUISH" OPTION
SQBUF2=7200	/""

FIELD 1
/GENERAL CHARACTER I/O ROUTINES FOR BLEEP
/CALLED AS FOLLOWS:

/JMS I (IOPEN		INITIALIZES THE INPUT ROUTINE

/JMS I (ICHAR		READS A CHARACTER
/ERROR RETURN		/AC>0 IF END OF FILE,
			/ AC<0 IF READ ERROR

/JMS I (OOPEN		INITIALIZES THE OUTPUT ROUTINE
/ERROR RETURN		AC>0 IF NO OUTPUT DEVICE/FILE,
			/ AC<0 IF ERROR

/JMS I (OCHAR		OUTPUTS A CHARACTER
/ERROR RETURN		OUTPUT ERROR OR TOO MUCH OUTPUT

/JMS I (OCLOSE		CLOSES THE OUTPUT FILE
/ERROR RETURN		FILE TOO LARGE TO BE CLOSED,
/			 OR OUTPUT ERROR

/JMS I (OTYPE		RETURNS DCB WORD OF OUTPUT DEVICE
/			 IN AC



/PARAMETERS NEEDED:

/INBUF=		ADDRESS OF INPUT BUFFER
/INCTL=		INPUT BUFFER CONTROL WORD
/OUBUF=		ADDRESS OF OUTPUT BUFFER
/OUCTL=		OUTPUT BUFFER CONTROL WORD (MUST BE NEGATIVE)
/INRECS=	[INCTL/256] ADDRESS OF PAGE FOR
/		INPUT HANDLER.
/ADDRESS OF PAGE FOR INPUT HANDLER
/OUDEVH=	ADDRESS OF PAGE FOR OUTPUT HANDLER

/ASSUMES I/O MONITOR IS RESIDENT IN CORE.
/CAN BE CALLED FROM ANY FIELD WITH BUFFERS IN ANY FIELD.
	INFLD=INCTL&70		/GET FIELD OF INPUT BUFFER
	OUFLD=OUCTL&70		/DITTO OUTPUT BUFFER
	*2000
IN7400,	7400
IOPEN,	0
	CLA CMA
	DCA INCHCT		/SET INCHCT TO FORCE A READ
	ISZ INEOF		/SET END-OF-FILE FLAG TO FORCE A NEW FILE
	TAD (7617
	DCA INFPTR		/RESET FILE POINTER
	RDF
	TAD INCDIF
	DCA .+1
INPTR,	HLT			/RESTORE CALLING FIELDS
	JMP I IOPEN

ICHAR,	0
IN7600,	7600
	RDF
	TAD INCDIF
	DCA INRTRN		/SAVE CALLING FIELDS
INCHAR,	CDF INFLD
	ISZ INJMP		/BUMP THREE-WAY UNPACK SWITCH
	ISZ INCHCT
INJMPP,	JMP INJMP
	TAD INEOF
	SNA CLA			/DID LAST READ YIELD END-OF-FILE?
	JMP INGBUF		/NO - DO ANOTHER
GETNEW,	JMS INNEWF		/OPEN A NEW INPUT FILE
	JMP EOFERR		/NO FILE TO OPEN
INGBUF,	TAD INCTR
	CLL
	TAD (INRECS
	SNL
	DCA INCTR		/RESTORE INCTR IF IT HASN'T OVERFLOWED
	SZL			/IS THIS THE LAST READ?
	ISZ INEOF		/YES - SET END-OF-FILE FLAG
	CLL CML CMA RTR	/CONSTRUCT A CONTROL WORD FOR THE READ
	RTR			/FROM THE AMOUNT OF THE OVERFLOW
	RTR			/(IF ANY) AND THE STANDARD CONTROL WORD
	TAD (INCTL+1
	DCA INCTLW
INCDIF,	CDF CIF 0
	CDF 10
	JMS I INHNDL		/CALL THE DEVICE HANDLER
INCTLW,	0
INBUFP,	INBUF
INREC,	0
	JMS I (SLASHG		/A HANDLER ERROR - SHOULD WE IGNORE?
	INERRX-.		/ADDRESS IF NOT
INBREC,	TAD INREC
	TAD (INRECS
	DCA INREC		/UPDATE THE RECORD NUMBER
	TAD INCTLW
	AND IN7600
	CLL RAL
	TAD INCTLW
	AND IN7600
	CMA
	DCA INCHCT		/COMPUTE THE NEW CHARACTER COUNT
	TAD INJMPP
	DCA INJMP		/RESET THE CHARACTER SWITCH
	TAD INBUFP
	DCA INPTR		/AND THE WORD POINTER
	JMP INCHAR		/GO BACK AND MAKE BELIEVE THIS NEVER HAPPENED
INERRX,	ISZ INEOF		/EITHER AN END-OF-FILE OR A BADDIE
	SMA CLA			/WHICH TYPE WAS IT?
	JMP INBREC		/END OF FILE - RESUME THY PROCESSING
INERR,	CLA CLL CML RAR		/BADDIE - GIVE ERROR RETURN WITH NEGATIVE AC
EOFERR,	JMP INRTRN
INJMP,	HLT			/THIS IS THE THREE - WAY CHARACTER SWITCH
	JMP ICHAR1
	JMP ICHAR2
ICHAR3,	TAD INJMPP
	DCA INJMP
	TAD I INPTR
IN200,	AND IN7400
	CLL RTR
	RTR			/COMBINE THE HIGH-ORDER FOUR BITS OF
	TAD INCTLW
	RTR			/THE TWO WORD TO FORM THE THIRD CHARACTER
	RTR
	ISZ INPTR
	JMP INCOMN
ICHAR2,	TAD I INPTR
	AND IN7400
	DCA INCTLW		/SAVE THE HIGH-ORDER BITS FOR THE THIRD CHAR
	ISZ INPTR		/BUMP THE WORD POINTER
ICHAR1,	TAD I INPTR
INCOMN,	AND (377
	TAD (-232
INCTZF,	SNA			/IS THE CHARACTER A ^Z?
	JMP GETNEW		/YES - GET A NEW FILE
	TAD (232		/RESTORE THE CHARACTER
	ISZ ICHAR		/BUMP RETURN TO NORMAL RETURN
INRTRN,	0			/RESTORE CALLING FIELDS
	JMP I ICHAR		/AND RETURN
				/IOPEN IS UNNECESSARY.
INNEWX=JMS INNEWF
INNEWF,	-1
	INCHCT=INNEWF
	CDF 10
	TAD (INDEVH+1
	DCA INHNDL		/INITIALIZE HANDLER ADDRESS
	TAD I INFPTR		/GET NEXT CD INPUT FILE ENTRY
	SNA			/ANY MORE?
	JMP I INNEWF		/NO - OUT OF INPUT
	JMS I IN200
	1			/ASSIGN, FETCH HANDLER
INHNDL,	0
	HLT			/HUH?
	TAD I INFPTR
	AND (7760		/GET LENGTH PART OF WORD
	SZA			/LENGTH OF 0 MEANS LENGTH >=256
	TAD (17		/ADD HIGH-ORDER BITS
	CLL CML RTR
	RTR
	DCA INCTR		/STORE LENGTH OF FILE
	ISZ INFPTR
	TAD I INFPTR
	DCA INREC		/STORE STARTING RECORD NUMBER OF FILE
	ISZ INFPTR
	DCA INEOF		/ZERO END-OF-FILE FLAG
	ISZ INNEWF
	JMP I INNEWF
	INCTR=IOPEN
	*2200
OOPEN,	0
OU7600,	7600
/	RDF
/	TAD OUCDIF
/	DCA OORETN
	TAD OU7601
	DCA OUBLK
	TAD (OUDEVH+1
	DCA OUHNDL
	CDF 10
	TAD I OU7600		/GET DEVICE NUMBER WORD OF OUTPUT FILE ENTRY
	AND (17			/STRIP OFF ANY LENGTH INFO
	SNA			/IS THERE AN OUTPUT DEVICE?
	JMP ONOFIL		/NO - INHIBIT OUTPUT
	JMS I (200
	1			/ASSIGN, FETCH HANDLER
OUHNDL,	0			/OUTPUT DEVICE HANDLER ENTRY
	HLT			/HUH?
OUENTR,	TAD I OU7600
	JMS I (200
	3			/ENTER OUTPUT FILE
OUBLK,	7601			/REPLACED WITH STARTING BLOCK
OUELEN,	0			/REPLACED WITH LENGTH OF HOLE
	JMP OEFAIL		/FAILED - MAYBE WE ASKED TOO MUCH
	DCA OUCCNT
	DCA I (OUTINH	/ZERO OUTPUT INHIBIT FLAG
	JMS I (OUSETP
	ISZ OOPEN
OORETN,	CDF CIF 10		/RESTORE CALLING FIELDS
	JMP I OOPEN
OEFAIL,	TAD I OU7600
	AND (7760		/GET REQUESTED LENGTH
	SNA CLA			/WAS IT AN INDEFINITE REQUEST
	JMP ONTERR		/YES - CANNOT ENTER THE FILE
	TAD I OU7600
	AND (17			/MAKE THE REQUESTED LENGTH ZERO
	DCA I OU7600
	JMP OUENTR		/TRY, TRY AGAIN
ONTERR,	CLA CLL CML RAR
	JMP OORETN		/TAKE THE ERROR RETURN WITH AC<0
ONOFIL,	ISZ I (OUTINH
	JMP OORETN		/TAKE THE ERROR RETURN WITH AC=0
OUTDMP,	0
	DCA OUCTLW		/STORE THE CONTROL WORD
	CDF 10
	TAD I (OUTINH
	SZA CLA
	JMP OUNOWR
	TAD OUCCNT
	SNA
	ISZ OUCTLW
	TAD OUBLK
	DCA OUREC		/COMPUTE THE STARTING BLOCK NUMBER OF THIS TRANSFER
	TAD OUCTLW
	CLL RTL
	RTL
	RTL
	AND (17			/COMPUTE THE NUMBER OF RECORDS
	TAD OUCCNT		/UPDATE THE NUMBER OF BLOCKS IN THE FILE
	DCA OUCCNT
	TAD OUCCNT
	CLL CML
	TAD OUELEN
	SNL SZA CLA		/DOES THE LENGTH EXCEED THE GIVEN LENGTH?
	JMP I OUTDMP		/YES - SIGNAL OUTPUT ERROR
OUCDIF,	CDF CIF 0
	CDF 10
	JMS I OUHNDL
OUCTLW,	0
	OUBUF
OUREC,	0
	JMS I (SLASHG
	.+2-.
OUNOWR,	ISZ OUTDMP		/BUMP OUTDMP TO NORMAL RETURN
	JMP I OUTDMP
OCLOSE,	0
/	RDF
/	TAD OUCDIF
/	DCA OCRET
	CDF 10
	TAD I (OUTINH
	SZA CLA			/IS OUTPUT INHIBITED?
	JMP OCISZ		/YES - CLOSE IS A NOP
	JMS I (OTYPE
	AND (770
	TAD (-PTP		/CHECK FOR PAPER TAPE PUNCH OUTPUT
	SZA CLA			/AND SKIP ^Z OUTPUT IF TRUE
	TAD (232		/OUTPUT A ^Z
	JMS I (OCHAR
	JMP OCRET
	JMS I (OCHAR
	JMP OCRET
FILLLP,	JMS I (OCHAR
	JMP OCRET
	JMS I (OTYPE		/GET TYPE OF OUTPUT DEVICE
	SPA CLA
	TAD (100		/IF ITS A DIRECTORY DEVICE FORCE A RECORD
	TAD (77			/BOUNDARY - OTHERWISE A HALF-RECORD
	AND I (OUDWCT
	SZA CLA			/UP TO THE BOUNDARY YET?
	JMP FILLLP		/NO - FILL WITH ZEROS
	TAD I (OUDWCT		/GET DOUBLEWORD COUNT LEFT
	TAD (OUCTL&3700
	SNA			/A FULL WRITE LEFT?
	JMP NODUMP		/YES - DON'T DO IT - THE ^Z IS ALREADY OUT
	TAD (4000+OUFLD		/PUT IN THE FIELD BITS AND THE WRITE BIT
	JMS OUTDMP
	JMP OCRET		/AN ERROR OCCURRED WHILE DUMPING THE BUFFER
NODUMP,	TAD I OU7600		/GET THE DEVICE NUMBER
	JMS I (200
	4			/CLOSE THE OUTPUT FILE
OU7601,	7601			/POINTER TO THE OUTPUT FILE NAME
OUCCNT,	0
	SKP			/ERROR WHILE CLOSING THE FILE - BAD!
OCISZ,	ISZ OCLOSE
OCRET,	CDF CIF 10		/RESTORE CALLING FIELDS
	JMP I OCLOSE
	*2400
OUSETP,	0			/ROUTINE TO INITIALIZE CHARACTER POINTERS
	TAD (OUCTL&3700		/GET SIZE OF BUFFER IN DOUBLEWORDS
	CIA			/NEGATE IT (PAL10 BLOWS)
	DCA OUDWCT
	TAD (OUBUF
	DCA OUPTR		/INITIALIZE WORD POINTER
	TAD OUJMPE
	DCA OUJMP		/INITIALIZE THREE-WAY CHARACTER SWITCH
	JMP I OUSETP

OCHAR,	0
	AND (377
	DCA OUTEMP
	RDF
	TAD (CDF CIF 0
	DCA OUCRET
	TAD OUTINH
	SZA CLA			/IS THERE AN OUTPUT FILE?
	JMP OUCOMN		/NO - EXIT
OUCHAR,	CDF OUFLD		/SET DATA FIELD TO BUFFER'S FIELD
	ISZ OUJMP		/BUMP THE CHARACTER SWITCH
OUJMP,	HLT			/THREE WAY CHARACTER SWITCH
	JMP OCHAR1
	JMP OCHAR2
OCHAR3,	TAD OUTEMP
	CLL RTL
	RTL
	AND (7400
	TAD I OUPOLD
	DCA I OUPOLD		/UPDATE FIRST WORD OF TWO WITH HIGH
				/ORDER 4 BITS OF THIRD CHAR
	TAD OUTEMP
	CLL RTR
	RTR
	RAR
	AND (7400
	TAD I OUPTR
	DCA I OUPTR		/UPDATE SECOND WORD FROM LOW ORDER 4 BITS
	TAD OUJMPE
	DCA OUJMP		/RESET SWITCH
	ISZ OUPTR
	ISZ OUDWCT		/BUMP DOUBLEWORD COUNTER EVERY 3 CHARS
	JMP OUCOMN
	TAD (OUCTL		/LOAD CONTROL WORD FOR A FULL WRITE
	JMS I (OUTDMP		/DUMP THE BUFFER
	JMP OUCRET		/OUTPUT ERROR - GIVE ERROR RETURN
	JMS OUSETP		/RE-INITIALIZE THE POINTERS
	JMP OUCOMN
OCHAR2,	TAD OUPTR
	DCA OUPOLD		/SAVE POINTER TO FIRST WORD OF TWO
	ISZ OUPTR		/BUMP WORD POINTER TO SECOND WORD
OCHAR1,	TAD OUTEMP
	DCA I OUPTR
OUCOMN,	ISZ OCHAR
OUCRET,	HLT			/RESTORE CALLING FIELDS
	JMP I OCHAR
OUTEMP,	0
OUPOLD,	0
OUPTR,	0
OUJMPE,	JMP OUJMP
OUDWCT,	0
OUTINH,	0

OTYPE,	0
	RDF
	TAD (CDF CIF 0
	DCA OTRTN
	CDF 10
	TAD I (7600
	AND (17
	TAD (DCB-1
	DCA OUTEMP
	TAD I OUTEMP
OTRTN,	HLT
	JMP I OTYPE
CTCTST,	0
	KRS
	TAD (-203
	SNA CLA			/IS THE TELETYPE BUFFER A ^C
	KSF			/WITH THE TELETYPE FLAG ON?
	JMP I CTCTST			/NO
	CDF CIF 0		/YES - GO TO MONITOR
	JMP I (7600		/THROUGH THE "DON'T SAVE CORE" RETURN

SLASHG,	0
	DCA CTCTST
	TAD SQFLAG
	SZA CLA		/ARE WE SQUISHING?
	JMP I (SQIOER	/YES
	TAD CTCTST
	SPA CLA		/ONLY IGNORE HARD ERRORS
	TAD I (MPARAM
	AND (40
	SZA CLA		/ "G" SWITCH
SLGRET,	JMP I SLASHG	/IGNORED!
	TAD I SLASHG
	TAD SLASHG
	DCA SLASHG	/SET UP NON-IGNORE ADDRESS
	TAD CTCTST
	JMP I SLASHG	/RETURN WITH AC RESTORED

DIR,	DCA DTYPE	/SAVE TYPE OF REQUEST
	TAD I (7600
	SZA CLA		/IS THERE AN OUTPUT FILE?
	JMP I (DIRPRE	/YES
	DCA TTYDEV+1
	JMS I (200
	12		/ASSIGN WITHOUT FETCH
TTYDEV,	5524		/COMPRESSED CODE FOR "TTY"
	0
	0
	HLT		/WHAT - NO TELETYPE!
	TAD TTYDEV+1
	DCA I (7600
	JMP I (DIRPRE

	/PIP PROPER BEGINS HERE
	/**********************

	/IMAGE MODE PROCESSOR FOR PIP
	*2600
IMAGE,	JMS I (FIXLEN
	JMS I (OUTOPN
	JMS IMTRA
IMCLOS,	TAD I (OUTINH
	SZA CLA		/WAS THERE AN OUTPUT FILE?
	JMP I (PIP	/NO - DON'T CLOSE IT
	TAD I (OUCCNT	/GET THE LENGTH OF THE OUTPUT FILE
	DCA IMCCNT
	TAD I IM7600
	JMS I (200
	4		/CLOSE
	7601		/FILE NAME
IMCCNT,	0
	JMP I (AOUERR
	JMP I (PIP

ENDFUJ,	0		/PART OF DIRECTORY PRINTING ROUTINE
	JMS I (PRNUM
	TAD (-6
	JMS I (PRWD	/PRINT SIX WORDS
	0006		/ F
	2205		/RE
	0500		/E 
	0214		/BL
	1703		/OC
	1323		/KS
	JMS I (PCRLF
	JMS I (PCRLF	/LEAVE A SPACE BETWEEN DIRECTORIES
	ISZ INEOF	/SIMULATE "END OF FILE" FOR INPUT ROUTINE
	CLA CMA
	DCA I (INCHCT	/AS WELL AS "END OF BUFFER"
	JMP I ENDFUJ

SQTRA,	0
	TAD SQTRA
	DCA IMTRA	/FAKE A CALL TO "IMTRA"
	TAD RECCNT	/SETTING UP THE ARGS TO DO THE SQUISHING FOR US
	DCA I (INCTR
	TAD IHNDLR
	DCA IMHNDL
	TAD INBLK
	DCA IMREC
	TAD OUTBLK
	DCA I (OUCCNT
	DCA INEOF
	JMP IMRCLP

IMTRA,	0
	JMS I (IOPEN	/INITIALIZE INPUT ROUTINE
IMFILP,	JMS I (INNEWF	/SET UP PARAMS FOR NEXT FILE
	JMP I IMTRA	/NO NEXT FILE
	TAD I (INHNDL
	DCA IMHNDL	/GET DEVICE HANDLER ENTRY
	TAD I (INREC
	DCA IMREC	/AND STARTING BLOCK NUMBER
IMRCLP,	TAD I (INCTR
	CLL
	TAD (15
	SNL		/IF LINK IS ON, THERE ARE LESS THAN 16 BLOCKS LEFT
	DCA I (INCTR
	SZL
	ISZ INEOF
	CLL CML CMA RTR
	RTR
	RTR
	TAD (3201	/FORM A FULL OR PARTIAL READ CONTROL WORD
	DCA IMCTLW
	JMS I (CTCTST	/CHECK FOR ^C
	CIF 0
	JMS I IMHNDL
IMCTLW,	0
	OUBUF
IMREC,	0
	JMS I (SLASHG
	IMERRX-.
	TAD IMREC
	TAD (15
	DCA IMREC	/UPDATE BLOCK NUMBER
	CLA CLL CML RAR
	TAD IMCTLW
IMOUT,	JMS I (OUTDMP	/WRITE OUT WHAT WE JUST READ IN
	JMP I (AOUERR	/WRITE ERROR - BAD!
	TAD INEOF
	SZA CLA		/KEEP READING?
	JMP IMFILP	/NO - OPEN THE NEXT FILE
	JMP IMRCLP	/YES
IMHNDL,	0

IMERRX,	ISZ INEOF	/SIGNAL EOF OR WORSE
	SPA CLA		/WHICH ONE IS IT?
	JMP IM7600
	TAD (6377	/MARCH DOWN THROUGH CORE
IMEFLP,	DCA CHAR	/LOOKING FOR THE FIRST NON-ZERO WORD
	CDF 0
	TAD I CHAR
	SZA CLA
	JMP IMNZRO
	CLA CMA CLL
	TAD CHAR
	SZL		/IF WE GO THROUGH THE BUFFER WITHOUT A NON-ZERO WORD
	JMP IMEFLP
IM7600,	7600
	JMS I (PIPERR	/SOMETHING IS WRONG (HANDLER SHOULD HAVE INSERTED
	4		/A ^Z AT LEAST)
IMNZRO,	CDF 10
	TAD CHAR
	CLL CML RAR
	AND IM7600
	TAD (200	/GET THE LENGTH OF THE USEFUL PART OF THE BUFFER
	JMP IMOUT	/AS AN OUTPUT CONTROL WORD AND GO OUTPUT IT
	*3000		/COMPATIBILITY WITH EARLY "PIP"
PIP,	JMP PIPCD	/NORMAL ENTRY/RE-ENTRY - CALL CD
	JMP NOPCD	/ENTRY FROM CHAIN COMMAND - ASSUME CD AREA SET UP
PIPCD,	JMS I (200	/OF COURSE THE MONITOR IS IN CORE!
	5		/COMMAND DECODE
	0		/NO ASSUMED EXTENSIONS ON INPUT
NOPCD,	DCA SQFLAG	/TURN OFF "SQUISH" FLAG
	TAD PIPSNA
	DCA I (INCTZF	/RESET INPUT SWITCH TO DETECT "^Z"'S
	TAD I (MPARAM+1
	AND (40		/"S" SWITCH
	SZA CLA
	JMP I (SQUISH	/IT WAS ON - COMPRESS THE INDICATED DEVICES
	TAD I (MPARAM+2
	RTL
	SZL CLA		/"Z" SWITCH IN THE LINK
	JMS I (DZERO	/ZERO DIRECTORY BEFORE PROCEEDING
	TAD I (MPARAM
	AND (400	/"D" SWITCH
	SZA CLA
	JMS I (DELETE	/DELETE ANY OUPUT FILES BEFORE PROCEEDING
	TAD I (MPARAM
	AND (301	/"E","F" AND "L" SWITCHES
	SZA		/ANY ONE OF THEM ON?
	JMP I (DIR	/YES - LIST A DIRECTORY
	TAD I (7617
	SNA CLA
	JMP PIP		/TERMINATE HERE IF NO INPUT SIDE
	TAD I (MPARAM
	RTL
	AND (40		/"I" SWITCH ROTATED TWO LEFT
	SZA CLA
	JMP I (IMAGE	/IMAGE MODE TRANSFER
	SZL CLA		/NO SKIP IF 'B'.
	JMP I (BINARY

	/DEFAULT MODE OF TRANSFER IS ASCII

ASCII,	TAD I (MPARAM+1
	AND (20
	DCA COPTSW
	TAD COPTSW
	SNA CLA
	JMS I (FIXLEN	/IF WE ARE NOT DOING ANY EDITING THEN
			/TRY TO APPROXIMATE OUTPUT LENGTH
	JMS OUTOPN
	DCA AEOFFG	/ZERO THE END-OF-FILE FLAG
	JMS I (EMM	/CHECK 'M' AND 'W' OPTIONS.
	JMS I (IOPEN	/OPEN THE INPUT FILES
	JMP I (ASCIGO

OUTOPN,	0
	JMS I (OOPEN	/OPEN OUTPUT FILE.
	SMA CLA		/WHAT KIND OF ERROR?
	JMP I OUTOPN	/OPEN OK OR NO FILE TO OPEN
			/ NO DIFFERENCE
	JMS I (PIPERR
	5

	/PART OF ASCII PROCESSOR - CLEAN UP AT END OF LINE AND END OF FILE

LFEED,	TAD CHAR
	DCA I XR	/PUT THE LINE FEED IN THE LINE BUFFER
EOL,	DCA I XR	/MARK THE END OF USEFUL INFO
	JMS I (CTCTST
	TAD (ABUF-1
	DCA XR		/RESET BUFFER POINTER
EOLLP,	TAD I XR	/GET A CHARACTER FROM THE LINE BUFFER
PIPSNA,	SNA		/ZERO MEANS NO MORE CHARS
	JMP EOFTST
	JMS I (OCHAR	/OUTPUT THE CHARACTER
	JMP AOUERR
	JMP EOLLP
EOFTST,	TAD AEOFFG
	SNA CLA		/END OF INPUT ENCOUNTERED?
	JMP I (ASCIGO	/NO - GET NEXT LINE
ACLOSE,	JMS I (OCLOSE	/YES - CLOSE THE OUTPUT FILE
	JMP AOUERR	/ERROR ON CLOSE
	JMP PIP
AOUERR,	SMA CLA		/WAS IT A DEVICE ERROR OR ARE WE OUT OF SPACE?
	JMP BOUERR	/OUT OF SPACE
	JMS I (PIPERR
	2
BOUERR,	JMS I (PIPERR
	0

	/ENTRY ON END OF INPUT
ASCEOF,	SPA CLA		/WAS IT END OF INPUT OR AN INPUT ERROR?
	JMS I (PIPERR	/INPUT ERROR
	4
	ISZ AEOFFG	/SET END-OF-INPUT FLAG
	JMP EOL		/PROCESS LAST LINE (IF ANY)
AEOFFG,	0

	/SUBROUTINE TO OUTPUT RUBOUTS AFTER FORM CONTROL CHARACTERS
RUBOUT,	0		/UNLESS OUTPUT IS TO A DIRECTORY DEVICE
	DCA TEMP	/STORE COUNT
	JMS I (OTYPE	/GET TYPE OF OUTPUT DEVICE
	SPA CLA
	JMP I RUBOUT	/DIRECTORY DEVICE - DON'T BOTHER
RBTLP,	TAD CHAR
	TAD (-214
	SNA CLA		/IS THE FORM CONTROL CHAR A FORM-FEED?
	IAC		/YES - OUTPUT BLANK TAPE INSTEAD
	TAD (377
	DCA I XR	/PUT IN BUFFER
	ISZ TEMP
	JMP RBTLP		/LOOP FOR THE REQUISITE COUNT
	JMP I RUBOUT
COPTSW,	0

DEND,	SPA CLA
	JMP ASCEOF+1
	JMP ACLOSE
	*3200
	/ASCII PROCESSOR CONTINUED

ASCIGO,	TAD (ABUF-2
	DCA XR
	DCA I XR	/PROTECT AGAINST NULL LINE WITH "T" OPTION
	DCA COLCT	/ZERO COLUMN COUNTER FOR TAB CONVERSION
ACHLP,	JMS I (ICHAR	/GET A CHARACTER
	JMP I (ASCEOF	/END OF INPUT OR WORSE
	AND (177	/MASK OUT PARITY BIT
	SNA
	JMP ACHLP	/IGNORE BLANK TAPE AND LEADER/TRAILER
	TAD (-177
	SNA
	JMP ACHLP	/DITTO RUBOUTS
	TAD (377	/FORCE COLUMN 8 ON
	DCA CHAR
	TAD CHAR
	TAD (-216
	CLL
	TAD (5
	SNL		/IS THE CHARACTER A FORM CONTROL CHARACTER?
	JMP CINSRT	/NO
	TAD ASCJMP	/YES - GO TO APPROPRIATE ROUTINE
	DCA .+1
	HLT
ASCJMP,	JMP I .+1
	TAB
	LFEED
	VTAB
	FFEED
	CARRET
CINSRT,	CLA
	TAD CHAR
ADCAXR,	DCA I XR	/STORE THE CHARACTER IN THE LINE BUFFER
	ISZ COLCT	/ALWAYS BUMP THE COLUMN POINTER
TESTXR,	TAD XR
	TAD (-ABUF-226
	SPA CLA		/HAS THE BUFFER OVERFLOWED?
	JMP ACHLP	/NO - GET NEXT CHARACTER
	JMS I (PIPERR
	1
TAB,	TAD I (COPTSW
	SNA CLA		/DO WE WANT TO CONVERT?
	JMP TABRBT	/NO
TABLP,	TAD (240
	DCA I XR	/OUTPUT A SPACE
	ISZ COLCT
	TAD COLCT
	AND (7
	SZA CLA		/IS THE COLUMN COUNTER A MULTIPLE OF 8?
	JMP TABLP	/NOT YET
	JMP TESTXR	/YES - CHECK BUFFER OVERFLOW
TABRBT,	TAD CHAR
	DCA I XR
	CLA CMA
	JMS I (RUBOUT	/TWO RUBOUTS FOLLOW A TAB
	JMP TESTXR	/CHECK FOR BUFFER OVERFLOW
VTAB,	TAD I (COPTSW
	SZA CLA		/SHOULD WE CONVERT?
	JMP VTLF	/YES
	TAD CHAR
	DCA I XR
	TAD (-4
	JMS I (RUBOUT	/FOUR RUBOUTS AFTER A VERTICAL TAB
	JMP I (EOL
FFLF,	TAD (-4		/NINE LINE FEED SIMULATE A FORM FEED
VTLF,	TAD (-5		/FIVE LINE FEEDS SIMULATE A VERTICAL TAB
	DCA TEMP
	TAD (212
	DCA I XR
	ISZ TEMP
	JMP .-3
	JMP I (EOL	/FORM FEED AND VERTICAL TAB ARE LINE ENDERS

FFEED,	TAD I (COPTSW
	SZA CLA		/SHOULD WE CONVERT?
	JMP FFLF	/YES
	TAD CHAR
	DCA I XR
	TAD (-11	/NINE RUBOUTS AFTER A FORM FEED
	JMS I (RUBOUT
	JMP I (EOL
CARRET,	TAD I (MPARAM
	RTL
	SMA CLA		/"C" SWITCH MEANS DELETE TRAILING BLANKS FROM CARDS

	JMP NOTOPT	/IT WASN'T ON
TOPT,	TAD XR
	DCA TEMP
	TAD I TEMP
	TAD (-240
	SZA CLA		/WAS THE LAST CHAR ON THE LINE A SPACE?
	JMP NOTOPT	/NO
	CLA CMA
	TAD XR		/YES - BACK UP THE LINE POINTER
	DCA XR
	JMP TOPT
NOTOPT,	TAD CHAR
	DCA I XR	/STORE THE CARRIAGE RETURN IN THE BUFFER
	JMP TESTXR	/CARRIAGE RETURN IS NOT A LINE TERMINATOR
COLCT,	0
	*3400
	/SUBROUTINES CALLED BY THE REST OF PIP
DELETE,	0		/DELETES THE FILES ON THE OUTPUT SIDE OF THE CD LIST
	TAD (7600
	DCA DPFILE
	CLA CLL CMA RTL
	DCA CHAR	/MAXIMUM OF THREE OUTPUT FILES
DELOOP,	TAD (OUDEVH+1
	DCA DLHNDL
	TAD I DPFILE
	SNA		/DOES THIS FILE EXIST?
	JMP I DELETE	/NO - THATS ALL
	JMS I (200
	1		/ASSIGN HANDLER FOR THE DELETION
DLHNDL,	0
	HLT
	TAD I DPFILE	/RELOAD DEVICE NUMBER FOR DELETE
	ISZ DPFILE	/BUMP DPFILE TO POINT TO THE FILE NAME
	JMS I (200	/DEVICE NUMBER IN AC
DP4,	4		/CLOSE - USED AS DELETE IN THIS CASE
DPFILE,	0		/POINTER TO FILE NAME
	0		/ZERO LENGTH FOR DELETE
	JMS I (PIPERR	/FILE WASN'T THERE TO BE DELETED
	3
	TAD DPFILE
	TAD DP4
	DCA DPFILE
	ISZ CHAR
	JMP DELOOP	/DELETE AS MANY FILES AS HE LISTED(UP TO 3)
	JMP I DELETE

DZERO,	0		/SUBROUTINE TO ZERO THE DIRECTORY OF THE
			/FIRST OUTPUT DEVICE
	JMS I (OTYPE
	CLL RTL
	SZL		/IS DEVICE READ-ONLY?
	JMP OZERR	/YES - ERROR
	RTR
	AND (770	/MASK OUT DEVICE TYPE
	CLL RTR
	RAR
	TAD (DEVLEN	/USE IT TO INDEX A TABLE OF DEVICE LENGTHS
	DCA TEMP
	TAD I TEMP
	SNA
	JMP I DZERO	/DEVICE LENGTH ZERO MEANS NON-DIRECTORY DEVICE
	DCA TEMP	/STORE LENGTH
	TAD (OUDEVH+1
	DCA OZHNDL
	TAD I (7600
	JMS I (200
	1		/ASSIGN DEVICE, FETCH HANDLER
OZHNDL,	0
	HLT
	TAD OZHNDL
	TAD (171
	SNA CLA		/IS THE DEVICE EQUIVALENT TO "SYS"?
	JMS I (RUSURE	/YES,TEST USER'S RESOLUTION.
	TAD (7		/FILE ORIGIN FOR NON-SYSTEMS DEVICE
	DCA DFORG
	TAD TEMP
	TAD DFORG
	DCA DLENGT
	TAD I (MPARAM+3
	CIA
	DCA DWASTE	/DEFINE THE NUMBER OF WASTE WORDS
	CIF 0
	JMS I OZHNDL
	4210		/OUTPUT 1 BLOCK FROM FIELD 1
	DIRECT
	1		/ALL DIRECTORIES ARE IN RECORD 1
OZERR,	JMS I (PIPERR	/ERROR WHILE ZEROING DIRECTORY
	2
	DCA OLDDIR	/ZERO DIRECTORY POINTER TO FORCE A NEW READ
	JMP I DZERO

PIPERR,	0
	CLA
	CDF 10		/JUST IN CASE
	TAD I PIPERR	/GET ARG
	TAD (ERRTBL
	DCA TEMP
	TAD I TEMP
	JMS I (ERPRNT
	JMP I (PIP	/RESTART PIP

TTYOUT,	0
	TLS
	TSF
	JMP .-1
	CLA
	JMP I TTYOUT	/NOT DEVICE INDEPENDENT - TOUGH BLEEP

LEADER,	0
	JMS I (OTYPE
	AND (770	/GET THE TYPE OF THE OUTPUT DEVICE
	TAD (-PTP	/IS IT A PAPER TAPE PUNCH?
	SZA CLA
	JMP I LEADER	/NO
	TAD (7600
	DCA TEMP
	JMS I (OCHAR	/PUT OUT SOME LEADER
	JMP I (AOUERR
	ISZ TEMP
	JMP .-3
	JMP I LEADER

DIRECT,	-1		/DUMMY DIRECTORY FOR /Z OPTION
DFORG,	0		/FILE OROGIN
	0		/LINK
	0		/FLAG
DWASTE,	0	/NUMBER OF GARBAGE WORDS
	0		/UNUSED SPACE
DLENGT,	0		/LENGTH OF UNUSED SPACE
	*3600
	/TABLE OF DEVICE LENGTHS FOR /Z OPTION

DEVLEN,	0;0;0;0;0;1520	/RK08 (1520= - DECIMAL 3248)
	6000;4000;2000;0001	/RF08 IN VARIOUS SIZES
			/(CHEATS A BLOCK ON LARGEST TO KEEP IT NON-ZERO)
	7601;7401;7201;7001	/DF32 IN VARIOUS SIZES
				/(CHEATS A BLOCK TO AVOID HARDWARE TROUBLE)
	6437;6437		/DECTAPE AND LINCTAPE
	ZBLOCK 60		/OTHER DEVICES


FIXLEN,	0		/ROUTINE TO ESTIMATE OUTPUT FILE LENGTH
	TAD I (7600
	AND (7760
	SZA CLA		/DID THE USER PROVIDE AN ESTIMATE?
	JMP I FIXLEN	/YES - USE IT
	DCA CHAR
	TAD (7617
	DCA TEMP
FIXLP,	TAD I TEMP	/GET NEXT INPUT FILE
	SNA
	JMP FIXOVR	/NO MORE INPUT FILES
	AND (7760
	CIA CLL		/GET LENGTH AS A POSITIVE NUMBER
			/(LENGTH OF ZERO TURNS LINK ON)
	TAD CHAR
	DCA CHAR	/UPDATE CUMULATIVE LENGTH
	SZL CLA		/DID CUMULATIVE LENGTH OVERFLOW 256 BLOCKS?
	JMP I FIXLEN	/YES - CAN'T ESTIMATE IT
	ISZ TEMP
	ISZ TEMP
	JMP FIXLP
FIXOVR,	TAD CHAR
	TAD I (7600
	DCA I (7600	/STICK LENGTH IN OUTPUT FILE DESCRIPTOR
	JMP I FIXLEN

PWRTEN,	-1750;-144;-12;-1;0

RUSURE,	0	/IS USER REALLY SURE?
	TAD (SURE
	JMS I (ERPRNT	/TYPE OUT "ARE YOU SURE?"
	KSF
	JMP .-1		/WAIT FOR REPLY
	JMS I (CTCTST	/WAS REPLY ^C? RETURN TO MONITOR
	KRB
	TAD (-"Y
	SNA CLA
	ISZ SQFLAG	/IT WAS "YES"!
	TAD SQFLAG
	CLL RAL
	TAD	(NOYES
	JMS I (ERPRNT	/PRINT "NO" OR "YES"
	TAD SQFLAG
	SNA CLA		/WELL, DO WE OR DON'T WE?
	JMP I (PIP	/WE DON'T
	TAD (61
	JMP I RUSURE	/BE SURE TO CLA AFTER THIS IF YOU
			/DONE LIKE THE 61 IN THE ACC!

NOYES,	TEXT	/NO/
	TEXT	/YES/
	/DIRECTORY PRINTER FOR PIP
	MDATE=7666
	*4000
DIRPRE,	JMS I (OUTOPN	/OPEN THE OUTPUT FILE
	TAD (ABUF
	DCA CHAR	/ABUF WILL BE A TEMPORARY ARRAY OF STARTING FILES
	TAD (7617
	DCA TEMP
	TAD I (7617
	SNA
	JMS I (DSKNUM
	DCA I (7617	/DEFAULT DIRECTORY IS DSK:
DFUJLP,	TAD I TEMP
	SNA		/ARE WE THROUGH WITH THE INPUT DEVICES?
	JMP GETDIR	/YES
	AND (17
	DCA I TEMP	/ONLY THE DEVICE NUMBER IS IMPORTANT
	TAD I TEMP
	TAD (DCB-1
	DCA PRWD
	CLA CLL CML RTL
	TAD TEMP
	DCA INFPTR	/THIS SERVES NO FUNCTION EXCEPT IMPROVING ERROR MESSAGES
	TAD I PRWD
	SMA CLA		/IS THE DEVICE A DIRECTORY DEVICE?
	JMS I (PIPERR	/NO
	6
	ISZ TEMP
	TAD I TEMP
	DCA I CHAR	/SAVE THE STARTING BLOCK NUMBER
	CLA IAC
	DCA I TEMP	/READ FROM THE DIRECTORY
	ISZ TEMP
	ISZ CHAR
	JMP DFUJLP
GETDIR,	TAD (ABUF
	DCA CHAR
	JMS PCRLF
	TAD I (MDATE
	JMS I (PDATE
	JMS PCRLF
	JMS I (IOPEN	/RESET POINTERS - WERE GONNA FAKE OUT THOSE "GENERAL"
			/ROUTINES
	JMP I (NXTDIR
PRWD,	0	/ROUTINE TO PRINT SIXBIT TEXT
	SNA		/IS COUNT ZERO?
	CMA		/MAKE IT ONE
	DCA PRCT	/STORE COUNT
PRWDLP,	TAD I PRWD
	RTR
	RTR
	RTR
	JMS PR6BIT
	TAD I PRWD
	JMS PR6BIT
	ISZ PRWD
	ISZ PRCT
	JMP PRWDLP
	JMP I PRWD
PRCT,	0
PR6BIT,	0
	AND (77
	SZA
	TAD (-40
	SPA
	TAD (100
	TAD (240	/CONVERT SIXBIT TO ASCII
	JMS I POCHAR
	JMP I (AOUERR
	JMP I PR6BIT
PRNUM,	0
	DCA PRWD
	DCA TEMP
	TAD (PWRTEN
	DCA PCRLF
PRNMLP,	DCA PR6BIT
	TAD I PCRLF
	SNA
	JMP I PRNUM
	CLL
	TAD PRWD
	SNL
	JMP .+4
	DCA PRWD
	ISZ PR6BIT
	JMP PRNMLP+1
	CLA
	TAD PR6BIT
	TAD TEMP
	SNA
PBLJMP,	JMP PRBLNK	/INCREMENTED BY PDATE TO KILL LEADING BLANKS
	TAD (260
	JMS PR6BIT
	CLA CLL CML RAR
	DCA TEMP
	ISZ PCRLF
	JMP PRNMLP
PRBLNK,	JMS PR6BIT
	JMP .-3
PCRLF,	0
	TAD (215
	JMS I POCHAR
	JMP I (AOUERR
	TAD (212
	JMS I POCHAR
	JMP I (AOUERR
	JMP I PCRLF
POCHAR,	OCHAR
	/MAIN DIRECTORY PRINTING LOOP
	*4200
NXTDIR,	JMS I (ICHAR	/FAKE, FAKE
	JMP I (DEND
	CLA		/WE DON'T WANT THE CHARACTER
	DCA ECOUNT
	TAD (INBUF-1	/WE WANT THE BUFFER!
NEWSEG,	DCA XR
	CDF 0
	TAD I XR
	DCA DCOUNT	/NUMBER OF ENTRIES
	TAD DCOUNT
	CLL
	TAD (100
	SNL CLA
	JMS I (PIPERR
	11
	TAD I XR
	DCA BLOKNO	/FIRST BLOCK OF FILE STORAGE
	TAD I XR
	DCA DLINK	/LINK TO NEXT SEGMENT
	ISZ XR		/BUMP XR PAST FLAG WORD
	TAD I XR
	DCA WASTE
NAMELP,	CDF 0
	TAD I XR
	SNA		/WHAT TYPE OF ENTRY IS IT?
	JMP DEMPTY	/A FREE FILE
	DCA NAME1	/A PERMENANT OR TENTATIVE FILE
	TAD I XR
	DCA NAME2
	TAD I XR
	DCA NAME3
	TAD I XR
	DCA NAME4
	TAD I XR
	DCA DDATE
	TAD WASTE	/COMPENSATE FOR THE DATE INCREMENT
	CMA		/AND THE WASTE WORDS
	TAD XR
	DCA XR
	TAD I XR
	SNA		/IS IT A TENTATIVE FILE?
	JMP ADDLEN+1	/YES - TENTATIVE FILES ARE ALWAYS IGNORED
	CIA
	DCA FLENGT	/NO - STORE THE LENGTH
	CDF 10
	TAD I CHAR	/GET THE STARTING FILE FOR THIS LISTING
	CIA CLL
	TAD BLOKNO
	SNL CLA		/ARE WE THERE YET?
	JMP ADDLEN	/NO - KEEP GOING
	CLA CLL CMA RTL
	JMS I (PRWD	/PRINT THREE WORDS
NAME1,	0
NAME2,	0
NAME3,	0
	TAD NAME4
	SNA CLA		/IS THERE AN EXTENSION?
	TAD (-16	/NO - PRINT A BLANK
	TAD (56		/YES - PRINT A PERIOD
	JMS I (PR6BIT
	JMS I (PRWD
NAME4,	0		/ZERO PRINTS AS TWO MORE BLANKS
PRLNGT,	TAD DTYPE
	AND (100
	SZA CLA		/WAS THE LISTING SWITCH /F?
	JMP PRTCRL	/YES - DON'T PRINT LENGTH
	TAD FLENGT
	JMS I (PRNUM
	TAD WASTE
	SZA CLA
	TAD DDATE
	JMS I (PDATE	/PRINT THE CREATION DATE OF THE FILE
PRTCRL,	JMS I (PCRLF
ADDLEN,	TAD FLENGT
	TAD BLOKNO
	DCA BLOKNO	/UPDATE BLOCK NUMBER
	ISZ DCOUNT
	JMP NAMELP	/LOOP UNTIL ALL FILES ARE PROCESSED
	TAD DLINK
	SNA CLA		/MULTI-SEGMENT DIRECTORY?
	JMP ENDDIR	/NO - FINISH UP
	TAD XR
	AND (7400
	TAD (377	/BUMP XR TO NEXT BLOCK
	JMP NEWSEG	/PROCESS NEXT LINK
DEMPTY,	TAD I XR
	CIA
	DCA FLENGT	/STORE LENGTH OF FREE ENTRY
	CDF 10
	TAD FLENGT
	TAD ECOUNT
	DCA ECOUNT	/BUMP COUNT OF FREE BLOCKS
	TAD DTYPE
	AND (200
	SNA CLA		/IS THE /E SWITCH ON?
	JMP ADDLEN	/NO - DON'T LIST FREE FILES
	TAD (-4
	JMS I (PRWD
	TEXT	/<EMPTY>/
	JMS I (PR6BIT
	TAD FLENGT
	JMS I (PRNUM
	JMP PRTCRL
ENDDIR,	ISZ CHAR	/BUMP TEMP ARRAY TO NEXT ENTRY
	TAD ECOUNT
	JMS I (ENDFUJ
	JMP NXTDIR

	FLENGT=24
	BLOKNO=25
	ECOUNT=26
	DTYPE=27
	DCOUNT=30
	DLINK=31
	WASTE=32
	DDATE=33

	*4400
		/BINARY MODE PROCESSOR FOR PIP
BIN360,	360
BINARY,	JMS I (FIXLEN
	JMS I (OUTOPN
	JMS I (EMM	/CHECK 'M' AND 'W' OPTIONS.
	JMS I (IOPEN
	JMS LTCODE
NEWTAP,	JMS I (ICHAR
	JMP BEOF		/END OF FILE ON INPUT
	SNA
	JMP NEWTAP	/BLANK TAPE - KEEP GOING
	TAD BN7600
	SZA CLA
	JMP NEWTAP
	JMS I (ICHAR
	JMP BEOF
	TAD BN7600
	SNA
	JMP .-4
	TAD BIN200
	DCA CHAR
	TAD CHAR
BIN200,	AND BIN360
	TAD (-240	/CHECK TYPE OF BINARY TAPE
	SNA
	JMP RELBIN	/RELOCATABLE BINARY TAPE
	TAD (140
	AND (7700
	SZA CLA		/IS THE FRAME AN ORIGIN?
	JMP NEWTAP	/IT AINT NUTHIN - CONTINUE
	CLA CMA
	JMS LTCODE	/ABSOLUTE TAPE - PUT OUT SHORT LEADER/TRAILER
ABSBIN,	JMS RCOPY1	/COPY THIS FRAME AND READ NEXT
	TAD BN7600
BNM140,	SZA CLA		/IS IT TRAILER?
	JMP ABSBIN	/NO - KEEP GOING
BEOT,	CLA CMA		/END OF TAPE
	JMS LTCODE	/PUT OUT SHORT LEADER/TRAILER
	JMP NEWTAP	/GET NEXT TAPE

LTCODE,	0		/SUBROUTINE TO PUNCH 200 CODE
	SMA		/SHORT LEADER/TRAILER?
	JMS I (OTYPE
	SPA CLA		/DIRECTORY DEVICE?
	TAD (70	/YES
	TAD (-100
	DCA TEMP
LTLOOP,	TAD BIN200
	JMS I (OCHAR	/OUTPUT 64 OR 8 FRAMES OF L/T CODE
	JMP I (AOUERR
	ISZ TEMP
	JMP LTLOOP
	JMP I LTCODE

RELBIN,	TAD (SKP
	DCA I (INCTZF	/DISABLE CONTROL-Z CHECKING ON INPUT
	CLA CMA
	JMS LTCODE	/PUT OUT SHORT LEADER/TRAILER
RELLP,	TAD CHAR
	RTR
	RTR
	AND (17
	TAD (RELTBL
	DCA TEMP
	TAD I TEMP	/GET DATA WORD FOR THIS FRAME
	SMA SZA		/POSITIVE MEANS SPECIAL OR ERROR
	JMP RELERR
RELSNA,	SNA
	JMP RELEND	/ZERO MEANS CHECKSUM FRAME
	DCA TEMP	/NEGATIVE MEANS COUNT OF NUMBER OF SLAVE FRAMES
	JMS RCOPY1
BN7600,	7600
	ISZ TEMP
	JMP .-3	/COPY THIS FRAME AND ALL SLAVE FRAMES
	JMP RELLP	/GET NEXT CONTROL FRAME
RELEND,	JMS RCOPY1	/COPY THE FIRST FRAME OF THE CHECKSUM
	JMS I (OCHAR
	JMP I (AOUERR	/OUTPUT THE SECOND FRAME
	JMP BEOT	/END TAPE - START NEXT ONE
BEOF,	JMS LTCODE
	JMS I (OCLOSE
	JMP I (AOUERR
	JMP I (PIP

RCOPY1,	0		/ROUTINE TO ADVANCE "CHAR" TO NEXT INPUT CHARACTER
	TAD CHAR
	JMS I (OCHAR
	JMP I (AOUERR
	JMS I (ICHAR
	JMP INEFER
	DCA CHAR
	TAD CHAR
	JMP I RCOPY1
INEFER,	JMS I (PIPERR
	7
RELERR,	CLL RAR
	SZA CLA		/CODE OF 1 MEANS SPECIAL
	JMS I (PIPERR	/ILLEGAL RELOCATABLE INPUT
	10
	JMS RCOPY1
	CLL CML CMA RTL	/MULTIPLY NAME COUNT BY -6 (APPROXIMATELY)
	TAD CHAR
	CLL CML RAL	/(ACTUALLY THIS PRODUCES -6X-1 WHICH IS WHAT WE WANT)
	JMP RELSNA


	*4600
ERPRNT,	0		/ERROR MESSAGE PRINTOUT ROUTINE
	DCA TEMP
ERLP,	TAD I TEMP
	RTR
	RTR
	RTR
	JMS ERPCH	/PRINT HIGH-ORDER CHARACTER
	TAD I TEMP
	JMS ERPCH	/PRINT LOW-ORDER CHARACTER
	ISZ TEMP
	JMP ERLP

ERPCH,	0
	AND (77
	SNA
	JMP ERCRLF	/0 CHARACTER TERMINATES
	TAD (-37
	SNA
	JMP FILENR	/"_" CHARACTER IS SPECIAL
	SPA
	TAD (100
	TAD (237
	JMS I (TTYOUT
	JMP I ERPCH
FILENR,	TAD ("#
	JMS I (TTYOUT
	TAD INFPTR	/GET PTR TO CURRENT INPUT FILE
	TAD (321	/MAGIC NUMBER
	CLL RAR
	JMP FILENR-2

ERCRLF,	TAD (215
	JMS I (TTYOUT
	TAD (212
	JMS I (TTYOUT
	JMP I ERPRNT

PDATE,	0		/PRINTS THE DATE
	SNA
	JMP I PDATE	/NO DATE TO PRINT
	DCA ERPRNT
	ISZ I (PBLJMP
	JMS I (PR6BIT
	TAD ERPRNT
	CLL RTL
	RTL
	RAL
	AND (17
	JMS I (PRNUM
	TAD (57
	JMS I (PR6BIT
	TAD ERPRNT
	RTR
	RAR
	AND (37
	JMS I (PRNUM
	TAD (57
	JMS I (PR6BIT
	TAD ERPRNT
	AND (7
	TAD (106
	JMS I (PRNUM
	CLA CMA
	TAD I (PBLJMP
	DCA I (PBLJMP	/RESET PRNUM TO PRINT LEADING SPACES
	JMP I PDATE

DSKNUM,	0
	DCA DSKNAM+1
	JMS I (200
	12
DSKNAM,	5723
	0
	0
	HLT
	TAD DSKNAM+1
	JMP I DSKNUM

RELTBL,	-2;-2;2;-10;-2;-2;-2;2;0;2;-2;2;2;2;2;1

ERRTBL,	ERR0
	ERR1
	ERR2
	ERR3
	ERR4
	ERR5
	ERR6
	ERR7
	ERR8
	ERR9
	ERR10

ERR2,	TEXT	/OUTPUT ERROR/

	*5000

		/ERROR MESSAGE TEXT GOES HERE


ERR0,	TEXT	/NO ROOM FOR OUTPUT FILE/
ERR1,	TEXT	/LINE TOO LONG IN FILE_/
ERR3,	TEXT	/ERROR DELETING FILE/
ERR4,	TEXT	/INPUT ERROR, FILE_/
ERR5,	TEXT	/CAN'T OPEN OUTPUT FILE/
ERR6,	TEXT	/DEVICE_ NOT A DIRECTORY DEVICE/
ERR7,	TEXT	/PREMATURE END OF FILE, FILE_/
ERR8,	TEXT	/ILLEGAL BINARY INPUT, FILE_/
ERR9,	TEXT	/BAD DIRECTORY ON DEVICE_/
ERR10,	TEXT	/DIRECTORY ERROR/

	*5200
		/SQUISH PROCESSOR
SQUISH,	JMS I (RUSURE	/TEST USER'S RESOLUTION!
	CLA CLL
	DCA I (OUELEN	/INITIALIZE PARAMS TO FAKE OUT "IMTRA"
	DCA I (OUBLK
	DCA I (7621	/ZERO SECOND FILE FOR "INNEWF"
	DCA I (CTCFLG
	JMS I (IOPEN
	JMS I (INNEWF
	JMP I (PIP	/NO INPUT
	TAD (OUDEVH+1
	DCA SOHND
	TAD I (7600
	SNA
	JMP I (PIP	/NO OUTPUTEE, NO SQUISHEE
	JMS I (200
	1
SOHND,	0
	HLT
	TAD I (7617
	AND (17
	TAD (DCB-1
	DCA TEMP
	TAD I TEMP
	SMA CLA
	JMS I (PIPERR
	6		/NOT A DIRECTORY DEVICE
	JMS I (OTYPE
	CLL RTR
	RAR
	AND (77
	TAD (DEVLEN
	DCA TEMP
	TAD I TEMP	/GET ENTRY FROM DEVICE LENGTH TABLE
	DCA OUDLEN	/SAVE OUTPUT DEVICE LENGTH
	TAD I (MPARAM+3
	CIA
	DCA OUWAST
	TAD SOHND
	DCA OHNDLR
	TAD OHNDLR
	DCA I (OUHNDL
	TAD I (INHNDL
	DCA IHNDLR
	TAD CDIF10
	CDF 0
	DCA I (7600
	TAD (5602
	DCA I (7601
	TAD (SQCTLC
	DCA I (7602
CDIF10,	CDF CIF 10
	JMS I (CTCFLG
	CIF 0
	JMS I IHNDLR
	1400
	0
P1,	1
	JMP I (SQIDER+1
	CIF 0
	JMS I (7607
	5400
	0
	MTEMP		/MOVE THE INPUT DIRECTORY TO SYS:
	JMP I (SQIDER+1
	CLA IAC
	DCA I (SQBUF2+2
	DCA I (CTCFLG
	CDF 0
	TAD I P1
	CDF 10
	DCA OUTBLK
	TAD SOHND
	CLL
	TAD (177
	SNL CLA
	JMP .+3
	TAD (70		/TRY NOT TO DESTROY THE SYSTEM DEVICE
	DCA OUTBLK
	TAD IHNDLR
	CIA
	TAD OHNDLR
	SNA CLA
	IAC
	DCA SAME
	CLA CMA
	DCA I (SQBUF2
	DCA I (OUTSEG
	JMP I (NEWOUT

	*5400
NEWIN,	TAD (MTEMP-1
	DCA INSEG
	JMS I (CTCFLG
	CIF 0
	JMS I (7607
	0210
S7200,	SQBUF2
INSEG,	0
	JMP I (SQIDER
	DCA I (CTCFLG
	TAD I (SQBUF2+1
	DCA INBLK
	TAD (SQBUF2+4
	DCA INXR
SGETIN,	TAD I INXR
	SNA
	JMP SEMPTY
	DCA I OUTXR
	TAD OUTXR
	DCA OUSAVE
	CLA CLL CMA RTL
	TAD OUWAST
	DCA TEMP
	TAD I INXR
	DCA I OUTXR
	ISZ TEMP
	JMP .-3
	TAD I (SQBUF2+4
	CIA
	TAD OUWAST
	TAD INXR
	DCA INXR
	TAD I INXR
	SNA
	JMP SNULL
	DCA RECCNT
	TAD RECCNT
	CIA CLL
	TAD OUTBLK
	TAD OUDLEN
	SZL CLA
	JMP SNULER
	TAD RECCNT
	DCA I OUTXR
	CLA CMA
	TAD I (SQBUF1
	DCA I (SQBUF1
	TAD INBLK
	CIA
	TAD OUTBLK
	SNA CLA
	TAD SAME
	SNA CLA
MOVFIL,	JMS I (SQTRA	/MOVE THE FILE DOWN
	TAD RECCNT
	CIA
	TAD OUTBLK
	DCA OUTBLK
	TAD RECCNT
DMTX,	CIA
	TAD INBLK
	DCA INBLK
	TAD OUTXR
	CIA
	TAD OUWAST
	TAD OUWAST
	TAD (SQBUF1+365
	SMA CLA		/DO WE HAVE ROOM FOR TWO MORE ENTRIES?
	JMP NEXTIN

	/DIRECTORY SEGMENT OVERFLOW ON OUTPUT...

	ISZ I (OUTSEG
	TAD I (OUTSEG
	IAC
	DCA I (SQBUF1+2	/STORE LINK TO NEXT SEGMENT
	TAD I (SQBUF1+2
	TAD (-7
	SMA CLA
	JMP I (SQIDER-1	/TOO MANY SEGMENTS
	JMS I (OUTDIR	/OUTPUT THIS SEGMENT
NEWOUT,	TAD (SQBUF1-1
	DCA OUTXR	/INITIALIZE XR FOR NEXT OUTPUT SEGMENT
	DCA I (OUTINH	/ZAP ANY OLD OUTPUT INHIBIT FLAG
	DCA I OUTXR
	TAD OUTBLK
	DCA I OUTXR
	DCA I OUTXR
	DCA I OUTXR
	TAD OUWAST
	DCA I OUTXR
NEXTIN,	ISZ I S7200
	JMP SGETIN
	TAD I (SQBUF2+2
	SNA		/ANY MORE INPUT SEGMENTS?
	JMP I (SQOVER
	JMP NEWIN
SNULER,	TAD (NOROOM
	JMS I (ERPRNT
SNULL,	CLA CMA
	TAD OUSAVE
	DCA OUTXR
	JMP	NEXTIN
SEMPTY,	TAD I INXR
	JMP DMTX
OUSAVE,	0
	*5600
SQOVER,	DCA I OUTXR
	TAD OUDLEN
	TAD OUTBLK
	SNA
	JMP CKZERO
		DCA I OUTXR
	CLA CMA
	TAD I (SQBUF1
	DCA I (SQBUF1
CKZERO,	TAD I (SQBUF1
	SZA CLA
	JMP ZEROK
	CLA CLL CML RAR
	JMS OUTDIR	/READ IN LAST DIRECTORY
	DCA I (SQBUF1+2	/ZERO OUT LINK WORD
	SKP
ZEROK,	ISZ OUTSEG
	JMS OUTDIR
ZEROKS,	JMS SRSTOR
	JMP I (PIP

	DCA I (SQBUF1+2
SQIDER,	JMS OUTDIR
	JMS SRSTOR
	JMS I (PIPERR
	12
OUTDIR,	0
	TAD (4210
	DCA .+4
	JMS CTCFLG
	CIF 0
	JMS I OHNDLR
	0
	SQBUF1
OUTSEG,	0
	JMP SQIDER+1
	DCA CTCFLG
	JMP I OUTDIR

SQIOER,	TAD (IOMSG
	JMS I (ERPRNT
	JMP I (SLGRET

SQCTLC,	KCC		/JUMPED TO BY CODE AT 07600
	TAD SAME
	SNA CLA
	JMP ZEROKS
	TAD (CTCMSG
	JMS I (ERPRNT
	TAD CTCFLG
	SZA CLA
	JMP I CTCFLG
	JMP I (MOVFIL

SRSTOR,	0
	TAD (4207
	CDF 0
	DCA I (7600
	TAD (5000
	DCA I (7601
	DCA I (7602
	CDF 10
	JMP I SRSTOR

CTCFLG,	0
	JMP I CTCFLG

CTCMSG,	TEXT	/SORRY - NO INTERRUPTIONS/
IOMSG,	TEXT	/I-O ERROR - CONTINUING/
SURE,	TEXT	/ARE YOU SURE?/
NOROOM,	TEXT	/NO ROOM - CONTINUING/
PAGE

IFNDEF JCA <XLIST
		EJECT>
/M AND W OPTION PROCESSOR.
/M OPTION PUNCHES LEGIBLE DATE (IF ANY)
/W OPTION PUNCHES LEGIBLE MESSAGE CONTAINED IN 1ST
/INPUT FILE (IF ANY), AND SIPHONS THE REST OF THE FILES
/DOWN, THEN CALLS THE 'LEADER' ROUTINE BEFORE RETURNING.

EMM,	0
	TAD I (MPARAM+1	/2ND OPTION WORD.
	SPA CLA		/SKIP IF NO 'M' OPTION
	JMS DPUNCH
	TAD I (MPARAM+1
	RTR		/'W' INTO LINK
	SNL CLA		/SKIP IF 'W' OPTION
	JMP NOTW
	TAD I (7617
	SNA CLA		/SKIP IF ANY INPUT FILES
	JMP I (PIP
	JMS I (IOPEN
	JMS I (ICHAR	/GET 1ST CHARACTER
	 JMP I (PIP	/NO INPUT FILE!
	JMS LPUNCH
	TAD (NOP
	DCA I (GETNEW
	JMS I (ICHAR
	JMP .+3		/END OF 1ST FILE.
	JMS LPUNCH
	JMP .-3
	TAD (INNEWX
	DCA I (GETNEW
SIPHON,	TAD (7616
	DCA 10
	TAD (7620
	DCA 11
	TAD (-22
	DCA WCNTR
	TAD I 11
	DCA I 10	/SIPHON FILES.
	ISZ WCNTR
	JMP .-3
NOTW,	JMS I (LEADER
	JMP I EMM

/DPUNCH PUNCHES THE DATE IN LEGIBLE FORM.

WCNTR,
DPUNCH,	0
	JMS LPUNCH	/VERY SHORT LEADER.
	TAD (LPUNCH
	DCA I (POCHAR	/FAKE OUT PR6BIT.
	TAD (NOP
	DCA I (PR6BIT+10	/FAKE OUT ERROR EXIT
	TAD I (MDATE
	JMS I (PDATE	/PUNCH DATE
	TAD (5760	/TEMPORARY!!!!!!!!!!!!!!!!!!!
	DCA I (PR6BIT+10	/RESTORE ERROR EXIT.
	TAD (OCHAR
	DCA I (POCHAR	/RESTORE PR6BIT.
	JMS LPUNCH	/ANOTHER VERY SHORT LEADER.
	JMP I DPUNCH

/LPUNCH PUNCHES A PAPER-TAPE LEGIBLE CHARACTER
/ON THE OUTPUT DEVICE.

LPUNCH,	0
	TAD (-240	/ASSUME ASCII INPUT.
	SPA		/SKIP IF PRINTING CHAR.
	CLA CLL
	CLL RAL		/*2
	TAD (TABLE
	DCA LPNTR
	JMS HALF
	JMS HALF
	JMS PUNCH
	JMP I LPUNCH

/HALF PUNCHES THE 12-BITS POINTED TO BY LPNTR AS TWO
/LINES ON THE PAPER TAPE OUTPUT.
/BIT-ORDER IS THE SAME AS FOR THE PDP-12 DSC INSTRUCTION
/IN ORDER TO BE ABLE TO USE PREVIOUSLY WORKED OUT
/DISPLAY CHARACTERS!

HALF,	0
	TAD I LPNTR
	JMS PUNCH
	TAD I LPNTR
	CLL RTR;RTR;RTR
	JMS PUNCH
	ISZ LPNTR
	JMP I HALF
LPNTR,	0

/PUNCH BIT-INVERTS THE LOWER 6 BITS OF THE ACC, AND 
/PUTS THE RESULTANT CHARACTER INTO THE OUTPUT FILE.

PUNCH,	0
	AND (77
	TAD (100	/ENTER STOP BIT.
	DCA LTMP
	DCA LTMP1
PLOOP,	TAD LTMP
	CLL RAR
	SNA		/NO SKIP WHEN INVERSION THROUGH.
	JMP PDONE
	DCA LTMP
	TAD LTMP1
	RAL
	DCA LTMP1
	JMP PLOOP
PDONE,	TAD LTMP1
	JMS I (OCHAR
	JMP I (AOUERR	/WHAT?
	JMP I PUNCH
LTMP,	0
LTMP1,	0
PAGE
IFNDEF JCA <XLIST>
/DISPLAY CHARACTERS FOR LEGIBLE PUNCHING.	THIS TABLE
/IS IN SAME FORMAT AS THE PDP-12 DSC INSTRUCTION, SO
/THE SAME CODES SHOULD WORK.	THESE CODES TAKEN FROM
/PDP-12 REFERENCE MANUAL DEC-12-SRZA-D, PAGE 3-34.

/THE ORDER IS ASCII-240.

TABLE,	0;0	/SPACE
7500;0		/!
7000;70		/"
7777;7777	/#
4731;4275	/$
3114;0643	/%
5166;0526	/&
3000;1		/'
3600;41		/(
4100;36		/)
2050;50		/*
404;437		/+
500;6		/,
404;404		/-
1;0		/.
601;4030	//
4136;3641	/0
2101;177	/1
4523;2151	/2
4122;2651	/3
2414;477	/4
5172;651	/5
1506;4225	/6
4443;6050	/7
5126;2651	/8
5122;3651	/9
2200;0		/:
4601;0		/;
2214;41		/<
1212;1212	/=
4100;1422	/>
4020;2055	/?
0;0		/@
4477;7744	/A
5177;2651	/B
4136;2241	/C
4177;3641	/D
4577;4145	/E
4477;4044	/F
4136;2645	/G
1077;7710	/H
7741;41		/I
4142;4076	/J
1077;4324	/K
177;301		/L
3077;7730	/M
3077;7706	/N
4177;7741	/O
4477;3044	/P
4276;376	/Q
4477;3146	/R
5121;4651	/S
4040;4077	/T
177;7701	/U
176;7402	/V
677;7701	/W
1463;6314	/X
770;7007	/Y
4543;6151	/Z
4177;0		/[
1060;304	/\
0;7741		/]
7720;2077	/^
3614;1455	/_

/PAGE 0 CONTANTS
OUTXR=10;INXR=11;IHNDLR=24;OHNDLR=25
SQFLAG=26;OUWAST=27;OUTBLK=30;OUDLEN=31;SAME=32
INBLK=33;RECCNT=34

$$$$$$$$$