/ STAR PIP FOR OS/8 (DMK)


/******************************************************
/
/  STAR PIP FOR OS/8
/
/  WRITTEN BY DAVID M. KRISTOL, SUMMER, 1972
/
/  PROGRAM PERMITS PDP-10 - TYPE TRANSFERS
/   WITH INPUT FILENAMES OF THE FORM:
/	* , *.* , NAME.* , AND *.EXT
/
/  OPTIONS:
/	/D	DELETE OUTPUT FILES BEFORE
/		TRANSFER (LIKE PIP)
/	/T	USE TODAY'S DATE INSTEAD OF
/		ORIGINAL CREATION DATE
/	/V	INVERT SENSE OF DIRECTORY SEARCH
/		(USE FILES WHOSE NAMES ARE NOT FOUND)
/	/R	REMOVE INPUT FILES FROM INPUT
/		DEVICE AFTER TRANSFER
/	/N	SAME AS /R, BUT DON'T TRANSFER FILES
/	/U	TRANSFER LIKE REGULAR PIP
/	/P	CHAIN TO PIP AFTER COMPLETION
/	$	RETURN TO MONITOR AFTER COMPLETION
/
/******************************************************
/
/  CORE LAYOUT
/	FIELD 0
/		200-6577	/IMAGE MODE BUFFER
/		6600-7177	/INPUT HANDLER
/		7200-7577	/OUTPUT HANDLER
/
/	FIELD 1
/		0-1777	/RESERVED FOR USR
/		2000-4777	/PROGRAM
/		5000-6177	/TRANSFER LIST:  SPACE
/				/FOR 160 FILES
/		6200-7577	/HALF A DIRECTORY
/
/******************************************************
                                               
	/CORE LAYOUT:
	BUF=200		/FIELD 0
	IHNDB=6600	/TO 7177
	OHNDB=7200	/TO 7577
	TLEN=IHNDB-BUF&7400%400	/BLOCKS PER TRANSFER

	DIRE=6200	/TO 7577.  3 BLOCKS
			/MUST BE >4000 (SEE GETSEG)

	TENTRY=240	/NUMBER OF SLOTS IN TRANSFER
			/LIST TABLE
	TRNSL1=-4^TENTRY+DIRE	/ALIGN WITH 'DIRE'


	OPT1=7643	/CD OPTION WORDS
	OPT2=7644
	OPT3=7645
	MDATE=7666	/FIELD 1 DATE
	DCB=7760	/FIELD 1 (DEVICE CONTROL TABLE)


	USR=200
	ZZZ=0		/FOR FILL-INS


	FIELD 1


	XR1=10
	XR2=11	/FOR ERRORS

	CDP=20		/POINTER TO CD INPUT STRING
	DIREP2=21	/POINTER TO FOUND DIRECTORY ENTRY
	DIREC1=22	/FILE LENGTH FOR FOUND FILE
	OTRANS=23	/OUTPUT DEVICE HANDLER ADDRESS;
			/IF 0, HANDLER HAS NOT BEEN LOADED
	ITRANS=24	/INPUT DEVICE HANDLER ADDRESS
	TRNSP1=25	/POINTER TO TRANSFER LIST
	OUTDEV=26	/PRESENT OUTPUT DEVICE #
	CMPRP1=27	/HELP OUT 'CMPRS'
	CMPRP2=30	/SAME
	DCBPTR=31	/POINT AT DCB ENTRY FOR OUTDEV
	TRNSC2=32	/# OF FILES TRANSFERRED FOR
			/PRESENT REQUEST

	*2000

STRPIP,	NOP		/PROGRAM START/RESTART
	JMS I (7700	/ALLOW FOR CHAIN
	 10		/USRIN
	TAD (JMP ALPHA-1
	DCA STRPIP	/RESET FOR FUTURE CALLS
	JMS I (USR
	 12		/INQUIRE ABOUT DSK:
DSKDEV=.+1
	 DEVICE DSK;0
	 HLT		/NO DSK:!?
	DCA CTLCFL	/0 ^C FLAG
ALPHA,	JMS I (USR	/MAIN PROGRAM LOOP
	 5		/CALL CD
	 5200		/SPECIAL MODE
	TAD I (7600	/OUTPUT FILE
	AND (17		/JUST GET DEVICE #
	SNA		/WAS THERE ONE?
	TAD DSKDEV	/NO.  USE DSK:
	DCA OUTDEV	/SAVE OUTPUT DEVICE #
	TAD OUTDEV
	TAD (DCB-1
	DCA DCBPTR	/POINT AT DCB ENTRY
	STL RTR		/2000
	AND I DCBPTR	/CHECK READ-ONLY BIT
	SZA CLA		/SET?
	 JMP BADOUT	/ILLEGAL OUTPUT DEVICE
	DCA DIOWI	/ZERO DIRECTORY WRITE FLAG
	DCA DIOSEG	/FORCE READING DIRE
	DCA OTRANS	/SO OUTPUT HANDLER WILL
			/BE FETCHED
	DCA INDEV	/CLEAR SO WE KNOW NO DEVICE
			/IN USE
	TAD (7605	/POINT AT FIRST INPUT
	DCA CDP
BETA,	JMS CTLCCK	/SAFE TO RETURN TO MONITOR HERE
			/IF ^C HAS BEEN TYPED
	TAD I CDP	/OTHERWISE, GET INPUT
	SNA CLA		/IS THERE ONE?
	JMP DELTA	/NO
	JMS SETUP	/YES.  SET EVERYTHING UP
	JMS CTLCCK	/CHECK FOR ^C
	STL RTR		/2000
	AND I (OPT2	/CHECK N OPTION
	SZA CLA		/SET?
	JMP GAMMA	/YES.  DON'T CHECK /U
	TAD (10
	AND I (OPT2	/CHECK U OPTION
	SZA CLA		/SET?
	JMP EPSLON	/YES.  DO 'USUAL MODE'
GAMMA,	JMS SEARCH	/NO.  LOOK UP NAME   
	 JMP GAMMA1	/NAME NOT FOUND
	JMS CTLCCK	/CHECK FOR ^C
	JMS LSTSUB	/FOUND.  ADD TO TRNSL1
	ISZ TRNSP1	/FUDGE
	JMS DELFIL	/DO /D DELETION NOW, IF
			/REQUIRED
	JMP GAMMA	/CONTINUE THIS PASS

GAMMA1,	TAD I (TRNSL1	/IS THERE A FIRST ENTRY IN
			/TRANSFER TABLE
	SNA CLA		/WELL??
	 JMP NOTFND	/NO SUCH FILE(S)
	STL RTR		/2000
	AND I (OPT2	/CHECK N OPTION
	SZA CLA		/SET?
	JMP GAMMA2	/YES.  SKIP ENTERS AND TRANSFER
	JMS PASS2	/PERFORM ENTER/CLOSE PAIRS
	JMS PASS3	/DO FILE TRANSFER
GAMMA2,	JMS CMPRS	/COMPRESS DIRECTORY IF REQUIRED
	JMP BETA	/LOOK FOR ANOTHER INPUT

DELTA,	JMS DIOW	/WRITE OLD DIRECTORY, IF
			/NECESSARY
	IAC		/THEN, PREPARE TO
	JMS BKPT	/CLEAR BREAKPOINT
	JMS CTLCCK	/CHECK FOR ^C
	TAD (400
	AND I (OPT2	/CHECK P OPTION
	SNA CLA		/SET?
	JMP DELTA2	/NO
	IAC		/YES
	JMS I (USR	/1 IS SYS:
	 2		/LOOKUP
	 PIP
	 0
	 JMP DELTA3	/NO PIP!  RETURN TO MON.
	TAD .-3		/START BLOCK
	DCA DELTA1
	DCA I (OPT1	/CLEAR OPTIONS SO PIP
	DCA I (OPT2	/WON'T DO ANYTHING
	DCA I (OPT3	/BUT LOOK AT USER
	DCA I (7600
	DCA I (7617	/0 INPUT AND OUTPUT SIDES
	JMS I (USR
	 6		/CHAIN
DELTA1,	 ZZZ
/NO RETURN

DELT   A2,	STL RAR		/4000
	AND I (7642	/CHECK FOR ALT MODE
	SNA CLA		/SET?
	JMP ALPHA	/NO.  BACK TO THE OLD GRIND
DELTA3,	CIF CDF 0	/USER'S WISING UP!
	JMP I (7600	/BYE BYE!!

	PAGE

EPSLON,	TAD (TRNSL1-1	/COME HERE FOR 'USUAL MODE'
	DCA XR1		/SET POINTER FOR 'TRNSFR'
	TAD (TRNSL1
	DCA TRNSP1	/THIS ONE FOR 'LSTSUB'
EPSL1,	JMS SEARCH	/SEEK NAME IN TABLE
	 JMP EPSL2	/NO MORE FOUND
	JMS EPSLS1	/CHECK FOR ^C
	JMS LSTSUB	/SAVE FOUND GOODIES
	JMS DELFIL	/DELETE IF REQUIRED
	TAD DIREP2	/POINTER TO NAME
	DCA .+3
	TAD DIREC1	/FILE LENGTH
	JMS ENTFIL	/ENTER FILE
	 ZZZ
	DCA I TRNSP1	/SAVE RETURNED START BLOCK IN
			/LIST
	ISZ TRNSP1	/HERE'S WHY THERE'S A FUDGE
			/IN 'GAMMA'
	SNL		/OPEN OKAY?
	JMP EPSL1	/NO.  DON'T DO ANYTHING WITH
			/THIS FILE
	JMS EPSLS1	/CHECK FOR ^C
	ISZ XR1		/SKIP PTR TO DIRE
	JMS TRNSFR	/MOVE FILE, USING XR1
	 1		/CLEAR BKPT, PERMIT ^C TO
			/TAKE EFFECT
	JMS EPSLS1	/CHECK FOR ^C AGAIN
	JMS CLOFIL	/CLOSE FILE
	JMS EPSLS1	/CHECK FOR ^C
	JMP EPSL1	/DO NEXT

EPSL2,	TAD I (TRNSL1	/FIRST TABLE ENTRY
	SZA CLA		/IS THERE ONE?
	JMP GAMMA2	/YES.  GOOD
	 JMP NOTFND	/FILE NOT FOUND


EPSLS1,	 .-.		/CHECK FOR ^C FOR EPSLON
	JMS CTLCSK	/^C TYPED?
	 JMP MONRT1	/YES.  RETURN THRU THERE
	JMP I EPSLS1	/NO.

SETUP,	.-.		/SUBROUTINE TO SET UP STUFF
	TAD I CDP
	CIA
	TAD INDEV	/COMPARE NEW INPUT DEVICE WITH
			/LAST ONE
	SZA CLA
	JMS DIOW	/IF DIFFERENT, MUST WRITE DIREC.
			/NOW, BEFORE HANDLER RUNS AWAY.
			/OTHERWISE, AS I FOUND OUT THE
			/HARD WAY, DIREC. FOR FIRST DEVICE
			/WOULD GET WRITTEN ON SECOND
	TAD I CDP	/GET DEVICE AGAIN
	ISZ CDP		/GET NEXT INPUT
	DCA INDEV	/SAVE
	STL RTR		/2000
	AND I (OPT2	/CHECK N OPTION
	SZA CLA		/SET?
	JMP SETU0	/YES.  DON'T COMPARE DEVICES
	TAD INDEV	/COMPARE INDEV
	CIA
	TAD OUTDEV	/WITH OUTDEV, REJECT IF =
	SNA CLA
	 JMP ILLDEV	/ILLEGAL DEVICES
SETU0,	TAD (INDEV
	DCA XR1		/PREPARE TO MOVE REQUESTED NAME
	DCA SPLTI1	/CLEAR INDICATOR OF *
	TAD CDP		/IMPROVE ERROR MESSAGES
	DCA INFILP	/SAVE PTR TO CD STRING
	JMS SPLTCH	/CHECK FOR SPLAT (*)
	JMS SPLTCH	/AGAIN
	JMS SPLTCH	/AGAIN.  ILLEGAL USES ARE FLAGGED
			/IN SPLTCH
	CMA
	TAD SPLTI1	/MAKE 1 OR 2 INTO 0 OR 1
	DCA NAMFLG	/SET NAMFLG, IF NAME IS *
	DCA SPLTI1	/CLEAR INDICATOR
	JMS SPLTCH
	CMA
	TAD SPLTI1	  /DO SAME FOR EXTENSION
	DCA EXTFLG
	TAD INDEV+1	/CHECK FOR 0 FILENAME
	SZA CLA
	JMP .+3		/LEAVE THINGS AS THEY ARE
	ISZ EXTFLG	/WOULD HAVE RETURNED THESE
	ISZ NAMFLG	/FLAGS AS 0.  SET BOTH TO
			/LOOK LIKE *.*
	TAD (TRNSL1-1	/TABLE OF TRANSFER REQUESTS
	DCA XR1
	TAD (-TENTRY^4	/ENTRIES ARE 4 WORDS
	DCA SETUC1	/COUNT FOR CLEARING
	DCA I XR1
	ISZ SETUC1
	JMP .-2
	TAD (TRNSL1
	DCA TRNSP1	/SET UP LIST PTR
	DCA TRNSC2	/0 # OF FILES TRANSFERRED, THIS
			/INPUT REQUEST
	DCA TRNSER	/ERROR FLAG USED BY 'CMPRS'
	TAD (SRCH1
	DCA SRCHS1	/INITIALIZE SEARCH
	JMS BKPT	/SET BREAKPOINT
	TAD (IHNDB+1
	DCA SETU1	/ALLOW TWO PAGE
	TAD INDEV
	JMS I (USR
	 1
SETU1,	 ZZZ
	 JMP FETHND	/FETCHING INPUT HANDLER
	TAD SETU1	/GET HANDLER ENTRY
	DCA ITRANS	/SAVE ADDRESS
	JMP I SETUP

SETUC1, 0


INFILP, 0	/PTR TO PRESENT CD INPUT

	PAGE

ENTFIL,	.-.		/ENTER FILE IN OUTPUT
			/AC HAS FILE LENGTH,
			/ARG 1 IS PTR TO DIRE
	DCA ENTFC1	/SAVE COUNT
	JMS OHNDLD	/MAKE SURE HANDLER IS HERE
	TAD I ENTFIL	/GET DIRE PTR
	ISZ ENTFIL
	DCA ENTFT1	/SAVE.  'CLOFIL' USES THIS
			/LATER
	TAD ENTFT1
	TAD (4
	DCA ENTFP1	/POINT A T DATE, IF ANY
	TAD (20
	AND I (OPT2	/CHECK T OPTION
	SZA CLA		/SET?
	JMP ENTF1	/YES.  USE 'TODAY'
	TAD I (DIRE+4	/NO.  EXTRA WORDS?
	SZA CLA
	TAD I ENTFP1	/YES.  GET DIRE DATE
	SKP		/NO.  USE 0
ENTF1,	TAD TDATE	/'TODAY'
	DCA I (MDATE	/SAVE IN MONITOR DATE CELL
	JMS BKPT	/SET BREAKPOINT
	TAD I DCBPTR
	AND (7770	/CLEAR TENTATIVE FILE INDICATION
	DCA I DCBPTR	/THIS IS A FUDGE, IN CASE ^C IS
			/TYPED DURING THIS BKPT.
			/OTHERWISE, FILE MAY BE ENTERED,
			/AND ATTEMPT TO RE-ENTER WILL
			/CAUSE AN ERROR
	TAD ENTFT1
	DCA ENTF2	/SET UP 'ENTER' PTR
	DCA ENTF2+1	/CLEAR WORD TO GET AROUND BUG IN
			/PS/8 AND OS/8 (FIRST RELEASE),
			/WHERE CONTROL RETURNS TO ENTF2+1
			/ON 'OUT OF ROOM', INSTEAD OF TO
			/ENTF2+2
	TAD ENTFC1	/GET COUNT
	TAD (400
	SMA SZA CLA	/>=400?
	TAD ENTFC1	/NO.  RETRIEVE
	CIA		/GIVES + COUNT OR 0
	CLL RTL
	RTL		/MAKE WAY FOR DEV.
	TAD OUTDEV
	JMS I (USR
	 3		/ENTER
ENTF2,	 ZZZ		/PTR TO NAME
	 ZZZ
	 JMP NOROOM	/OUT OF OUTPUT ROOM
	TAD .-2		/GET TRUE AVAILABLE LENGTH
	CLL CIA
	TAD ENTFC1	/CHECK AGAINST REQUESTED
			/LENGTH
	SNL CLA		/ENOUGH ROOM?:  THIS CHECK
			/MADE TO ACCO  MMODATE FILES
			/>400 BLOCKS, WHICH NORMAL PIP
			/WON'T HANDLE
	 JMP NOROOM	/OUT OF OUTPUT ROOM
	TAD ENTF2	/GET START BLOCK
			/LINK = 1 MEANS OK ENTRY
	JMP I ENTFIL	/RETURN IT

/COME HERE AFTER PRINTING 'NOROOM' ERROR

ENTF3,	ISZ TRNSER	/SET ERROR FLAG TO DISABLE /N
			/AND /R SO INPUT FILES WON'T
			/DISAPPEAR ON ERROR
	CMA CLL		/LINK IS SIGNAL
	JMP I ENTFIL	/RETURN 7777 'TO' BLOCK, WHICH
			/IS ILLEGAL ON ALL DEVICES
			/EVEN RS08!
			/0 LINK MEANS ERROR ENTERING

ENTFT1, 0	/USED BY CLOFIL
ENTFC1, 0	/USED BY CLOFIL
ENTFP1, 0


CLOFIL,	.-.		/CLOSE PRESENTLY OPEN FILE
	TAD ENTFT1
	DCA CLOF1	/SAVE FOR 'CLOSE'
	TAD ENTFC1
	CIA		/MAKE POSITIVE,
	DCA CLOF2	/AND SAVE FOR 'CLOSE'
	JMS BKPT
	TAD OUTDEV
	JMS I (USR
	 4		/CLOSE
CLOF1,	 ZZZ		/PTR
CLOF2,	 ZZZ		/LENGTH
	 HLT		/ONLY POSSIBLE IF OUTDEV=0, OR NO
			/TENTATIVE FILE EXISTS, BOTH
			/OF WHICH POSSIBILITIES ARE NIL
	JMP I CLOFIL


DELFIL,	.-.		/DELETE FILE POINTED AT BY
			/DIREP2
	STL RTR		/2000
	AND I (OPT2	/CHECK N OPTION
	SZA CLA		/SET?
	JMP I DELFIL	/YES.  /D NOT ALLOWED
	JMS OHNDLD	/MAKE SURE OUTPUT IS HERE
	TAD (400
	AND I   (OPT1	/CHECK D OPTION
	SNA CLA		/SET?
	JMP I DELFIL	/NO.  DO NOTHING MORE
	JMS BKPT	/YES
	TAD DIREP2	/GET PTR
	DCA .+4		/SET UP DELETE
	TAD OUTDEV	/OUTPUT DEVICE #
	JMS I (USR
	 4		/CLOSE (DELETE WITH 0 LENGTH)
	 ZZZ
	 0
	 NOP		/NO PROBLEM IF NOT FOUND
	JMP I DELFIL


OHNDLD,	.-.		/LOAD OUTPUT HANDLER IF NOT IN
			/CORE
	TAD OTRANS	/ADDRESS
	SZA CLA		/ANYTHING THERE?
	JMP I OHNDLD	/YES.  ALREADY LOADED
	TAD (OHNDB+1	/NO.  ALLOW TWO PAGE
	DCA OHND1
	JMS BKPT
	TAD OUTDEV
	JMS I (USR
	 1		/FETCH HANDLER
OHND1,	 ZZZ
	 JMP FETHND	/FETCHING HANDLER
	TAD OHND1
	DCA OTRANS	/SAVE ADDRESS
	JMP I OHNDLD


CRLF,	.-.
	TAD (215
	JMS TYO
	TAD (212
	JMS TYO
	TSF		/WAIT FOR FLAG
	JMP .-1		/SO WE DON'T MESS UP CD
	JMP I CRLF

	PAGE

SPLTCH,	.-.		/CHECK FOR VARIOUS POSSIBILITIES
			/OF * IN NAME:
			/*0  *X  X*  **  XX  ,
			/WHERE X IS SOME OTHER CHAR
	TAD I CDP
	ISZ CDP		/GET NAME WORD
	CIA		/MAKE - FOR CHECKS
	DCA SPLTT1	/SAVE
	TAD SPLTT1
	DCA I XR1	/SAVE FOR LATER USE
	TAD SPLTT1
	TAD ("*		/CHECK FOR * IN LOWER BYTE
	AND (77		/(ALWAYS ILLEGAL)
	SNA CLA		/FIND X*?
	 JMP ILLSYN	/ILLEGAL SY  NTAX
	CMA		/NO
	TAD SPLTI1	/WHAT STATE ARE WE IN (NO, NOT
			/MASSACHUSETTS!)
			/0 : INITIAL: *0, X0, XX LEGAL
			/1 : NO *   : 00, X0, XX LEGAL
			/2 : * SEEN : 00 ONLY LEGAL
	SNA		/LOOKING FOR XX?
	JMP SPLT2	/YES
	SMA CLA		/NO.  INITIAL STATE?
	JMP SPLT4	/NO.  MUST SEE 00
	TAD SPLTT1	/YES
	TAD ("*^100	/LOOKING AT *0?
	SZA CLA
	JMP SPLT2	/NO.  COULD BE X0 OR XX
	IAC		/YES.  WILL SET INDICATOR
SPLT1,	IAC		/SET INDICATOR FOR STATE 1
	DCA SPLTI1
	JMP I SPLTCH	/RETURN

SPLT2,	TAD SPLTT1	/STATE 1.  CHECK FOR * IN
			/UPPER BYTE
	CIA
	AND (7700	/MASK JUST UPPER BYTE
	TAD (-"*^100	/SUBTRACT *
	SZA CLA		/* IN UPPER BYTE?
	JMP SPLT1	/NO
	 JMP ILLSYN	/ILLEGAL SYNTAX

SPLT4,	TAD SPLTT1	/CHECK FOR 00
	SNA CLA
	JMP I SPLTCH	/OK
	 JMP ILLSYN	/ILLEGAL SYNTAX

SPLTI1, 0
SPLTT1, 0


DIOR,	.-.		/READ DIRECTORY HALF
	TAD INDEV	/START TO FORM UNIQUE CODE
	CLL RTL
	RAL		/MAKE ROOM FOR BLK #
	TAD I DIOR	/SHOULD BE 1 OR 4
	DCA DIORT1	/GIVES DEVICE & BLOCK KEY TO
			/DIRECTORY SEGMENT
	TAD DIORT1
	TAD DIOSEG	/COMPARE WITH OLD
	SNA CLA		/WANT PRESENT DIRE. HALF?
	JMP I DIOR	/YES.  ALREADY IN CORE
	JMS DIOW   	/WRITE OLD DIRE IF REQUIRED
	TAD DIORT1	/SAVE KEY
	CIA		/NEGATIVE
	DCA DIOSEG
	TAD I DIOR	/GET BLOCK #
	DCA DIORBL
	JMS BKPT	/BREAKPOINT HERE
	CIF 0
	JMS I ITRANS	/ON INPUT DEVICE
	 610		/3 BLOCKS, FIELD 1
	 DIRE
DIORBL,	 ZZZ
	 JMP DRERR	/READING DIRECTORY
	DCA DIOWI	/CLEAR WRITE REQUEST
	ISZ DIOR
	JMP I DIOR

DIORT1, 0
DIOSEG, 0	/PRESENT ENCODED SEGMENT IN CORE

DIOW,	.-.		/WRITE DIRE SEG. IN CORE
			/IF SO INDICATED
	TAD DIOWI	/WRITE REQUEST INDICATOR
	SNA CLA		/NEED TO WRITE?
	JMP I DIOW	/NO
	JMS BKPT	/YES.  BREAKPOINT SET
	TAD DIORBL
	DCA .+5
	CIF 0
	JMS I ITRANS	/WRITE ON INPUT DEVICE
	 4610		/3 BLOCKS, FIELD 0
	 DIRE
	 ZZZ
	 JMP DWERR	/WRITING DIRECTORY
	DCA DIOSEG	/MARK SEGMENT GONE
	DCA DIOWI	/CLEAR WRITE REQUEST
	JMP I DIOW

DIOWI, 0	/WRITE REQUEST FLAG: #0 : PLEASE WRITE


PASS2,	.-.		/PERFORM PASS 2:  ENTER
			/AND CLOSE ALL FILES
	TAD (TRNSL1-1
	DCA XR1
PSS21,	JMS CTLCSK	/HAS ^C BEEN TYPED?
	 JMP PSS22	/YES.
	TAD I XR1	/NO.  IS THERE A NEXT FILE?
	SNA
	JMP I PASS2	/NO.  DONE PASS2
	JMS GETSEG	/YES.  READ SEG., GET PTR
	DCA .+3		/STORE FOR ENTER
	TAD I XR1	/GET COUNT
	  JMS ENTFIL
	 ZZZ
	ISZ XR1		/SKIP 'FROM'
	DCA I XR1	/SAVE AS 'TO' BLOCK
	SZL		/ENTRY OKAY?
	JMS CLOFIL	/YES.  CLOSE FILE NOW!!!
	JMS CTLCSK	/HAS ^C BEEN TYPED?
	 SKP		/YES
	JMP PSS21	/NO
PSS22,	DCA I XR1	/ZERO LIST ENTRY, SO ONLY THOSE
			/FILES THAT HAVE BEEN OPENED AND
			/CLOSED SO FAR WILL BE MOVED
	JMP I PASS2	/THEN, RETURN IMMEDIATEDLY


PIP,	FILENAME PIP.SV	/FOR DELTA

	PAGE

TRNSFR,	.-.		/TRANSFER FILE POINTED AT BY
			/XR1 (THREE WORDS); ARG1 HAS
			/BKPT STATUS
	DCA TRNSI1	/CLEAR TRANSFER COMPLETE
	TAD I XR1	/GET LENGTH
	DCA TRNSC1	/ SAVE FILE LENGTH
	TAD I XR1	/FROM BLOCK
	DCA FRMBLK
	TAD I XR1	/TO BLOCK
	CMA		/CHECK FOR 7777
	SNA		/WAS 'TO' 7777?
	JMP I TRNSFR	/YES.  MEANS FILE WAS OPENED, BUT
			/THERE WAS NOT ENOUGH ROOM.
			/DON'T TRANSFER
	CMA		/NO.  RESTORE BLOCK #
	DCA TOBLK
	ISZ TRNSC2	/MARK ONE MORE FILE TRANSFERRED
TRNS1,	CLL		/FOR TEST
	TAD (TLEN	/LENGTH OF TRANSFER (IN BLOCKS)
	TAD TRNSC1	/COMPARE WITH BLOCKS REMAINING
	SNL CLA		/LAST TIME?
	JMP TRNS2	/NO
	ISZ TRNSI1	/YES.  SET INDICATOR
	TAD TRNSC1	/USE REMAINDER
	CIA		/AS # OF BLOCKS TO COPY
	SKP
TRNS2,	TAD (TLEN	/USE MAX. # OF BLOCKS FOR
			/TRANSFER
	CLL RTR		/R6R=R7L
	RTR
	RTR
	DCA FRMCW	/SAVE READ CONTROL WORD
	STL RAR		/4000
	TAD FRMCW
	DCA TOCW	/WRITE CONTROL WORD
	TAD I TRNSFR	/GET BKPT ON/OFF INDICATION
	JMS BKPT	/SAVE PLACE, IN CASE OF NEFARIOUS
			/^C TYPER!
	CIF 0
	JMS I ITRANS	/INPUT HANDLER
FRMCW,	 ZZZ
	 BUF
FRMBLK,	 ZZZ
	 JMP TRNS5
TRNS3,	TAD I TRNSFR	/GET BKPT ON/OFF INDICATION
	JMS BKPT	/BREAKPOINT AGAIN
	CIF 0
	JMS I OTRANS	/WRITE
TOCW,	 ZZZ
	 BUF
TOBLK,	 ZZZ
	 JMP TRNS6
TRNS4,	TAD TRNSI1	/FINISHED YET?
	SZA CLA
	JMP I TRNSFR	/YES.  RETURN
	TAD FRMBLK	/NO.
	TAD (TLEN	/UPDATE FROM BLOCK
	DCA FRMBLK
	TAD TOBLK
	TAD (TLEN
	DCA TOBLK	/AND TO BLOCK
	TAD (TLEN
	TAD TRNSC1
	DCA TRNSC1	/UPDATE COUNT
	JMP TRNS1	/CONTINUE TRANSFER

TRNS5,	ISZ TRNSER	/INDICATE ERROR TO
			/DISABLE /N OR /R
	 JMP RERR1	/READ ERROR WHILE TRANSFER

TRNS6,	ISZ TRNSER	/INDICATE ERROR TO DISABLE
			/ /N OR /R
	 JMP WERR1	/WRITE ERROR WHILE TRANSFER

TRNSC1, 0
TRNSI1, 0


SRCHS3,	.-.		/PART OF 'SEARCH':
			/COMPARE WORD IN DIRE WITH
			/CD WORD
	SZA		/COUNT PROVIDED?
	DCA SRCHC1	/YES. USE IT
	JMS SR  CHS2	/GET DIRE WORD
	TAD I DIREP4	/AND USER'S
	ISZ DIREP4
	ISZ SRCHC1	/HANDY-DANDY KEEP TRACKER
	NOP		/BEWARE OF SKIPS, AND THE
			/FRUMIOUS BANDERSNATCH
	SNA CLA		/MATCH OK?
	JMP I SRCHS3	/YES.  RETURN
	CLL		/NO.  LINK IS SIGNAL
	TAD (4
	AND I (OPT2	/CHECK V OPTION
	SZA CLA		/SET?
	STL		/YES.  INDICATE FORCED MATCH
	TAD SRCHC1	/AMOUNT TO CORRECT PTR
	CMA
	SNL		/DO WE MATCH?
	JMP SRCH8	/NO.  UPDATE PTR.
	TAD DIREP1	/YES.  UPDATE PTR HERE
	DCA DIREP1
	JMP SRCH7	/AND PRETEND TO MATCH

SRCHC1,	0
DIREP4, 0

CTLCSK,	.-.		/SKIP IF ^C NOT TYPED
	TAD CTLCFL	/GET ^C FLAG
	SNA CLA		/^C TYPED?
	ISZ CTLCSK	/NO
	JMP I CTLCSK

CTLCCK,	.-.		/RETURN TO MONITOR IF ^C TYPED
	TAD CTLCFL	/^C FLAG
	SNA CLA		/UP?
	JMP I CTLCCK	/NO
	TAD ("^
	JMS TYO
	 JMP CTLCTP	/^C TYPE ERROR

MONRT1,	TAD ("^		/FUDGE TYPE-OUT
	JMS TYO
	TAD ("C
	JMS TYO
MONRET,	IAC
	JMS BKPT	/RESTORE BKPT'ED CORE
	JMS TYOWT	/WAIT FOR FLAG, IF ANY
	CDF CIF 0
	JMP I (7600	/RETURN TO MONITOR


CTLCFL, 0	/^C FLAG.  #0 IF ^C WAS TYPED
	PAGE

/
/	THIS ROUTINE IS USED TO SET AND REMOVE TRAPS
/	IN SYSTEM AREA.  NECESSARY TO INTERCEPT ^C
/	AN  D MONITOR AREAS BECAUSE OF THE WAY FILES
/	ARE CREATED AND MOVED IN THIS CRAZY PROGRAM


BKPT,	.-.
	SNA CLA		/SET OR REMOVE?
	JMP BKPT1	/SET BREAKPOINT
	TAD BKPTFG	/BREAKPOINT SET ALREADY?
	SNA CLA
	JMP I BKPT	/NO.  NONE TO REMOVE
	JMS BKPTS2	/PUT FIELD 0 AREA, DATE BACK
	DCA BKPTFG	/CLEAR FLAG
	JMP I BKPT

BKPT1,	TAD BKPTFG	/SET BREAKPOINT
	SZA CLA		/SET ALREADY?
	JMP I BKPT	/YES
	JMS BKPTS1	/NO.  SET UP POINTERS
	TAD (BKPTL2	/LIST OF STUFF TO MOVE
	DCA BKPTP3
BKPT2,	CDF 0
	TAD I BKPTP2
	CDF 10		/MOVE FIELD 0 TO 1
	DCA I BKPTP1
	ISZ BKPTP1
	TAD I BKPTP3
	ISZ BKPTP3	/AND MY STUFF
	CDF 0		/TO FIELD 0
	DCA I BKPTP2
	ISZ BKPTP2
	ISZ BKPTC1	/DONE?
	JMP BKPT2	/NO
	CDF 10		/BACK TO THIS FIELD
	TAD I (MDATE	/GET DATE
	DCA TDATE	/SAVE AS TODAY'S DATE
	ISZ BKPTFG	/SET BREAKPOINT FLAG
	JMP I BKPT	/RETURN

BKPTS1,	.-.		/SET UP BKPT POINTERS
	TAD (BKPTL1
	DCA BKPTP1
	TAD (7600
	DCA BKPTP2
	TAD (-7		/7 ITEMS
	DCA BKPTC1
	JMP I BKPTS1

BKPTS2,	.-.		/MOVE FIELD 0 STUFF BACK
	JMS BKPTS1
	TAD I BKPTP1
	ISZ BKPTP1
	CDF 0
	DCA I BKPTP2
	ISZ BKPTP2
	CDF 10
	ISZ BKPTC1
	JMP .-7
	TAD TDATE
	DCA I (MDATE
	JMP I BKPTS2

/
/	IF SOMEONE TYPES ^C, OR IF A MONITOR
/	ERROR OCCURS, CONTROL COMES HERE:
/

BKPT3,	KSF		/SOMETHING TYPED?
	JMP BKPT4	/NO.  ASSUME MONITOR ERROR
	KCC		/YES.  ASSUME ^C.  IGNORE
	TAD (207	/BELL
	JMS TYO		/DINGALING USER!
	ISZ CTLCFL	/SET ^C FLAG
	JMP I BKPT	/RETURN TO STRPIP AT POINT
			/WHERE BKPT LAST CALLED

BKPT4,	JMS BKPTS2	/MONITOR ERROR.  PANIC!!!
			/RESTORE FIELD 0 AREA
	CDF CIF 0
	JMP I (7600	/AND GO TO MONITOR

BKPTP1, 0
BKPTP2, 0
BKPTP3, 0
BKPTC1, 0
BKPTFG, 0	/1 IF BREAKPOINT IS SET

TDATE, 0	/SAVED TODAY'S DATE

BKPTL1,	*.+7	/ROOM FOR FIELD 0 STUFF

BKPTL2,	7605&177+5200	/'JMP 7605'
TYOM3,	-3;0;0	/FILLER
	BKPT3
	CDF CIF 10
	7604&177+5600	/'JMP I 7604'

TYO,	.-.		/GOOD OLD TTY OUTPUT
	DCA TYOT1
	JMS TYOWT
	TAD TYOT1	/GET CHAR AGAIN
	TLS
	CLA
	JMP I TYO

TYOWT,	.-.
	TAD TYOM3	/PRESERVE LINK
	DCA TYOC2
	DCA TYOC1
TYOW1,	TSF
	SKP
	JMP I TYOWT
	NOP
	NOP		/DELAY ENOUGH FOR 8/E
	ISZ TYOC1
	JMP TYOW1
	ISZ TYOC2
	JMP TYOW1
	JMP I TYOWT	/ASSUME NO FLAG

TYOT1, 0
TYOC1, 0
TYOC2, 0


GETSEG,	.-.		/GET SEGMENT IN CORE, RETURN
			/TRUE PTR.  ENTER WITH
			/TRNSL1 TYPE PTR
	STL RAR		/FORM TRUE PTR, SEG TO LINK
	DCA GETST1	/SAVE
	SZL
	TAD (3
	IAC		/FORM PROPER BLOCK #
	DCA .+2		/SAVE FOR SUBROUTINE
	JMS DIOR	/READ IF NECESSARY
	 ZZZ
	TAD GETST1	/FETCH PTR FOR RETURN
	JMP I GETSEG

GETST1, 0

	PAGE

SEARCH,	.-.		/DIRECTORY SEARCH ROUTINE
	JMP I SRCHS1
SRCHS1,	.-.
	JMP I SEARCH

SRCH1,	JMS DIOR	/READ FIRST DIRE HALF
	 1		/THAT'S WHAT THIS MEANS
	CMA		/-1 OFFSET.  (SEE SRCH2A)
SRCH1A,	DCA SRCHI1	/BLOCK OFFSET OF FIRST
			/BLOCK IN CORE
	CMA CLL RTL	/-3
	DCA SRCHC2	/# OF BLOCKS IN CORE
	JMP SRCH3

SRCH2,	TAD DIREI3	/NEXT BLOCK FLAG
	SNA CLA		/FINISHED DIRE?
	JMP I SEARCH	/YES.  RETURN
	ISZ SRCHC2	/NO.  FINISHED STUFF IN CORE?
	JMP SRCH2A	/NO
	JMS DIOR	/YES.  READ SECOND HALF
	 4		/WHICH BEGINS AT BLOCK 4
	TAD (-4		/SET OFFSET
	JMP SRCH1A

SRCH2A,	TAD SRCHI1	/GET BLOCK OFFSET
	TAD DIREI3	/AND BLOCK WE WANT
	CLL RTR
	RTR
	RAR		/R5R=R8L: *400
SRCH3,	TAD (DIRE	/FORM POINTER TO DIRE BLOCK
	DCA DIREP1	/POINTER TO DIRECTORY BLOCK
	CLL		/FOR TEST
	TAD I DIREP1	/COUNT
	TAD (100	/MAKE VALIDITY CHECK
	SNL CLA		/GOOD DIRE?
	 JMP BADDIR	/BAD DIRECTORY
	JMS SRCHS2	/YES
	DCA DIREC2	/NEXT WORD IS COUNT FOR SEGMENT
	JMS SRCHS2
	DCA DIREBL	/NEXT WORD IS FIRST BLOCK REFERENCED
	JMS SRCHS2
	DCA DIREI3	/NEXT WORD IS FLAG FOR NEXT SEGMENT
	ISZ DIREP1	/SKIP TENTATIVE FLAG
	JMS SRCHS2
	CMA		/EXTRA WORDS FLAG
	DCA XTRAWD	/SAVE -1 TO #-1 EXTRA WORDS FLAG
SRCH4,	TAD I DIREP1	/CHECK THIS ENTRY
	SNA CLA		/EMPTY?
	JMP SRCH9	/YES.  JUST UPDATE BLOCK
	TAD NAMFLG	/NAMFLG SET?  (AUTOMATIC MATCH)
	SNA CLA
	JMP SRCH5	/NO
	ISZ DIREP1	/YES.
	ISZ DIREP1	/SKIP NAME
	ISZ DIREP1
	TAD (INDEV+1+3	/POINT AT .EXT
	DCA DIREP4	/FOR EXTENSION CHECK
	JMP SRCH6

SRCH5,	TAD (INDEV+1	/SET UP FOR SRCHS3
	DCA DIREP4
	TAD (-5		/PASS COUNT
	JMS SRCHS3
	JMS SRCHS3
	JMS SRCHS3
SRCH6,	TAD EXTFLG	/NAME MATCHED.  CHECK EXT.
	SZA CLA		/EXTENSION FLAG SET?
	JMP SRCH6A
	CMA CLL RAL	/NO.  PASS COUNT (-2)
	JMS SRCHS3	/CHECK FOR .EXT MATCH
	SKP		/OK, SO DON'T INCREMENT PTR
SRCH6A,	ISZ DIREP1	/SKIP OVER EXTENSION
/EXTENSION MATCHED
	TAD (4
	AND I (OPT2	/CHECK V OPTION
	SZA CLA		/SET?
	JMP SRCH8	/YES.  INVERT SENSE, TREAT
			/LIKE FAILURE
SRCH7,	TAD XTRAWD	/NO.
	IAC
	TAD DIREP1
	DCA   DIREP2	/POINT AT COUNT
	TAD I DIREP2
	SNA		/#0?
	JMP SRCH8	/WAS TENTATIVE FILE.  TREAT LIKE
			/FAILURE
	DCA DIREC1	/SAVE COUNT FOR LATER USE
	ISZ SEARCH	/RETURN WITH A SKIP
	TAD DIREP1
	TAD (-4		/POINT AT FIRST WORD
	DCA DIREP2
	JMS SRCHS1	/EXIT THRU SRCHS1
SRCH8,	TAD XTRAWD
	TAD DIREP1
	DCA DIREP1	/UPDATE POINTER
SRCH9,	ISZ DIREP1	/FROM EMPTY ENTRY
	JMS SRCHS2	/GET COUNT WORD
	CIA
	TAD DIREBL	/UPDATE BLOCK #
	DCA DIREBL
	ISZ DIREC2	/DONE SEGMENT?
	JMP SRCH4	/NO
	JMP SRCH2	/YES

SRCHS2,	.-.		/USE THIS TO SAVE SOME SPACE
	TAD I DIREP1
	ISZ DIREP1
	JMP I SRCHS2	/RETURN DIRE WORD


DIREP1, 0	/INTERNAL POINTER
DIREI3, 0	/NEXT SEGMENT FLAG
DIREC2, 0	/ENTRIES/SEGMENT COUNTER
DIREBL,	0		/CURRENT BLOCK # REPRESENTED
			/BY PRESENT FILE

XTRAWD, 0	/# OF EXTRA WORDS IN THIS DIRE.
		/SAVED AS 1'S COMP (-1=0 WORDS)
NAMFLG, 0
EXTFLG, 0


SRCHC2, 0	/# OF BLOCKS IN THIS HALF TO DO
SRCHI1, 0	/BLOCK OFFSET FOR FIRST BLOCK IN CORE

INDEV,	ZBLOCK 5	/FIRST WORD IS INDEV #,
			/2ND - 5TH ARE FILENAME, FRESH
			/FROM CD AND NEGATED

	PAGE

CMPRS,	.-.		/COMPRESS DIRECTORY, SQUEEZING
			/OUT ALL REFERENCED FILES,
			/ALL ABUTTING EMPTIES IN ANY
			/ONE BLOCK
	TAD (2100
	AND I (OPT2	/CHECK N,R OPTION
	SNA CLA		/SET?
CMPRRT,	JMP I CMPRS	/NO.  DON'T DO THIS
			/SERVE AS CROSS-PAGE RETURN
	JMS CTLCCK	/CHECK FOR ^C
	TAD TRNSER	/CHECK FOR ERRORS
	SZA CLA		/HAVE THERE BEEN ANY?
	JMP I CMPRS	/YES.  DON'T DO DELETIONS
	TAD (TRNSL1
	DCA CMPRP1	/POINT AT FIRST LIST ENTRY
	CMA CLL RAL	/-2
	TAD EXTFLG
	TAD NAMFLG
	SZA CLA		/ARE BOTH FLAGS SET?
	JMP CMPR1	/NO
	CMA CLL RAL	/-2
	TAD INDEV	/YES.  CHECK INPUT DEVICE
	SMA SZA CLA	/WAS IT 1 OR 2?
	JMP CMPR1	/NO
	TAD (CMPRM1-1	/YES.  SYS OR DSK
	JMS CMPRS1	/WIPE OUT?
	CMA
	TAD INDEV	/1 OR 2
	SNA CLA
	TAD (CMPRM2-CMPRM3
	TAD (CMPRM3-1
	JMS CMPRS1	/DSK? OR SYS?
	JMS CRLF
	KSF		/WAIT FOR RESPONSE
	JMP .-1
	KRB
	TAD (-"Y	/WAS IT 'Y'
	SNA CLA
	JMP .+5		/YES
	TAD (CMPRM5-1	/NO.
	JMS CMPRS1	/'NO'
	JMS CRLF
	JMP I CMPRS

	TAD (CMPRM4-1
	JMS CMPRS1	/'YES'
	JMS CRLF
CMPR1,	CLA IAC
	AND I CMPRP1	/GET SEG. BIT
	CIA
	DCA CMPRI1	/SAVE INDICATOR
CMPR2,	TAD I CMPRP1	/GET NEXT LIST ENTRY
	SNA		/DONE?
	JMP CMPR3	/ALMOST.  REMOVE ANY
			/ENTRIES FIRST
	RAR		/NO.  PUT SE G. BIT IN LINK
	GLK		/GET AGAIN
	TAD CMPRI1	/COMPARE WITH PRESENT SEG.
			/BEING LOOKED AT
	SZA CLA		/SAME?
	JMP CMPR3	/NO.  REMOVE STUFF IN THIS
			/SEG.  BEFORE GETTING NEXT
	TAD I CMPRP1	/YES.  GET PTR AGAIN
	JMS GETSEG	/LAZY WAY TO ADJUST PTR, MAKE
			/SURE PROPER SEG. IS IN CORE
	DCA CMPRP2	/SAVE RETURNED PTR
	CMA		/INDICATE DELETABLE FILE
	DCA I CMPRP2	/BY STORING 7777 IN FIRST WORD
	TAD (4
	TAD CMPRP1
	DCA CMPRP1	/UPDATE LIST PTR
	JMP CMPR2	/PROCEED


TRNSER, 0	/RECORD OF # OF ERRORS
		/WHILE TRANSFERRING FILE
		/IF #0, DON'T DELETE INPUT FILES

CMPRS1,	.-.		/SUBR. TO HELP OUT
	DCA XR1
	TAD I XR1	/PAIR OF CHARS
	JMS PR2CH
	 JMP I CMPRS1
	 JMP .-3
	 JMP .-4

CMPRM1,	TEXT 'WIPE OUT '
CMPRM2,	TEXT 'SYS?'
CMPRM3,	TEXT 'DSK?'
CMPRM4,	TEXT 'YES'
CMPRM5,	TEXT 'NO'

LSTSUB,	.-.		/SUBR. TO PUT FOUND FILE INFO
			/INTO TRNSL1
	IAC
	AND DIOSEG	/WHICH SEGMENT?
	CLL RAR		/PUT IN LINK
	TAD DIREP2
	CML RAL		/FORM STORABLE PTR
	DCA I TRNSP1
	ISZ TRNSP1
	TAD DIREC1	/GET FILE LENGTH
	DCA I TRNSP1
	ISZ TRNSP1
	TAD DIREBL	/AND START BLOCK OF 'FROM'
	DCA I TRNSP1
	ISZ TRNSP1	/LEAVE PTR AT 'TO' BLOCK
	JMP I LSTSUB


	PAGE

CMPR3,	CMA CLL RTL	/-3
	DCA CMPRC2	/# OF BLOCKS PER DIRE HALF
CMPR4,	TAD (DIRE
	DCA CMPRP2	/PTR TO PLACE IN CORE
	TAD CMPRP2
	DCA CMPRFM	/KEEP PTR TO COUNT, SO IF
			/DIRE IS SHORTENED,
			/DELETIONS WILL BE NOTED
	TAD I CMPRFM	/GET COUNT WORD
	ISZ CMPRFM
	DCA CMPRC1	/ENTRIES IN THIS BLOCK
	ISZ CMPRFM	/SKIP BLOCK #
	TAD I CMPRFM
	ISZ CMPRFM
	DCA CMPRI2	/NEXT BLOCK #
	ISZ CMPRFM	/SKIP TENTATIVE FLAG
	TAD I CMPRFM
	ISZ CMPRFM
	TAD (-5		/# OF WORDS TO MOVE FOR
			/NORMAL FILE ENTRY
	DCA CMPRI3	/SAVE
	TAD CMPRFM
	DCA CMPRTO	/SET 'TO' PTR
	DCA MTFLG	/CLEAR EMPTY FILE FLAG
CMPR5,	TAD MTFLG	/GET BIT
	CLL RAR		/PUT IN LINK
	TAD I CMPRFM	/GET FIRST WORD OF ENTRY
	SNA		/EMPTY?
	JMP CMPR9	/YES
	CMA		/NO.  CHECK FOR 7777
	SNA CLA		/WELL?
	JMP CMPR8	/YES
	SZL		/NO.  REGULAR ENTRY
	ISZ CMPRTO	/INCREMENT TO IF WE WERE
			/PLAYING WITH EMPTIES
	TAD CMPRI3	/ITEMS TO MOVE
	DCA CMPRC3
	TAD I CMPRFM
	ISZ CMPRFM
	DCA I CMPRTO
	ISZ CMPRTO
	ISZ CMPRC3
	JMP .-5
CMPR6,	DCA MTFLG	/SET MTFLG
	ISZ CMPRC1	/DONE BLOCK
	JMP CMPR5	/NO
	TAD CMPRI2	/YES.  CHECK FOR NEXT BLOCK
	SNA CLA		/IS THERE ONE?
	JMP .+3		/NO
	ISZ CMPRC2	/ARE WE DONE THIS HALF?
	JMP CMPR7	/NOT YET.  MORE TO DO
	TAD I CMPRP1	/YES.  WAS LIST ENTRY 0?
	SZA CLA
	JMP CMPR1	/NO.  PICK UP WHERE WE LEFT OFF
	JMP CMPRRT	/AND RETURN

CMPR7,	TAD CMPRI1	/ANOTHER BLOCK TO DO
	SZA CLA		/WHICH HALF?
	CMA CLL RTL	/-3.  SECOND
	TAD (-1		/GIVES BLOCK OFFSET OF FIRST
			/BLOCK IN CORE
	TAD CMPRI2	/ADD TO NEXT BLOCK
	CLL RTR
	RTR
	RAR		/R5R=R8L: *400
	JMP CMPR4	/DO NEXT BLOCK

CMPR8,	ISZ DIOWI	/FILE TO DELETE.  MARK
			/FOR WRITING
	TAD CMPRI3	/# OF WORDS
	CMA		/WILL POINT AT COUNT
	TAD CMPRFM
	DCA CMPRFM	/RESET FROM
	SKP
CMPR9,	ISZ CMPRFM	/EMPTY.  POINT AT COUNT
	SNL		/EMPTY FLAG SET?
	JMP CMPR11	/NO
	ISZ DIOWI	/YES.  WE ARE REMOVING ONE FILE
	ISZ I CMPRP2	/BY INCREMENTING COUNT
	SKP		/SHOULD NEVER SKIP
	HLT
	TAD I CMPRTO	/GET PRESENT COUNT
CMPR10,	TAD I CMPRFM	/COMBINE WITH NEW
	ISZ CMPRFM
	DCA I CMPRTO	/SAVE EMPTY COUNT
	IAC		/TO SET FLAG
	JMP CMPR6	/NOW IN EMPTY MODE

CMPR11,	DCA I CMPRTO	/0 TO FIRST WORD
	ISZ CMPRTO
	JMP CMPR10	/MOVE COUNT


CMPRC1, 0
CMPRC2, 0
CMPRC3, 0
CMPRI1, 0
CMPRI2, 0
CMPRI3, 0
CMPRTO, 0	/'TO' PTR
CMPRFM,	0	/'FROM' PTR
MTFLG,	0	/EMPTY FLAG: 1 MEANS EMPTY MODE


PASS3,	.-.		/PERFORM PASS3:  TRANSFER ALL
			/FILES
	TAD (TRNSL1-1
	DCA XR1		/POINT AT TRNSL1
	TAD I XR1	/DO ANOTHER?
	SNA CLA
	JMP I PASS3	/NO
	JMS TRNSFR	/YES.  INFO POINTED AT BY XR1
	 0		/DON'T ALLOW ^C TO BREAK IN
	JMP .-5


	PAGE

ERROR,	.-.		/GENERAL ERROR ROUTINE
CSPACE,	CLA CMA		/USED AS CONSTANT (240)
	TAD I ERROR	/GET PTR TO TEXT
	ISZ ERROR
	DCA XR2
ERR1,	TAD I XR2	/GET FIRST TWO CHARS
	JMS PR2CH
	 JMP ERR7	/ADD FINISHING TOUCH
	 JMP ERR1	/REGULAR PRINT
	CMA		/^ SEEN
	TAD I ERROR	/GET TYPE WORD
	ISZ ERROR
	SNA		/WAS IT 1?
	JMP ERR5	/YES.  HANDLE INPUT #
	SMA CLA		/WAS IT 0?
	JMP ERR6	/NO
	TAD I ERROR
	ISZ ERROR
	DCA ERRT1	/PTR
	TAD I ERRT1
ERR2,	CLL RAL		/GET READY
	DCA ERRT1
	TAD (-4
	DCA ERRC1	/4 DIGITS
	JMS ERRS2	/DRIVE OUT DIGITS
	ISZ ERRC1	/LAST ONE?
	SZA		/NO.  NON-ZERO?
	SKP		/YES.  PRINT IT
	JMP .-4		/NO.  WAIT FOR NON-ZERO
	JMS ERRS3	/PRINT DIGIT
	JMS ERRS2	/GET NEXT DIGIT
	JMP .-2		/PRINT ALL THE REST

ERRS3,	.-.		/PRINT DIG                                                          IT, CHECK FOR END
	TAD ERRSK1	/"0
	JMS TYO		/PRINT DIGIT
	TAD ERRC1	/COUNT
	SNA CLA		/DONE YET?
	JMP ERR1	/YES
	ISZ ERRC1	/NO.  INCR. COUNT
ERRSK1,	 "0
	JMP I ERRS3


ERRT1, 0
ERRC1, 0

ERR5,	DCA ERRT1	/PRINT INPUT REQUEST #
	TAD ("#
	JMS TYO		/PRINT #
	TAD CDP
	TAD (-7605	/INITIAL VALUE
	TAD (-5		/INCREMENT
	ISZ ERRT1
	SMA SZA		/FIND OUT WHICH ONE?
	JMP .-3		/NO
	CIA		/YES.  CORRECT POINTER
	TAD CDP
	DCA CDP		/IN CASE IT'S USED LATER
	TAD ERRT1	/PICK UP SINGLE DIGIT
	JMP ERR2	/PRINT DIGIT

ERR6,	TAD I ERROR	/GET PTR TO PTR
	ISZ ERROR
	DCA ERRT1	/PTR TO PTR
	TAD I ERRT1
	DCA ERRT1	/SAVE PTR TO FILENAME
	JMS ERRS1	/PRINT FIRST TWO
	JMS ERRS1	/SECOND TWO
	JMS ERRS1	/THIRD TWO
	TAD I ERRT1	/GET EXTENSION
	SNA CLA		/IS THERE ONE?
	JMP ERR1	/NO
	TAD (".		/YES.  PRINT .
	JMS TYO
	JMS ERRS1	/PRINT .EXT
	JMP ERR1

ERR7,	JMS CRLF
	JMP I ERROR

ERRS1,	.-.		/PRINT TWO FILENAME CHARS
	TAD I ERRT1
	ISZ ERRT1
	JMS PR2CH
	 JMP I ERRS1
	 JMP I ERRS1
	 JMP I ERRS1	/ACCOUNT FOR ALL RETURNS


PR2CH,	.-.		/PRINT TWO CHARS IN AC
			/RETURN +0 IF CHAR IS 0
			/	+1 IF REGULAR TWO CHARS
			/	+2 IF ^ IS A CHAR
	SNA		/SEE TWO 0'S?
	JMP I PR2CH	/YES
	DCA PR2CT1	/NO
	TAD PR2CT1
	CLL RTR
	RTR
	RTR
	JMS PR6BIT	/PRINT 1 SIX BIT CHAR
	 JMP I PR2CH	/WAS 0
	 JMP PR2C1	/WAS ^
	TAD PR2CT1	/PRINT SECOND CHAR
	JMS PR6BIT
	 JMP I PR2CH	/WAS 0
PR2C1,	 ISZ PR2CH	/WAS ^
	ISZ PR2CH	/WAS REGULAR
	JMP I PR2CH

PR2CT1, 0

PR6BIT,	.-.		/PRINT 6-BIT CHAR IN AC
	AND (77
	SNA
	JMP I PR6BIT	/RETURN +0 ON 0
	TAD (-"^&77+7700
	SNA		/CHECK FOR ^
	JMP PR6B1	/SAW IT.  DON'T PRINT
	TAD ("^&77+240	/RESTORE CHAR, ADD 240
	AND (77
	TAD CSPACE	/CREATE 8-BIT CHAR
	JMS TYO		/PRINT
	ISZ PR6BIT	/+2 ON NORMAL
PR6B1,	ISZ PR6BIT	/+1 ON ^
	JMP I PR6BIT


	PAGE


ERRS2,	.-.		/CARRY OVER FROM PREVIOUS PAGE
	TAD ERRT1
	RAL
	RTL
	DCA ERRT1
	TAD ERRT1
	AND (7
	JMP I ERRS2	/RETURN NEXT DIGIT

/ERROR MESSAGE HANDLING

BADOUT,	JMS ERROR
	 MBADOUT
	JMP ALPHA

NOTFND,	JMS ERROR
	 MNOTFND
	 2;INFILP	/PRINT FILENAME POINTED AT BY INFILP
	JMP BETA

ILLDEV,	JMS ERROR
	 MILLDEV
	 1	/PRINT FILE #
	JMP BETA

FETHND,	JMS ERROR
	 MFETHND
	 1	/PRINT FILE #
	JMP ALPHA

NOROOM,	JMS ERROR
	 MNOROOM
	 2;ENTFT1	/PRINT FI    LENAME POINTED AT BY ENTFT1
	 1	/PRINT FILE #
	JMP ENTF3

ILLSYN,	JMS ERROR
	 MILLSYN
	 2;INFILP	/PRINT FILENAME POINTED AT BY INFILP
	 1	/PRINT FILE #
	JMP BETA
/PRINTING INPUT # CAUSES CDP TO BE CORRECTED


MBADOUT,	TEXT 'ILLEGAL OUTPUT DEVICE'
MNOTFND,	TEXT '^@ NOT FOUND'
MILLDEV,	TEXT 'INPUT=OUTPUT, INPUT ^@'
MFETHND,	TEXT 'ERROR FETCHING HANDLER, INPUT ^@'
MNOROOM,	TEXT 'NO ROOM FOR ^@, INPUT ^@'
MILLSYN,	TEXT '^@ IS AN ILLEGAL NAME, INPUT ^'

	PAGE

DRERR,	JMS ERROR
	 MDRERR
	 1	/PRINT FILE #
	JMP ALPHA

DWERR,	JMS ERROR
	 MDWERR
	 1	/PRINT FILE #
	JMP ALPHA

RERR1,	JMS ERROR
	 MRERR1
	 0;FRMBLK	/PRINT VALUE IN FRMBLK (OCTAL)
	 1	/PRINT FILE #
	JMP TRNS3

WERR1,	JMS ERROR
	 MWERR1
	 0;TOBLK	/PRINT VALUE IN TOBLK (OCTAL)
	 1	/PRINT FILE #
	JMP TRNS4


BADDIR,	JMS ERROR
	 MBADDIR
	 1	/PRINT FILE #
	JMP BETA

CTLCTP,	JMS ERROR
	 MCTLCTP
	 0;TRNSC2	/PRINT VALUE IN TRNSC2 (OCTAL)
	 1	/PRINT FILE #
	JMP MONRET


MDRERR,	TEXT 'DIRECTORY READ ERROR, INPUT ^@'
MDWERR,	TEXT 'DIRECTORY WRITE ERROR, INPUT ^'
MRERR1,	TEXT 'ERROR READING BLOCK ^@ , INPUT ^'
MWERR1,	TEXT 'E         RROR WRITING BLOCK ^@, INPUT ^@'
MBADDIR,	TEXT 'BAD DIRECTORY, INPUT ^'
MCTLCTP,	TEXT 'C^_^'


$$$$$$$$$$$$$$$$$$$$$$$$