/3 PIP FOR OS/8 MONITOR
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1970,1971,1972,1973,1974,1975,1977
/BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
/	4-MAY-1977	FILE: PIP.PA	OS/8 VERSION 12A
/RL/EF/ET.AL./S.R./E.S.



/ABSTRACT----
/PIP (PERIPHERAL INTERCHANGE PROGRAM) IS A GENERAL FILE
/MANIPULATION PROGRAM FOR THE OS/8 PROGRAMMING SYSTEM.
/PIP ACCOMPLISHES DATA TRANSFERS BETWEEN ANY DEVICES IN THE OS/8
/CONFIGURATION.


/VERSION 3 MODS:

/FIXED PROBLEM WITH ONE-PAGE WRITE
/IN /S OR /Z, =OPTION IS TAKEN MODULO 100 (OCTAL)
/	WITH 100, 200, ETC. MEANING USE 0 ADDITIONAL WDS.
/DATES STILL DON'T LINE UP
/'0 FREE BLOCKS'
/ALLOW FILLING UP DEVICE TO VERY LAST BLOCK
/ALLOW 7-BIT ^C
/ALTMODE ON CD LINE RETURNS TO MONITOR WHEN DONE
/NO HALT ON /L IF NO TTY HANDLER (ACTS AS NOP)
/ /V PRINTS VERSION NUMBER FIRST TIME CALLED
/ /O AFFIRMS /Y ON ZERO SYS OR ARE YOU SURE
/=NNNN ON /I OPTION SPECIFIES LENGTH TO CLOSE FILE


/MAINTENANCE RELEASE CHANGES:

/1.	FIXED LENGTH OF ALL VARIETIES OF RF08
/2.	ADDED RX01 TO INTERNAL LENGTH TABLES
/3.	CHANGED VERSION NUMBER TO V10
/4.	ADDED CHECK FOR 7-BIT CTRL/Z TO ASCII HANDLER

/E.S.	DISABLED /E,/F,/L
/E.S.	FIXED /Y OPTION PER SPR

/DETAILS OF PIP:

/PIP RUNS WITH THE USR (USER SERVICE ROUTINES) ALWAYS IN CORE.
/THIS ELIMINATES SWAPPING THE MONITOR. IF ANY CHANGES ARE MADE
/TO PIP, CARE SHOULD BE TAKEN IN USING PAGE ZERO LOCATIONS, AS
/THEY MUST NOT DESTROY ANY MONITOR LOCATIONS.

/CORE USED:
/FIELD 0

/00000-02777-	OUTPUT BUFFER
/03000-06377-	INPUT BUFFER
/06400-06577-	USED FOR /Y COMMAND ONLY
/06600-07177-	INPUT HANDLER
/07200-07577-	OUTPUT HANDLER

/FIELD 1

/10000-11777-	OS/8 I/O MONITOR
/12000-16577-	EXECUTABLE CODE
/16600-17177-	HOLDS NEW DIRECTORY SEGMENT FOR /S OPTION
/17200-17577-	HOLDS OLD DIRECTORY SEGMENT IN /S OPTION


/MAJOR PIECES OF CODE AND THEIR FUNCTION (BRIEFLY).
/THIS IS A LIST OF ROUTINES AS THEY APPEAR PHYSICALLY, AND
/NOT AS THEY ARE LOGICALLY CONNECTED.

/ICHAR-		GENERAL CHARACTER INPUT ROUTINE. ASSIGNS NEW
/		DEVICE HANDLERS AS NEEDED.

/OOPEN-		ENTERS A FILE ON A SPECIFIED DEVICE.

/OUTDMP-	WRITES OUTPUT BUFFER TO OUTPUT DEVICE.

/OCLOSE-	CLOSES FILE CREATED BY OOPEN

/OCHAR-		CHARACTER OUTPUT ROUTINE. WRITES CHARACTERS
/		TO OUTPUT BUFFER, CALLING OUTDMP WHEN FULL.

/OTYPE-	USES DEVICE NUMBER IN OUTPUT AREA OF CD TO
/		INSPECT THE DEVICE CONTROL BLOCK WORD. THIS
/		GIVES A CODE FOR THE TYPE OF DEVICE.

/SLASHG-	HANDLES I/O ERRORS. IF /G IS SET, HARD I/O
/		ERRORS ARE IGNORED. IF /S AND /G ARE ON, A
/		SPECIAL RETURN IS TAKEN.

/IMAGE-		IMAGE MODE PROCESSOR FOR PIP.

/SQTRA-		MAIN SUBROUTINE OF IMAGE MODE, AND /S OPTION.

/PIP, PIP+1-	MAIN ENTRANCES TO PIP. THE CODE ON THIS PAGE
/		INSPECTS CD OPTION WORDS AND BRANCHES TO PROPER
/		ROUTINES.

/ASCII-		THE DEFAULT TRANSFER MODE IN PIP IS ASCII.

/DELETE-	DELETES FILES ON OUTPUT SIDE OF CD LIST.

/DZERO-		ZEROES DIRECTORY OF FIRST OUTPUT DEVICE.

/PIPERR-	ERROR ROUTINR FOR PIP.

/DIRPRE-	DIRECTORY PRINTING ROUTINE.

/BINARY-	BINARY MODE PROCESSOR. HANDLES ABSOLUTE AND
/		RELOCATABLE BINARY FILES.

/ERPRNT-	ERROR PRINTOUT.

/SQUISH-	FILE COMPRESSION PROCESSOR. ELIMINATES 'HOLES'
/		IN DIRECTORY OF INPUT DEVICE.

/SYSCOP-	SYSTEM COPY PROCESSOR. ALLOWS TRANSFER OF THE
/		OS/8 SYSTEM AREA.
/OPTIONS AVAILABLE IN PIP:

/A-	ASCII TRANSFER; DEFAULT MODE
/B-	BINARY MODE TANSFER
/C-	DELETE TRAILING BLANKS. (ASCII MODE)
/D-	DELETE FIRST OUTPUT FILE BEFORE PROCEEDING
/E-	LIST INPUT DIRECTORY INCLUDING EMPTY FILES
/F-	LIST INPUT DIRECTORY; ONLY FILE NAMES
/G-	IGNORE ERRORS WHILE TRANSFERING
/I-	IMAGE MODE TRANSFER
/L-	LIST INPUT DIRECTORY; EXCLUDE EMPTY FILES
/O-	OK TO PERFORM A SQUISH OR ZERO WITHOUT ASKING
/S-	COMPRESS INPUT DEVICE ONTO OUTPUT DEVICE. ELIMINATES
/	'HOLES' ON INPUT DEVICE.
/T-	PROVIDE SIMPLE TTY FORMATTING. (ASCII ONLY)
/Y-	COPY OS/8 SYSTEM AREA
/Z-	ZERO OUTPUT DEVICE DIRECTORY BEFORE PROCEEDING
/=N-	LEAVE N WORDS EXTRA PER DIRECTORY ENTR. VALID
/	ONLY WITH /S OR /Z.
/=N-	WITH /I OPTION CLOSES OUTPUT FILE WITH THIS LENGTH
/V	PRINTS VERSION # (FIRST TIME ONLY)

/COMMENTS ON THE PROGRAM:

	/SINCE PIP RUNS WITH USR IN CORE, NO PAGE ZERO LITERALS
	/CAN BE USED. THE LOCATIONS CURRENTLY USED IN
	/FIELD 1 ON PAGE ZERO ARE:

	OUTXR=10
	INXR=11
	TEMP1=12
	IHNDLR=24	/HOLDS INPUT HANDLER ADDRESS
	OHNDLR=25	/OUTPUT HANDLER ADDRESS
	SQFLAG=26	/'SQUISH INDICATOR
	OUWAST=27	/# WASTE WORDS ON OUTPUT
	OUTBLK=30
	OUDLEN=31
	SAME=32
	INBLK=33
	RECCNT=34

/CONSTANTS USED BY THE DIRECTORY PRINTOUT ROUTINE (OVERLAPPING) ARE:

	FLENGT=24
	BLOKNO=25
	DTYPE=27
	DCOUNT=30
	DLINK=31
	WASTE=32
	DDATE=33
	ECOUNT=35
	/PIP FOR OS/8 MONITOR
	/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, EXCEPT DURING /Y COMMAND

	/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

/TO ENABLE /E,/F,/L SET
/OS78=0

/TO DISABLE /E,/F,/L
IFNDEF OS78 <OS78=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]
	/INDEVH=	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
			/NOT END-OF-FILE IF INPUT DEVICE
			/IS NON-FILE STRUCTURED!
	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.
INNEWF,	-1		/ROUTINE TO OPEN NEW INPUT FILE
	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
	PAGE
OOPEN,	0		/OPEN OUTPUT FILE
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
	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
	PAGE
OUSETP,	0		/ROUTINE TO INITIALIZE CHARACTER POINTERS
	TAD (OUCTL&3700	/GET SIZE OF BUFFER IN DOUBLEWORDS
	CIA		/PAL10 IS DEFINITELY NOT NICE
	DCA OUDWCT
/	TAD (OUBUF
	IFNZRO OUBUF <ERROR!>	/V3
	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
	TAD (200	/V3
	KRS
	TAD (-203
	SNA CLA		/IS THE TELETYPE BUFFER A ^C
	KSF		/WITH THE TELETYPE FLAG ON?
	JMP I CTCTST	/NO
LEAVE,	CDF CIF 0	/YES - GO TO MONITOR
	JMP I (7600	/THROUGH THE "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


	IFZERO OS78 <
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
	JMP I (PIP	/V3 WHAT - NO TELETYPE!
	TAD TTYDEV+1
	DCA I (7600
	JMP I (DIRPRE
	>

	IFNZRO OS78 <
DIR,	JMS I	(PIPERR	/TYPE OUT MESSAGE
	14
DIRMSG,	TEXT	"USE DIRECT"
	>

	PAGE
	/PIP PROPER BEGINS HERE
	/**********************

	/IMAGE MODE PROCESSOR FOR PIP

IMAGE,	JMS I (FIXLEN
	JMS I (OUTOPN
	JMS IMTRA
IMCLOS,	TAD I (OUTINH
	SZA CLA		/WAS THERE AN OUTPUT FILE?
	JMP I (PIPCLR	/NO - DON'T CLOSE IT
	JMS I (OUK	/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 (PIPCLR

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
IMHNDL,			/V3
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
AGAIN,	TAD INEOF	/IOPEN ALWAYS SETS INEOF
	SNA CLA		/KEEP READING?
	JMP IMRCLP	/YES
			/NO, OPEN NEXT FILE
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!
	JMP AGAIN	/V3
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
	PAGE
/** PIP STARTS HERE (OR HERE+1 IF CHAINED TO) **

PIPSA,	JMP PIPCD	/NORMAL ENTRY/RE-ENTRY - CALL CD
	JMP NOPCD	/ENTRY FROM CHAIN COMMAND - ASSUME CD AREA SET UP
	/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 I (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 I (AOUERR	/ERROR ON CLOSE
PIP,	TAD I (MPARAM-1	/V3
	SMA CLA		/ALTMODE TERMINATE LAST COMMAND STRING?
	JMP PIPCD	/NO
	CDF CIF 0	/YES
	JMP I (7605	/EXIT TO OS/8 WITHOUT SAVING CORE
PIPCD,	JMS I (200	/OF COURSE THE MONITOR IS IN CORE!
	5		/COMMAND DECODE
	0		/NO ASSUMED EXTENSIONS ON INPUT
L20,			/V3
NOPCD,	JMS I (ONCE	/REPLACED BY '20' BY ONCE-ONLY CODE
	JMS I (SRSTOR	/CLEAR /S OR /Y;READ MONITOR
	DCA SQFLAG	/CLEAR /S INDICATOR
	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 OUTPUT FILE
	TAD I (MPARAM+2	/IS /Y ON?
	SPA CLA
	JMP I (SYSCOP	/YEP..TRANSFER SYSTEM HEAD
	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 (MPARAM
	RTL
	AND (40		/"I" SWITCH ROTATED TWO LEFT
	SZA CLA
	JMP I (IMAGE	/IMAGE MODE TRANSFER
	TAD I (7617	/MUST PRESERVE THE LINK
	SNA CLA		/V3 IMAGE MODE ALLOWS NO INPUT FILE
	JMP PIP		/TERMINATE HERE IF NO INPUT SIDE
	SZL CLA		/"B" SWITCH IN LINK
	JMP I (BINARY	/BINARY MODE TRANSFER

	/DEFAULT MODE OF TRANSFER IS ASCII

ASCII,	TAD I (MPARAM+1
	AND L20
	DCA COPTSW
	TAD COPTSW
	JMS I (ASCI2	/TEST FOR OUTPUT DEVICE
	JMS I (OUTOPN
	JMS I (IOPEN	/OPEN THE INPUT FILES
	DCA AEOFFG	/ZERO THE END-OF-FILE FLAG
	JMS I (LEADER
	JMP I (ASCIGO

	/ENTRY ON END OF INPUT
ASCEOF,	SPA CLA		/WAS IT END OF INPUT OR AN INPUT ERROR?
PER4,	JMS I (PIPERR
	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 PER4
	JMP ACLOSE
	PAGE
	*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
	SZA		/IGNORE BLANK TAPE AND LEADER/TRAILER
	TAD (-177
	SNA
	JMP ACHLP	/DITTO RUBOUTS
	TAD (177-32	/V3C
	SNA
	JMP I (ASCPTCH	/7-BIT ^Z CHECK
	TAD (232	/FORCE COLUMN 8 ON
	DCA CHAR
	TAD CHAR
	TAD (-216
	CLL
	TAD ASCI5
	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,	7600		/GRP 2 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

OUTOPN,	0
	JMS I (OOPEN
	SMA CLA
	JMP I OUTOPN
	JMS I (PIPERR
ASCI5,	5
	PAGE
	/SUBROUTINES CALLED BY THE REST OF PIP

K770,	770		/** DON'T MOVE THIS CONSTANT
DELETE,	0
	TAD P7600
	DCA DPFILE
	CLA CLL CMA RTL
	DCA CHAR	/MAXIMUM OF THREE OUTPUT FILES
DELOOP,	TAD (7201
	DCA DLHNDL
	TAD I DPFILE
	SNA		/DOES THIS FILE EXIST?
	JMP I DELETE	/THAT'S ALL
	JMS I C200
	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 C200	/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 K770	/MASK OUT DEVICE TYPE
	CLL RTR
	RAR
	TAD (DEVLEN	/USE IT TO INDEX A TABLE OF DEVICE LENGTHS
	DCA PIPERR
	TAD I PIPERR
	SNA
	JMP I DZERO	/DEVICE LENGTH ZERO MEANS NON-DIRECTORY DEVICE
	DCA PIPERR	/STORE LENGTH
	TAD (OUDEVH+1
	DCA OZHNDL
	TAD I P7600
	JMS I C200
	1		/ASSIGN DEVICE, FETCH HANDLER
OZHNDL,	0
	HLT
	TAD I (MPARAM+2	/IF /Y ON, DO SYSTEM ZERO
	SPA CLA
	JMP ZRO70
	TAD OZHNDL	/BUT IF NOT, CHECK FOR SYSTEM ZERO
	TAD (-7607
	SZA CLA
	JMP ZRO70+1	/NOT SYSTEM FILES BEGIN AT 7
	JMS I (CONFRM	/ASK IF HE'S SURE
	SYSZRO		/V3
ZRO70,	TAD (61
	TAD (7
	DCA I (DFORG
	DCA I (SQFLAG	/AND CLEAR OUT SQUISHES
	TAD PIPERR
	TAD I (DFORG
	DCA I (DLENGT
	JMS I (GETEQ
	DCA I (DWASTE	/DEFINE # OF WASTE WORDS
	DCA I (MPARAM+3	/KILL = OPTION FOR FUTURE /I TRANSFERS
	CIF 0
	JMS I OZHNDL
	5410		/V3 OUTPUT 6 BLOCKS 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
P7600,	7600		/V3 CLA
	JMS I (SRSTOR	/RESET 07600!
	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

LEADER,	0
	JMS I (OTYPE
C200,	AND K770	/GET THE TYPE OF THE OUTPUT DEVICE
	TAD (-PTP	/IS IT A PAPER TAPE PUNCH?
	SZA CLA
	JMP I LEADER	/NO
	TAD P7600
	DCA TEMP
	JMS I (OCHAR	/PUT OUT SOME LEADER
	JMP I (AOUERR
	ISZ TEMP
	JMP .-3
	JMP I LEADER
	PAGE
	/TABLE OF DEVICE LENGTHS FOR /Z OPTION

DEVLEN,	0;0;0;0;0;1520	/RK08 (1520= - DECIMAL 3248)
	6001;4001;2001;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 1	/20 MAGTAPE
	6437		/21 TD8E
	0
	1520		/ 1/2 OF AN RK8E IS 23
	0		/24
	7022		/25 RX01 FLOPPY DISK
	ZBLOCK 52	/ALL THE REST


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
NOYES,	TEXT	/NO/
	TEXT	/YES/

CONFRM,	0
	TAD I (MPARAM+1
	RTL		/'O' BIT TO SIGN
	SPA CLA
	JMP GOTCON	/V3 'O' MEANS OK, ASSUME 'YES'
	TAD I CONFRM	/V3
	JMS I (ERPRNT
	KSF
	JMP .-1
	JMS I (CTCTST
	KRB		/LOOK AT HIS REPLY
	AND (177	/IGNORE PARITY TTY
	TAD (-"Y!7600	/V3
	SNA CLA		/IS IT YES?
	ISZ SQFLAG	/SET SQFLAG TO 1 (NEEDED 1 LATER)
	TAD SQFLAG	/USE SQFLAG AS INDEX FOR MESSAGE
	CLL RAL
	TAD (NOYES
	JMS I (ERPRNT
	TAD SQFLAG
	SNA CLA
	JMP I (PIP
CNFMXT,	ISZ CONFRM
	JMP I CONFRM

GOTCON,	ISZ SQFLAG	/SET SQFLAG
	JMP CNFMXT	/AND TAKE SKIP EXIT
	PAGE
	/DIRECTORY PRINTER FOR PIP
	MDATE=7666

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
PR212,	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 (240	/V3
	AND (77		/V3
	TAD (240	/V3
	JMS I (OCHAR
	JMP I (AOUERR
	JMP I PR6BIT
PRNUM,	0
	DCA PRWD
	DCA TEMP
	TAD (PWRTEN
	DCA PCRLF
PRNMLP,	DCA PR6BIT
	TAD I PCRLF
	SNA
	JMP PRLAST	/V3
	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
PRLAST,	TAD PRWD	/V3
	TAD (260	/V3
	JMS PR6BIT	/V3
	JMP I PRNUM	/V3
PCRLF,	0
	TAD (215
	JMS I (OCHAR
	JMP I (AOUERR
	TAD PR212
	JMS I (OCHAR
	JMP I (AOUERR
	JMP I PCRLF

PWRTEN,	-1750;-144;-12;0	/V3
	PAGE
	/MAIN DIRECTORY PRINTING LOOP

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
	PAGE
/BINARY MODE PROCESSOR FOR PIP

BIN360,	360
BINARY,	JMS I (FIXLEN
	JMS I (OUTOPN
	JMS I (IOPEN
	JMS I (LEADER	/PUT OUT BLANK TAPE IF HS PUNCH OUTPUT
	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 TAPE
	SNA		/IS IT RELOCATABLE?
	JMP RELBIN	/YES
	TAD (-40	/IF A FIELD SETTING, IT'S ABSOLUTE
	AND (7700
	SNA
	JMP ABSLUT
	TAD BIN200	/CHECK FOR ORIGIN ALSO
	SZA CLA
	JMP NEWTAP	/NOTHING..NEXT FRAME
ABSLUT,	CLA CMA
	JMS LTCODE
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,	SMA CLA		/DETECT FATALITIES
	JMS I (PIPERR
	7
	JMS I (PIPERR		/A REAL BAD READ
	4

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
	PAGE
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
	JMS CHPRNT
	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

CHPRNT,	0
	TAD (-37	/IS IT A _?
	SNA
	JMP FILENR	/YES..PRINT FILE NUMBER
	IAC
	SNA 		/MAYBE ^?
	JMP I (SQFILE	/YEP..PRINT FILE NAME
	SPA
	TAD (100
	TAD (236
	JMS I (TTYOUT
	JMP I CHPRNT

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
	ERR11
	IFNZRO OS78 <DIRMSG>

	PAGE
/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/


TTYOUT,	0
	TLS
	TSF
	JMP .-1
	CLA
	JMP I TTYOUT
	PAGE
/SQUISH PROCESSOR

SQUISH,	JMS I (CONFRM
	SURE		/V3
SQUISX,	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 SQ7600
	SNA
	JMP I (PIP	/NO OUTPUTEE, NO SQUISHEE
	JMS I (200
	1
SOHND,	0
	HLT
	JMS INTEST
	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
	JMS GETEQ
	DCA OUWAST
	TAD SOHND
	DCA OHNDLR
	TAD OHNDLR
	DCA I (OUHNDL
	TAD I (INHNDL
	DCA IHNDLR
	JMS SETCTC
	JMS I (CTCFLG
	CIF 0
	JMS I IHNDLR
	1400
	0
	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
	TAD SOHND	/SETUP DIRECTORY START
	JMS I (SQDTST
	JMS I (SETSAM	/IF IHNDLR=OHNDLR, SAME=1
	CLA CMA
	DCA I (SQBUF2
	DCA I (OUTSEG
	JMP I (NEWOUT

GETEQ,	0		/V3
	TAD I (MPARAM+3
	SNA
	IAC
	AND (77		/CONVERT 0 TO 1 AND 100 TO 0
	CIA
	JMP I GETEQ

INTEST,	0		/TEST IF INPUT IS DIRECTORY
	TAD I (7617
	AND (17
	TAD (DCB-1
	DCA TEMP
	TAD I TEMP
	SMA CLA
	JMS I (PIPERR
	6
	JMP I INTEST

SETCTC,	0		/MODIFY 07600 TO RETURN TO SQCTLC
	TAD CDIF10
	CDF 0
	DCA I SQ7600
	TAD (5602	/JMP I .+1
	DCA I (7601
	TAD (SQCTLC
	DCA I (7602
CDIF10,	CIF CDF 10
	JMP I SETCTC
OUK,	0		/V3 ON IMAGE MODE TRANSFER
			/CLOSE OUT FILE WITH = OPTION
			/IF NOT TOO SMALL
	TAD I (OUCCNT
	CLL CIA
	TAD I (MPARAM+3
	SNL		/IS = OPTION LARGER?
SQ7600,	7600		/RETURN OUCCNT IF IT'S LARGER
	TAD I (OUCCNT	/RETURN LOW ORDER = OPTION IF IT'S LARGER
	JMP I OUK
	PAGE
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
	JMS I (CYWAST	/COPY WASTE WORDS
	TAD I INXR
	DCA RECCNT
	TAD RECCNT
	SNA
	JMP SNULL
	CMA CLL		/V3
	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 DMTX-1
SEMPTY,	TAD I INXR
	JMP DMTX
OUSAVE,	0
SURE,	TEXT	/ARE YOU SURE?/

SETSAM,	0
	TAD IHNDLR
	CIA
	TAD OHNDLR
	SNA CLA
	IAC
	DCA SAME
	JMP I SETSAM
	PAGE
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
	JMS I (TSTSAM	/TEST IF OPERATION IS TO ITSELF 
	TAD (CTCMSG
	JMS I (ERPRNT
	TAD CTCFLG
	SZA CLA
	JMP I CTCFLG
	TAD I (MPARAM+1	/IS IT /S?
	AND (40
	SNA CLA
	JMP I (SYSCPY	/NO../Y
	JMP I (MOVFIL

SRSTOR,	0
	JMS I (7700	/MAKE SURE MONITOR IS IN CORE
	10
	DCA .-2		/AND WIPE THE CALL AWAY
	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 IN ^ - CONTINUING/
NOROOM,	TEXT	/NO ROOM IN ^ - CONTINUING/
	PAGE
K7760,	7760
SYSCOP,	TAD K7622		/SET INFPTR IN CASE OF /Y ERROR
	DCA INFPTR	/WILL FILE #1
	JMS I (SETCTC	/KLUDGE UP 07600
SYSCPY,	TAD (INDEVH+1
	DCA YIHAND	/SET TO ASSIGN INPUT HANDLER
	TAD (OUDEVH+1
	DCA YOHAND
	TAD (2000
	DCA K2000	/THIS MAY GET CLOBBERED READING IN DIRECT.
	TAD (10
	DCA OFSET
	TAD I K7617
	SNA CLA		/IS THERE AN INPUT DEVICE?
	ISZ I K7617	/MAKE INPUT =SYS
	JMS I (INTEST	/SEE IF OPERATIONS ARE TO SAME DEVICE
	TAD I K7617
	JMS I K200	/ASSIGN HANDLER
	1
YIHAND,	0
K7622,	7622	/THINLY DISGUISED HALT
	TAD I K7617
K200,	AND K7760	/CHECK INPUT FILE LENGTH
	SNA		/IF BLANK,INPUT SYSTEM HEAD
	JMP	YSOUT
	TAD (-6340	/CHECK FOR PROPER LENGTH
	SZA CLA
	JMP PER13	/ERROR..NOT SYSTEM HEAD
	TAD I (7601	/IS THERE OUTPUT DEVICE?
	SZA CLA		/IF YES..WE CAN DO IMAGE XFER
	JMP I (IMGTST
	TAD I (7620
YOUSYS,	DCA YINREC	/PICK UP STARTING RECORD
	CIF 0
	JMS I YIHAND	/READ IN FIRST INPUT RECORDS
K2000,	2000		/(0-15 IF SYSTEM HEAD,0-7 IF FILE)
	OUBUF
YINREC,	0
	JMP I (PER4	/INPUT ERROR
	TAD I (7620	/IF INPUT FROM A FILE, OPEN
	SZA CLA		/A HOLE FOR OUTPUT DIRECTORY
	JMS I (MOVE	/DO A CORE MOVE
	JMS I (TSTHED	/TEST FOR VALID SYSTEM HEAD
	TAD YINREC
	TAD OFSET	/BUMP TO NEXT RECORD
	DCA NXTRD
	TAD I (7600	/IF NO OUTPUT, FORGET IT
	SNA
	JMP PIPCLR	/RESET AND GO TO PIP
	JMS I K200
	1
YOHAND,	0
	HLT		/V3
	JMS I (FAKE
	JMS I (SETSAM
	JMS I (TSTIO	/TEST OUTPUT. SEE IF DIRECT. DEV.
	CIF 0
	JMS I YOHAND	/READ OUTPUT DIRECTORY INTO PLACE
	1400
	400
	1
	JMP I (PER4
	CDF 0
	TAD I (401	/NOW TEST FOR VALID OUTPUT DEVICE
	CDF 10
	TAD (-10	/IF LESS THAN 10, DON'T XFER
	SPA CLA
	JMS I (PIPERR
	11
	TAD (-4
	DCA YINREC	/XFER COUNTER

	JMP	YDUMP
YLOOP,	CIF 0
	JMS I YIHAND	/READ NEXT
K3400,	3400		/16 BLOCKS
	OUBUF
NXTRD,	0
	JMP I (PER4
	TAD NXTRD
	TAD (16
	DCA NXTRD
YDUMP,	TAD (7400
	JMS I (OUTDMP	/WRITE BUFFER
	JMP I (AOUERR
	ISZ YINREC	/DONE YET?
	JMP YLOOP	/NOT YET..LOOP
PIPCLR,	JMS I (SRSTOR	/CLEAR OUT 07600
	JMP I (PIP
YSOUT,	TAD I	(7601	/HERE IF INPUT FROM SYSTEM HEAD
	SZA CLA		/IS THERE AN OUTPUT FILE?
	JMP I	(YTSOUT	/YES, SET UP FOR IMAGE MODE
YNOOUT,	TAD K3400	/SET TO READ IN DIRECTORY
	DCA K2000	/PLUS FIRST 7 RECORDS
	TAD (16		/AND RESTART READ AT RECORD 16
	DCA OFSET
	JMP YOUSYS
OFSET,	0

PER13,	JMS I (PIPERR
	13
K7617,	7617		/V3
	PAGE
DIRECT,	-1
DFORG,	0		/FILE STORAGE
	0
	0
DWASTE,	0		/#WASTE WORDS
	0
DLENGT,	0

MOVE,	0
	TAD (4400	/MOVES CORE TO OPEN DIRECTORY HOLE
	DCA TEMP
	TAD (3777
	DCA MWAST
	TAD (6777
MOVE1,	DCA TSTSAM
	CDF 0
	TAD I MWAST
	DCA I TSTSAM
	CMA
	TAD	MWAST
	DCA	MWAST
	CMA
	TAD	TSTSAM
	ISZ TEMP
	JMP MOVE1
	CLA
	CDF 10
	JMP I MOVE

ERR11,	TEXT	/BAD SYSTEM HEAD/

YTSOUT,	TAD I (7617	/O.K. SETUP CD AREA FOR IMAGE XFER
	TAD (7760	/FROM SYSTEM AREA OF INPUT DEVICE
	DCA I (7617
	TAD I (7617
	AND (17
	TAD (6360
	DCA I (7621
	TAD K7
	DCA I (7622
IMGTST,	DCA SAME	/ALLOW ^C IF TO OUTPUT FILE
	TAD I (YIHAND	/TEST FOT VALID SYSTEM
	DCA IHNDLR
	CIF 0
	JMS I IHNDLR
	0200
	3400
K7,	7
	JMP I (PER4
	JMS I (TSTHED
	JMP I (IMAGE
TSTSAM,	0
	TAD SAME	/IF /Y IS TO SAME DEVICE AS INPUT (SYS)
	SNA CLA		/^C GIVES MESSAGE AND RETRIES OPERATION
	JMP I (ZEROKS
	JMP I TSTSAM

ERR2,	TEXT	/OUTPUT ERROR/

SQFILE,	DCA MWAST
	TAD I (OUSAVE
	DCA TSTSAM	/IF ERROR DURING /S
	DCA DWASTE
	CLA CLL CMA RTL
	DCA MOVE	/-3 FOR FILE NAME
SQFIL3,	TAD I TSTSAM	/FIRST 2 CHARS. IN NAME
	CLL RTR
	RTR
	RTR
SQFIL5,	AND (77
	SZA		/IF ZERO, DON'T BOTHER
	JMS I (CHPRNT
	ISZ DWASTE	/RIGHT HALF OR NEW WORD?
	JMP SQFIL4	/RIGHT HALF
	ISZ TSTSAM
	ISZ MOVE	/EXHAUSTED ALL?
	JMP SQFIL3	/NOPE
	TAD MWAST	/DONE WITH IT YET?
	SZA CLA
	JMP I (FILENR-1	/YES
	TAD I TSTSAM	/IS THERE AN EXTENSION?
	SNA CLA
	JMP I (FILENR-1	/NO..CONTINUE ORIGINAL MSG
	TAD (256
	JMS I (TTYOUT
	ISZ MWAST	/SIGNAL END
	CLA CMA
	JMP SQFIL3-1
SQFIL4,	CLA CMA
	DCA DWASTE
	TAD I TSTSAM	/GET RIGHT HALF
	JMP SQFIL5
MWAST,	0
	DCA TEMP
	TAD I INXR
	DCA I OUTXR	/ROUTINE TO COPY WASTE WORDS
	ISZ TEMP
	JMP .-3
	JMP I MWAST
	PAGE
FAKE,	0
	TAD I (YIHAND
	DCA IHNDLR
	TAD I (YOHAND
	DCA OHNDLR
	DCA I (OUCCNT
	DCA I (OUBLK
	DCA I (OUELEN
	TAD I (YOHAND
	DCA I (OUHNDL
	JMP I FAKE

CYWAST,	0		/ROUTINE TO COPY WASTE WORDS
	CLA CLL CMA RTL	/THREE MORE FOR FILE NAME
	JMS I (MWAST	/COPY THEM
	TAD I (SQBUF2+4	/NOW ADJUST I/O WASTE WORDS
	CIA
	TAD OUWAST	/DIFF. BETWEEN OUT AND IN WORDS
	SMA		/IF <0, MORE OUT THAN IN
	JMP CGEWST	/POS. MORE IN THAN OUT (OR SAME)
	DCA TEMP1
	TAD I (SQBUF2+4
	SZA
	JMS I (MWAST	/COPY ALL INPUT WORDS
	DCA I OUTXR	/AND 0 ALL EXTRA OUTPUT WORDS
	ISZ TEMP1
	JMP .-2
	JMP I CYWAST
CGEWST,	DCA TEMP1
	TAD OUWAST	/XFER ONLY ENOUGH OUTPUT WDS.
	SZA
	JMS I (MWAST
	TAD INXR
	TAD TEMP1	/POINT INPUT TO NEXT FILE
	DCA INXR
	JMP I CYWAST

TSTHED,	0		/TESTS FOR KEYBOARD MONITOR
	CDF 0
	TAD I (3401
	CDF 10
	TAD (-7200
	SZA CLA
	JMP I (PER13	/IF NOT CLA, NOT VALID
	JMP I TSTHED
TSTIO,	0		/SEE IF OUTPUT IS DIRECTORY DEVICE
	JMS I (OTYPE	/GET DCB WORD FOR OUTPUT
	SMA CLA		/IF NOT NEG., NOT DIRECT DEVICE
	JMS I (PIPERR
	5
	TAD OHNDLR	/IF OUTPUT=SYS, SET NO INTERRUPT
	TAD (171
	SNA CLA
	ISZ SAME
	JMP I TSTIO

ASCI2,	0		/SEE IF VALID ASCII OUTPUT
	DCA TSTIO
	TAD I (7600
	SNA CLA
	JMP I (PIP	/NO..BACK TO PIP
	TAD TSTIO	/SEE IF /C IS ON
	SNA CLA
	JMS I (FIXLEN	/NO..TRY TO ESTIMATE OUTPUT
	JMP I ASCI2

SQDTST,	0		/ROUTINE TO CHECK /S DIRECTORIES
	DCA NOHND	/PRESERVE POSSIBLE SYS ON OUTPUT
	TAD (7		/DEFAULT TO BLOCK 7
	DCA OUTBLK	/INITIAL GUESS
	CDF 10		/NOW TRY TO READ DIRECTORY OF OUTPUT
	JMS I (OTYPE	/IF NON-FILE, DON'T READ IT
	SMA CLA
	JMP P1A
	CIF 0		/COULD BE NON-FILE, HOWEVER.
	JMS I NOHND
	0210
	1400
P1,	1
	JMP I (SQIDER+1	/ERROR IN READ
P1A,	DCA OLDDIR	/WIPES ANY DIRECT. SEGMENT
	TAD I (1401
	TAD (-70	/IS OUTPUT A SYS DEVICE?
	SNA CLA
	JMP SYSDIR	/YES.
	TAD NOHND	/IS OUTPUT THE SYSTEM DEVICE?
	TAD (171
	SZA CLA
	JMP .+3
SYSDIR,	TAD (70
	DCA OUTBLK
	JMP I SQDTST

NOHND=FAKE

SYSZRO,	TEXT /ZERO SYS?/
AOUERR,	SMA CLA		/WAS IT A DEVICE ERROR OR ARE WE OUT OF SPACE?
	JMP BOUERR	/OUT OF SPACE
PER2,	JMS I (PIPERR
	2
BOUERR,	JMS I (PIPERR
	0

ASCPTCH,TAD (ACHLP+1	/V3C FAKE OUT ICHAR
	DCA I (ICHAR	/SIMULATE CALL TO ICHAR FROM 'ACHLP'
	JMP I (GETNEW	/V3C SIMULATE OCCURRENCE OF 8-BIT ^Z IN ICHAR
	PAGE
/THIS IS ONCE-ONLY CODE

ONCE,	0
	STA
	TAD ONCE
	DCA ONCENF
	TAD (20
	DCA I ONCENF	/RESTORE L20, DON'T ALLOW REENTRY
	TAD I (MPARAM+1
	AND (7
	SNA CLA		/IS /V SET?
	JMP I ONCE	/NO, RETURN
	TAD (VER	/YES
	JMS I (ERPRNT	/PRINT VERSION NUMBER
	JMP I ONCE	/RETURN

VER,	TEXT	\OS/8 PIP V11A\
ONCENF,	0
	PAGE
	$

