	.SYSID <	.TITLE		PIP >,<000>
/ 
/ 
/ 
/
/COPYRIGHT (C) 1975
/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/
/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY
/ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH
/THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS
/SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT BE PRO-
/VIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON
/EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO
/THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE
/WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COM-
/MITMENT BY DIGITAL EQUIPMENT CORPORATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
/OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
	.EJECT
/COPYRIGHT 1971,72, 73 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
/M. SIFNAS, J.M. WOLFBERG 
/
/V7A FOR DOS-15		JUN.  29, 73	EDIT #095
/	096	S.KRISH	23-OCT-73	N DP/DK/RK FORWARD & BACKWARD
/					LINK SETUP BUG FIX
/	097	J. WOLFBERG 13-MAY-74	CORRECTION OF EDIT 96.
/
/	098, 099	P. RAGON 28-JUNE-74	SEVERAL FIXES DENOTED IN SOURCE
/
/	100	P. RAGON 3-JULY-74	SEVERAL FIXES DENOTED IN SOURCE
/	101	J. WOLFBERG 11-JULY-74	TTY USE UNDER BOSS, DON'T ALLOW 2 DATA MODE
/					SPECIFICATIONS, NO CTRL P IF SEGEMENTING ON BULK STORAGE.
/	102	J.WOLFBERG 16-JULY-74	CORRECTION TO 101: TTY UNDER BOSS.
/
/	103	J. KENTON 16-JULY-74	ADD COPY FROM MAGTAPE
/	103A	J.WOLFBERG 18-JULY-74	CORRECTION TO DATA MODE SWITCH CONFLICTS,
/					N SWITCH PROBLEM FIXED - SEE ROUTINE 'DKCLER'.
/	103B	ED GARDNER 19-JUL-74	CHANGE HELLO MESSAGE
/
/	104	J KENTON 2-AUGUST-74	FIX COPY FROM MAGTAPE
/	105	J.WOLFBERG 10-30-74	FIX PROTECTION CODE ERROR IN COPY.
/	106	J.WOLFBERG 10-30-74	MAKE WPC FOR LINES CORRECTED UNDER G SWITCH BE OTHER
/					THAN 132.
/	107	J.WOLFBERG 2-JAN-75	CHANGE HELLO TO V3B000.
/	108	J.WOLFBERG 7-MAY-75	C SWITCH RETURNED TO ORIGINAL FUNCTION OF CHANGING MULTIPLE
/					SPACES TO TABS SUCH THAT THE LISTING FILE LOOKS
/					IDENTICAL BEFORE AND AFTER; REPLACE COPYRIGHT; IGNORE
/					FILE PROT. CODES IF UIC UNPROTECTED; ADD ERROR
/					MESSAGE 'DATA MODE MISMATCH'.
/	109	J. WOLFBERG  3-JULY-75	ADD V SWITCH (VERTICAL FORMAT CONTROL); DISALLOW S,N
/					SWITCH TO MAGTAPE; IN LIST, AND OFF BIT 0 FOR
/					BLOCK COUNT; DELETE 2 EXTRA BLANK WORDS AFTER
/					USING T,C,E SWITCHES.
/	110	J. WOLFBERG 24-JULY-75	CORRECTION TO N SWITCH (DELETIONS ONLY).
/	111	K. BLACKETT 21-AUG-75	PUT IN 'SY' AND 'CM' PSEUDO-DEVICES.
/					RESMON HAS BEEN CHANGED TO PUT ONE MORE
/					WORD IN THE .DEV TABLE--THE MNEMONIC FOR
/					THE SYSTEM DISK TYPE.  SO WE EXTRACT THIS
/					NEW WORD DURING INITIALIZATION AND USE
/					IT TO TRANSLATE 'SY' IN THE GETDEV RTN.
/					AS FOR 'CM', WE HAVE CHANGED DEVCHK
/					TO KNOW THAT 'CM' IS TO USE DAT SLOT -2.
/					CM STANDS FOR 'COMMAND' AND IS THE BATCH
/					FILE IF WE'RE BATCHING, THE TTY IF WE'RE
/					NOT.
/	112	J. WOLFBERG	23-SEPT-75	CORRECT VERSION NUMBER.
/	113	K. BLACKETT	04-NOV-75	EXIT FROM PIP IS DESIRED
/						WHEN A COMMAND ERROR IS
/						DETECTED WHILE IN BATCH
/						MODE, AS IN BOSS MODE.
/	114	J. WOLFBERG 09-NOV-75	FIX UPDATE ROUTINE: (1) NO BLOCK I# IS 
/					ENTERED INTO THE BAT % COUNTED MORE THAN ONCE;
/					(2) BLOCK # OF AN OCCUPIED BLOCK IS NOT ENTERED;
/					AND (3) WRITE BAT AFTER EACH ENTRY TO AVOID
/					POSSIBLE LOSS ON A LIST ENTRY.
/	115	J. WOLFBERG 12-NOV-75	SEARCH ON CORRECT NUMBER + .DAT SLOTS.
/	116	J. WOLFBERG 26-NOV-75	(1) ALWAYS WRITE BAT (FOR 1ST TIME CASE);
/					(2) EXIT AFTER H MODE COPY IF COMMAND STRING
/					ENDED IN ALTMODE OR JUST COPIED OVER SY DISK.
/
/MACRO P OPTION CAN BE USED WHEN ASSEMBLING PIP.
/DEFAULT ASSEMBLY (NO PARAMETERS DEFINED) YIELDS A STANDARD  VERSION THAT WILL
/  RUN ON THE PDP-9 ,PDP-15 AND XVM.
/PARAMETERS TO BE DEFINED: 
/
/
/TEST		/DEFINE (1) TO ENABLE USE OF DDT FOR DEBUGGING.
	.TITLE
	.IFDEF TEST
TEST=1
	.EBREL
	.ENDC
	.IODEV 1,2,3,4,5,6,7,10,11,12,13,14,15,16,17,20
IDX=ISZ			/USE FOR INDEXING
SET=ISZ			/USED TO SET SWITCHES.
.SCOM=100
UENTRY=10		/UFD ENTRY SIZE.
MENTRY=4			/MFD ENTRY SIZE.
DEPORT=.SCOM+54			/DEFAULT PROTECTION CODE.
UIC=.SCOM+41			/LOGGED IN UIC STORED IN .SCOM+41.
MIC=.SCOM+42			/BIT 0=1=MIC LOGGED-IN.
SDATE=.SCOM+47			/CURRENT DATE IN FORM MMDDYY.
DEVTSZ=.SCOM+24			/NUMBER OF POSITIVE .DAT SLOTS.
BOSS=.SCOM+52			/BIT 0=1 IF BOSS OPERATING; BIT 4=1 TO OUTPUT TO TTY.
SC.NMF=.SCOM+42			/(RKB-113) NON-RES MON FLAGS WORD.
/				/(RKB-113) BIT 17 IS BATCH OR BOSS MODE
SC.BCH=1			/(RKB-113) MASK FOR SC.NMF FOR CHECKING
/				/(RKB-113) EITHER BATCH OR BOSS MODE
RFMFD=1777		/MFD BLOCK ON DECDISK.
DPMFD=47040		/MFD BLOKC ON DISK PACK.
	.TITLE PIP INITIALIZATION
/
/STARTING ADDRESS OF PIP.
Z1BUF=.
BEGIN	LAC* (UIC
	DAC PIPUIC		/LOGGED-IN UIC.
	LAC* (MIC		/BIT 0=1=MIC LOGGED-IN.
	AND LM4M		/(400000.
	DAC PIPMIC		/NON-ZERO IF MIC LOGGED-IN.
	LAC* (DEVTSZ
	DAC DEVSZE
	LAC* (DEPORT
	AND (7
	DAC PROTCT		/DEFAULT PROTECTION CODE.
	JMP RESTRT
	.BLOCK	365		/THIS # MUST BE CHANGED IF # LINES OF CODE ABOVE CHANGE.
Z2BUF	.BLOCK 400
CMDOUT=.-124		/COMMAND STRING ECHO BUFFER.
CMECHO=.-121		/A SPACE (40) AT CHECHO-1 IS NECESSARY
			/TO LINE UP ECHO WITH THE ORIGINAL.
PPATCH	.BLOCK 25		/AREA FOR PATCHING.
OUTPIP	3000		/WORD PAIR COUNT OF 3 (ALSO LIT 3000).
TCHAR1	0
	.IFUND TEST
	.SYSID <	.ASCII 'PIP >,<000'<15>>
	.ENDC
	.IFDEF TEST
	.SYSID <	.ASCII 'PIP >,<000 EDIT116'<15>>
	.ENDC
PIPAGN	777777			/-1 IF "PIP" TO BE OUTPUT.
RESTRT	DZM RSTRTP	/RESTART ON ^P.
	DZM YEOFSW
/	.INIT -2,0,NUORRE	/.INIT TELETYPE IN AND OUT
	CAL+776		/CAUSES CR/LF TO
	1		/TELEPRINTER.
	NUORRE		/CONTROL ON ^P.
	0
	LAC* (BOSS
	SPA
	JMP AROUND
	ISZ PIPAGN
	JMP AROUND	/NO INTERMEDIATE TTY OUTPUT
/	.WRITE -3,2,OUTPIP,6	/OUTPUT PIP VXX<CR><LF>
	CAL+2775		/IOPS ASCII
	11
	OUTPIP
	-6
/
/INITIALIZATION
/
	.IFDEF TEST
AROUND	LAC (TSTDVP		/FOR TESTING, HAVE OWN DEV TABLE.
	.ENDC
	.IFUND TEST
AROUND	LAC* (.SCOM+1	/(.SCOM+1STARTING ADDRESS OF 
	.ENDC
	DAC DEVBGN	/PIP .DEV TABLE, WHICH
	DAC TEMP1		/IS SAME SIZE AS POSITIVE .DAT TABLE.
	TAD	DEVSZE		/(RKB-111) WORD AFTER .DEV IS SYSTEM DISK TYPE
	DAC	TEMP2		/(RKB-111) SO PICK IT UP AND SAVE IT FOR
	LAC*	TEMP2		/(RKB-111) USE IN TRANDSLATING 'SY'
	DAC	SYDEVC		/(RKB-111) PSEUDO-DEVICE.
	LAC DEVSZE
	CMA			/2'S COMPLEMENT OF
	DAC TEMP2		/SIZE OF .DEV TABLE
	LAC LITJMP
	DAC ERRJMP
	CLC
	DAC ZECHO		/RESET INPUT MESG ECHO SWITCH
	DAC ZSPACE		/SET TO IGNORE SPACES
SETBK1	LAC* TEMP1		/CLEAR IN USE BIT
	AND MASK1		/OF ALL .DEV ENTRIES (MASK1=737777)
	DAC* TEMP1
	IDX TEMP1
	ISZ TEMP2		/ARE ALL ENTRIES INITIALIZED
	JMP SETBK1		/NO.
	LAC (DAC* ALLOUT
	DAC VALSW
	LAC LIT40
	DAC CMECHO-1		/SET SPACE TO LINE UP ECHO.
LM2	LAW -2
	TAD (SNAMES		/INIT SPLIT STRING POINTER
	DAC SNAMPT
	JMS INITPT		/INIT FILE POINTERS AND COUNTS
	DZM DESTSW		/CLEAR DEST BLK SW.
	DZM SRCDEV		/CLEAR SOURCE DEVICE CODE.
	DZM QUSTON		/IF NON-0, SOURCE DEVICE MUST BE BULK STORAGE (FOR S/Z OPTIONS)
	DZM DATAMD		/INITIALIZE
	DZM WSWTCH		/SWITCH
	DZM CNTSW
	DZM CETSW		/OPTION
	DZM FSWTCH
	DZM GSWTCH
	DZM BSWTCH
	DZM YSWTCH
	DZM VCMD
	DZM DIRSWH		/REGISTERS.
	DZM QSWTCH
	DZM MSWTCH
	DZM LSWTCH
	DZM PSWTCH
	DZM XSWTCH
	DZM KSWTCH
	DZM VSWTCH
	DZM NEWPRO		/CLEAR SPECIFIED PROTECTION SWITCH.
	DZM PAPER
	DZM DMPSW
	DZM CORSPC
	DZM LNAME1
	DZM LNAME2
	DZM LEXT
	DZM X4KSW
	LAW -400
	DAC TRANWD		/WORD COUNT FOR .TRAN ROUTINE.
	DAC ZCEXIT		/CLEAR COPY SWITCH (AN EFFECTIVE NOP).
	LAC LITCLS		/(JMS ZCLOS
	DAC ZEOF2
	LAC (Z1BUF
	DAC Z1BUFP
	LAC (Z2BUF
	DAC Z2BUFP
	LAC LITSKP		/SET COMMAND DECODER (SKP).
	DAC COMSW		/IN PROGRESS SWITCH.
	LAW -34			/INITIALIZE
	DAC INROOM		/FILE BLOCK
	DAC OTROOM		/COUNTS(28(10)).
	DZM USWTCH
	DZM MULTBK
	DZM TCOPSW
	DZM DKSW
	DZM UBKSET	/(JMW:114)
	LAC (CMECHO		/INITALIZE FOR ECHOING OF VALID PART OF
	DAC VALOUT		/COMMAND STRING ON AN ERROR.
	DAC ALLOUT
	.TITLE COMMAND STRING DECODER
/
/PIP'S COMMAND STRING DECODER IS A SEQUENTIAL ONE AND EXPECTS TO FIND
/THE COMMAND STRING IN 'BUFFER' (1ST CHAR AT 'BUFFER+2'). IT CHECKS THE FUNCTION
/CHARACTER, PUTTING IT'S CODE INTO 'FUNCDE'.  IT THEN EXPECTS THE DESTINATION
/DEVICE (ESSENTIAL) AND UNIT NUMBER (OPTIONAL).  'GETDEV' PICKS UP THE DEVICE
/NAME, CHECKS THAT THE DEVICE IS IN THE POSITIVE .DAT SLOT TABLE, IS NOT BUSY,
/AND IS NOT ILLEGAL FOR THIS FUNCTION AND DIRECTION ('DEVCHK')
/AND ISSUES THE .USER CAL FOR THE .DAT SLOT, USING EITHER THE DEFAULT
/(LOGGED-IN) OR SPECIFIED(<UIC>) UIC ('CAROT').  NEXT CAN COME A FILE NAME(S)
/(OPTIONAL IF THE INPUT DEVICE IS FILE STRUCTURED; MANDENTORY IF THE INPUT
/DEVICE IS NON-FILE STRUCTURED BUT THE OUTPUT DEVICE IS FILE STRUCTURED AND
/THE FILE NAME IS NOT SPECIFIED ON THE SOURCE SIDE), AN OPEN PARENTHESIS,
/A HASH MARK (#) OR A BACK ARROW (_).
/   A. A FILE NAME(S) AND OPTIONAL EXTENSION, PROCESSED IN 'FILECK',
/IS ASSEMBLED IN SIXBIT IN 'TMPFLE'(3 WORDS) AND THEN ENTERED INTO THE LIST OF
/DESTINATION FILES ('FSTAT').  THE DECODER THEN EXPECTS ANOTHER FILE NAME
/PRECEDED BY A COMMA), AN OPEN PARENTHESIS OR A LEFT ARROW.  A COUNT OF
/THE DESTINATION FILES IS KEPT IN 'DSFCNT' AND THE ACTUAL NAMES ARE KEPT IN
/'DESFLS'.
/   B. AN OPEN PARENTHESIS, PROCESSED IN 'OPENPR', SIGNIFIES THAT A DATA
/MODE OR OPTION SWITCH IS COMING. THE SWITCH IS CHECKED FOR LEGALITY, BOTH FOR
/BEING A PERMISSIBLE SWITCH FOR THE FUNCTION, AND FOR NOT CONFLICTING WITH A
/PREVIOUS SWITCH.  THE NEXT THING IN THE COMMAND STRING CAN BE ANOTHER SWITCH
/OR A CLOSE PARENTHESIS.
/      A CLOSE PARENTHESIS IS PROCESSED BY 'CLSPAR' AND CAN ONLY BE FOLLOWED
/      BY A BACK ARROW.
/   C. A HASH MARK (#), PROCESSED IN 'FILECK', SIGNIFIES THAT THE NEXT 3
/CHARACTERS ARE TO BE USED AS AN EXTENSION FOR A SEARCH DURING A LIST DIRECTORY
/OPERATION.  THOSE 3 CHARACTERS CAN BE FOLLOWED BY AN OPEN PARENTHESIS OR
/A BACK ARROW.
/   D. A BACK ARROW, PROCESSED BY 'LFTROW', CHANGES THE DIRECTION
/(DIRECT = 1) AND PROCESSING OF THE SOURCE INFORMATION BEGINS.
/
/THE FIRST ENTRY FOLLOWING THE BACK ARROW MUST BE A DEVICE NAME, WITH AN OPTIONAL
/UNIT NUMBER, WHICH IS CHECKED BY 'GETDEV' (SAME AS ABOVE).  NEXT CAN BE A
/FILE NAME (MANDENTORY IF THE INPUT DEVICE IS FILE STRUCTURED, OPTIONAL FOR
/NON-FILE STRUCTURED DEVICES) AND AN OPTIONAL EXTENSION, AN OPEN PARENTHESIS
/OR A CARRIAGE RETURN OR ALTMODE.
/   A. FILE NAME, PROCESSED AS ABOVE IN 'FILECK', IS SUBJECT TO AN .FSTAT
/(IN 'FSTAT') BEFORE IT IS ENTERED  NTO THE LIST OF SOURCE FILE NAMES.
/THAT LIST IS TITLED 'SRCLFS' AND THE COUNT OF FILES IS KEPT IN
/'SRFCNT'.  THE NEXT ENTRY IN THE COMMAND STRING CAN BE
/ANOTHER FILE NAME (PRECEDED BY A COMMA), AN OPEN PARENTHESIS OR  A
/CR OR ALTMODE.
/   B.  AN OPEN PARENTHESIS IS PROCESSED AS IN B. ABOVE, EXCEPT THAT
/THE CLOSE PARENTHESIS CAN ONLY BE FOLLOWED BY A CR OR ALTMODE.
/GO TO 'RESTRT' AFTER COMPLETION OF THE REQUESTED OPERATION; AND ALTMODE REESULTS IN
/AN .EXIT BEING SET UP.
/
/AT THE END OF THE COMMAND DECODER IS A DISPATCH TO THE REQUESTED FUNCTION.
	.EJECT
/START PROCESSING COMMAND STRING.
/
	JMS LFOUT		/OUTPUT LF >, READ TTY, GET 1ST CHAR
GTFUNC	SAD LITCR		/CR
	JMP RESTRT
	SAD LITT		/T -- TRANSFER FILE (0)
	LAW 0
	SAD LITL		/L -- LIST DIRECTORY (2)
	LAW 2
	SAD LITD		/D -- DELETE FILE (4)
	LAW 4
	SAD LITC		/C -- COPY FILE (6)
	LAW 6
	SAD LITR		/R -- RENAME FILE (10)
	LAW 10
	SAD LITB		/B -- BLOCK COPY (12)
	LAW 12
	SAD LITS		/S -- SEGMENT FILE (14)
	LAW 14
	SAD LITV		/V -- VERIFY FILE (16)
	LAW 16
	SAD LITN		/N -- NEW DIRECTORY (20)
	LAW 20
	SAD LITI		/I -- INITIALIZE  (22).
	LAW 22
	SAD LITU		/U -- UPDATE BAT (24).
	LAW 24
	SMA
	JMP ERR00		/ILLEGAL FUNCTION CHARACTER.
	AND (77
	DAC FUNCDE	/SAVE FUNCTION CODE
	LAC ALLOUT	/UPDATE VALID COMMAND
	DAC VALOUT	/STRING POINTER
	LAC FUNCDE		/T?
	SZA		/YES-DO NOT CLEAR SPLIT FILE COUNT
	DZM STRCNT	/CLEAR STRING COUNT
	XOR FUNCS			/S?
	SZA			/YES-EXAMINE COMMAND STRING
	JMP GTFNC3		/CLEAR STRCNT.
/
/SPLIT (S) FUNCTION COMMAND DECODER
/
	LAC (740000
	DAC VALSW
	DZM ZECHO		/WANT NO ECHO ON ERRORS.
	LAW -21			/INIT SPLIT STRING COUNT TO 16
	DAC SPROOM
	LAC (SNAMES
	DAC PUTP			/SET UP KLPUT
	DZM PUTCT
	DZM PUTC
/NEXT STRING
SNEXST	ISZ SPROOM
	SKP
	JMP ERR22			/STRING CAPACITY EXCEEDED
	LAC PTLIT			/(JMS KLPUT
	DAC STRSW
LM5	LAW -5
	DAC TCOUNT
	DAC ZSPACE		/IGNORE SPACES
SNEXC	JMS GETCHR
	DZM ZSPACE		/DO NOT IGNORE SPACES
	SAD LITCR			/CR
	JMP STREND		/END OF COMMAND STRING
	SAD LIT40			/SP
	LAC COMMA
	SAD COMMA			/COMMA
	JMP STREND
STRSW	XX			/JMS KLPUT OR NOP
	ISZ TCOUNT
	JMP SNEXC			/NEXT CHAR
	LAC (740000
	DAC STRSW
	JMP SNEXC
/END OF STRING
STREND	DAC TEMP2			/SAVE CHAR (CR OR,)
	LAC TCOUNT			/5 CHAR'S?
	SMA!CLA			/NO-PAD WITH NULLS
	JMP SENDCK-1		/CHECK FOR CR
	JMS KLPUT			/OUTPUT NULL
	ISZ TCOUNT
	JMP .-2
	ISZ STRCNT		/INDEX STRING COUNT FOR Y OPTION
/CR CHECK
SENDCK	LAC TEMP2
	SAD LITCR			/CR=END
	JMP RESTRT
	JMP SNEXST		/NEXT STRING
/
/ALL FUNCTIONS EXCEPT S
/
FIXN	LAC TCHAR		/IF N FUNCTION, NEXT CHAR CAN ONLY BE AN
	SAD OPAREN		/OPEN PAREN OR A CR/ALT MODE.
	JMP SETDIR
FIXI	LAC TCHAR		/FOR I FUNCTION, ONLY CR/ALT MODE LEGAL.
	SAD LITCR
	JMP ALLDNE
	SAD ALTMOD
	JMP ALLDNE
	JMP ERR34		/ILLEGAL COMMAND STRUCTURE (NON-RECOVERABLE).
GTFNC3	DZM DIRECT	/0 INDICATES DESTINATION DEVICE
	JMS GETDEV		/PICK UP DEVICE CODE AND CHECK ITS VALIDY.
DESNUM	0		/DESTINATION UNIT NUMBER
DESDEV	0		/DESTINATION DEVICE CODE. (2.SIXBIT CHARS.)
DESDAT	0		/DESTINATION .DAT SLOT.
	LAC FUNCDE	
	SAD FUNCI
	JMP FIXI
	SAD FUNCN
	JMP FIXN
	SAD FUNCU
	JMP SETDIR
	SAD FUNCV		/VERIFY (V)
	LAC FUNCD
	XOR FUNCD		/SET DIRECT =1 (SOURCE) IF FUNCTION= VERIFY(V) OR
	SZA		/DELETE FILE (D). THIS
	JMP GTFILE
SETDIR	SET DIRECT		/CAUSES CHECKING OF PRESENCE OF
	LAC DESDAT		/FILE NAMES VIA FSTAT.
	DAC SRCDAT
	LAC DESDEV
	DAC SRCDEV
GTFILE	JMS FILECK	/PICK UP FILE NAME(S) AND EXT(S).
	LAC TMPCHR	/CHAR. THAT TERMINATED FILE NAMES
	SAD OPAREN		/OPEN PAREN.
	JMP OPENPR
	SAD LFTARW		/LEFT ARROW
	JMP LFTARO
ALLDNE	DZM XITFLG
	SAD LITCR		/CARRIAGE RETURN
	IDX XITFLG
/CARRIAGE RETURN OR ALT MODE
/PERFORM SPECIFIED OPERATION AND
/THEN EITHER .EXIT (XITFLG=0)
/OR GO TO RESTRT (XITFLG=1)
/
	LAC STRCNT
	CMA
	DAC STRCNT		/1'S COMP OF STRING COUNT.
	LAC (740000		/SET SO 'GETCHR' NO LONGER SETS UP ECHO
	DAC VALSW		/IN Z2BUF.
	LAC LM4M		/SET UP FOR DEFAULT DIRECTORY PROTECTION.
	DAC DIRPRO
	LAC NEWPRO		/IF NO PROTECTION CODE SPECIFIED,
	SMA
	JMP ZFCHK1		/USE DEFAULT.
	AND (7
	SNA
	DZM DIRPRO		/NO PROTECTION ON DIRECTORY.
ZFCHK1	LAC LITCLA	/CLEAR COMMAND DECODER SWITCH.
	DAC COMSW
	DZM ZECHO
	CLC
	TAD SRFCNT		/2'S COMP OF
	CMA
	DAC SRFCNT		/SOURCE FILE COUNT.
	CLC
	TAD DSFCNT
	CMA
	DAC DSFCNT
	LAC DESDAT
	DAC CHKDAT
	LAC FUNCDE		/DISPATCH TO FUNCTION
	SNA
	JMP ZTGO		/T = 0
	SAD FUNCL
	JMP LSTDIR		/L = 2
	SAD FUNCD
	JMP DELETE		/D = 4
	SAD FUNCC
	JMP COPY		/C = 6
	SAD FUNCR
	JMP RENAME		/R = 10
	SAD FUNCV			/V=16
	JMP VERIFY
	SAD FUNCN		/N=20.
	JMP NEWDIR
	SAD FUNCU		/U=22.
	JMP UPDATE
	SAD FUNCI		/I=24
	JMP INITAL
	DAC BSWTCH		/B=12
	JMP ZCOPY		/B COPY DISPATCH.
/
/DISPATCH TO COPY FUNCTIONS.
/
COPY	LAC DATAMD
	SAD LIT2		/H MODE COPY?
	JMP ZCOPY
	JMP TCOPY		/COPY WITH NO SWITCHES.
	.TITLE    LFTROW: LEFT ARROW PROCESSOR.
/LEFT ARROW AFTER CLOSE PARENTHESIS.
/
LFTROW	LAC ALLOUT	/UPDATE VALID PORTION OF
	DAC VALOUT	/COMMAND STRING POINTER
LFTARO	SET DIRECT		/SET DIRECTION INDICATOR TO SOURCE.
	JMS GETDEV	/GET DEVICE AND UNIT
SRCNUM	0		/SOURCE UNIT NUMBER
SRCDEV	0		/SOURCE DEVICE CODE
SRCDAT	0		/SOURCE .DAT SLOT.
	JMP GTFILE	/PICK UP FILE NAME (EXT)
	.TITLE    OPENPR: SWITCH AND DATA MODE PROCESSOR.
/
/OPEN PAREN ENCOUNTERED.
/
OPENPR	JMS GETCHR	/CHECK SWITCH OPTIONS
ER7BAK	DAC TEMP2
	SAD LITA		/A
	LAW 3
	SAD LITB		/B
	LAW 1
	SAD LITI		/I
	LAW 4
	SAD CMODE		/H
	JMP FOUNDH
	SAD LITD		/D
	LAW 5
	SPA
	JMP DATAOP	/DATA MODE OPTION
	SAD LITW		/W
	JMP FOUNDW
	SAD LITC		/C
	JMP FOUNDC
	SAD LITS		/S
	JMP FOUNDS
	SAD LITN		/N
	JMP FOUNDN
	SAD LITE		/E
	JMP FOUNDE
	SAD LITT		/T
	JMP FOUNDT
	SAD LITF		/F
	JMP FOUNDF
	SAD LITG		/G
	JMP FOUNDG
	SAD LITQ		/Q
	JMP FOUNDQ
	SAD LITY		/Y
	JMP FOUNDY
	SAD LITM		/M.
	JMP FOUNDM
	SAD LITL		/L.
	JMP FOUNDL
	SAD LITP		/P.
	JMP FOUNDP
	SAD LITK		/K.
	JMP FOUNDK
	SAD LITX		/X.
	JMP FOUNDX
	SAD LITV	/V.
	JMP FOUNDV
	SAD CPAREN		/CLOSE PAREN ())
	JMP CLSPAR
	TAD LM57		/LOOKING FOR PROTECT CODE: DIGIT BETWEEN 0-7.
	SPA!SZA
	JMP ERR07		/INVALID SWITCH OPTION.
	TAD (-6
	SMA
	JMP ERR07
	LAC FUNCDE
	SNA
	JMP GOTPRO		/PROTECT CODE USED ONLY FOR T,N,R.
	SAD FUNCR
	JMP GOTPRO
	SAD FUNCN
	JMP GOTPRO
	JMP ERR07
FOUNDH	LAC FUNCDE
	XOR LIT6		/C = 6.
	SZA
	JMP SETH
	LAC DIRSWH		/FUNCTION IS C
	SZA
	JMP ERR10		/S OR Z RULES OUT H.
SETH	LAW 2
/DATA MODE SWITCH OPTION
/
DATAOP	AND (77
	DAC TDATA		/DATA MODE CODE.
	SAD DATAMD		/ILLEGAL TO SPECIFY MORE THAN ONE DATA MODE, BUT
	JMP DATOP1		/ALLOW SPECIFICATION OF IMPLICIT MODE.
	LAC DATAMD		/ANY BEEN SPECIFIED?
	SZA			/0 IF NONE ALREADY DECLARED.
	JMP ERR10		/'SWITCH CONFLICT'.
DATOP1	JMS VALOPT		/SWITCH OPTION VS. FUNCTION CHECK
	LAC WSWTCH		/HAS W BEEN REQUESTED
	SNA
	JMP WITHW		/NO
	LAC TDATA
	SAD (3		/IOPS ASCII (A)
	JMP WITHW
	SAD (1		/IOPS BINARY (B)
	JMP WITHW
	JMP ERR10
WITHW	LAC FSWTCH	/HAS F BEEN REQUESTED?
	TAD GSWTCH	/HAS G BEEN REQUESTED?
	TAD QSWTCH	/HAS Q BEEN REQUESTED?
	TAD YSWTCH	/HAS Y BEEN REQUESTED
	SNA		/YES
	LAC CETSW		/HAS E,C,OR T BEEN REQUESTED?
	SNA
	JMP WITHC		/NO
	LAC TDATA
	SAD (3		/IOPS ADCII.
	JMP WITHC
	JMP ERR10
WITHC	LAC DESDEV		/DESTINATION DEVICE
	SAD LPDEV		/L.P.
	JMP TSTAL2	/LP15 TAKES BOTH IOPS AND IMAGE ASCII.
	SAD TTDEV
	JMP TSTAL2
	SAD PPDEV
	JMP TSTAL3
	LAC SRCDEV		/SOURCE DEVICE
	SAD TTDEV
	JMP TSTAL2
WITHAI	LAC TDATA		/SET DATA MODE SWITCH.
	DAC DATAMD
SWCHOK	LAC ALLOUT		/UPDATE VALID COMMAND
	DAC VALOUT	/POINTER
	JMP OPENPR	/CHECK FOR MORE OPTIONS
/GOT PROTECTION CODE.
GOTPRO	LAC NEWPRO
	SZA
	JMP ERR10		/ALREADY DECLARED.
	LAC TEMP2
	XOR MINUS		/(400000.
	DAC NEWPRO
	JMP SWCHOK
/
/Y SWITCH ENCOUNTERED
/Y IS VALID ONLY WITH A DATA MODE
/Y VALID ONLY IF S FUNCTION IMMEDIATELY PRECEDES
/Y CONFLICTS WITH W
/
FOUNDY	JMS VALOPT		/FUNCTION VS OPTION CHECK.
	LAC STRCNT	/STRING COUNT
	SNA
	JMP ZSNOT		/IF 0 , S FUNCTION NOT PERFORMED
	LAC WSWTCH	/W SW SET?
	SZA		/NO, ALL OK
	JMP ERR10
	JMS AMODCK	/CHECK FOR I.A. DATA MODE
	DAC YSWTCH	/OK TO SET Y SW
	JMP SWCHOK
/S NOT PERFORMED PRIOR TO USING Y SWITCH
/MSG# 14: S OPERATION NOT PERFORMED
ZSNOT	DZM ZECHO		/SET TO GO TO RESTRT AFTER MSG
	JMP ERR14
/
/F OPTION ENCOUNTERED
/F IS VALID ONLY WITH A DATA MODE
/
FOUNDF	JMS VALOPT		/FUNCTION VS OPTION CHECK.
	JMS AMODCK
	DAC FSWTCH
	JMP SWCHOK
/
/Q OPTION ENCOUNTERED
/Q IS VALID ONLY WITH A DATA MODE
/
FOUNDQ	JMS VALOPT
	JMS AMODCK
	DAC QSWTCH
	JMP SWCHOK
/
/SUBR TO CHECK FOR IOPS ASCII DATA MODE OR NO MODE (0)
/
AMODCK	0
	LAC DATAMD
	SZA
	SAD (3		/(A)
	SKP!CLA!CMA
	JMP ERR10
	JMP* AMODCK	/SWITCH OK
/
/W SWITCH OPTION ENCOUNTERED
/W IS ONLY VALID WITH A OR B DATA MODES
/W CONFLICTS WITH Y
/
FOUNDW	JMS VALOPT		/FUNCTION VS OPTION CHECK.
	LAC YSWTCH	/Y SW SET?
	SNA!CLC		/YES - DROP THRU TO  JMP TO ERR10.
	LAC DATAMD
	SZA
	SAD (3		/IOPS ASCII (A).
	SKP
	SAD (1		/IOPS BINARY (B)
	SKP!CLA!CMA
	JMP ERR10
	DAC WSWTCH	/SET TO -1.
	JMP SWCHOK
/
/E SWITCH OPTION ENCOUNTERED
/E IS VALID ONLY WITH A DATA MODE AND
/E CONFLICTS WITH C AND T.
/
FOUNDE	JMS CETCOM		/FUNCTION VS OPTION CHECK.
	LAC (1			/SET TO 1.
SETCET	DAC CETSW
	JMP SWCHOK
/
/G OPTION ENCOUNTERED
/G IS VALID ONLY WITH A DATA MODE.
/
FOUNDG	JMS VALOPT		/FUNCTION VS OPTION CHECK.
	JMS AMODCK
	SET GSWTCH		/SET TO NON-0
	JMP SWCHOK
/
/T SWITCH OPTION ENCOUNTERED
/T IS VALID ONLY WITH A DATA MODE
/T CONFLICTS WITH C AND E
/
FOUNDT	JMS CETCOM	/FUNCTION VS OPTION CHECK
	LAC LIT4		/SET TO 4.
	JMP SETCET
/
/
/
CETCOM	0
	JMS VALOPT	/FUNCTION VS OPTION CHECK
	LAC CETSW		/ONLY ONE ALLOWED: C OR E OR T.
	SZA
	JMP ERR10
	JMS AMODCK	/MUST BE A DATA MODE
	JMP* CETCOM
/
/C SWITCH OPTION ENCOUNTERED
/C IS ONLY VALID WITH A DATA MODE AND
/C CONFLICTS WITH E AND T.
/
FOUNDC	JMS CETCOM		/FUNCTION VS OPTION CHECK.
	LAC LIT2		/SET SWITCH TO 2.
	JMP SETCET
/
/CHECK FOR IOPS AND IMAGE ASCII: PR TO PP,TT,LP.
TSTAL3	LAC SRCDEV	/A,I,B = ONLY LEGAL OPTIONS: PR TO PP
	SAD PRDEV
	SKP		/YES
	JMP WITHAI
	LAC TDATA
	SAD (1		/B
	JMP WITHAI	/OK
TSTAL2	LAC TDATA		/TELETYPE.
	SAD LIT4		/IMAGE ALPHA (I)
	JMP WITHAI
TSTAL1	LAC TDATA		/LINE PRINTER.
	SAD (3		/IOPS ASCII (A)
	JMP WITHAI
	JMP ERR07
/
/S SWITCH OPTION ENCOUNTERED
/
FOUNDS	JMS VALOPT	/FUNCTION VS. OPTION CHECK.
	LAC DESDEV
	SAD DECTAP			/ONLY LEGAL ON DECTAPE.
	SKP
	JMP ERR07		/'ILLEGAL SWITCH'
	LAC FUNCDE
	SAD FUNCN
	SKP
	JMP ONLYS
	LAC KSWTCH		/S AND K CONFLICT.
	SZA
	JMP ERR10
	JMS GETCHR
	SAD CPAREN
	JMP SOUTOK
	SAD (70		/8K SPECIFIED?
	JMP FIX8K
	SAD (61		/12 OR 16 K?
	JMP FINDK1
	SAD (62		/20,24 OR 28K?
	JMP FINDK2
	SAD (63		/32K?
	JMP FINDK3
	JMP ERR07		/ERROR MSG #7.
FINDK1	JMS GETCHR
	SAD (62		/ALLOW 12K ONLY ON PDP-15.
	JMP FIX12K
	SAD  (66		/16K?
	JMP FIX16K
	JMP ERR07
FINDK2	JMS GETCHR
	SAD LIT20		/ALLOW 20K ONLY ON PDP-15.
	JMP FIX20K
	SAD (70		/ALLOW 28K ONLY ON PDP-15.
	JMP FIX28K
	SAD (64		/24K?
	JMP FIX24K
	JMP ERR07
FINDK3	JMS GETCHR
	SAD (62		/32K?
	JMP FIX32K
	JMP ERR07
FIX12K	LAC MINUS			/SET EXTRA 4K ENDICATOR.
	DAC X4KSW
FIX8K	LAC (17777		/SET BITS 3-6=1.
	JMP FINFIX
FIX20K	LAC MINUS
	DAC X4KSW
FIX16K	LAC MASK1		/SET BITS 3-6=3.
	JMP FINFIX
FIX28K	LAC MINUS
	DAC X4KSW
FIX24K	LAC LITCLC		/SET BITS 3-6=5
	SKP
FIX32K	LAC (77777		/SET BITS 3-6=7.
FINFIX	DAC CORSPC
	JMS GETCHR
	SAD CPAREN		/CLOSE PAREN ONLY LEGAL CHAR HERE.
	SKP
	JMP ERR07
SOUTOK	LAC ALLOUT		/UPDATE COMMAND POINTER.
	DAC VALOUT
	LAC (1
	JMS FNDS
	JMS GETCHR
	JMP SRCEND+1
ONLYS	LAC (1
BOTHSN	JMS FNDS
	JMP SWCHOK
/
/CHECK THAT S,N SWITCHES LEGAL.
/
FNDS	0
	DAC TDATA
	LAC DIRSWH
	SAD TDATA
	JMP STDIRT		/DIRECTORY OPTION ALIKE
	SZA		/NO PREVIOUS DIRECTORY OPTION.
	JMP ERR10
STDIRT	LAC FUNCDE
	XOR LIT6
	SZA
	JMP STDIRZ		/NOT C FUNCTION
	LAC DATAMD		/S OR N ARE ILLEGAL
	SZA		/IF H ALREADY SPECIFIED
	JMP ERR10
/FOR S AND N OPTIONS, THE TWO DEVICES
/CANNOT BOTH BE NON-FILE STRUCTURED
/
STDIRZ	LAC DESDEV		/DESTINATION DEVICE CODE
	SAD MAGTAP		/(JMW:109) ILLEGAL TO MAGTAPE.
	JMP ERR07		/(JMW:109) 'ILLEGAL DEVICE'.
	JMS FNDBLK
	SNL
	JMP SZOK1		/ONE, FILE ORIENTED
	LAC FUNCDE	/L?
	SAD LIT2
	SKP		/YES, MAY BE OK
	JMP ERR04		/ILLEG DEST DEV FOR N OR S
	LAC SRCDEV		/SOURCE DEVICE CODE
	SNA
	JMP SZOK
	JMS FNDBLK
	SNL
	JMP SZOK1
	JMP ERR04
SZOK	IDX QUSTON		/QUESTIONABLE OPTION.
SZOK1	LAC TDATA
	DAC DIRSWH		/SET DIRECTORY OPTION INDICATOR.
	JMP* FNDS
QUSTON	0			/NON-0 IF S OR Z SWITCH IN DOUBT.
/
/SUBROUTINE TO CHECK FILE STRUCTURING OR NOT
/EXITS WITH LINK = 0 IF AC CONTAINED THE
/CODE OF A FILE ORIENTED DEVICE.
/OTHERWISE THE LINK = 1 ON EXIT.
/AC= DEVICE CODE ON ENTRY.
/
FNDBLK	0
	DAC FNDTMP		/SAVE DEVICE CODE
	LAC (LAC BULK
	DAC .+1
FNDMOD	XX		/NON-FILE STRUCTURED DEVICE TABLE
	SAD FNDTMP
	SKP!CLL!CML		/FILE ORIENTED
	SPA!CLL
	JMP* FNDBLK	/END OF TABLE
	IDX FNDMOD
	JMP FNDMOD
FNDTMP	0
/
/N SWITCH OPTION ENCOUNTERED.
/
FOUNDN	JMS VALOPT		/FUNCTION VS. OPTION CHECK.
	LAC LIT2
	JMP BOTHSN		/DO REST OF LEGALITY CHECKING.
/
/M SWITCH ENCOUNTERED.
/M CONFLICTS WITH P.
/
FOUNDM	JMS VALOPT		/FUNCTION VS OPTION CHECK.
	LAC PSWTCH
	SZA!CLC
	JMP ERR10
	DAC MSWTCH		/SET TO NON-ZERO.
	JMP SWCHOK
/
/L SWITCH OPTION ENCOUNTERED.
/L CONFLICTS WITH P.
/
FOUNDL	JMS VALOPT		/FUNCTION VS OPTION SWITCH.
	LAC PSWTCH
	SZA!CLC
	JMP ERR10
	DAC LSWTCH		/SET TO NON-ZERO.
	JMP SWCHOK
/
/P SWITCH ENCOUNTERED.
/P CONFLICTS WITH M AND L.
/
FOUNDP	JMS VALOPT		/FUNCTION VS OPTION CHECK.
	LAC MSWTCH
	TAD LSWTCH
	SZA!CLC
	JMP ERR10
	DAC PSWTCH		/SET TO NON-ZERO.
	JMP SWCHOK
/
/K OPTION ENCOUNTERED.
/K CONFLICTS WITH S.
/
FOUNDK	JMS VALOPT
	LAC DIRSWH		/BOTH S AND K ILLEGAL.
	SAD (1
	JMP ERR10
	SET KSWTCH
	JMP SWCHOK
/
/X OPTION ENCOUNTERED (DELETE ALL TRUNCATED FILES).
/
FOUNDX	JMS VALOPT
	SET XSWTCH
	JMP SWCHOK
/
/ (JMW:109) V FUNCTION -VERTICAL FORMS CONTROL - LEGAL WITH T FUNCTION, ASCII ONLY.
/
FOUNDV	JMS VALOPT
	JMS AMODCK
	SET VSWTCH
	JMP SWCHOK
/
/SUBROUTINE TO CHECK IF A SWITCH OPTION
/IS VALID FOR A PARTICULAR FUNCTION.
/
VALOPT	0
	LAC FUNCDE	/FUNCTION CODE.
	CLL!RAR		/DIVIDE BY 2
	TAD (MODES	/START OF VALID MODES DISPATCH.
	DAC TCHAR1
	LAC* TCHAR1	/PICK UP LAC OF
	DAC MODTST	/PROPER TABLE.
MODTST	XX
	SAD TEMP2		/OPTION CHARACTER
	JMP* VALOPT
	IDX MODTST
	SMA		/TABLE IS TERMINATED WITH
	JMP MODTST		/A WORD WITH BIT 0=1.
	JMP ERR07		/INVALID SWITCH OPTION.
/TABLE OF POINTERS TO LISTS OF SWITCH OPTIONS
/THAT ARE VALID FOR A PARTICULAR FUNCTION.
/
MODES	LAC TMODE		/T
	LAC LMODE		/L
	LAC DMODE		/D
	LAC CMODE		/C
	LAC RMODE		/R
	LAC BMODE		/B
	LAC SMODE		/S
	LAC VMODE		/V
	LAC NMODE		/N
	LAC IMODE		/I
	LAC UMODE		/U
/TABLES OF VALID SWITCH OPTIONS FOR
/THE PARTICULAR FUNCTIONS. EACH TABLE IS
/TERMINATED BY A WORD WITH BIT 0=1.
	/TRANSFER FILE (T)
TMODE=.
LITI	111		/I IMAGE ALPHA
LITD	104		/D DUMP
LITW	127		/W STRIP EOT OR EOF
LITC	103		/C SPACES TO TABS
LITT	124		/T DELETE TRAILING BLANKS
LITE	105		/E TABS TO SPACES
LITF	106		/F INSERT FF,CR
LITG	107		/G PARITY CHECK
LITQ	121		/Q DELETE SEQUENCE #'S (73-80)
LITY	131		/Y SEGMENT FILE
	110		/H IMAGE BINARY
LITV	126		/(JMW:109) VERTICAL FORMS CONTROL.
/S AND S ARE ONLY LEGAL FOR FILE STRUCTURED DEVICES.
	116			/N NEW DIRECTORY.
LITS	123			/S NEW SYSTEM DIRECTORY.
/VERIFY FILE (V)
VMODE=.
LITA	101			/A IOPS ASCII.
LITB	102			/B IOPS BINARY.
/RENAME (R)
RMODE=.
/SEGMENT (S)
SMODE=.
/INITIALIZE (I), UPDATE (U).
IMODE=.
UMODE=.
L757TH	757000
/LIST DIRECTORY.
LMODE=.
LITM	115			/M LIST MASTER FILE DIRECTORY.
LITL	114			/L LIST SYSBLK.
LITP	120			/P LIST RIB INFORMATION WITH DIRECTORY.
LM15	777763
/NEW DIRECTORY.
NMODE	123			/S NEW SYSTEM DIRECTORY.
LITK	113			/L LIST SYSBLK.
LM57	777721
CMODE	110			/H
LITR	122			/R
BMODE	116			/N
	123			/S
LM4M	400000
/DELETE (D)
DMODE=.
LITX	130			/X.
L77TH	770000
	.TITLE    CLSPAR: ROUTINE TO PROCESS CLOSE PARENTHESIS.
/CLOSE PARENTHESIS ENCOUNTERED.
/
CLSPAR	LAC DIRECT
	SNA
	JMP MDESET		/DESTINATION INFO.
	LAC DATAMD	/SOURCE INFO.
	SZA
	JMP MDESET
	LAC FUNCDE
	SNA
	JMP ERR11			/NO DATA MODE YET FOR T FUNCTION.
MDESET	LAC ALLOUT		/UPDATE VALID
	DAC VALOUT	/COMMAND POINTER.
	JMS BLCOMP
	JMS GETCHR	/GET NEXT CHAR.
LSTCAR	DAC TCHAR1
	LAC DIRECT
	SZA
	JMP SRCEND	/SOURCE INFO.
	LAC TCHAR1
	SAD LFTARW		/DESTINATION INFO.
	JMP LFTROW
	JMP ERR02
SRCEND	LAC TCHAR1
	SAD LITCR
	JMP ALLDNE
	SAD ALTMOD
	JMP ALLDNE
	JMP ERR02
	.TITLE    GETDEV: SUBROUTINE TO PROCESS DEVICE AND UNIT.
/SUBROUTINE TO PICK UP DEVICE AND UNIT CODE AND CHECK
/ITS PRESENCE IN POSITIVE .DAT TABLE AND ITS
/LEGALITY FOR THIS FUNCTION AND DIRECTION.
/IF LEGAL, IT CHECKS FOR A SPECIFIED UIC AND ISSUES THE .USER CAL TO THE DAT SLOT.
/CALLING SEQUENCE:
/	JMS GETDEV
/	0		/RETURN DEVICE UNIT #
/	0		/RETURN DEV. CODE (2 6-BIT CHARS.)
/	0		/RETURN .DAT SLOT NUMBER
/	(RETURN)
GETDEV	0
	LAC	GETDEV	/SAVE POINTER TO UNIT #
	DAC	TEMP2
	ISZ	GETDEV	/MOVE POINTER TO DEVICE
LITCLC	CLC
	DAC ZSPACE		/IGNORE SPACE
	JMS GETCHR
GTDEV2	JMS GTDEV1		/CHECK IF CHAR IN 100-177 RANGE
	LAC TCHAR1		/CHARACTER.
	JMS R6L
	AND (7700
	DAC* GETDEV
	JMS GETCHR
	JMS GTDEV1	/CHECK IF CHAR IN 100-177 RANGE
	LAC TCHAR1		/CHARACTER.
	AND (77
	XOR* GETDEV
	SAD	(002331)	/(RKB-111) IS THE DEVICE CODE 'SY'?
	LAC	SYDEVC		/(RKB-111) YES, REPLACE WITH RIGHT DISK CODE
	DAC* GETDEV
	DZM ZSPACE		/DO NOT IGNORE SPACE
GTDEV5	JMS GETCHR
	DAC TCHAR		/T STORE FOR LATER CR CHECK.
	DAC* TEMP2		/PRESERVE CHARACTER.
	JMS TERMCK	/CHECK FOR CR OR , OR SP OR: OR_OR ALTMODE
	XOR COLON
	SZA		/(JMW:116)
	JMP GTDEV6	/(JMW:116) NOT A TERMINATOR.
	DZM* TEMP2	/(JMW:116) RESET TO UNIT 0.
	JMP GTDEV3	/: (COLON) NO UNIT NO.
GTDEV6	LAC* TEMP2		/NUMERIC?
	AND (100
	SZA		/YES
	JMP GTDEV5	/KEEP LOOKING
	JMS GETCHR	/BYPASS COLON
	DAC TCHAR		/T STORE FOR LATER CR CHECK.
	JMS TERMCK	/CHECK FOR CR OR , OR SP OR: OR_OR ALTMODE
	SAD COLON		/:(COLON) (72).
	JMP GTDEV4	/TERMINATOR
	LAC LIT2
	JMP ERR04+1		/CHARACTER NOT :.
GTDEV4	LAC* TEMP2		/UNIT NUMBER.
	AND (170
	SAD (60
	SKP
	JMP ERR01			/CHAR. NOT OCTAL NUMBER.
	LAC* TEMP2
	RTR
	RTR
	AND MASK2		/UNIT NO. IN BITS 0-2 (MASK2=700000)
GTDEV3	XOR* GETDEV		/DEVICE CODE IN BITS 6-17
	DAC TCHAR1		/WILL BE USED BY DEVCK.
	AND (7777
	SAD PRDEV
	LAW 1
	SAD PPDEV
	LAW 2
	SMA
	JMP GTDEV9
	XOR PAPER
	DAC PAPER		/LAW 1=PR; LAW 2=PP; 3=BOTH
GTDEV9	JMS DEVCHK		/CHECK PRESENCE IN .DAT TABLE
	IDX GETDEV		/AND RETURN
	DAC* GETDEV		/.DAT SLOT NUMBER
	DAC CURDAT		/SET UP TO ISSUE .USER MACRO.
	IDX GETDEV
	CLC
	TAD ALLOUT		/UPDATE VALID CHAR COUNT.
	DAC VALOUT
	LAC TCHAR		/TERMINATOR.
	JMS CAROT		/CHECK FOR SPECIFIED UIC AND ISSUE .USER CAL.
	XOR LITCR		/CR?
	SZA
	JMP* GETDEV
	SNA!CLA
	CLC		/YES - SUB 1 FROM ECHO POINTER
	TAD ALLOUT
	DAC VALOUT
	JMP* GETDEV
/
/CHECK IF CHARACTER IN 100-177 RANGE. OTHERWISE
/COMMAND STRING IS IN ERROR.
GTDEV1	0
	DAC TCHAR1		/PRESERVE CHARACTER.
	AND (100
	SZA
	JMP* GTDEV1
	JMP ERR01
/
/SUBR TO CHECK FOR CR OR , OR SP
/ENTRY: AC=CHAR TO BE CHECKED
/EXIT:  AC=72(:) IF MATCH
/       AC=ORIGINAL CHAR IF NO MATCH
TERMCK	0
	SAD LITCR		/CR
	LAC COLON		/:
	SAD ALTMOD		/ALT MODE
	LAC COLON
	SAD LIT40		/SP
	LAC COLON
	SAD COMMA		/,
	LAC COLON
	SAD LFTARW		/_ (LEFT ARROW)
	LAC COLON
	JMP* TERMCK
	.TITLE    DEVCHK: SUBROUTINE TO CHECK VALIDITY OF DEVICES AND UNIT.
/SUBROUTINE TO CHECK IF A DEVICE AND UNIT
/(IF APPLICABLE) REQUEST IN A USER COMMAND
/STRING CAN BE SATISFIED BY ONE OF THE
/POSITIVE .DAT SLOTS. IT ALSO CHECKS THAT IT IS NOT
/INVALID FOR THIS FUNCTION AND DIRECTION.
/CALLING SEQUENCE:
/
/	JMS DEVCHK	WITH TEMP1 CONTAINING
/			DEVICE CODE AND UNIT
/			NO. IN THE FOLLOWING
/			FORMAT:
/			BITS 0-2	UNIT NO.
/			BITS 3-5		0
/			BITS 6-11		1ST LETTER OF
/					DEVICE CODE IN
/					6-BIT ASCII.
/			BITS 12-17 2ND LETTER
/	ON EXIT, THE AC WILL CONTAIN THE CORRESPONDING .DAT
/SLOT NO. RIGHT JUSTIFIED IN AN OTHERWISE CLEAR AC. WHEN A
/.DAT SLOT NO. IS RETURNED, THE RESPECTIVE ENTRY IN THE .DEV TABLE
/HAS BIT 3 SET TO 1 TO PREVENT MULTI-USAGE OF THE SAME .DAT SLOT;
DEVCHK	0
	LAC DEVBGN
	DAC DEVPNT		/START OF DEV TABLE.
	LAC DEVSZE
	TCA		/(JMW:115) 
	DAC TCOUNT		/2'S COMP DEV TABLE SIZE.
	LAC	FALTMD		/(RKB-111) SETUP DATSLOT -3 FOR 'TT'
	DAC	TTCMDS		/(RKB-111) WILL BE CHANGED TO -2 FOR 'CM'
	LAC (1
	DAC DATSLT		/.DAT SLOT NO.
	LAC TCHAR1		/REQUESTED DEVICE AND UNIT.
	AND (7777
	SAD TTDEV	/IF TTY, SKIP CHECK
	JMP DEVTTY
	SAD	(000315)	/(RKB-111) IF 'CM', SKIP CHECK
	JMP	DEVTTY-1	/(RKB-111) BUT START ONE WORD EARLIER THAN TTY
DEVBCK	SAD* DEVPNT		/DOES IT MATCH ENTRY IN .DEV.
	JMP DEVFND	/YES.
	IDX DEVPNT		/CHECK NEXT ENTRY.
	IDX DATSLT		/INCREMENT .DAT SLOT NO.
	ISZ TCOUNT		/IS TABLE EXHAUSTED?
	JMP DEVBCK	/NO
	JMP ERR03
DEVOUT	LAC TCHAR1
	SAD	(000315)	/(RKB-111) TREAT 'CM' SIMILAR TO TTY
	SKP			/(RKB-111)
	SAD TTDEV
	SKP!CLA!CMA	/INTERMEDIATE TTY I/O
	JMP DEVQ
	DAC PIPAGN
	LAC FALTMD	/(775)=.DAT SLOT-3 FOR TTY
	DAC DATSLT
DEVQ	LAC QUSTON		/QUESTION
	SNA		/ON S OR Z
	JMP .+4		/OPTION.
	DZM QUSTON	/CHECK IF
	LAC BULK		/DEVICE FILE
	JMP LACMOD-1	/ORIENTED.
	LAC* GETDEV	/DEVICE CODE
	SAD TTDEV
	SKP
	JMP FINALY
	LAC DATAMD
	SAD (3		/IOPS ASCII (A)
	JMP TTFIN
	SAD LIT4		/IMAGE ALPHA (I)
	JMP TTFIN
	SZA
	JMP ERR04
TTFIN	LAC DATSLT
	JMP* DEVCHK		/IF TTY, EXIT.
FINALY	LAC FUNCDE	/BYPASS MULTI-
	SAD LIT10		/USAGE PREVENTION
	JMP FINALZ		/IF RENAME
	LAC* DEVPNT		/PREVENT MULTI-USAGE OF SAME .DAT SLOT.
	XOR (40000		/BIT 3 SET.
	DAC* DEVPNT
FINALZ	LAC DATSLT		/GET UNIT # AND PUT IT INTO .DAT SLOT.
	TAD* (.SCOM+23
	DAC TDEVCD
	LAC TCHAR1		/EXTRACT UNIT.
	AND MASK2		/(700000.
	DAC TCHAR1
	LAC* TDEVCD	/BITS 3-17 OF .DAT SLOT.
	AND (77777
	XOR TCHAR1
	DAC* TDEVCD
	LAC DATSLT		/.DAT SLOT NO.
	JMP* DEVCHK	/EXIT.
	ISZ	TTCMDS		/(RKB-111) HAVE 'CM', CHANGE -3 TO -2
DEVTTY	DAC TCHAR1		/REMOVE UNIT # FROM TTA.
	DAC* GETDEV
DEVFND	LAC FUNCDE	/FUNCTION CODE
	TAD DIRECT	/DIRECTION CODE (0=DEST., 1=SOURCE)
	TAD (DEVALD		/START OF VALID DEVICE
	DAC TDEVCD		/FOR FUNCTION DISPATCH TABLE.
	LAC* TDEVCD	/PICK UP LAC OF PROPER TABLE.
	DAC LACMOD
LACMOD	XX
	SAD* GETDEV	/DEVICE CODE FROM COMMAND STRING.
	JMP ERR04		/INVALID.
	SPA
	JMP DEVOUT	/TABLE EXHAUSTED (NEG. REGISTER ENCOUNTERED)
	ISZ LACMOD
	JMP LACMOD
	JMP ERR04
DEVBGN	0		/STARTING ADDRESS OF .DEV TABLE.
TDEVCD	0			/HOLDS DEVICE CODE.
DATSLT	0		/HOLDS DAT SLOT NUMBER.
/TABLE OF POINTERS TO LISTS OF DEVICES THAT ARE INVALID
/FOR A PARTICULAR FUNCTION AND DIRECTION.
/NEGATIVE CHECKING IS DONE TO ALLOW FOR NON-STANDARD DEVICES.
			/CODE - FUNCTION - DIRECTION
DEVALD	LAC TOUTPT		/0 T (D) DESTINATION (PR,CD)
	LAC TINPUT		/1 T (S) SOURCE (PP,VP,VT,LP)
	LAC LOUTPT		/2 L DEST (PR,PP,CD,MT,DT,DK,DP)
	LAC LINPUT		/3 L SRC. (MT,TT,PR,PP,CD,LP,VT,VP)
	LAC DOUTPT		/4 D DEST. (TT,PR,PP,CD,LP,VT,VP)
	LAC ALLBAD		/5 D SRC. (ALL)
	LAC COUTPT		/6 C DEST. (TT,PR,PP,CD,LP,VT,VP)
	LAC CINPUT		/7 C SRC. (TT,PR,PP,CD,LP,VT,VP)
	LAC ROUTPT		/10 R DEST. (TT,PR,PP,CD,LP,VT,VP)
	LAC RINPUT		/11 R SRC. (TT,PR,PP,CD,LP,VT,VP)
	LAC BOUTPT		/12 B DEST (MT,TT,PR,PP,CD,LP,VT,VP)
	LAC BINPUT		/13 B SRC (MT,TT,PR,PP,CD,LP,VT,VP)
	LAC ALLBAD		/14 S DEST (ALL)
	LAC ALLBAD		/15 S SRC (ALL)
	LAC VOUTPT		/16 V DEST (LP,PP,VT,VP)
	LAC ALLBAD		/17 V SEC (ALL)
	LAC NOUTPT		/20 N DEST (MT,TT,PR,PP,CD,LP,VT,VP)
	LAC ALLBAD		/21 N SRC (ALL)
	LAC IOUTPT		/22 I DEST (DT,MT,TT,PR,PP,CD,LP,VT,VP)
	LAC ALLBAD		/23 I SRC (ALL)
	LAC UOUTPT		/24 U DEST. (DT,MT,TT,PR,PP,CD,LP,VT,VP)
	LAC ALLBAD		/25 U SRC. (ALL)
/
/TABLES OF INVALID DEVICES FOR FUNCTIONS AND DIRECTION.
/EACH TABLE IS TERMINATED BY A NEGATIVE REGISTER.
/
/L SOURCE; R,C,B SOURCE AND DEST; D AND N DEST; I DEST; U DEST.
UOUTPT=.
IOUTPT	0424		/DT -- DECTAPE.
BOUTPT=.
BINPUT=.
NOUTPT=.
LINPUT	1524		/MT - MAGNETIC TAPE.
ROUTPT=.		/(JMW:109) ALLOW RENAME TO MAGTAPE.
RINPUT=.		/(JMW:109)
CINPUT=.
COUTPT=.
BULK=.
DOUTPT=.
TTDEV	2424		/TT - TELETYPE (PRINTER).
	2022		/PR - PAPER TAPE READER.
	0304		/CD - CARD READER.
VOUTPT=.
TINPUT=.
LPDEV	1420		/LP -- LINE PRINTER.
	2620		/VP - DISPLAY.
PPDEV	2020		/PP - PAPER TAPE PUNCH.
	2624		/VT - DISPLAY.
ALLBAD=.
MASK1	737777		/END OF THIS TABLE.
/
/L, DEST.
LOUTPT=.
DECTAP	0424		/DT - DECTAPE
MAGTAP	1524		/MT - MAGNETIC TAPE.
DSKPAK	0420			/DP - DISK PACK.
DECDSK	0413		/DK - DISK.
DECPAK	2213		/RK - DISK
/T, DEST.
TOUTPT=.
PRDEV	2022		/PR
CDDEV	0304		/CD
MASK2	700000		/END OF THIS TABLE.
	.IFDEF TEST
/
/DEV TABLE - FOR TESTING PURPOSES ONLY (SO CAN HAVE RELOCATABLE
/VERSION TO USE WITH DDT).
/
TSTDVP	0413			/DAT SLOT 1: DK
	0413			/2: DK
	0424			/3: DT
	0424			/4:DT
	0420			/5: DP
	0420			/6:DP.
	1420			/7:LP
	2620			/10: VP.
	2020			/11: PP.
	2022			/12: PR.
	2624			/13: VT.
	1524			/14:MT.
	1524			/15: MT.
	2213			/16: RK.
	2213			/17: RK
	0304			/20: CD.
	.ENDC
	.TITLE    CAROT: SUBROUTINE TO PROCESS UIC.
/
/SUBROUTINE TO PROCESS SPECIFIED UIC.
/AC = NEXT CHARACTER IN THE COMMAND STRING ON BOTH ENTRY AND EXIT.
/THIS ROUTINE PICKS UP THE SPECIFIED UIC (FORM: <UIC>) , IF THERE IS ONE, AND
/ISSUES THE .USER CAL FOR THE .DAT SLOT BEING PROCESSED.  ON A RENAME (FILE
/NAME) FUNCTION, IT DETERMINES WHICH SPECIFIED UIC TO USE.  IT PROCESSES THE
/REMAINDER OF A RENAME (DIRECTORY PROTECTION CODE) FIMCTOPM, WHICH MUST BE IN THE
/FORM : R DV <UIC:P>   WHERE P IS 0 (UNPROTECTED) OR 1 (PROTECTED).
/
CAROT	0
IGNRSP	SAD LIT40		/IGNORE  SPACES.
	SKP
	SAD COLON		/IGNORE COLON HERE (SAME AS SPACE).
	SKP
	JMP LOKCRT
	SET ZSPACE		/SET TO IGNORE SPACES.
	JMS GETCHR		/GET ANOTHER CHARACTER.
	DAC TCHAR
LOKCRT	SAD LFTCRT		/LOOKING FOR A LEFT CAROT.
	JMP CAROT1		/GOT ONE - MEANS UIC TO FOLLOW.
	LAC PIPUIC		/USE LOGGED-IN UIC IN ABSENCE OF SPECIFIED UIC.
CAROTA	DAC TMPUIC
	LAC DIRECT		/IF ON SOURCE SIDE OF RENAME, MUST DECIDE
	SNA			/WHICH UIC TO USE.
	JMP CAROTB
	LAC FUNCDE
	SAD FUNCR
	SKP
	JMP CAROTB
	LAC TMPUIC		/IF BOTH SIDES THE SAME, .USER ALREADY OUT.
	SAD DESUIC
	JMP SKPUSE
	SAD PIPUIC		/IF SAME AS LOGGED-IN UIC BUT NOT DESUIC, MEANS
	JMP SKPUSE		/UIC SPECIFIED ON DESTINATION SIDE.
CAROTB	LAC TMPUIC		/OTHERWISE, USE SRCUIC NO MATTER WHAT ELSE WAS SPECIFIED.
	JMS USER
SKPUSE	LAC DIRECT		/MUST SET UP CORRECT UIC.
	RAR			/L=0 IF DEST., L=1 IF SOURCE.
	LAC TMPUIC
	SZL
	JMP .+3
	DAC DESUIC
	SKP
	DAC SRCUIC
	LAC TCHAR
	SET ZSPACE
	JMP* CAROT
CAROT1	DZM ZSPACE		/SPACES COUNT NOW.
	JMS GETCHR		/FIRST UIC CHAR.
	AND (77
	JMS R6L
	DAC TMPUIC
	JMS GETCHR		/SECOND CHAR.
	AND (77
	XOR TMPUIC
	JMS R6L
	DAC TMPUIC
	JMS GETCHR		/THIRD CHARACTER.
	AND (77
	XOR TMPUIC
	DAC TMPUIC		/NOW HAVE 3 CHARACTER UIC.
	JMS GETCHR		/LOOKING FOR > OR :.
	SAD RTCRT
	JMP CKUIC1		/OK - GOT A >.
	SAD COLON
	JMP CPROT		/GOT A :.
	JMP ERR24			/ILLEGAL UIC.
CPROT	LAC ALLOUT		/ALL OK TO HERE.
	DAC VALOUT		/UPDATE CHARACTER POINTER.
	JMS GETCHR		/RENAME CAN SPECIFY A DIRECTORY PROTECTION
CPROTA	SAD (61			/CODE WITHEIN TH <>S.
	JMP CPROT1
	SAD (60
	SKP
	JMP ERR30		/ILLEGAL PROTECTION CODE.
CPROT1	XOR MINUS		/INDICATE THAT PROTECTION HAS BEEN SPECIFIED.
	DAC NEWPRO
	LAC FUNCDE
	SAD FUNCR
	SKP
	JMP ERR24
	DAC DIRECT		/FORCE END OF COMMAND.
	JMS GETCHR
	SAD RTCRT		/NOW MUST HAVE >.
	SKP
	JMP ERR24
	LAC ALLOUT		/MUST PROCESS THE REST OF RENAME COMMAND HERE
	DAC VALOUT
	JMS GETCHR		/LOOKING FOR CR OR ALTMODE.
LOKAGN	SAD LITCR
	JMP REND
	SAD ALTMOD
	JMP REND
	LAC LIT2		/ILLEGAL TERMINATOR.
	JMS ECHOCS
	JMP LOKAGN		/STILL LOOKING FOR CR OR ALTMODE.
REND	DAC TCHAR		/DONE.
	LAC TMPUIC
	DAC DESUIC
	JMS USER
	LAC TCHAR
	JMP ALLDNE
CKUIC1	SET ZSPACE		/IGNORE SPACES.
	LAC ALLOUT
	DAC VALOUT
	JMS GETCHR		/GET THE NEXT CHAR.
	DAC TCHAR
	LAC TMPUIC
	JMP CAROTA
TMPUIC	0			/TEMP STORAGE FOR SPECIFIED UIC.
/
/SUBROUTINE TO ISSUE .USER MACRO
/AC=UIC ON ENTRY.
/
USER	0
	DAC USEUIC
/.USER .DAT,UIC
CURDAT	XX			/BITS 9-17 MODIFIED TO DAT SLOT # BY GETDEV.
	23
USEUIC	XX			/UIC.
	JMP* USER
	.TITLE    FILECK: SUBROUTINE TO GET AND CHECK FILE NAMES.
/ROUTINE TO PICK UP FILE NAME AND EXTENSION
/AND CHECK ITS VALIDITY IF SOURCE FILE.
/EXIT WITH NEXT 7-BIT CHARACTER IN TMPCHR.
FILECK	0
	LAC TCHAR
FLEA	DAC TMPCHR
	LAW -7			/ALLOW ONLY 6 CHARS IN A FILE NAME.
	DAC TCOUNT
	DZM TMPFLE	/CLEAR OUT TEMPORARY
	DZM TMPFLE+1	/FILE AND EXT
	DZM TMPEXT	/WORDS.
	DZM CHRPOS	/INITIALIZE CHR. POSITION CTR.
	LAC (TMPFLE		/INITIALIZE FILE (EXT)
	DAC TMPPTR		/WORD POINTER.
	LAC (740000
	DAC ZILCH
	LAC TMPCHR
	SKP
FLEBCK	JMS GETCHR
	DAC TMPCHR		/SAVE FOR EXIT.
	SAD SEMICO		/SEMI COLON (;)
	JMP FSEMIC
	SAD HASH		/HASH (#).
	JMP FSEMIC
	SAD LIT40		/SPACE (=;)
	JMP FSEMIC
	SAD OPAREN		/OPEN PAREN (()
	JMP FOPARN
	SAD COMMA		/COMMA (,)
	JMP FCOMMA
	SAD LFTARW		/LEFT ARROW
	JMP FLARRO
	SAD LITCR		/CARRIAGE RETURN
	JMP FCRRET
	SAD ALTMOD		/ALT MODE (ESC)
	JMP FALTMD
	SAD DASH		/-?
	JMP FLDASH
	AND (77
	DAC TMPCHR
	LAC CHRPOS	/DISPATCH TO
	TAD (JMP WRDPOS	/APPROPRIATE
	DAC FILEC2		/CHARACTER
/CHECK FOR BLOCK OR UPDATE FUNCTION.
	LAC FUNCDE		/B?
	SAD FUNCB
	SKP			/YES.
	SAD FUNCU		/U?
	SKP			/YES.
	JMP FILEC1
	LAC TMPCHR		/CHECK FOR OCTAL DIGIT
	AND (170
	SAD (60
	JMP FILEC1		/OK
	JMP ERR21
FILEC1	LAC TMPCHR		/HANDLER
	DZM ZSPACE		/DO NOT IGNORE SPACE
FILEC2	XX
WRDPOS	JMP FRSTCH		/1ST CHAR. OF WORD.
	JMP SECNCH		/2ND CHAR. OF WORD.
	XOR* TMPPTR	/THIRD CHAR POSITION.
	DAC* TMPPTR
	ISZ TCOUNT
	SKP
	JMP ERR05
	LAC TMPPTR
	SAD (TMPFLE		/IF 1ST WORD OF
	SKP		/FILE NAME, MORE
	JMP DPSIT1	/CHARS. MAY
	IDX TMPPTR	/FOLLOW.
THROUT	DZM CHRPOS
	JMP FLEBCK
FSEMIC	LAC (TMPEXT	/SEMI-COLON
	DAC TMPPTR	/SET UP TO PICK UP EXTENSION.
	DAC ZSPACE		/IGNORE SPACE
	LAW -4			/ALLOW ONLY 3 CHARS IN AN EXTENSION.
	DAC TCOUNT
	JMP THROUT
FLARRO	JMS BLCOMP
	LAC DIRECT		/VALID TERMINATOR (LEFT ARROW)
	SZA!CLC		/IF DESTINATION
	JMP CERR02		/INFO.
FOPARN	DAC ZSPACE		/IGNORE SPACE.
	LAC FUNCDE
	SAD FUNCL		/L FUNCTION?
	JMS FINSHL		/YES - UPDATE TABLES AND EXIT.
	SAD FUNCC		/C FUNCTION?
	SKP		/YES -EXIT
	SAD FUNCB			/B FUNCTION?
	SKP			/YES - EXIT
	SAD FUNCI		/I FUNCTION?
	SKP			/YES - EXIT.
	SAD FUNCU		/U FUNCTION?
	SKP			/YES - EXIT.
	SAD FUNCN		/N FUNCTION?
	JMP NOFSAT
	SAD FUNCD		/CAN HAVE DELETE WITH NO FILE NAME.
	SKP
	JMP DOFSAT
	LAC TMPFLE
	SZA			/IF 0, NO FILE NAME AND NO NEED FOR .FSTAT.
DOFSAT	JMS FSTAT		/CHECK PRESENCE OF GOOD FILE AND EXTENSION.
NOFSAT	LAC ALLOUT
	DAC VALOUT
ZILCH	XX		/NOP OR JMP FCREZ IF CR.
	JMP* FILECK	/SOURCE FILES.
FLDASH	JMS BLCOMP
	SET MULTBK		/SET SWITCH INDICATING STRING OF IMPLIED BLOCKS COMING.
	SET ZSPACE
	JMP FDASH1
FCOMMA	DAC ZSPACE	/IGNORE SPACE
	JMS BLCOMP
FDASH1	LAC FUNCDE
	SAD FUNCL		/L FUNCTION?
	JMS FINSHL		/YES - UPDATE TABLES AND EXIT.
	SAD FUNCB			/B FUNCTION?
	SKP			/YES - EXIT.
	SAD FUNCU		/UPDATE FUNCTION?
	SKP
	JMS FSTAT		/CHECK PRESENCE OF SOURCE FILES
	LAC ALLOUT
	DAC VALOUT
	JMS GETCHR
	JMP FLEA			/GET NEXT FILE
FRSTCH	CLL!RAR		/FIRST CHARACTER POSITION.
	JMS R3R
	JMS R3R		/3 RIGHT.
DPSITC	DAC* TMPPTR
	ISZ TCOUNT
	SKP
	JMP ERR05
DPSIT1	IDX CHRPOS
	JMP FLEBCK
SECNCH	CLL			/SECOND CHAR POSITION.
	JMS R6L
	XOR* TMPPTR
	JMP DPSITC
/
/SUBROUTINE TO SAVE REQUESTED FILE NAME FOR L FUNCTION.
//
FINSHL	0
	LAC DIRECT
	SZA			/UPDATE FILE NAME ONLY IF DEST SIDE.
	JMP FINL1
	LAC TMPFLE		/PUT NAME AND EXTENSION INTO
	DAC LNAME1		/LIST'S NAME AND EXT.
	LAC TMPFLE+1
	DAC LNAME2
	LAC TMPEXT
	DAC LEXT
FINL1	IDX FINSHL
	JMP* FINSHL
/
/.CLOSE -3
FALTMD	CAL+775		/FOR CR AFTER ALT MODE
	6
	CLC
FCRRET	DAC ZSPACE	/IGNORE SPACE
	JMS BLCOMP	/CHECK B FUNCT AND CONVERT BL #'S
	LAC DIRECT	/CR OR ALT MODE
	SNA		/ARE VALID TERMINATORS
	JMP CERR02		/IF SOURCE INFO.
	LAW -2
	DAC ECHOCS	/COUNT FOR PASSES THROUGH FOPARN
FCREZ	LAC DATAMD	
	SZA		/NO DATA MODE SPECIFIED.
	JMP ZPRCHK		/ALREADY HAVE DATA MODE.
	LAC FUNCDE
	SZA		/0=T FUNCTION
	SAD FUNCV		/16=V FUNCTION
	SKP
	JMP FOPARN
	LAC (JMP FCREZ
	DAC ZILCH
	ISZ ECHOCS
	JMP FOPARN
	CLC
	TAD ALLOUT	/GET RID OF CR IN ECHO MSG
	DAC VALOUT
CERR11	LAC LIT11		/ERROR MESSAGE # 9-DATA MODE NEEDED.
	JMS ECHOCS
	SAD OPAREN
	SKP			/ONLY A DATA MODE SWITCH ACCEPTABLE HERE.
	JMP CERR11
	DAC TMPCHR		/SAVE NEW CHAR.
	JMP* FILECK
CERR02	LAC LIT2		/#2 - ILL. TERMINATOR.
	JMP ERR06+1
/
/ROUTINE TO CHECK H OR D MODE FOR T FROM PR TO PP
/
ZPRCHK	SAD (5		/D?
	JMP DMICK		/CHECK FOR DUMP+PR
	SAD LIT2		/H?
ZPR1	LAC FUNCDE	/T?
	SZA		/YES
	JMP FOPCK
	LAC PAPER		/PR OR PP?
	SAD (3		/BOTH  BAD
	SNA!CLA		/YES, BAD DATA MODE
	JMP FOPCK
	DAC DATAMD
	JMP ERR07		/SWITCH ILLEGAL FOR THE DEVICE.
DMICK	LAW 1		/PR+DUMP?
	XOR PAPER
	SNA!CLA
	LAC LIT2
	DAC DMPSW
	JMP ZPR1
FOPCK	LAC ZILCH		/IF ZILCH=NOP,
	SAD (740000
	JMP FOPARN	/GO THRU FOPARN TO DO FSTAT
	JMP* FILECK	/OTHERWISE, ALL OK, EXIT
/
TMPCHR	0		/6-BIT  CHARACTER
CHRPOS	0		/POSITION OF NEXT CHAR. IN NAME
TMPFLE	0		/TEMPORARY STORAGE OF
	0		/FILE NAME AND
TMPEXT	0		/EXTENSION
TMPPTR	0		/POINTER TO TEMP. FILE STORAGE.
	.TITLE    BLCOMP: SUBROUTINE TO PROCESS BLOCK NUMBERS.
/
/SUBROUTINE TO CONVERT 6-BIT ASCII BLOCK NUMBERS INTO OCTAL BLOCK
/NUMBERS OF 6 DIGITS.  VALUE ENTERED IN 'TMPFLE' AND 'TMPFLE+1'.
/BL#'S STORED IN DEST FILE AREA.
/
BLCOMP	0
	LAC FUNCDE	/B FUNCTION?
	SAD FUNCB
	SKP
	SAD FUNCU		/U FUNCTION?
	SKP
	JMP* BLCOMP	/NO - EXIT.
	LAC TMPFLE
	SZA
	JMP GETBLK
	LAC FUNCDE
	XOR FUNCU		/IF U, MUST HAVE BLOCK #.
	SZA
	JMP* BLCOMP	/NO BLOCK # AND B FUNCTION.
	JMP ERR26		/NEED BLOCK NUMBER.
GETBLK	LAC BLSAV		/BLK # USED LAST TIME THRU.
	DAC ORGBLK		/WILL BE USED IF GET IMPLIED STRING OF BLOCK #S.
	DZM BLSAV
	LAC TMPFLE		/DIGIT 1 (HIGH ORDER).
	RTL; RAL
	DAC TMPFLE
	AND MASK2		/(700000.
	JMS BLKDIG
	LAC TMPFLE		/DIGIT 2.
	AND (77000		/IF NO DIGIT, ADJUST WORD.
	SZA
	JMP .+3
	LAW -5
	JMP DIGPOS
	LAC TMPFLE
	RTL; RAL
	DAC TMPFLE
	AND (70000
	JMS BLKDIG
	LAC TMPFLE		/DIGIT 3.
	AND (7700
	SZA
	JMP .+3
LM4	LAW -4
	JMP DIGPOS
	RTL; RAL
	AND (7000
	JMS BLKDIG
	LAC TMPFLE+1		/DIGIT 4.
	AND L77TH		/(770000
	SZA
	JMP .+3
	LAW -3
	JMP DIGPOS
	JMS R3R
	JMS R3R
	AND (700
	JMS BLKDIG
	LAC TMPFLE+1		/DIGIT 5.
	AND (7700
	SZA
	JMP .+3
	LAW -2
	JMP DIGPOS
	JMS R3R
	AND (70
	JMS BLKDIG
	LAC TMPFLE+1		/DIGIT 6.
	AND (77
	SZA
	JMP .+3
	LAW -1
	JMP DIGPOS
	AND (7
	JMS BLKDIG
ALLDIG	DAC ENDBLK		/FINALLY HAVE 6 DIGIT BLOCK NUMBER.
	LAC MULTBK		/NON-ZERO IF STRING OF BLOCKS COMING.
	SNA
	JMP BCONT2
	LAC ORGBLK
	DAC BLSAV
BCONT1	IDX BLSAV
BCONT2	LAC DIRECT
	SNA!CMA
	JMP BLDEST	/DEST BLOCKS
	LAC DESTSW	/SRC BLOCKS
	SNA!STL		/DEST BLKS PRESENT, SET SRC ONLY
	CLL		/PLACE SRC BLKS IN DEST LIST ALSO
	ISZ INROOM
	JMP BLSRC
	JMP NOROOM	/OVERFLOW, TOO MANY BLK #'S
BLDEST	DAC DESTSW	/SET DEST BLKS PRESENT SW
	ISZ OTROOM
	SKP
	JMP NOROOM		/TOO MANY BLOCK #'S IN COMMAND STRING.
	LAC BLSAV
	DAC* DSFPTR
	IDX DSFPTR
	IDX DSFCNT
	JMP BCHECK
BLSRC	LAC BLSAV		/SRC ONLY
	SNL
	DAC* DSFPTR
	DAC* SRFPTR
	SNL
	IDX DSFPTR
	IDX SRFPTR
	SNL
	IDX DSFCNT
	IDX SRFCNT
BCHECK	LAC BLSAV
	SAD ENDBLK
	SKP
	JMP BCONT1
	DZM MULTBK
	JMP* BLCOMP
BLSAV	0
ENDBLK	0
ORGBLK	0
MULTBK	0
/
/SUBROUTINE TO XOR THE DIGIT IN THE AC INTO THE ACCUMULATED BLOCK NUMBER.
/
BLKDIG	0
	XOR BLSAV
	DAC BLSAV		/PUT THIS DIGIT INTO THE BLOCK NUMBER.
	JMP* BLKDIG
/
DIGPOS	DAC TIMES
	CLL
DIGPO1	LAC BLSAV
	JMS R3R
	DAC BLSAV
	ISZ TIMES
	JMP DIGPO1
	JMP ALLDIG
	.TITLE    FSTAT: SUBROUTINE TO CHECK LEGALITY OF FILE NAME.
/SUBROUTINE TO CHECK VALIDITY OF FILE NAME
/AND EXTENSON IF SOURCE FILE (EXT).  ENTER FILE (EXT)
/IN APPROPRIATE TABLE.  AND UPDATE FILE COUNTER
/
FSTAT	0
	LAC DIRECT
	SNA
	JMP DFSTAT	/DESTINATION FILE
	LAC SRCDEV
	DAC FSTATZ		/TEMP STORAGE FOR CHKNUL
	JMS CHKNUL		/CHECK FOR NULL FILE NAME.
	LAC (TMPFLE
	DAC MODN07
	JMS EXTCK
	DAC BLCOMP	/TMPEXT
	LAC (TMPFLE
	JMS EXTCK1
	LAW -3
	DAC EXTCK1	/COUNT FOR # OF FSTAT PASSES
/INITIALIZE .DAT SLOT OF SOURCE DEVICE.
FST	LAC SRCDAT
	DAC INITMD
/	.INIT XX,0,NUORRE
INITMD	XX			/CAL + .DAT SLOT.
	1
	NUORRE
	0
	LAC SRCDAT
	JMS FSTATZ
	SZA		/FILE NOT ON DEV
	JMP FILEOK
	LAC MODN07
	AND MASK2		/MASK2 = 700000
	SZA		/SKIP IF DEVICE NOT FILE ORIENTED
	JMP MOREF		/DOUBLE CHECK FILE THERE
FILEOK	LAC BLCOMP		/ORIGINAL EXTENSION IN BLCOMP.
	DAC TMPEXT		/RESTORE.
	ISZ INROOM
	JMP ISROOM
NOROOM	CAL 775		/.CLOSE
	6
	DZM ZECHO		/OUTPUT ERROR - TOO MANY FILES OR BLOCKS.
	LAC (FULLER
	JMP LACALB+1
ISROOM	LAC TMPFLE		/O.K
	DAC* SRFPTR	/PLACE FILE AND EXT
	IDX SRFPTR	/IN BLOCK FOR THIS PURPOSE
	LAC TMPFLE+1
	DAC* SRFPTR
	IDX SRFPTR
	LAC TMPEXT
	DAC* SRFPTR
	IDX SRFPTR
	IDX SRFCNT		/INDEX COUNT
	JMP FSTATO
/IF FILE NOT FOUND WITHOUT EXT, TRY SRC AND BIN
MOREF	LAC BLCOMP	/ORIG EXT
	SZA
	JMP ERR06			/FILE REALLY NOT THERE.
	LAC TMPEXT
	SAD BIN
	JMP MORSRC	/TRY SRC
	LAC BIN		/TRY BIN
MOREG	DAC TMPEXT
	ISZ EXTCK1
	JMP FST		/KEEP TRYING
	JMP ERR06			/NOT EVEN SRC OR BIN IS THERE.
MORSRC	LAC SRC
	JMP MOREG
/DESTINATION FILE
DFSTAT	ISZ OTROOM
	SKP
	JMP NOROOM		/NO MORE ROOM FOR DES. FILES IN BLOCK.
	LAC FUNCDE		/IF RENAME, MUST HAVE FILE NAME ON
	SAD FUNCR		/DESTINATION SIDE ALSO.
	SKP
	JMP DFLEOK
	LAC DESDEV
	DAC FSTATZ		/TEMP STORAGE FOR CHKNUL.
	JMS CHKNUL		/CHECK FOR NULL FILE NAME.
DFLEOK	LAC TMPFLE		/DESTINATION FILE
	DAC* DSFPTR	/PLACE FILE AND EXT
	IDX DSFPTR	/IN BLOCK FOR THIS PURPOSE.
	LAC TMPFLE+1
	DAC* DSFPTR
	IDX DSFPTR
	JMS EXTCK
	DAC* DSFPTR
	IDX DSFPTR
	IDX DSFCNT	/INDEX COUNT
FSTATO	LAC ALLOUT	/UPDATE VALID
	DAC VALOUT	/COMMAND POINTER
	JMP* FSTAT
/
/SUBROUTINE TO CHECK FOR NULL FILE NAME.
/FSTATZ MUST BE SET  TO DEVICE CODE TO CHECK BEFORE ENTRY.
/
CHKNUL	0
	LAC TMPFLE
	SZA
	JMP* CHKNUL		/OK - GOT NAME.
	LAC TMPFLE+1
	SZA
	JMP* CHKNUL		/ALL OF FILE NAME MUST BE 0 TO BE ILLEGAL.
	LAC TMPEXT
	SZA
	JMP* CHKNUL
	LAC FSTATZ		/LEGAL TO HAVE NULL FILE NAMES TO NON-FILE
	JMS FNDBLK		/ORIENTED DEVICES.
	SZL			/L=1  IF NON-FILE ORIENTED.
	JMP* CHKNUL
	JMP ERR33
/
/SUBROUTINE TO DO THE ACTUAL .FSTAT.
/ENTER WITH DAT SLOT #IN AC
/EXIT: AC=0=FILE NOT FOUND, AC=NOT 0=FOUND
/
FSTATZ	0
	XOR OUTPIP	/(3000
	DAC FSTATM
	LAC MODN07
	AND (77777
	DAC MODN07
/
/	.FSTAT XX, TMPFLE
FSTATM	XX
	2
MODN07	XX
	JMP* FSTATZ
/EXTENSION CHECK SUBROUTINE.
/IF EXT=SRC, BIN OR ABS AND NO DATA MODE AS YET, SET DATA MODE
/TO A IF SRC, B IF BIN ,D IF ABS.
/IF EXTENSION CONTAINS A NUMBER AS THE LAST CHAR, SET DATA MODE TO A.
/
EXTCK	0
	LAC DATAMD
	SZA
	JMP EXTEND	/ALREADY HAVE DATA MODE, EXIT
	LAC TMPEXT
	SAD SRC
	JMP SRCPUT	/SET DATA MODE TO A
	SAD BIN
	JMP BINP		/SET DATA MODE TO B
	SAD ABS
	JMP ABSPUT		/SET DATA MODE TO D.
	JMS R3R
	AND (7
	SAD LIT6
	JMP SRCPUT
	SAD (7
	JMP SRCPUT
EXTEND	LAC TMPEXT	/MUST BE IN AC ON EXIT
	JMP* EXTCK
ABSPUT	LAC (5		/DUMP MODE.
	SKP
SRCPUT	LAC (3
	SKP
BINP	LAC (1
	DAC DATAMD
	JMP EXTEND
/EXTENSION CHECK SUBR #2
/IF THERE IS NO EXT, AND DATA MODE = A, B, OR D,
/THEN SET EXT TO SRC FOR A, BIN FOR B, ABS FOR D.
/AC ON ENTRY: FILE NAME POINTER
/
EXTCK1	0
	TAD LIT2		/POINT TO EXT.
	DAC EXTCK
	LAC* EXTCK
	SZA
	JMP* EXTCK1	/EXT ALREADY PRESENT
	LAC DATAMD
	SAD (1
	JMP BINSET	/SET EXT = BIN
	SAD (3
	JMP SRCSET	/SET EXT = SRC
	SAD (5
	JMP ABSSET
	JMP* EXTCK1
ABSSET	LAC ABS
	SKP
SRCSET	LAC SRC
	SKP
BINSET	LAC BIN
	DAC* EXTCK
	JMP* EXTCK1
SRC	.SIXBT /SRC/
BIN	.SIXBT /BIN/
ABS	.SIXBT /ABS/
	.TITLE INITAL: INITIALIZE DISK FUNCTION.
/
/INITIALIZE FUNCTION.
/LEGAL ONLY TO THE DECDISK AND DISK PACK, THIS FUNCTION ISSUES A .CLEAR 
/WHICH RETURNS THE DISK TO IT'S ORIGINAL VIRGIN STATE.  THIS FUNCTION IS
/LEGAL ONLY IF THE LOGGED-IN UIC IS THE MIC.
/
INITAL	LAC PIPMIC		/BIT 0=1 IF LOGGED-IN UIC=MIC.
	SMA
	JMP ERR23		/ILLEGAL FUNCTION FOR UIC.
	LAC DESDAT
	DAC CLERDT
	DAC CLWAT
	JMS INITOT		/INIT DEVICE.
/	.CLEAR DAT
CLERDT	XX
	5
/	.WAIT DAT
CLWAT	XX
	12
ICLOSE	LAC DESDAT
	JMP CLOUT		/CLOSE DAT SLOT AND GO TO EXIT ROUTINE.
	.TITLE UPDATE: UPDATE FUNCTION
/
/UPDATE, PRIMARILY AIMED AT DISK PACK USERS, IS THE METHOD OF MAINTAINING
/THE BAD ALLOCATION TABLE (BAT).  THE BLOCK NUMBER OF THE FIRST BAT BLOCK IS IN
/WORD 1 OF THE FIRST MFD BLOCK, IF ONE EXISTS.  PIP WILL CREATE ONE IF NEED BE.
/AT ANY RATE, THE BAD BLOCK NUMBER(S) WILL BE ENTERED INTO THE BAT IN OCTAL,
/ONE ENTRY PER WORD, AND THE CORRESPONDING BIT IN THE CORRECT SAT WILL BE SET
/TO INDICATE THAT BLOCK AS BUSY.  IF THE BIT IN THE SAT IS ALREADY SET AS OCCUPIED,
/A WARNING MESSAGE IS ISSUED TO INDICATE THAT THE USER SHOULD FIRST DELETE THE FILE
/THAT USED THE BLOCK, AS THE HANDLER DOES NOT CHECK THE BAT WHEN RETURNING
/BLOCKS TO THE SYSTEM. THE BLOCK # IS NOT ENTERED IN THE BAT IN THAT CASE.
/AFTER THE UPDATE IS COMPLETE, THE TOTAL NUMBER OF BAD BLOCKS IN THE 
/SYSTEM IS OUTPUT TO THE TELETYPE.
/
UPDATE	LAC (DPMFD		/SET UP FOR DISK PACK AS DEFAULT CASE.
	DAC DIRBLK
	LAC DESDEV
	SAD DSKPAK
	JMP UPDAT1
	LAC (RFMFD
	DAC DIRBLK
UPDAT1	LAC DSFCNT		/NUMBER OF BLKS TO BE ENTERED (NEGATIVE).
	DAC UCOUNT
	LAC (DESFLS		/AREA WHERE BLOCK NUMBERS ARE STORED.
	DAC BLKPNT
	SET USWTCH
	DZM NUMBAD
	LAC DESDAT
	STL
	JMS ZSETTR		/SET UP FOR TRAN INPUT.
	JMS ZTRANS		/BRING IN MFD. (IN Z1BUF)
	LAC* (Z1BUF+3		/BLOCK NUMBER OF FIRST SAT BLOCK.
	AND (77777		/IN BITS 3-17.
	DAC SATBLK
	LAC* (Z1BUF+1		/BAT BLOCK NUMBER IN 2ND WORD OF MFD.
	SAD LM1
	JMP CREATB		/NO BAT BLOCK - MUST CREATE ONE.
NEWBAT	DAC ZBLNUM
	DAC BATBLK
	LAC ZTRANZ		/(JMW:114)  SINCE SEQUENCE OF READ/WRITES CHANGED
	AND (776777		/(JMW:114)  WITH THIS EDIT, CLEAR OUT POSSIBLE OUTPUT
	DAC ZTRANZ		/(JMW:114)  BIT.
	JMS ZTRANS		/READ BAT INTO Z1BUF.
UPDAT4	LAC Z1BUFP		/SET UP LIMITS FOR SEARCH ON BAT.
	AAC 375
	CMA
	DAC BATEND		/LAST LEGAL ADDR FOR SEARCH.
	LAC Z1BUFP		/(JMW:114) IF BLOCK IS ALREADY IN THE BAT,
	AAC 1			/(JMW:114)  DON'T WANT TO PUT IT IN AGAIN.
	DAC TEMP		/(JMW:114)
UPDAT5	LAC* TEMP		/(JMW:114)
	SAD* BLKPNT		/(JMW:114)
	JMP ADDROT		/(JMW:114 GOT A MATCH.
	IDX TEMP		/(JMW:114)
	LAC TEMP		/(JMW:114)
	TAD BATEND		/(JMW:114)
	SPA			/(JMW:114)
	JMP UPDAT5		/(JMW:114)  MORE ENTRIES.
	LAC Z1BUFP
	TAD* Z1BUFP		/FIRST WORD OF BAT CONTAINS POINTER TO NEXT FREE WORD.
	DAC BATPNT
UIDXPT	TAD BATEND		/MORE ROOM IN THIS BAT?
	SPA
	JMP ADDROK		/YES.
	LAC* Z1BUFP		/SAVE NUMBER OF BAD BLKS TO OUTPUT AT END.
	AAC -2
	TAD NUMBAD
	DAC NUMBAD
	LAC* (Z1BUF+377		/NO - SEE IF THERE IS ANOTHER BAT.
	SAD (777777
	JMP CREAT1		/NO - MUST CREATE ONE.
	JMP NEWBAT		/YES - GO GET IT.
ADDROT	SET UBKSET		/(JMW:114) BLOCK ALREADY IN BAT.
ADDROK	LAC* BLKPNT		/BAD BLOCK NUMBER.
	DAC BADBLK
FIXSAT	DZM SATNUM		/NOW MUST SET BIT BUSY IN SAT. (NEWDIR COMES IN HERE)
	LAC SATBLK
	DAC ZBLNUM
	LAC Z2BUFP		/PUT SAT INTO Z2BUF.
	DAC TRNBUF
	LAC DESDAT		/DAT SLOT NUMBER.
	DAC ZTRANZ
	JMS ZTRANS		/BRING SAT INTO Z2BUF.
	LAC USWTCH		/IF UPDATE, VERIFY LEGALITY OF BAD BLOCK #.
	SNA
	JMP NOTEST		/NO NEED FOR THAT IF 'NEWDIR'.
	LAC BADBLK		/IS BLOCK # TO BE INSERTED A LEGAL ONE?
	SPA!CMA
	JMP UERR21
	ADD* Z2BUFP		/TOTAL # BLOCKS IN SYSTEM.
	SPA
	JMP UERR21		/NO - ISSUE ERROR.
NOTEST	LAC* (Z2BUF+1		/# BLOCKS IN THIS SAT.
	TCA
	DAC SATPOS
	TAD BADBLK		/IS BAD BLK # IN THIS SAT?
	SPA
	JMP HAVSAT		/YES.
	DAC BADBLK
	LAC* (Z2BUF+377		/GET NEXT SAT BLOCK.
	SAD LM1
	JMP ERR35		/SOMETHING RADICALLY WRONG WITH SAT STRUCTURE.
	DAC ZBLNUM
	JMS ZTRANS
	JMP NOTEST
HAVSAT	LAC BADBLK
	CMA
	DAC BADBLK
	LAC (Z2BUF+2		/DATA STARTS IN 3RD WORD OF SAT.
	DAC SATPNT
ADJST1	CLL
	LAC MINUS
	DAC UMASK
	IDX SATPNT
	LAW -22
	DAC BITCNT
UPDAT2	ISZ BADBLK
	JMP UPDAT3
	LAC USWTCH		/IF U FUNCTION, SET BIT OCCUPIED. (SET LINK)
	RAR			/OTHERWISE, FREE IT UP. (LINK=0)
	LAC UMASK
	AND* SATPNT
	DAC FOREPT		/SAVE (TEMP) STATUS OF THAT BIT.
	LAC UMASK
	CMA
	AND* SATPNT
	SZL			/FREE UP BIT. (N FUNCTION OR SWITCH)
	XOR UMASK		/SET BIT AS OCCUPIED. (U FUNCTION)
	DAC* SATPNT
	LAC USWTCH		/IF 'UPDATE', MAY WANT TO COUNT BIT, OR
	SNA			/IT MAY ALREADY BE COUNTED.
	JMP TAKBLK		/'NEWDIR' - SUBTRACT ONE FROM COUNT.
	LAC FOREPT		/IF NON-0, MEANS BLOCK ALREADY OCCUPIED.
	SNA
	JMP CNTBBK		/WAS 0, COUNT IT.
	LAC (BUFFER+2		/OUTPUT WARNING MESSAGE.
	JMS SETPUT
	LAC UBKSET		/(JMW:114) WORKING WITH PRESET BLOCK?
	SNA			/(JMW:114)
	JMP UWARN		/(JMW:114) NO - OUTPUT WARNING.
	LAC (UBLKST		/(JMW:114) TELL THE USER BLOCK IN BAT ALREADY.
	SKP			/(JMW:114)
UWARN	LAC (BLKOCU
	JMS PACKBF
	DZM PUTC		/STRIP CR - ASSUMES 1ST CHAR IN WORD!!!
	JMS PACK40		/INSERT A SPACE.
	LAC* BLKPNT		/(JMW:114)CURRENT BAD BLOCK.
	JMS KLFOCT
	JMS PRSET		/SET UP PROUT.
	JMS LNEOUT		/OUTPUT LINE.
	SET UBKSET		/(JMW:114) SET SO PUT NOTHING INTO BAT.
	SKP			/NO NEED TO COUNT ALREADY OCCUPIED BLOCK.
CNTBBK	IDX* (Z2BUF+2		/UPDATE # BLOCKS OCCUPIED IN THIS SAT.
	JMP WRITSA
TAKBLK	CLC
	TAD* (Z2BUF+2		/SUBTRACT ONE FROM COUNT AS JUST RETURNED A BLOCK.
	DAC* (Z2BUF+2
WRITSA	LAC ZTRANZ		/DAT SLOT NUMBER.
	XOR (1000
	DAC ZTRANZ
	JMS ZTRANS		/REWRITE UPDATED SAT.
	LAC USWTCH		/IF NEW DIRECTORY ROUTINE, RETURN.
	SNA
	JMP RTBLK1
	LAC UBKSET		/(JMW:114) IF NON-ZERO, NOTHING TO PUT INTO BAT.
	DZM UBKSET		/(JMW:114)
	SZA			/(JMW:114)
	JMP UBKNXT		/(JMW:114)
	LAC* BLKPNT		/(JMW:114)  BAD BLOCK NUMBER.
	DAC* BATPNT		/(JMW:114)  PUT IT INTO THE BAT.
	IDX* Z1BUFP		/(JMW:114) INCREMENT # ENTRIES IN BAT.
UBKNXT	LAC Z1BUFP		/(JMW:116)  SET UP TO WRITE OUT THIS ALTERED BAT.
	DAC TRNBUF		/(JMW:114)
	LAC BATBLK		/(JMW:114)
	DAC ZBLNUM		/(JMW:114)
	JMS ZTRANS		/(JMW:114) WRITE IT OUT.
	IDX BLKPNT		/UPDATE TO NEXT BAD BLOCK #, IF THERE IS ONE.
	IDX BATPNT
	LAC BATPNT
	ISZ UCOUNT
	JMP UIDXPT		/THERE ARE MORE BLOCK NUMBERS.
	LAC (BUFFER+2		/OUTPUT TOTAL NUMBER BAD BLOCKS IN SYSTEM.
	JMS SETPUT
	JMS PRSET
	CLC
	TAD* Z1BUFP
	TAD NUMBAD		/NUMBER FROM OTHER BAT BLOCKS.
	JMS KLFOCT
	LAC (BADBKN
	JMS PACKBF
	JMS PROUT
	JMP ICLOSE		/CLOSE DEST. DEVICE AND EXIT.
UPDAT3	ISZ BITCNT
	SKP
	JMP ADJST1
	LAC UMASK
	RAR
	DAC UMASK
	JMP UPDAT2
/NO BAT EXISTS AT ALL - MUST CREATE ONE.
/ALSO COME HERE IF CREATING A NEW MFD BLOCK FOR 'NEWDIR' FUNCTION (NDIRSW=NON-ZERO).
CREATB	LAC DESDAT		/DAT SLOT NUMBER.
	DAC ZTRANZ
	LAC Z2BUFP
	DAC TRNBUF
	DZM SATNUM
	LAC SATBLK
CREATC	DAC ZBLNUM
	LAC ZTRANZ		/(JMW:114) SINCE SEQUENCE OF READ/WRITES CHANGED
	AND (776777		/(JMW:114)  WITH THIS EDIT, CLEAR OUT POSSIBLE OUTPUT
	DAC ZTRANZ		/(JMW:114)  BIT.
	JMS ZTRANS		/PUT SAT IN Z2BUF.
	LAC* (Z2BUF+1
	SAD* (Z2BUF+2		/SAT FULL?
	JMP UNXSAT		/YES - GET ANOTHER ONE.
	LAC (Z2BUF+2		/ROOM IN THIS SAT.
	DAC SATPNT
	LAC* (Z2BUF+1		/# BITS TO CONSIDER IN THIS SAT.
	TCA
	DAC SATL
CREATD	IDX SATPNT
	LAC LM4M
	DAC UMASK
	LAW -22
	DAC BITCNT
	LAC* SATPNT
CREATE	DAC SATWRD
	SMA
	JMP GOTBLK
	IDX SATNUM
	LAC UMASK
	RAR!CLL
	DAC UMASK
	LAC SATWRD
	RAL
	ISZ SATL
	SKP
	JMP ERR35		/PROBABLY MEANS SAT CONTAMINATED.
	ISZ BITCNT
	JMP CREATE
	JMP CREATD
UNXSAT	TAD SATNUM		/UPDATE BLOCK NUMBER.
	DAC SATNUM
	LAC* (Z2BUF+377
	SAD LM1
	JMP ERR32			/DISK FULL.
	JMP CREATC
GOTBLK	LAC* SATPNT
	XOR UMASK
	DAC* SATPNT		/SET BIT BUSY FOR BAT BLOCK.
	IDX* (Z2BUF+2		/UPDATE # BLOCKS BUSY IN THIS SAT.
	LAC DESDAT		/DAT SLOT NUMBER.
	XOR (1000
	DAC ZTRANZ
	JMS ZTRANS		/REWRITE UPDATED SAT.
/MUST CHECK THAT NEW BAT BLOCK IS NOT ONE OF THE BAD BLOCKS.
	LAC NDIRSW		/NO BAD BLOCKS TO CHECK IF NEWDIR.
	SZA
	JMP BATKND
	LAC DSFCNT		/SET UP TEMP POINTERS SO CAN SCAN
	DAC BACKPT		/FOR MATCH ON BAD BLOCK NUMBERS.
	LAC (DESFLS
	DAC FOREPT
BADCHK	LAC* FOREPT
	SAD SATNUM
	JMP CREATB		/IT IS - GO GET ANOTHER BAT BLOCK.
	IDX FOREPT
	ISZ BACKPT
	JMP BADCHK		/MORE BAD BLOCK NUMBERS.
BATKND	LAC BAT1		/CREATING ENTIRELY NEW BAT?
	SZA
	JMP CREAT2		/NO - ONLY ADDING ANOTHER BAT BLOCK.
	LAW -1
	DAC BACKPT		/SET BACKWARD AND FOREWARD LINK POINTERS
	DAC FOREPT		/TO -1 FOR ENTIRELY NEW BAT.
	LAC SATNUM
	DAC* (Z1BUF+1		/SET BAT BLOCK NUMBER IN MFD.
	LAC DIRBLK
CREAT3	DAC ZBLNUM
	LAC Z1BUFP
	DAC TRNBUF
	JMS ZTRANS		/REWRITE UPDATED MFD OR UFD.
	LAC SATNUM
	DAC BATBLK
	LAW -376		/ZERO OUT WORDS 0-375 OF BAT.
	DAC TIMES
	LAC Z1BUFP
	DAC BATPNT
UZERO	DZM* BATPNT
	IDX BATPNT
	ISZ TIMES
	JMP UZERO
	LAC (1
	DAC* Z1BUFP		/WORD 0 OF BAT POINTS TO NEXT FREE LOC.
	LAC BACKPT
	DAC* BATPNT		/SET BACKWARD AND FOREWARD LINK POINTERS.
	IDX BATPNT
	LAC FOREPT
	DAC* BATPNT
	LAC NDIRSW
	DZM NDIRSW
	SZA
	JMP GTMFD1		/RETURN TO 'NEWDIR' ROUTINE.
	JMP UPDAT4
/THERE IS AT LEAST ONE BAT OR MFD BLOCK, BUT IT IS FULL.  MUST CREATE ANOTHER.
CREAT1	SET BAT1
	JMP CREATB
CREAT2	DZM BAT1
	LAC SATNUM
	DAC* (Z1BUF+377		/SET FOREWARD LINK OF PREVIOUS BAT.
	LAW -1			/FOREWARD LINK OF THIS BAT =1.
	DAC FOREPT
	LAC BATBLK
	DAC BACKPT
	JMP CREAT3
/ON ILLEGAL BLOCK NUMBER, MUST WRITE BAT OUT AND CLOSE DEVICE.
UERR21	LAC BATBLK
	DAC ZBLNUM
	LAC DESDAT
	DAC ZCLOSD
	XOR (1000
	DAC ZTRANZ
	LAC Z1BUFP
	DAC TRNBUF
	JMS ZTRANS
	JMS ZCLOS
	JMP ERR21
UCOUNT	0
BLKPNT	0
BATEND	0
SATNUM	0
BATPNT	0
UMASK	400000
SATWRD	0
SATPNT	0
BADBLK	0		/CURRENT BAD BLOCK #.
SATPOS	0
BAT1	0			/SWITCH = 1 IF CREATING ANOTHER BAT, RATHER THAN ENTIRELY NEW.
BACKPT	0			/BACKWARD LINK.
FOREPT	0			/FOREWARD LINK.
BATBLK	0
NUMBAD	0			/HOLDS TOTAL # BAD BLKS FOR OUTPUT.
UBKSET	0			/(JMW:114) NON-ZERO IF BLOCK # ALREADY IN BAT.
BLKOCU	.ASCII 'WARNING* BLOCK OCCUPIED: '<15>
	.LOC .-1
BADBKN	.ASCII ' TOTAL BAD BLKS'<15>
	.LOC .-1
UBLKST	.ASCII '  BLOCK ALREADY IN BAT:  '<15>
	.TITLE TRANSFER ROUTINES
/
/THERE ARE 3 FUNCTIONS INVOLVED HERE:
/ 1. COPY WITH NO SWITCHES, WHICH IS DESCRIBED BELOW (TCOPY).
/ 2. VERIFY.  THE VERIFY FUNCTION CHECKS PARITY/CHECKSUM OF THE THE INPUT FILE.
/     THE SAME ROUTINES ARE USED AS IN THE STANDARD TRANSFER, EXCEPT THAT
/     OUTPUT IS INHIBITED.
/ 3. 'TRANSFER' (ZTGO). A FILE IS TRANSFERRED FROM ONE DEVICE TO ANOTHER.
	.TITLE    TCOPY: COPY FUNCTION WITH NO SWITCHES.
/
/COPY WITH NO SWITCHES - USES TRANSFER FUNCTION ROUTINE.
/
/THIS ROUTINE WORKS BY TAKING ALL FILE NAMES FROM THE SOURCE DEVICE
/AND ENTERING THEM IN BOTH THE DESTINATION AND SOURCE FILE LISTS.  34(10) FILES
/CAN BE ENTERED AT ONCE.  (IT IS POSSIBLE THAT THE ROUTINE WOULD HAVE TO BEENTERED
/MORE THAN ONCE: THIS IS DONE BY SETTING A SWITCH IN 'ZCEXIT'.)
/IT THEN SETS THE DATA MODE TO DUMP, CHANGES THE FUNCTION TO 'T' AND DOES A
/TRANSFER OF MULTIPLE FILES.
/THE BUFFER SIZES FOR DUMP ARE DETERMINED AS FOLLOWS.  THE INITIAL TRANSFER IS
/DONE IN DUMP MODE, WITH THE BUFFER SIZE EQUAL TO THE MAXIMUM FOR THE INPUT DEVICE.
/THE HEADER WORD IS CHECKED FOR THE DATA MODE.  IF IT IS DUMP, THE INPUT BUFFER SIZE
/IS USED AS THE OUTPUT BUFFER SIZE.  IF, HOWEVER, THE DATA MODE IS
/NOT DUMP, THE OUTPUT BUFFER SIZE IS SET TO 376.  THIS MUST BE DONE TO
/AVOID PROBLEMS WITH TRANSFERRING NON-DUMP FILES IN DUMP MODE WHEN THE
/INPUT DEVICE IS DECTAPE (USES BLOCKS OF 377) AND THE OUTPUT DEVICE
/IS DISK (BLOCK SIZE = 376).  NOTE THAT WORD 376 IS ONLY USED ON THE DECTAPE IF
/IN DUMP MODE.
/ON THE DISKS, TRUNCATED FILES ARE NOT COPIED AND PROTECTION CODES ARE HONORED.
/PROTECTION CODES ARE PACKED IN 'COPTBL', 3 BITS PER FILE, RIGHT JUSTIFIED.
/
TCOPY	LAC SRCDEV		/MUST NOT ALLOW COPY TO/FROM SAME UIC.
	SAD DESDEV
	SKP
	JMP TCOPYA
	SAD	DECDSK	/DECDSK IS ONE UNIT ONLY!!
	JMP TCOPYB
	LAC	SRCNUM	/ARE UNIT #'S THE SAME?
	SAD	DESNUM
	SKP
	JMP	TCOPYA	/NO, THAT'S OK
TCOPYB	LAC SRCUIC		/BOTH DEVICES SAME; UIC'S CANNOT BE.
	SAD DESUIC
	JMP ERR23
TCOPYA	JMS INITOT		/SET UP AND INIT DESTINATION DEVICE.
	LAC DESDEV
	SAD DECTAP
	JMP .+3
	LAW -376		/BUFFER SIZE INITALLY 376 FOR DISKS.
	SKP
	LAW -377		/BUFFER SIZE INITALLY 377 FOR DECTAPE.
	DAC TCOPOT
	SET TCOPSW
	LAC DESUIC
	DAC CURUIC
	LAC DESDEV
	JMS CHKPRO		/SEE IF FUNCTION LEGAL TO THIS UIC. (DESTINATION)
	LAC SRCDAT
	STL
	JMS ZSETTR		/SET UP ZTRAN TO BRING IN DIRECTORY.
	JMS INITIN		/INIT SOURCE DEVICE.
	LAC SRCUIC
	DAC CURUIC
	LAC SRCDAT
	DAC CHKDAT
	LAC SRCDEV
	STL
	JMS CHKPRO		/CHECK LEGAL FUNCTION FOR SOURCE.
	LAC SRCDEV	/<103>  NO (N) FOR MAGTAPE
	XOR MAGTAP	/<103>
	SZA		/<103>
	IDX FUNCDE		/ALLOW FOR (N) WITH COPY.
	LAC DKSW
	DAC TDKSW		/NON-ZERO IF DISK INPUT.
	LAC TDKSW		/DECTAPE OR DISK?
	SNA
	JMP TDECTP		/DECTAPE.
TNEWMF	JMS ZTRANS		/PUT DISK MFD INTO Z1BUF.
	LAC Z1BUFP
	DAC MFDPT1
TNXTEY	LAC* MFDPT1
	SAD SRCUIC		/MATCH ON UFD?
	JMP TMATCH		/YES - GO PROCESS IT.
	LAC MFDPT1		/NO - GO SEE IF THERE IS ANOTHER ENTRY IN
	TAD (MENTRY		/THIS MFD.
	DAC MFDPT1
	TAD MFNUM
	SPA
	JMP TNXTEY		/YES - LOOK AT THE NEXT ONE.
	LAC* (Z1BUF+377		/NO - SEE IF THERE IS ANOTHER MFD BLOCK.
	SAD LM1
	JMP ERR24			/NO.
	DAC ZBLNUM		/YES - GET THE NEXT MFD BLOCK.
	JMP TNEWMF
TMATCH	IDX MFDPT1		/HAVE MATCH ON UIC.
	LAC* MFDPT1
	SAD LM1
	JMP ZCEXIT		/NO UFD AND THEREFORE NO FILES.
	DAC TBLOCK
	IDX MFDPT1
	LAC* MFDPT1
	AND (77
	DAC TUFDSZ		/# ENTRIES IN UFD.
	LAC Z1BUFP
	DAC DIRPT
	TAD (376		/CALCULATE LIMITS FOR SEARCH.
	CMA
	TAD TUFDSZ
	DAC TUFNUM		/LAST LEGAL ADDR FOR SEARCH.
TRENTR	JMS INITPT		/INITIALIZE FILE POINTERS AND COUNTS.
	LAC (SRCFLS		/AREA FOR STORAGE OF SOURCE FILE NAMES.
	DAC TEMP2
	LAC (DESFLS		/AREA FOR STORAGE OF DESTINATION FILE NAMES.
	DAC CFILP
	LAW -34			/LIST HOLDS ONLY 28(10) FILES.
	DAC ZCT
	DZM COPTBL
	LAC (COPTBL
	DAC TCOPPT		/INIT POINTER TO PROTECTION CODE TABLE.
	LAW -6
	DAC TCOUNT
	DZM COPCNT		/CLEAR FOR DUMMY ISZ'S TO USE SAME ROUTINE FOR DK AND DT.
	LAC DIRPT
TNWUFD	DAC DTDIRP
	DAC CDIREP
	LAC TBLOCK
	DAC ZBLNUM
	LAC Z1BUFP		/RESET TO FILL BUFFER 1.
	DAC TRNBUF
	JMS ZTRANS
TUFDEY	LAC* DTDIRP
	SNA
	JMP TIDXEY
	LAC CDIREP
	TAD (3
	DAC CDIREP
	LAC* CDIREP		/BIT 0=1 FOR TRUNCATED FILE.
	SPA
	JMP TIDXEY		/TRUNCATED FILE - SKIP.
	LAC CDIREP
	TAD (3
	DAC CDIREP
	LAC* CDIREP
	AND MASK2		/PROTECTION CODE IN BITS 0-2.
	DAC PROCOD		/TEMP SAVE OF PROTECTION CODE.
	SNA
	JMS PROTER		/PROTECTION CODE OF 0 ILLEGAL.
	XOR (300000
	SZA
	JMP TCOP5A		/SOMETHING OTHER THAN 3 - OK.
	LAC PIPMIC		/IF NOT MIC OR LOGGED-IN UIC, SKIP THIS FILE.
	SPA
	JMP TCOP5A		/PROCTECTION CODE DOESN'T COUNT IF UIC=MIC.
	LAC PIPUIC
	SAD SRCUIC
	JMP TCOP5A		/WORKING ON OWN UIC, SO LEGAL.
	LAC (BUFFER+2		/ANNOUNCE THAT THE CURRENT FILE IS NOT
	JMS SETPUT		/BEING COPIED.
	JMS PRSET
	LAC DTDIRP		/RESET POINTER TO POINT TO NAME.
	DAC CDIREP
	LAC* CDIREP
	JMS KLFSIX		/OUTPUT FIRST 3 CHARS OF NAME.
	IDX CDIREP
	LAC* CDIREP
	JMS KLFSIX		/SECOND 3 CHARS.
	JMS PACK40
	IDX CDIREP
	LAC* CDIREP
	JMS KLFSIX		/PACK EXTENSION (3 CHARS).
	JMS PACK40		/INSERT SPACE.
	LAC (NOCOPY		/'NOT COPIED'.
	JMS PACKBF
	JMS PROUT		/PRINT MESSAGE.
TIDXEY	LAC DTDIRP		/UPDATE UFD POINTERS.
	TAD TUFDSZ
	DAC DTDIRP
	DAC CDIREP
	TAD TUFNUM		/MORE ENTRIES IN THIS UFD?
	SPA
	JMP TUFDEY		/YES - LOOK AT THE NEXT ONE.
	LAC* (Z1BUF+377		/ANOTHER UFD BLOCK?
	SAD LM1
	JMP TCOP8A		/NO - GO FINISH.
	DAC TBLOCK		/SAVE UFD BLOCK # FOR REENTRY.
	LAC Z1BUFP
	JMP TNWUFD
/	MAGTAPE COPY COMES HERE AS WWWELL AS DECTAPE <103>
		/EDIT 98: INSERT FOLLOWING INSTRUCTIONS
		/TO USE DEFAULT PROTECTION CODE FOR DECTAPE
TDECTP	LAC (COPTBL	/<103>
	DAC TCOPPT
	LAC .SCOM+54
	CLL!RTR
	RTR
	AND MASK2
	DAC PROCOD
	LAW -6
	DAC TCOUNT
	DZM COPTBL
		/END OF EDIT 98 INSERTION
	LAC SRCDEV	/<103>
	SAD MAGTAP	/<103.
	JMP COPYMT	/<103> MAGTAPE IS SOURCE--PROCESS SEPARATELY
	LAC (Z1BUF+40	/<103> DECTAPE IS SOURCE
	DAC DIRPT	/<103>
	LAC (100
	DAC ZBLNUM		/DECTAPE DIRECTORY IN BLOCK 100.
	JMS ZTRANS		/BRING IN SRC DIRECTORY.
	JMS ZFIL56		/CHECK FOR 24 OR 56 FILES.
	TAD LM1
	DAC COPCNT
	JMP TCOPY6
TCOP1A	LAC DIRPT		/UPDATE TO NEXT FILE BEFORE RESUMING.
	TAD TUFDSZ
	DAC DIRPT
	JMP TRENTR
TCOPY1	LAC COPCNT		/MUST DO THIS TO ALLOW FOR EXTRA ISZ ON 2ND PASS.
	TAD LM1
	DAC COPCNT
	LAC TDKSW
	SZA
	JMP TCOP1A
	LAC SRCDEV	/<103>
	SAD MAGTAP	/<103>
	JMP MTRW	/<103> GO RE READ MAGTAPE DIRECTORY
	LAC (100		/RESET ZTRANS TO BRING IN DECTAPE DIRECTORY.
	DAC DIRBLK
	LAC SRCDAT
	STL
	JMS ZSETTR
TCOPY6	JMS ZTRANS		/BRING IN DIRECTORY.
	JMS INITPT		/INIT FILE POINTERS AND COUNTS
	LAC SRFPTR		/SOURCE FILE POINTER
	DAC TEMP2
	LAC DSFPTR		/DEST FILE POINTER
	DAC CFILP
	LAW -34			/28(10) FILE COUNT.
	DAC ZCT
	LAC DIRPT
TCOPY2	ISZ COPCNT
	SKP
	JMP TCOP8A		/DONE - NO MORE FILES SO EXIT.
	DAC CDIREP		/DIRECTORY ENTRY  POINTER.
	TAD (3
	DAC DTDIRP		/POINTER TO WD. 4 OF ENTRY.
/	MAGTAPE DIRECTORY HAS ONLY 3 WORD ENTRIES <103>
	LAC SRCDEV	/<103>
	SAD MAGTAP	/<103>
	JMP TCOP5B	/<103> MAGTAPE -- NO COMPLETE BIT TO CHECK
	LAC* DTDIRP		/FILE COMPLETE BIT SET?
	IDX DTDIRP		/UPDATE TO POINT TO NEXT ENTRY.
LSPRAL	SPA!RAL			/RAL HERE ONLY SO CAN USE AS LITERAL.
		/EDIT 098:   CHANGE FOLLOWING JUMP FROM TCOPY5 TO TCOP5B
		/TO USE DEFAULT PROTECTION CODE
	JMP TCOP5B		/YES, PLACE ENTRY ON SRC AND DEST LISTS
TCOPY3	LAC TDKSW
	SZA
	JMP TIDXEY
	LAC DTDIRP		/NO, GET ANOTHER ENTRY.
	JMP TCOPY2
TCOP5C	CLL!RAR
	RTR
	DAC* TCOPPT
	JMP TCOPY5	/EDIT 098 CHANGE FROM TCOP5B TO TCOPY5
		/AND ADD FOLLOWING TWO INSTRUCTIONS, CHANGE LABEL
		/OF FOLLOWING WORD TO TCOPB (WAS TCOP5A)
TCOP5A	LAC DTDIRP
	DAC CDIREP
TCOP5B	LAC PROCOD		/PUT PROTECTION CODE IN 'COPTBL' AND
	XOR* TCOPPT		/RIGHT JUSTIFY IT.
	DAC* TCOPPT
	ISZ TCOUNT
	JMP TCOP5C
	LAW -6
	DAC TCOUNT
	IDX TCOPPT
	DZM* TCOPPT
TCOPY5	LAW -3			/PUT 3 WORDS IN SRC AND DEST LISTS.
	DAC ZCOUNT
TCOPY4	LAC* CDIREP		/DIR. ENTRY POINTER.
	DAC* TEMP2		/SRC FILE LIST POINTER
	DAC* CFILP		/DEST FILE LIST POINTER.
	IDX CDIREP
	IDX TEMP2
	IDX CFILP
	ISZ ZCOUNT
	JMP TCOPY4
	IDX SRFCNT		/INDEX SRC AND DEST FILE COUNTS
	IDX DSFCNT
	ISZ ZCT
	JMP TCOPY3
	LAC (740000		/ALL 28(10) FILES ENTERED.
	ISZ COPCNT
	LAC (JMP TCOPY1
TCOPY8	DAC ZCEXIT		/SET UP TO RETURN TO PROCESS THE REMAINDER.
	LAC SRFCNT		/EXIT IF 0 FILE COUNT.
	SNA
	JMP ZCEXIT
RTADJU	ISZ TCOUNT
	SKP
	JMP TSETCT
	LAC* TCOPPT
	CLL!RAR
	RTR
	DAC* TCOPPT
	JMP RTADJU
TSETCT	LAW -6
	DAC TCOUNT
	LAC (COPTBL
	DAC TCOPPT
/SET SWITCHES TO ENTER TRANSFER (T) FUNCTION CODE
	DZM FUNCDE		/FUNCTION SWITCH = T
	LAC DTDIRP		/SAVE FILE POINTER FOR NEXT PASS.
	DAC DIRPT
	LAC (5
	DAC DATAMD		/DATA MODE = DUMP
	JMP ZFCHK1		/BACK TO FUNCTION CHECK
TCOP8A	LAC (740000
	JMP TCOPY8
/
/<103>	COME TO COPYMT WHEN MAGTAPE IS SOURCE FOR COPY
/
EOFLAG	0
COPYMT	DZM COPCNT	/FLAG FOR FIRST TIME THROUGH HERE
	LAC SRCDAT
	DAC MTRW	/THIS IS A CAL FOR MT OPERATIONS
	DAC MTRAN
	DAC MTWT
	DAC MTWT2
/
MTRW	XX	/REWWWIND
	7
MTWT	XX	/WWWAIT
	12
/
	DZM EOFLAG
MTRAN	XX	/BRING IN DIRECTORY
	13
	0
	Z1BUF
	-401
MTWT2	XX	/WAIT
	12
	DAC STATUS
	AND (10000	/EOF?
	SNA
	JMP MT3		/NO
	LAC EOFLAG
	CMA
	DAC EOFLAG
	SPA
	JMP MTRAN	/FIRST EOF -- TRY AGAIN
	JMP ERR35	/SECOND ONE -- GARBAGED DIRECTORY STRUCTURE
/
MT3	LAC STATUS
	AND (21600	/CHECK FOR READ ERRORS
	SZA
	JMP ERR35	/CAN'T READ DIRECTORY
	LAC (747377
	SAD Z1BUF	/CHECK RECORD TYPE
	SKP
	JMP ERR35	/NOT DIRECTORY RECORD
/
	LAC COPCNT	/CHECK IF FIRST TIME THROUGH HERE
	SZA
	JMP TCOPY6+1	/NO
	LAC Z1BUF+2
	AND (777
	XOR (777000
	DAC COPCNT	/1'S COMPLEMENT OF ACTIVE FILE COUNT
	LAC (Z1BUF+21
	DAC DIRPT
	JMP TCOPY6+1	/GO DO COPY
/
STATUS	0
DIRPT	0
COPCNT	0
ZCT	0
CFILP	0
DTDIRP	0
CDIREP	0			/DIRECTORY ENTRY POINTER.
TDKSW	0			/SET = 1 IF DISK=SOURCE DEVICE.
TBLOCK	0			/UFD BLOCK # - MUST CARRY IN THIS ROUTINE.
TUFDSZ	0
TUFNUM	0
TCOPSW	0			/SET TO CORRECT DUMP MODE BUFFER SIZE (-).
TCOPOT	0			/OUTPUT BUFFER SIZE.
TCOPPT	0			/POINTER TO TABLE TO MODE BITS.
COPTBL	.BLOCK 5		/TABLE TO HOLD PROTECTION CODES. (3 BITS PER FILE, RIGHT JUSTIFIED)
PROCOD	0			/TEMP STORAGE OF PROTECTION CODE.
			/MUST REMAIN IMMEDIATELY AFTER 'COPTBL'!!!!!
NOCOPY	.ASCII 'NOT COPIED'<15>
	.LOC .-1
	.TITLE    VERIFY FUNCTION.
/VERIFY FUNCTION
/SET UP FOR VERIFY BY SETTING VCMD (THIS WILL BE CHECKED IN THE
/TRANSFER CODE AND, IF NON-ZERO, OUTPUT WILL BE INHIBITED) AND PUT
/THE SOURCE FILE COUNT INTO THE DESTINATION FILE COUNT.  OTHERWISE, A
/STANDARD 'TRANSFER' IS DONE.
/
VERIFY	SET VCMD	/SET V SWITCH.
	LAC SRFCNT	/SOURCE FILE COUNT INTO
	DAC DSFCNT	/DEST FILE COUNT.
	LAC DESUIC
	DAC SRCUIC
/
/VERIFY FUNCTION FALLS INTO T FUNCTION
/
/INSERT NO CODE HERE!!!!!
/
	.TITLE    ZTGO: STANDARD TRANSFER FUNCTION.
/TRANSFER (T) FILE ROUTINE.
/
/IN GENERAL, THE TRANSFER CODE WORKS AS FOLLOWS:
/THE DESTINATION FILE NAMES (IF ANY) ARE STORED IN 'DESFLS'. IF THERE ARE NONE,
/THE SOURCE FILE NAME IS USED - STORED IN 'SRCFLS'.  THE PROTECTION CODE IS PUT IN THE
/.ENTER MACRO.  DOUBLE BUFFERING IS USED - FIRST Z1BUF AND THEN Z2BUF.  BEFORE THE 
/FIRST .WRITE, THE SPECIFIED DATA MODE IS CHECKED AGAINST THE DATA MODE IN THE
/HEADER WORD TO GET THE CORRECT DAT MODE FOR THE .WRITE MACRO.  (IF THERE
/IS A DISCREPANCY, THE DATA MODE FROM THE HEADER WORD IS USED.)  AFTER EACH READ,
/THE HEADER WORD IS CHECKED FOR EOF, EOM, AND PARITY/CHECKSUM ERRORS (ALL
/MODES EXCEPT DUMP, WHICH HAS NO HEADER WORDS).  IF IN DUMEP MODE, A
/SEARCH IS DONE ON THE CURRENT BUFFER FOR AN EOF (1005, 776773): IF FOUND, THE
/BUFFER SIZE IS ADJUSTED TO THE APPROPRIATE SIZE.  THE NEXT TIME THRU, IS IS
/THIS ADJUSTED BUFFER SIZE WHICH INDICATES THAT THE FILE IS COMPLETE.  THE FILE
/IS THEN CLOSED, AS IT IS IF AN EOF IS DETECTED IN THE HEADER WORD FOR OTHER MODES.
/THE ENTIRE PROCESS IS REPEATED FOR EACH ADDITIONAL FILE TO BE TRANSFERRED.
/THE FILE COUNT, MINUS, IS IN 'DSFCNT' AND 'SRFCNT'.  IF AN EOM IS
/DETECTED, ADDITIONAL INPUT IS REQUESTED (VIA ^P) UNLESS IT IS THE LAST TAPE,
/IN WHICH CASE A .CLOSE IS ISSUED.
/  IF DOING A VERIFY (VCMD=NON-ZERO), THE OUTPUT IS INHIBITED.
/  IF DOING A COPY (TCOPSW=NON-ZERO), THE CORRECT BUFFER SIZE MUST BE
/DETERMINED  (FROM THE ACTUAL DATA MODE; DATAMD=5) BEFORE THE FIRST WRITE.
/  BEFORE EACH WRITE, ALL SWITCH OPTIONS ARE CHECKED
/AND THE APPROPRIATE ACTION IS PERFORMED IN EACH CASE.
/
/
ZTGO	LAC DESDAT	/SET UP DEST DAT SLOTS IN I/O MACROS:
	DAC ZEFILE	/ENTER,
	DAC ZXFILE
	DAC ZWTWAT	/WAIT,
	LAW -70			/SET OUTPUT LINE COUNT TO 55 FOR POSSIBLE FF.
	DAC LINCNT
	LAC VCMD	/VERIFY?
	SZA
	JMP ZTGO2		/YES, DO NOT INIT DEST DEVICE.
	LAC DESDEV		/DON'T ISSUE DOUBLE INITS IF THE LINE PRINTER
	SAD LPDEV		/IS THE OUTPUT DEVICE (AVOIDS DOUBLE FF'S).
	JMP ZTGO2
	JMS INITOT		/INIT DEST DEVICE.
	JMS ZSCODE		/CHECK FOR N OR S SWITCH.
	CLL			/LOOK AT DIRECTORY PROTECTION ONLY.
	LAC DESUIC
	DAC CURUIC
	LAC DESDEV
	JMS CHKPRO		/SEE IF FUNCTION LEGAL TO THIS UIC.
ZTGO2	LAC (SRCFLS	/INIT SOURCE
	DAC ZSFILP	/FILE POINTER AND
	LAC (DESFLS	/DEST FILE POINTER.
	DAC ZEFILP
	DAC TEMP		/T. STORAGE.
	DAC ZXFILP		/.ENTER MACRO.
	JMP ZTFIL3
ZTFIL1	LAC ZSFILP		/THIS ROUTINE USED FOR SECOND + FILES.
	TAD (3			/UPDATE SOURCE FILE POINTER.
	DAC ZSFILP
	LAC TEMP		/UPDATE DEST.
	TAD (3			/FILE POINTER.
	DAC TEMP
	DAC ZEFILP
	ISZ SRFCNT		/UPDATE INPUT
	JMP ZTFIL3		/FILE COUNT.
	JMP ERR16			/TOO MANY DESTINATION FILES.
ZTFIL3	LAC VCMD		/VERIFY?
	SZA
	JMP ZTFIL5		/YES, DO NOT ENTER.
	LAC DESDEV		/IF LP, MUST SET BIT 6 TO INHIBIT FF'S
	SAD LPDEV		/IF F SWITCH NOT ON.
	SKP
	JMP GOINIT		/NOT LPA - SKIP.
	LAC FSWTCH		/IF ON, WANT FF EVERY 56 LINES.
	SZA
	JMP GOINIT		/DON'T INHIBIT FF.
	LAC DESDAT
	XOR (5000		/BIT 6=INHIBIT FF; BIT 8=OUTPUT.
	DAC ZIFILD
	JMS ZIFIL		/.INIT LPA.
	SKP
GOINIT	JMS INITOT		/INITIALIZE OUTPUT DEVICE.
	LAC* ZEFILP		/CHECK ABSENCE OF DESTINATION FILE.
	SZA
	JMP ZEFILX		/THERE IS ONE, SO USE IT.
	LAC ZSFILP		/NONE SO USE
	DAC ZEFILP		/SOURCE FILE NAME IN .ENTER MACRO.
ZEFILX	LAC ZEFILP		/DO EXTENSION CHECK ON FILE.
	JMS EXTCK1
	LAC ZEFILE		/(JMW:105)
	AND (777		/(JMW:105) STRIP OLD PROTECTION CODE, IF ANY.
	DAC ZEFILE		/(JMW:105)
	LAC TCOPSW		/COPY MODE?
	SNA!CLL
	JMP EPROT1		/NO.
	LAC* TCOPPT		/YES - MUST GET PROTECTION CODE FOR THIS FILE
	DAC PROTCT		/FROM TABLE 'COPTBL' (3 BITS PER FILE, RIGHT JUSTIFIED).
	JMS R3R
	DAC* TCOPPT		/ALL SET UP TO GET THE NEXT ONE.
	ISZ TCOUNT
	JMP EPROT2
	LAW -6			/NO MORE IN THIS WORD: BUMP TO NEXT.
	DAC TCOUNT
	IDX TCOPPT
EPROT1	LAC NEWPRO		/PUT PROTECT CODE IN .ENTER MACRO.
	SMA			/BIT 0=1 IF NEW CODE SPECIFIED.
EPROT2	LAC PROTCT		/NONE SPECIFIED - USE DEFAULT.
	AND (7
	CLL!RAL
	JMS R8L			/PUT IN BITS 6-8.
	XOR ZEFILE
	DAC ZEFILE
ZTFIL5	LAC SRCDAT	/SET UP SOURCE DAT SLOTS
	DAC ZSFILE		/IN I/O MACROS: SEEK;
	DAC ZRDWAT		/WAIT.
	JMS INITIN		/INIT SOURCE FILE - 1ST TIME THROUGH.
	JMS SRCHK		/DO EXTENSION CHECK AND SEE IF FUNCTION LEGAL FROM UIC.
	LAC DATAMD		/DETERMINE BUFFER SIZE.
	XOR (5			/IN DUMP MODE?
	SZA
	JMP NOTDMP		/NO - ALL BUFFER SIZES = 377.
		/EDIT 099:  DELETE THREE INSTRUCTIONS AND INSERT
		/NEW VERSION:  FORMERLY CONSIDERED DESTINATION
		/DEVICE INSTEAD OF SOURCE DEVICE
	LAC SRCDEV	/CHECK TO SEE IF SOURCE DEVICE A DISC
	SAD DSKPAK
	JMP NOTDMP
	SAD DECDSK
	JMP NOTDMP
	SAD DECPAK
	JMP NOTDMP
		/END OF EDIT 099 INSERTION
	SAD MAGTAP	/<104>
	JMP NOTDMP	/<104>
	LAW -377		/NOT DISK - ASSUME DECTAPE BUFFER SIZE OF 377.
	SKP
NOTDMP	LAW -376
	DAC BUFFSZ
ZSFILX	JMS SRCHK		/CHECK LEGALITY OF FUNCTION FROM THIS UIC.
ZSFILE	XX			/SEEK SOURCE FILE.
	3
ZSFILP	XX			/FILE ENTRY POINTER.
	LAC VCMD
	SZA
	JMP SKPENT		/OMIT ENTER IF VERIFY.
	LAC MSWTCH		/OMIT ENTER IF W SWITCH BEING PROCESSED
	SZA			/BUT ONLY AFTER FIRST ENTER HAS BEEN DONE.
	JMP SKPENT
ZEFILE	XX			/ENTER DESTINATION FILE.
	4
ZEFILP	XX			/FILE ENTRY POINTER.
SKPENT	LAC Z1BUFP		/SET UP BUF POINTER.
	DAC MODN02		/IN READ, WRITE MACROS
	TAD DMPSW		/0, OR 2 IF PR+DUMP
	DAC MODN03
	LAC Z2BUFP
	DAC MODN04
	LAC TCOPSW		/DOING COPY WITH NO SWITCHES?
	SZA!CLC
	DAC FIRST		/SET TO LOOK AT DATA MODE IN COPY.
	DAC CKDATA		/SET UP TO VERIFY DATA MODE.
	LAC BUFFSZ
	DAC MODN02+1		/WORD COUNT IN READ MACROS.
	DAC MODN04+1
	TAD DMPSW		/0 OR 2 IF DUMP AND PR.
	DAC MODN03+1
	JMS YSPLIN	/SET UP FOR SEGMENT(Y) OPTION
	LAC DMPSW		/PR + DUMP?
	SZA!CLC
LH4	LAW -4		/YES, SET FOR READ IN H
	TAD DATAMD	/VALUES AND SHIFT TO (6-8)
	CLL!RAL
	JMS R8L
	XOR ZRDWAT
	DAC ZRDCAL	/CAL+DATA MODE(6-8)+DATSLOT(9-17)
	DAC ZRDCL2
ZRDCAL	XX		/READ I/O MACRO
	10
MODN02	XX			/BUFFER ADDRESS.
	-376
ZRDWAT	XX		/WAIT FOR READ
	12
	LAC VCMD		/IF VERIFY, NO NEED TO DO WAIT TO OUTPUT DEVICE.
	SZA
	JMP NOWAIT
ZWTWAT	XX			/.WAIT TO OUTPUT DEVICE.
	12
NOWAIT	ISZ FIRST		/FIRST TIME THRU, MUST CHECK DATA MODE ON COPY FUNCTION.
	JMP MIDTRN
	LAW -3
	DAC FIRST		/SET UP TO LOOK AT 3 LEGAL-LOOKING HEADERS.
	LAC SRCDEV	/<104>
	SAD MAGTAP	/<104>
	JMP .+3
	LAC MODN02	/<104>
	JMP .+3		/<14>
	LAC MODN02	/<104>
	TAD LIT2		/<104> POINT TO RIGHT WORD FOR MAG TAPE
	DAC HTEMP	/<104> CHECK FOR LEGAL HEADER WORDS -- ELSE DUMP MODE
	TAD (377		/SET UP LIMITS FOR SEARCH ON BUFFER.
	CMA
	DAC ZSPW
LOKHDR	LAC* HTEMP
	AND (7			/LOOK AT DATA MODE.
	TAD LM4			/0-4 ACCEPTABLE.
	SMA
	JMP CPDUMP		/NOT THOSE - ASSUME DUMP MODE.
	LAC* HTEMP
	AND (377000		/LOOK AT WPC - MUST BE 177 OR LESS.
	DAC ZENTC		/TEMP SAVE OF WPC.
	TAD (-200000
	SMA
	JMP CPDUMP		/GREATER THAN 177 - ASSUME DUMP MODE.
	LAC ZENTC		/CONVERT WPC TO NUMBER OF WORDS.
	JMS R3R
	JMS R3R
	RTR
	TAD HTEMP
	DAC HTEMP		/FIND POSITION OF NEXT HEADER WORD.
	TAD ZSPW		/DON'T GO BEYOND END OF BUFFER.
	SMA
	JMP .+3			/OVER END OF BUFFER - ASSUME OK.
	ISZ FIRST
	JMP LOKHDR		/LOOK ONLY AT 3.
	LAC TCOPOT		/MODE NOT DUMP - OUTPUT BUFFER SIZE IS THAT
	DAC BUFFSZ		/OF DEVICE.
CPDUMP	LAC BUFFSZ		/DUMP MODE - OUTPUT BUFFER SIZE SAME AS INPUT BUFFER SIZE.
	DAC MODN03+1		/WRITE MACRO BUFFER SIZE.
	DZM FIRST
	DZM CKDATA
	JMP FIXMOD		/SET UP WRITE CAL.
MIDTRN	ISZ CKDATA		/VERIFY DATA MODE FIRST TIME THRU.
	JMP INITDN		/ALREADY DONE.
	LAC DATAMD		/IF DUMP MODE, NO HEADER WORD.
	SAD (5
	JMP FIXMOD
	LAC* Z1BUFP		/NO MATTER WHAT, USE DATA MODE IN HEADER.
	TAD (1			/PIP'S DATA MODE IS ONE MORE.
	AND (7
	SAD DATAMD
	SKP			/THEY MATCH - NO PROBLEM.
		/EDIT 099:  FORMERLY:  DAC DATAMD      NOW DECLARE ERROR
	JMP ERR37	/(JMW: 108) OUTPUT UNIQUE ERROR.
FIXMOD	CLC
	TAD DATAMD		/SUBTRACT 1 FROM PIP'S DATA MODE.
	CLL!RAL
	JMS R8L			/PUT IN BITS 6-8.
	XOR ZWTWAT
	DAC ZWTCAL		/WRITE CAL SET UP NOW.
	LAC VCMD		/IF VERIFY, INHIBIT OUTPUT.
	SNA
	JMP INITDN
	LAC LITZR		/(JMP ZREST
	DAC ZWTCAL
INITDN	DZM DELSW
	LAC DATAMD		/DUMP MODE?
	XOR DMPSW
	SAD (5
	JMP ZDUMCK		/YES - SEE IF HAD EOF LAST TIME.
	CLC		/SET UP HEADER POINTER FOR LATER EXAM
	TAD DMPSW		/0 OR 2 IF PR+DUMP
	CMA
	TAD MODN03
	DAC PNTTMP
	LAC* PNTTMP	/HEADER POINTER
	DAC HTEMP
	AND (7
	SAD (5		/EOF CHECK
	JMP ZPTRCK
	SAD LIT6		/EOM CHECK
	JMP ZEOM
	LAC* PNTTMP	/HEADER POINTER
	AND (60		/CHECK VALIDITY.
	SZA
	JMP RFAIL		/ERROR MESSAGE 10,11 - PARITY/CHECKSUM ERROR.
ZLINCK	JMS FCHECK	/F SWITCH CHECK
ZRDCL2	XX		/2ND READ
	10
MODN04	XX
	-376
	LAC DELSW		/DELETE LINE?
	SZA
LITZR	JMP ZREST		/YES - SIMPLY SKIP THE WRITE MACRO.
	LAC DATAMD	/DUMP MODE?
	XOR DMPSW
	SAD (5
	JMP DEOFCK	/YES, SCAN FOR EOF
	JMS ZEOTCK		/CHECK W SWITCH
	JMS QCHEK		/Q CHECK MUST PRECEDE E,C,T CHECK
	JMS CECHEK		/CHECK E,C,T SWITCH
	JMS YCHECK	/CHECK Y SWITCH
	JMS VCHECK	/(JWM:109) VERTICAL FORMS CONTROL?
ZWTCAL	XX			/.WRITE CAL.
	11
MODN03	XX		/BUFF. ADDR.
	-376		/FOR IMAGE MAX ON DTA
ZREST	LAC DATAMD	/DUMP MODE?
	XOR DMPSW
	SAD (5
	JMP ZREST1	/YES,SKIP EOM CHECK
	LAC HTEMP		/HEADER  WD 1
	AND (7
	SAD LIT6		/EOM?
	JMP ZEOM1		/YES.
ZREST1	LAC MODN04
	DAC MODN02
	CLC		/CALCULATE CORRECT HEADER POINTER.
	TAD DMPSW		/0 OR 2 IF PR+DUMP
	CMA
	TAD MODN03
	DAC MODN04
	LAC MODN02
	TAD DMPSW		/0 OR 2 IF PR+DUMP
	DAC MODN03
	JMP ZRDWAT
ZEOM	LAC* PNTTMP		/HEADER.
	AND (7
	SAD (5
	JMP ZEOM1		/DON'T OUTPUT EOF HEADER AS LINE
	LAC DMPSW		/PR+DUMP?
	SNA		/YES, EQUIVALENT TO H INPUT
	LAC DATAMD	/CHECK FOR I OR H MODE
	SAD LIT2
	JMP ZWTCAL
	SAD LIT4		/I
	JMP ZEOM5		/SEE IF LAST FRAMES ARE TO BE DELETED
ZEOM1	LAC SRFCNT		/LAST SOURCE FILE?
	TAD (1
	DAC RSTRTP
	DZM YEOFSW		/CLEAR NEW OUTPUT MEDIUM SWITCH.
	SNA			/NO.
	JMP ZEOF		/YES.
	LAC DSFCNT
	SAD LM1
	JMP ZEOM4
	LAW 2			/IF OUTPUT TO PP, CLOSE DEV FOR TRAILER.
	JMS PRCHK
	JMP ZEOM3		/PP ONLY.
	LAC DESDAT		/PR + PP.
	DAC ZCLOSD
LITCLS	JMS ZCLOS		/.CLOSE DEVICE.
	LAC (740000
	DAC ZEOF2		/PP ONLY.
ZEOM3	JMS CONTLP	/OUTPUT ^P (PR + PP).
	JMS BOSTTY		/MAKE SURE INPUT FROM TTY.
	JMP .		/NEW MEDIUM REQUIRED
ZEOM4	LAW 1
	JMS PRCHK
	JMP ZEOF
	JMP ZEOM3		/YES, WAIT
ZEOM5	LAW 1		/PR?
	JMS PRCHK
	JMP ZWTCAL	/NO, WAIT
	LAW 17000		/PR INPUT+EOM, STRIP LAST FRAMES
	TAD* PNTTMP	/DECR HEADER WPC (6 FRAMES)
	DAC* PNTTMP
	JMP ZWTCAL	/NOW, WAIT
PRCHK	0
	SAD PAPER		/PR?
	SKP			/YES.
	LAC (3		/PR + PP?
	SAD PAPER
	IDX PRCHK		/YES.
	JMP* PRCHK
/
/DUMP MODE EOF CHECK.
/THE BUFFER IS SCANNED FOR TWO WORDS IN SEQUENCE: 1005 776773.  IF THEY ARE
/FOUND, THE BUFFER SIZE IS ADJUSTED TO INCLUDE ONLY THE DATA WORDS UP TO THE
/EOF WORDS.  BEFORE THE BUFFER IS WRITTEN, HOWEVER, THE NEWLY READ BUFFER IS
/CHECKED FOR THE SAME EOF WORDS IN THE FIRST 2 WORDS IN THE BUFFER IS THE
/INPUT DEVICE IS DECTAPE OR DISK.  IF AN EOF IS
/FOUND, THE ADJUSTED BUFFER IS WRITTEN AND PIP WILL THEN CLOSE THE FILE WHEN IT
/FINDS THE ADJUSTED BUFFER SIZE THE NEXT TIME AROUND.  IF THE EOF WAS
/NOT FOUND IN THE 2 FIRST WORDS, IT IS ASSUMED THAT THE PREVIOUS EOF FOUND WHEN
/SCANNING THE PREVIOUS BUFFER WAS DATA AND THE TRANSFER WILL BE RESUMED.
/
/
DEOFCK	LAC BUFFSZ	/SET WRITE WORD COUNT.
	DAC MODN03+1
	DAC CHRTAB+1
	LAC MODN03	/SET UP BUFF POINT FOR EOF SCAN
	DAC CHRTAB
	DZM CHRTAB+3	/ACTUAL DATA COUNT
DEOF1	LAC* CHRTAB
	ISZ CHRTAB+3	/INDEX DATA COUNT
	ISZ CHRTAB	/INDEX DATA POINTER
	SAD (1005		/EOF, 1ST HALF?
	JMP DEOF2		/FOUND
DEOF3	ISZ CHRTAB+1	/NEG DATA COUNT
	JMP DEOF1		/TRY NEXT
	JMP ZWTCAL	/NOT FOUND, OUTPUT BLOCK
DEOF2	LAW 16773		/CHECK 2ND HALF OF EOF.
	XOR* CHRTAB
	SZA
	JMP DEOF3		/NO MATCH
	ISZ CHRTAB+1
	SKP		/DUMP MODE EOF FOUND
	JMP ZWTCAL	/OVERFLOW OF BUFF,OUTPUT BLOCK
	LAW -2		/EXCLUDE EOF ITSELF FROM COUNT
	TAD CHRTAB+3
	CMA
	DAC FCHECK		/T STORE OF ADJUSTED WORD COUNT FOR BUFFER.
	SZA!CLC		/EOF ONLY IN BLOCK.
	SKP
	DAC FCHECK		/-1 IF WORD COUNT CALCULATED TO BE 0.
	LAC SRCDEV		/CHECK FOR EOF IN NEXT BUFFER ONLY IF
	SAD DECTAP		/INPUTTING FROM DECTAPE OR DISKS.
	JMP NXTEOF
	SAD DSKPAK
	JMP NXTEOF
	SAD DECPAK
	SKP
	SAD DECDSK
	SKP
	JMP WRTEOF
NXTEOF	LAC ZRDWAT		/MUST CHECK INCOMING BUFFER FOR
	DAC .+1			/EOF IN FIRST 2 WORDS.
	XX			/DAT SLOT OF INPUT DEVICE (.WAIT).
	12
	LAC MODN04		/INCOMING BUFFER POINTED TO BY MODN04
	DAC CHRTAB
	LAC* CHRTAB		/FIRST 2 WORDS MUST BE EOF TO CONSTITUTE REAL EOF.
	SAD (1005
	SKP
	JMP ZWTCAL		/NO EOF - OUTPUT BLOCK AND GO ON.
	LAW 16773
	IDX CHRTAB
	XOR* CHRTAB
	SZA
	JMP ZWTCAL		/NO EOF - OUTPUT BLOCK.
WRTEOF	LAC FCHECK		/IF -1, WORD CNT = 0.
	SAD LM1
	JMP ZPTRCK
	DAC MODN03+1		/ADJUST BUFFER SIZE IN WRITE CAL
	JMP ZWTCAL		/AND OUTPUT BLOCK.
ZPTRCK	LAC PAPER		/PR OR PP?
	SZA
	JMP ZEOM		/YES - ACT LIKE EOM CODE.
ZEOF	LAC SRCDAT	/SOURCE DAT SLOT
	DAC ZCLOSD
	JMS ZCLOS		/CLOSE SOURCE FILE
	LAC WSWTCH	/W SWITCH SET
	SZA		/NO - CLOSE OUTPUT FILE
	JMP ZEOFCK	/YES
ZEOF1	LAC DESDAT
	DAC ZCLOSD
	LAC VCMD	/VERIFY?
	SNA		/YES, DO NOT CLOSE DEST FILE
ZEOF2	XX		/CLOSE DEST FILE OR NOP IF CLOSED AT ZEOM2
	LAC LITCLS	/RESTORE
	DAC ZEOF2
	ISZ DSFCNT	/DEST FILE COUNT
	JMP ZTFIL1	/TRANSFER NEXT FILE
	ISZ SRFCNT
	SKP
	JMP ZCEXIT	/DONE - CHECK EXIT OR RSTART
	JMP ERR16			/TOO MANY SOURCE FILES.
ZEOFCK	LAC DSFCNT	/DOES DEST FILE COUNT
	SAD SRFCNT	/DIFFER FROM SOURCE COUNT
	JMP ZEOF1		/MAP FILES ONE TO ONE
	SAD LM1
	SKP
	JMP ZEOF1		/NOT THE LAST - STILL ONE FOR ONE
	LAC ZSFILP		/UPDATE SOURCE
	TAD (3		/FILE POINTER
	DAC ZSFILP
	ISZ SRFCNT		/CHECK SOURCE COUNT
	JMP ZSFILX	/COMBINE REMAINING SOURCE
	CLA!CMA		/.CLOSE OUTPUT
	DAC SRFCNT		/FILE AND
	JMP ZEOF1		/TERMINATE FUNCTION
ZDUMCK	LAC BUFFSZ		/DUMP MODE EOF?
	SAD MODN03+1
	JMP ZLINCK	/NO
	JMP ZPTRCK
PNTTMP	0
HTEMP	0
CKDATA	0		/NON-0 TO VERIFY DATA MODE FIRST TIME THRU.
/
SRCHK	0			/MUST CHECK BOTH DIRECTORY AND  FILE
	LAC SRCUIC		/PROTECTION FOR SOURCE FILES.
	DAC CURUIC
	LAC SRCDAT
	DAC CHKDAT
	LAC ZSFILP		/DO EXTENSION CHECK.
	JMS EXTCK1
	STL
	LAC SRCDEV
	JMS CHKPRO
	JMP* SRCHK
	.TITLE       ZEOTCK: W SWITCH PROCESSOR.
/
/.EOT, .END CHECK SUBROUTINE (W SWITCH)
/
ZEOTCK	0
	LAC WSWTCH		/W SWITCH SET
	SNA
	JMP* ZEOTCK	/NO - OUTPUT LINE AS IS.
	SET MSWTCH		/SET TO AVOID MULTIPLE .ENTERS W/ W SWITCH.
	LAC DATAMD
	SAD (1		/IOPS BIN?
	JMP* ZEOTCK	/YES, EXIT - CHECKED ELSEWHERE
	LAC DSFCNT	/DOES DEST FILE COUNT DIFFER
	SAD SRFCNT	/FROM SOURCE COUNT?
	JMP* ZEOTCK	/NO, MAP FILES 1 TO 1 AND OUTPUT .END OR .EOT
	TAD (1		/LAST (OR ONLY 1) FILE?
	SZA		/YES, CHECK .EOT AND .END
	JMP* ZEOTCK	/STILL 1 TO 1
	LAC (ZEOTTB		/.EOT TABLE POINTER
	DAC ZENTP
	DZM ZSPACE		/CLEAR IGNORE SPACE SWITCH
	LAW -4		/CHAR COUNT
	JMS ZENTC		/.EOT CHECK
	DAC ZSPACE		/SET OR CLEAR SPACE SWITCH
	SZA		/.EOT NOT FOUND
	JMP ZREST		/DO NOT OUTPUT .EOT, READ NEXT LINE
	LAC (ZENDTB		/.END TABLE POINTER
	DAC ZENTP		/STRIP .END IF FOUND
	LAW -4		/CHAR COUNT
	JMS ZENTC		/.END CHECK
	ISZ ZSPACE
	SZA		/.END NOT FOUND
	JMP ZREST		/FOUND - STRIP
	JMP* ZEOTCK
/
/EXAMINE LINE SUBROUTINE
/
ZENTC	0
	DAC ZENTC4	/SET CHAR COUNT FROM AC AT ENTRY
	LAC MODN03		/INPUT BUF. HEADER POINTER
	TAD LIT2
	JMS ZSET		/SET UP GETCHR ROUTINE
GTLIT	JMS GETCHR		/GET AN ASCII CHAR
	SAD LITCR
	JMP ZENTC5		/NOT FOUND
	SAD LIT40		/SPACE
	JMP ZENTC4		/YES
	SAD HT		/HT (11).
	SKP		/YES - CHECK SPACE SWITCH
	JMP GTLIT
ZENTC4	XX
	DAC ZSPACE
	DAC ZSPW		/NOW USED AS COUNT
ZENTC3	JMS GETCHR		/NOW LOOK FOR .EOT
	XOR* ZENTP
	DZM ZSPACE
	SZA
	JMP ZENTC5		/NOT .EOT
	ISZ ZENTP		/INDEX TABLE POINTER
	ISZ ZSPW
	JMP ZENTC3
	JMS GETCHR		/FOUND - NOW NEXT CHAR
	SAD LIT40		/MUST BE SP,HT,CR , ; OR ALT MODE.
	JMP* ZENTC		/
	SAD HT		/HT
	JMP* ZENTC		/
	SAD LITCR		/CR
	JMP* ZENTC
	SAD SEMICO		/; (73).
	JMP* ZENTC
	SAD ALTMOD
	JMP* ZENTC
ZENTC5	CLA		/NOT FOUND
	JMP* ZENTC
/
ZSPW	0		/SPACE SWITCH, NOT 0 = SP OR HT FOUND
	.TITLE       FCHECK: F SWITCH PROCESSOR.
/F (FORM FEED) SWITCH SUBR
/
FCHECK	0
	LAC FSWTCH	/IS F SWITCH SET?
	SNA		/F SWITCH IS SET
	JMP* FCHECK	/NOT, EXIT
	LAC MODN03	/CHECK FOR FF IN CHAR POSITION 1 OF LINE
	TAD LIT2
	DAC ZENTC
	LAW 14000
	AND* ZENTC	/FF?
	XOR (60000
	SZA		/YES
	JMP FCH2		/NO, CHECK FOR .EJECT
	LAW -70
	DAC LINCNT
	JMP* FCHECK
FCH2	LAC (ZEJTAB	/SET UP POINTER TO .EJECT TABLE
	DAC ZENTP
	DZM ZSPACE	/CLEAR IGNORE SPACE SWITCH
	LAW -6		/CHAR COUNT
	JMS ZENTC		/EXAMINE LINE SUBR
	SZA		/NOT FOUND
	LAW -3		/.EJECT FOUND, SET -2 INTO LNCNT
	TAD (1
	SPA
	DAC LINCNT	/.EJECT FOUND, SET LINE COUNT TO OVERFLOW
	DAC ZSPACE	/SET IGNORE SPACE SWITCH
	ISZ LINCNT
	JMP* FCHECK
	JMS FFOUT		/INSERT FF, CR
	JMP* FCHECK
ZEJTAB=.
	56		/.
	105		/E
	112		/J
	105		/E
	103		/C
	124		/T
LINCNT	0			/LINE COUNT FOR FF.
/
/FF,CR OUTPUT SUBR
/
FFOUT	0
	LAC ZWTCAL	/WRITE CAL
	DAC FFWRIT
	AND (777
	DAC FFWT
FFWT	XX
	12		/WAIT
FFWRIT	XX
	11
	FFLIN
LM376	-376
	LAW -67		/RESET LINE COUNT TO -55 (ACTUALLY 54 SINCE ONE LINE
	DAC LINCNT	/READY TO GO NOW- SAME EFFECT AS -70 AND 'JMP FCH4'.').
	JMP* FFOUT
	.TITLE       YCHECK: Y SWITCH PROCESSOR.
/
/Y SWITCH SUBR
YCHECK	0
	LAC YSWTCH	/Y SWITCH SET?
	SNA
	JMP* YCHECK	/NO
	LAC MODN03
	TAD LIT2
	JMS ZSET		/SET UP GETCHR ROUTINE
	LAW -5
	DAC ZSPW		/CHARACTER COUNT
	LAC (CHRTAB
	DAC ZENTP
YCHNEX	DZM ZSPACE	/CLEAR IGNORE SPACE SW
	JMS GETCHR
	SAD LF		/IGNORE FORM CONTROL (LF)
	JMP YCHNEX
	SAD VT		/VT (13).
	JMP YCHNEX
	SAD FF		/FF  (14).
	JMP YCHNEX
	DAC ZSPACE	/SET IGNORE SPACE SW
	LAC* ZENTP
	SZA
	SAD ZSPACE
	SKP
	JMP* YCHECK	/NO MATCH
	ISZ ZENTP
	ISZ ZSPW
	JMP YCHNEX
/
/SPLIT LINE FOUND - OUTPUT .EOT, CLOSE OUTPUT FILE, ENTER NEW FILE
/
	LAC ZWTCAL
	DAC .+1
	XX		/WRITE CAL FOR .EOT
	11
	EOTLIN
	-376
	LAC DESDAT	/CLOSE OUTPUT FILE
	DAC ZCLOSD
	JMS ZCLOS
LITCLA	CLA
	ISZ DSFCNT
	SKP
	JMP YECHOE	/MSG 15, TOO FEW DEST FILES
	LAC ZXFILP
	TAD (3
	DAC ZXFILP
	LAC PAPER		/NO NEED FOR CTRL P IF ALL BULK STORAGE.
	SNA
	JMP NEWOUT
	LAW -1		/SET UP FOR ^P FOR NEW OUTPUT MEDIUM
	DAC RSTRTP
	DAC YEOFSW
	JMS CONTLP	/OUTPUT ^P
	JMP .
/
/INIT NEXT OUTPUT FILE
/
NEWOUT	JMS INITOT
	LAC ZXFILP
	JMS EXTCK1	/CHECK EXT.
/
/ENTER NEXT OUTPUT FILE
/
ZXFILE	XX
	4
ZXFILP	XX
	JMS YSPLIN	/SET UP FOR NEXT SPLIT
	JMP* YCHECK
/
YECHOE	DZM STRCNT	/CLEAR STRING COUNT.
	JMP ERR15
/
/SET UP FOR SPLIT (Y) OPTION
/
YSPLIN	0
	ISZ STRCNT
	JMP YSP1
	DZM YSWTCH	/SPLITS COMPLETE
	LAW -1
	DAC STRCNT	/INSURE ISZ NEXT TIME THRU
	JMP* YSPLIN
YSP1	LAC SNAMPT
	TAD LIT2
	DAC SNAMPT
	JMS ZSET		/SET UP GETCHR
	LAW -5		/COUNT TO GET 5 CHAR'S
	DAC ZSPW
	LAC (CHRTAB	/INIT STRING AREA POINTER (CHARTAB
	DAC ZENTP
YSPNCH	JMS GETCHR	/PICK UP AND STORE 5 CHAR'S IN CHRTAB.
	DAC* ZENTP
	ISZ ZENTP
	ISZ ZSPW
	JMP YSPNCH
	JMP* YSPLIN
/
/CHAR STRING AREA
CHRTAB	0
	0
	0
	0
	0
	0
SNAMPT	0		/(SNAMES.
/
/
ZEOTTB=.
	56	/.
	105	/E
	117	/O
	124	/T
/
ZENDTB=.
	56	/.
	105	/E
LITN	116	/N
	104	/D
	.TITLE		G SWITCH ERROR PROCESSOR
RFAIL	DAC TVALDY		/T. STORE VALIDITY BITS.
	LAC GSWTCH		/G OPTION ONOR VERIFY ON?
	TAD VCMD
	SNA
	JMP RFAIL1		/NO
	JMS BOSTTY		/IF BOSS, MAKE SURE GOING TO TTY.
	LAC (JMP RFRET
	DAC ERRJMP
	DAC BOSJMP		/RETAIN CONTROL.
RFAIL1	LAC TVALDY		/PRINT PARITY OR CHKSUM ERR.
	JMP ERRPAR
TVALDY	0		/TEMP STORAGE OF VALIDITY BITS.
/
RFRET	LAC (JMP BOSEXT		/RESET ERROR EXIT.
	DAC BOSJMP
	LAC LITJMP		/RESTORE
	DAC ERRJMP
	LAC DATAMD
	SAD (1		/IOPS BIN?
	JMP ZRDCL2	/KEEP READING
	JMS PRSET		/SET UP PROUT
	JMS BOSTTY		/AND MAKE SURE GOING TO TTY IF BOSS.
	LAC MODN03		/OUTPUT LINE POINTER
	JMS PROUT		/OUTPUT BAD LINE ON TTY
	LAC VSWTCH	/V SWITCH SET?
	SZA		/NO, ALLOW CORRECTION
	JMP ZRDCL2	/KEEP READING
	JMS BOSTTY		/ONCE AGAIN, SET UP TTY FOR BOSS.
	JMS LFOUT		/OUTPUT LF > AND READ KEYBOARD.
	SAD LITCR		/CHARACTER IN AC ON RETURN.
	JMP ZLINCK		/LINE OK, CONTINUE
	SAD LITD		/D = DELETE LINE
	JMP RDCEK
/
/INSERT NEW LINE IN Z1BUF OR Z2BUF
INSERT	LAC (BUFFER		/(BUFFER.
	JMS INS1
	JMP ZLINCK		/CONTINUE TRANSFER
RDCEK	JMS GETCHR
	SAD LITCR		/CR?
	SKP
	JMP INSERT		/D NOT FOLLOWED BY CR
	DAC DELSW		/SET DELETE LINE SWITCH
	JMP ZRDCL2		/CONTINUE.
	.TITLE       CECHECK: C,E,T SWITCH PROCESSOR.
/E,C,T SWITCH CHECK SUBROUTINE
/
CECHEK	0
	LAC CETSW		/E=1, C=2, T=4
	SNA
	JMP* CECHEK	/NONE SET
	JMS CSET		/INIT GET ,PUT
	LAC CETSW
	CLL!RTR	/EDIT 098  OLD*  RTR   SEE CTSW
	SMA		/E SWITCH SET
	JMP CTSW
/
/E SWITCH: TABS TO SPACES
/
CECHL	LAW -10		/8 CHARACTER TAB SET.
	DAC TYPPOS
GETSW	JMS GETCHR		/JMS GETCHR 
	SAD LITCR
	JMP CECEND		/END LINE ROUTINE
	SAD HT			/HT?
	JMP VTCON		/CONVERT TO SPACES.
	JMS KLPUT		/OUTPUT CURRENT CHARACTER.
	JMS CHKVET		/CHECK FOR FF,LF,VT - DON'T COUNT THOSE.
	ISZ TYPPOS		/NOT ONE OF THE ABOVE - COUNT AS CHAR.
	JMP GETSW		/NEXT CHAR
	JMP CECHL
/
/HT TO SP ROUTINE
/
VTCON	LAC LIT40
	JMS KLPUT
	ISZ TYPPOS
	JMP VTCON
	JMP CECHL		/NEXT CHAR-RESET CHAR COUNT
/
CHKVET	0
	SAD LF		/LF
	JMP .+4
	SAD VT		/VT
	SKP
	SAD FF		/FF
	IDX CHKVET
	JMP* CHKVET
	.EJECT
/
/C (MULTIPE SPACES TO TABS) AND T (DELETE TRAILING SPACES) PROCESSED HERE.
/THE T IS "FAKED" SUCH THAT MQ2 AND MQ1 ARE ALWAYS 0 AND THEREFORE EQUAL.
/ALGORITHM:
/	THE FIRST TAB STOP IS ASSUMED TO BE AT TYPE POSITION X, WHERE TYPE POSITION
/	0 IS AT THE LEFT MARGIN.  THUS THE FIRST TAB ON A NEW LINE IS EQUIVALENT TO
/	X SPACES.  OTHER SETTINGS AR 2X, 3X, ETC.  CURRENTLY, X=8.  A TAB IS ALWAYS
/	CAUSES AN ADVANCE OF THE TYPE POSITION BY AT LEAST 1 CHARACTER.  THUS A TAB
/	GIVEN WHEN THE TYPING POSITION IS X CAUSES THE POSITION TO BECOME 2X.
/	THERE MUST BE 2 OR MORE SPACES TO GENERATE A TAB.
/
/INITIALIZE:   TYPOS = CSET = 0   WHERE
/	TYPPOS IS THE TYPING POSITION ( 0= LEFT MARGIN) AND
/	CSET = SPACE COUNT.
/
/RECEIVE:
/	1. CR OR ALTMODE	TYPPOS = CSET = 0
/	2. VT, LF, FF		NO CHANGE TO TYPPOS OR CSET; CHAR OUTPUT.
/	3. SPACE		CSET = CSET+1.
/	4. TAB			Q1,R1 = (TYPPOS+CSET)/X
/				CSET = CSET+X-R1.
/	5. PRINTING CHARACTER
/		A. IF CSET = 0, OUTPUT CHAR AND TYPPOS = TYPPOS+1.
/		B. IF CSET=1, OUTPUT SPACE + CHAR AND TYPPOS = TYPPOS +2
/			AND CSET = 0.
/		C. IF CSET GREATER THAN 1, Q1,R1 = T/X
/					   Q2,R2 = (TYPPOS + CSET)/X
/			IF Q2=Q1, OUTPUT R2-R1 SPACES.
/			ELSE OUTPUT Q2-Q1 TABS AND R2 SPACES
/			THEN OUTPUT CHAR AND TYPPOS= TYPPOS + CSET + 1
/					     CSET = 0.
/ON ENTRY, AC=1 IF T SWITCH; 0 IF C SWITCH.
/
CTSW	DZM TYPPOS		/INITIALIZE TYPING POSITION
	DZM CSET		/AND SPACE COUNTER.
		/EDIT 098 - C & T SWITCH CONFUSION
		/OLD VERSION ALSO HAD  AND (7,  SAD (1
	DAC CNTSW
TBLOOP	JMS GETCHR
	SAD LIT40
	JMP TBSPAC		/GO PROCESS A SPACE.
	SAD HT
	JMP TABTAB		/TAB.
	SAD LITCR
	JMP CECEND		/END OF LINE - LEAVE.
	SAD ALTMOD
	JMP CECEND		/END OF LINE - LEAVE.
	JMS CHKVET		/CHECK FOR LF, VT OR FF - THESE DON'T GET COUNTED.
	SKP
	JMP TLFOUT		/GOT ONE OF THE ABOVE.
	DAC TCHAR		/TEMP SAVE OF CHAR.
	LAC CSET		/ANY SPACES?
	SZA
	JMP TBPAD		/YES - GO SEE WHAT TO OUTPUT.
TOUTCH	LAC TCHAR
	IDX TYPPOS		/T=T+1.
TLFOUT	JMS KLPUT		/OUTPUT CHARACTER.
	JMP TBLOOP		/GO ET NEXT CHAR.
TBSPAC	IDX CSET		/GOT A SPACE - COUNT IT.
	JMP TBLOOP
TABTAB	LAC CNTSW		/IF DOING T, WANT TO OUTPUT TAB.
	SZA
	JMP TABOUT
	LAC TYPPOS
	TAD CSET
	JMS DIVX		/Q3,R3= (T+S)/X.
R3	0
	LAW -11			/NOTE: X=10(8) (CURRENT TAB STOP) HERE.
	TAD R3
	CMA
	TAD CSET
	DAC CSET		/S=S+X-R3.
	JMP TBLOOP
TABOUT	LAC HT
	JMP TLFOUT
TBPAD	SAD (1
	JMP TONESP		/ONLY ONE SPACE - OUTPUT IT.
	TAD TYPPOS
	JMS DIVX		/Q2,R2=(T+S)/X.
R2	0
	CMA
	TAD (1
	DAC MQ2			/SAVE -Q2.
	LAC TYPPOS
	JMS DIVX		/Q1,R1= T/X.
R1	0
	TAD MQ2
	SNA
	JMP NOTABS		/Q1=Q2: NO TABS.
	JMS OUTBUN		/OUTPUT Q2-Q1 TABS.
LIT11=.
HT	11
	DZM R1		/SO R2 SPACES WILL GO OUT.
NOTABS	LAC CNTSW		/IF DOING T, WANT TO OUTPUT 'CSET' SPACES.
	SNA
	JMP .+4			/C SWITCH.
	LAC CSET		/MAKE SURE ALL SPACES TO OUT FOR T.
	DAC R2
	DZM R1
	CLC
	TAD R2
	CMA
	TAD R1
	SNA
	JMP NOSPC		/R1=R2: NO SPACES (CAN HAPPEN ONLY AFTER TABS).
ONESP1	JMS OUTBUN		/OUTPUT R2-R1 SPACES.
LIT40	40
NOSPC	LAC TYPPOS
	TAD CSET
	DAC TYPPOS		/T=T+S (+1 IS LATER).
	DZM CSET		/S=0.
	JMP TOUTCH		/GO OUTPUT CHARACTER.
TONESP	CLC
	JMP ONESP1		/OUTPUT ONLY ONE SPACE.
/DIVIDE ROUTINE.
/AC = # TO BE DEVIDED ON ENTRY; QUOTIENT ON EXIT.
/
DIVX	0
	DAC OUTBUN		/TEMP STORAGE.
	AND (7			/X=8.
	DAC* DIVX		/RETURN REMAINDER.
	LAC CNTSW			/IF T SWITCH, FAKE OUT ROUTINE TO THINK NO TABS.
	SZA!CLA
	JMP DIVXOT		/RETURN WITH AC=0.
	LAC OUTBUN
	JMS R3R
	AND (77777		/QUOTIENT IN AC NOW.
DIVXOT	IDX DIVX		/BUMP TO CORRECT RETURN.
	JMP* DIVX
/
OUTBUN	0			/OUTPUT BUNCH OF ONE CHAR.
	DAC INS1		/AC HAS MINUS COUNT ON ENTRY.
	LAC* OUTBUN		/ARG IN MEMORY IS CHAR.
	JMS KLPUT		/OUTPUT CHAR.
	ISZ INS1
	JMP .-3
	IDX OUTBUN		/BUMP TO RETURN
	JMP* OUTBUN
/
TYPPOS	0			/TYPING POSITION, 0 AT LEFT MARGIN.
MQ2	0
	.EJECT
/END LINE ROUTINE
/
CECEND	JMS KLPUT		/OUTPUT CR
	LAC PUTP	/(JMW:109) FOR LISTING ON PDP-10, MAKE SURE THAT
	DAC INS1		/(JMW:109) ALL UNUSED CHAR POSITIONS
	IDX INS1		/(JMW:109) IN THE LAST PAIR 
	DZM* INS1		/(JMW:109) ARE CLEARED.
CECEN2	LAC (CMECHO
	JMS INS1		/SUBSTITUE MODIFIED LINE
	JMP* CECHEK	/EXIT
/
/INSERT LINE SUBR (TO Z1BUF OR Z2BUF)
/ON ENTRY: AC=NEW LINE BUFFER POINTER
/
INS1	0
	DAC ZLSAV1		/(BUFFER
	LAW -70			/ALLOWS FOR 132 CHARS IN LINE.
	DAC TVALDY			/USED AS COUNTER HERE.
	LAC GSWTCH
	SZA			/(JMW:106) WPC EXISTS IF CORRECTING UNDER G SWITCH.
	JMP FIXWPC
	LAW -3		/COMPUTE WPC ('CLC' AND 'TAD (2' FOR HEADER PAIR.)
	TAD ZLSAV1
	CMA
	TAD PUTP
	JMS R8L
	SKP
FIXWPC	LAC* ZLSAV1		/WPC ALREADY CONSTRUCTED.
	AND (377000
	DAC* ZLSAV1	/HEADER
INS	LAC* ZLSAV1
/MODN10 MUST HAVE BEEN SET TO POINT TO Z1BUF OR Z2BUF.
	DAC* MODN10
	IDX ZLSAV1
	IDX MODN10
	ISZ TVALDY
	JMP INS
	JMP* INS1
/
/INIT GET PUT SUBR
/
CSET	0
	LAC (CMECHO+2
	DAC PUTP		/INIT KLPUT
	DZM PUTC
	DZM PUTCT
	LAC MODN03
	DAC MODN10	/INIT MODN10 FOR LINE SWAP
	TAD LIT2			/INIT GETCHR (INPUT BUF POINTER)
	JMS ZSET
	DZM ZSPACE		/CLEAR IGNORE SPACE SWITCH
	JMP* CSET		/AC MUST BE NON 0 ON EXIT
	.TITLE       QCHEK: Q SWITCH PROCESSOR.
/Q SWITCH SUBROUTINE.
/DELETE SEQUENCE NUMBERS FROM ASCII INPUT LINES.
/ASSUMES CARD FORMAT AND DELETE ANYTHING BEYOND 72 CHARS.
/
/
QCHEK	0
	LAC QSWTCH	/Q SWITCH SET?
	SZA		/NO, FALL THRU TO EXIT
	LAC* MODN03	/EXAM WPC
	AND (377000
	TAD L757TH		/GREATER THAN 72 CHAR'S?  (757000
	SPA		/YES, TRUNCATE TO 72, CR AS 73RD
	JMP* QCHEK	/NO, EXIT
	LAC (377000
	CMA
	AND* MODN03
	XOR (20000		/WPC FOR 73 CHARACTERS.
	DAC* MODN03
	LAC MODN03	/BUFF POINTER
	TAD (36
	DAC QSWTCH	/TEMP.
	LAW 17760		/AND OUT 1ST 2 CHAR'S OF 5/7 PAIR
	AND* QSWTCH
	TAD (1		/BUILD 3RD CHAR=CR
	DAC* QSWTCH
	ISZ QSWTCH
	LAC LH5		/2ND HALF.
	DAC* QSWTCH
	JMP* QCHEK
	.TITLE	VCHECK: V SWITCH PROCESSOR
/
/(JMW:109) VCHECK: VERTICAL FORMS CONTROL.  AIMED AT ASCII PROGRAMS OUTPUT BY
/		FORTRAN (WITH FORMAT CONTROL CHARACTERS AS FIRST CHARS OF EACH LINE),
/		THAT ARE TO BE OUTPUT TO THE LINE PRINTER.
/
/THE FIRST CHARACTER IS CHANGED AS FOLLOWS:
/	"1" (61) TO FF (14)
/	"+" (53) TO DLE (20)
/	"0" (60) TO DC1 (21)
/	ALL OTHERS TO LF (12)
/
VCHECK	0
	LAC VSWTCH		/NON-ZERO IF WANT CONVERSION.
	SNA
	JMP* VCHECK
	LAC MODN03		/MUST SET UP GETCHR.
	TAD LIT2		/NOW POINTS TO FIRST DATA WORD.
	DAC VSWTCH		/TEMP
	JMS ZSET
	JMS GETCHR
	SAD (61
	JMP MAKFF
	SAD (53
	JMP MAKDLE
	SAD (60
	JMP MAKDC1
	LAC (50000		/FIRST CHAR A LF.
ALLV	DAC QCHEK		/TEMP SAVE OF NEW FIRST CHAR.
	LAC* VSWTCH
	AND (3777		/STRIP OUT OLD FIRST CHAR.
	XOR QCHEK		/PUT IN ALTERED CHAR.
	DAC* VSWTCH
	JMP* VCHECK
/
MAKFF	LAC (60000
	JMP ALLV
/
MAKDLE	LAC (100000
	JMP ALLV
/
MAKDC1	LAC (104000
	JMP ALLV
/
/
VSWTCH	0		/NON-ZERO IF V SWITCH SPECIFIED WITH T.
	.TITLE NEWDIR: NEW DIRECTORY FUNCTION.
/
/NEW DIRECTORY OPERATION.
/LEGAL ONLY TO DECTAPE, DECDISK, RK DISK AND DISK PACK.
/DECTAPE:
/A .CLEAR IS ISSUED TO THE DECTAPE.  IF THE S SWITCH IS SET, THE DIRECTORY IS THEN
/.TRAN'ED IN AND THE NUMBER OF BLOCKS NEEDED FOR THE ^Q AREA FOR THE EXISTING
/CORE SIZE (FROM .SCOM) IS INDICATED AS BEING BUSY. IF THE S SWTCH WAS COMBINED WITH
/A NUMBER (FOR CORE SIZE: 8,12,16,20,24,28,32) THE NUMBER OF BLOCKS NEEDED FOR
/THE SPECIFIED CORE SIZE ^Q AREA WILL BE SET AS BUSY.
/DISKS:
/AFTER CHECKING THAT THE FUNCTION IS LEGAL TO THIS UIC (SEE "CHKPRO"), THE MFD
/IF .TRAN'ED IN  AND A MATCH ON THE UIC IS SOUGHT.  IF NONE EXISTS, A MESSAGE IS
/IS TYPED TO THAT EFFECT AND PIP RESTARTS.  OTHERWISE, THE
/UFD IS .TRAN'ED IN AND EACH FILE IS .DELET'ED.  IF THE K SWITCH IS SET, THE
/UIC IS DELETED FROM THE MFD. THE UFD BLOCK(S) IS RETURNED TO THE SYSTEM FREE
/BLOCKS.  ON JUST A 'N DEV', THE FIRST BLOCK OF THE UFD IS LEFT (FOR THE SAKE
/OF RSX PLUS III).
/
NEWDIR	LAC DIRSWH		/SET TO 1 FOR S, 2 FOR N.
	SNA			/S ALREADY SPECIFIED IF NON-0.
	LAW 2			/S NOT SPECIFIED 
	DAC DIRSWH
	DZM INSUIC
	DZM KILUFD
	DZM NSWTCH
	DZM UBLKSW
		/EDIT 098: INSERT ABOVE 4 DZM TO INSURE CLEAR FLAGS
	DZM UFDCNT		/ZERO THE COUNT OF UFD BLOCKS
	JMS INITOT		/INITIALIZE FOR OUTPUT.
	LAC DESDEV
	SAD DECDSK		/DECDISK?
	JMP NDISK		/YES.
	SAD DSKPAK		/DISK PACK?
	JMP NDISK		/YES.
	SAD DECPAK		/DISK CARTRIDGE?
	JMP NDISK		/YES.
	JMS ZSCODE		/DECTAPE BY DEFAULT - OUTPUT NEW DIRECTORY.
NDONE	LAC NSWTCH		/NSWTCH SET IF JUST CLEARED DISK
	DZM NSWTCH		/UNDER CONTROL OF THE N SWITCH RATHER THAN
	SZA			/THE N FUNCTION.
	JMP* ZSCODE		/RETURN TO CALLING ROUTINE.
	LAC DESDAT
	JMP CLOUT		/CLOSE DEVICE AND LEAVE.
NDISK	LAC DESUIC
DKCLER	DAC CURUIC
	LAC DESDEV
	CLL			/EDIT 103A: DON'T CHECK FILES IF T FUNCTION, N SWITCH.
	JMS CHKPRO		/CHECK IF LEGAL FUNCTION AND SET UP DISK PARAMETERS.
RSETMF	LAC DESDAT
	STL
	JMS ZSETTR		/SET UP TO .TRAN IN MFD.
NMFD	JMS ZTRANS		/BRING IN MFD BLOCK. (PUT IN Z1BUF)
	LAC Z1BUFP
NINDX	TAD MFDSZE		/INDEX TO NEXT ENTRY.
NINDX1	DAC NDIRP1
	TAD MFNUM		/MORE ENTRIES?
	SPA!SZA
	JMP NMFDOK		/YES.
	LAC* (Z1BUF+377		/NO - ANOTHER MFD?
	SAD LM1		/777777 ENDS LINK.
	JMP GETMFD		/NO UIC MATCH FOUND.
	DAC ZBLNUM		/NEW BLOCK NUMBER IN AC.
	DAC DIRBLK
	JMP NMFD		/ANOTHER BLOCK - GO GET IT.
NMFDOK	LAC* NDIRP1
	SZA
	JMP SEEUIC		/SOME UIC IS ENTERED HERE.
	ISZ INSUIC		/SHOULD CURRENT UIC BE ENTERED IN THIS EMPTY SPACE?
	JMP IDXUIC		/NO - ONLY LOOKING.
	LAC DESUIC
	DAC* NDIRP1		/UIC GOES IN WORD 1.
	IDX NDIRP1
	LAW -1
	DAC* NDIRP1		/SET BLOCK NUMBER TO -1 (WORD 2).
	IDX NDIRP1
	LAC (UENTRY		/STANDARD UFD ENTRY SIZE.
	XOR DIRPRO		/DIRECTORY PROTECTION CODE.
	DAC* NDIRP1
	JMP WRITOT		/WRITE MMODIFIED MFD.
SEEUIC	SAD DESUIC		/FOUND UIC ENTRY?
	JMP NMATCH		/YES.
IDXUIC	LAC NDIRP1		/NO - GET NEXT ENTRY.
	JMP NINDX		
NMATCH	ISZ KILUFD		/DELETE UIC ENTRY FROM MFD??
	JMP NMTCH1		/NO.
	CLC
	TAD MFDSZE		/YES - ESTABLISH # WORDS TO ZERO OUT.
	CMA
	DAC MFDSZE
ZERUFD	DZM* NDIRP1
	IDX NDIRP1
	ISZ MFDSZE
	JMP ZERUFD
WRITOT	LAC DESDAT		/ALL ZEROED - OUTPUT MODIFIED MFD.
	XOR (1000
	DAC ZTRANZ
	JMS ZTRANS
	JMP NDONE
NMTCH1	IDX NDIRP1		/GET FIRST BLOCK OF UFD.
	LAC* NDIRP1
	DAC NDELET		/TEMP STORAGE FOR UFD BLOCK #.
		/EDIT 098  REMOVE FOLLOWING 5 INSTRUCTIONS: NOT NEEDED
		/LAC UBLKSW
		/SNA			/SET IF LAST PASS THRU.
		/JMP .+3
		/LAC	RSXTMP		/PUT STARTING BLOCK # IN MFD: RSX PLUS III???
		/DAC* NDIRP1		/RESET UFD BLOCK NUMBER.
	IDX NDIRP1		/GET SIZE OF EACH ENTRY IN UFD.
	LAC* NDIRP1
	AND (77
	DAC UFDSZE
	LAC UBLKSW
	SNA
	JMP CONMFD
	LAC NEWPRO		/IF NO NEW DIRECTORY PROTECTION SPECIFIED,
	SMA			/LEAVE OLD ONE ALONE.
	JMP NOCHNG
	LAC UFDSZE
	XOR DIRPRO
	DAC* NDIRP1
NOCHNG	JMS	WRIBLK		/WRITE OUT BLOCK
	DZM UBLKSW
	JMP	NDONE2
/
WRIBLK	0			/WRITE CURRENT BLOCK ONTO DISK
	LAC DESDAT		/BLOCK # ALREADY IN 'ZBLNUM'.
	XOR (1000		/SET THE OUTPUT BIT IN THE .TRAN CAL.
	DAC ZTRANZ
	JMS ZTRANS
	JMP*	WRIBLK
/
CONMFD	LAC (BUFFER		/USE BUFFER TO STORE UFD BLOCK
	DAC UFDPNT		/NUMBERS TO DELETE FROM SAT.
	LAC NDELET
	SAD LM1			/IS THERE A UFD BLOCK?
	JMP NDONE1		/NO - NOTHING TO DELETE.
	DAC ZBLNUM		/YES - GO GET IT.
	DAC* UFDPNT
	IDX UFDCNT		/SET SO WILL DELETE BLOCK FROM SAT.
	LAC Z1BUFP
	TAD (376		/CALCULATE LIMITS OF SEARCH FOR BLOCK.
	CMA
	TAD UFDSZE
	DAC NUFNUM		/LAST LEGAL ADDR FOR SEARCH.
NUFD	LAC DESDAT
	DAC ZTRANZ
	JMS ZTRANS		/UFD BLOCK INTO Z1BUF.
	LAC Z1BUFP
	DAC NDIRP1		/SET UP POINTERS.
	DAC NDIRP2
NENTRY	LAC* NDIRP1
	SNA
	JMP UFDETY		/ZERO ENTRY - GO GET ANOTHER ONE.
	DAC DNAME1		/SET UP FILE NAME FOR DELETE MACRO.
	IDX NDIRP1
	LAC* NDIRP1
	DAC DNAME2
	IDX NDIRP1
	LAC* NDIRP1
	DAC DEXT
	LAC DESDAT
	JMS NDELET		/GO DELETE FILE.
UFDETY	LAC NDIRP2
	TAD UFDSZE
	DAC NDIRP1		/UPDATE TO NEXT FILE ENTRY.
	DAC NDIRP2
	TAD NUFNUM		/LOOKED AT WHOLE BLOCK?
	SPA!SZA
	JMP NENTRY		/NO - GET THE NEXT ENTRY.
	LAC* (Z1BUF+377		/BLOCK DONE.
	SAD LM1			/ANOTHER UFD BLOCK? (-1 ENDS LINKAGE)
	JMP NDONE1		/DONE.
	DAC ZBLNUM		/GO GET NEW UFD BLOCK.
	IDX UFDPNT
	DAC* UFDPNT		/SAVE BLOCK # SO CAN DELETE FROM SAT.
	IDX UFDCNT
	JMP NUFD
NDONE1	LAC UFDCNT		/NON-0 IF THERE ARE ANY BLOCKS TO DELETE.
	SZA
	JMP RETBLK		/RETURN BLOCKS THAT WERE DELETED.
NDONE2	LAC KSWTCH		/NON-0 IF TO REMOVE ENTRY FROM MFD.
	SNA!CLC
	JMP NDONE
	DAC KILUFD
	JMP RSETMF
/RETURN FROM CHKPRO - ASKED TO N DIRECTORY THAT DOESN'T EXIST (LINK=1)
/OR THAT IS PROTECTED AND DIFFERENT UIC (L=0).
NOUIC	SNL
	JMP ERR23		/'ILLEGAL FUNCTION FOR UIC'
	LAC PIPUIC		/IF CREATING DIRECTORY TO OWN UIC OR IF
	SAD DESUIC
	JMP NNOUIC
	LAC PIPMIC		/MIC IS IN, MAKE A PROTECTED DIRECTORY.
	SMA
	DZM DIRPRO		/OTHERWISE, CREATE AN UNPROTECTED DIRECTORY.
NNOUIC	LAC KSWTCH		/IF ASKED TO DELETE A UFD THAT DOESN'T EXIST,
	SZA!CLC			/COMPLAIN.
	JMP ERR25		/'UIC NOT PRESENT IN MFD'.
	DAC INSUIC		/SET UP TO INSERT UFD IN MFD.
	JMP RSETMF
/
/MUST NOW RESET ALL DEALLOCATED UFD BLOCKS ON THE DISK TO ZERO WITH -1 IN LINKS.
/'BUFFER' HAS THE NUMBERS OF ALL THE BLOCKS THAT MUST BE SO CLEARED.
/
RETBLK	LAC (BUFFER
	DAC UFDPNT
	CLC
	TAD UFDCNT
	CMA
	DAC UFDCNT		/# BLOCKS TO CLEAR.
	DAC NDELET
	LAC (Z1BUF		/SET THE BUFFER TO ZERO.
	DAC TEMP
	LAW -374
	DAC ZCOUNT
ZUFD	DZM* TEMP
	IDX TEMP
	ISZ ZCOUNT
	JMP ZUFD
	CLC
	DAC* (Z1BUF+376			/BACKWARD AND
	DAC* (Z1BUF+377			/FOREWARD LINKS = 777777.
WZUFD	LAC* UFDPNT
	DAC ZBLNUM			/BLOCK # FOR .TRAN ROUTINE.
	JMS WRIBLK			/.TRAN OUT THE RESET BLOCK.
	IDX UFDPNT			/POINT TO THE NEXT BLOCK #.
	ISZ NDELET			/ALL DONE?
	JMP WZUFD			/NO _ DO THE NEXT ONE.
		/EDIT 098 : PREVIOUSLY DID NOT DEALLOCATE PROPER BLOCKS
		/FOLLOWING 5 INSTRUCTIONS ADDED
	LAC (BUFFER
	DAC UFDPNT
	LAC KSWTCH
	SNA
	JMP RTBLK1
		/EDIT 098  FOLLOWING INSTRUCTIOS DELETED
		/LAC KSWTCH			/KILL UFD?
		/SZA
		/JMP RTBLK2		/YES.
		/LAC BUFFER		/NO. DEALLOCATE ALL BLOCKS EXCEPT FIRST ONE
		/DAC RSXTMP		/FOR RSX PLUS III?????
		/ISZ UFDCNT		/SUBTRACT 1 FROM THE COUNT.
		/SKP
		/JMP RTBLK1+3		/NO BLOCKS TO RETURN.
		/LAC* UFDPNT
		/DAC BUFFER
		/DZM* UFDPNT
/RTBLK2	LAC (BUFFER		/RESET POINTER TO BEGINNING OF LIST.
		/DAC UFDPNT
BITOUT	LAC* UFDPNT
	DAC BADBLK
	JMP FIXSAT		/GO FREE BIT IN SAT. (VIA 'UPDATE' ROUTINE)
RTBLK1	IDX UFDPNT
	ISZ UFDCNT
	JMP BITOUT
	SET UBLKSW
	JMP RSETMF
GETMFD	SET NDIRSW		/MUST CREATE NEW MFD BLOCK VIA 'UPDATE' ROUTINE.
	LAC DIRBLK
	DAC BATBLK
	JMP CREAT1		/GO TO UPDATE ROUTINE.
GTMFD1	LAC SATNUM		/NEW BLOCK NUMBER.
	DAC ZBLNUM
	CLC
	DAC INSUIC
	DZM* Z1BUFP
	LAC Z1BUFP
	JMP NINDX1
/
NDIRP1	0			/DIRECTORY POINTER.
NDIRP2	0
NUFNUM	0			/HOLDS LAST LEGAL ADDR (MINUS) FOR SEARCH ON UFD BLK.
UBLKSW	0			/NON-0 IF DELETING UFD BLK # FROM MFD.
INSUIC	0			/-1 IF TO INSERT UFD INTO MFD.
NDIRSW	0			/NON-ZERO IF CREATING A NEW MFD BLOCK (VIA UPDATE).
KILUFD	0			/-1 IF TO REMOVE UIC ENTRY FROM MFD.
NSWTCH	0			/SET TO NON-ZERO IF DOING N SWITCH TO DISKS.
UFDPNT	0			/PNTR TO UFD BLK #S (IN 'BUFFER') TO DELETE FROM SAT.
UFDCNT	0			/# UFD BLKS TO DELETE FROM SAT.
/EDIT 098  TAKE OUT  RSXTMP	0
/
/DELETE SYSTEM MACRO.
/
NDELET	0
	DAC DELWAT
	XOR (1000		/SET BIT 8 TO INDICATE DELETE.
	DAC DELDAT
/	.DELET DAT,NAME1
DELDAT	XX			/.DAT SLOT NUMBER.
	2
	DNAME1
/	.WAIT DAT
DELWAT	XX			/SAME .DAT NUMBER AS ABOVE.
	12
	JMP* NDELET
/
DNAME1	0			/NAME AND EXT OF FILE TO BE DELETED.
DNAME2	0			/SET UP BY CALLING ROUTINE.
DEXT	0
	.TITLE    ZSCODE: SUBROUTINE TO PROCESS S OR N OPTION.
/
/SUBR. TO PROCESS S OR N OPTION
/
ZSCODE	0
	LAC DIRSWH
	SNA!CLL!CML
	JMP* ZSCODE		/NEITHER N OR S. EXIT
	LAC DESDEV		/IF IT'S THE DISK, MUST GO TO THE NEWDIR
	SAD DECTAP		/ROUTINE.
	JMP DTCLER
	SET NSWTCH
	LAC DESUIC
	JMP DKCLER
DTCLER	LAC (100		/GET DIRECTORY
	DAC DIRBLK
	LAC DESDAT
	JMS ZSETTR	/TRAN SETUP
ZCLEAR	XX		/CLEAR (BE SURE INIT EXECUTED FOR THIS DAT SLOT.)
	5
	LAC DIRSWH
	DZM DIRSWH	/ONCE ONLY
	RAR
	SNL!CLC		/S SWITCH
	JMP* ZSCODE	/N SWITCH, DONE
	JMS ZTRANS
	LAC (077777	/DIR WD 3=077777 IN ALL CASES
	DAC* (Z1BUF+3
	LAC (Z1BUF+3
	TAD (1
	DAC ZENTP		/SET UP POINTER FOR REST OF SAVE AREA
	LAC CORSPC		/0 IF CORE SIZE NOT SPECIFIED.
	SNA			/EQUAL TO EQUILIVANT .SCOM IF SPECIFIED.
	LAC* (.SCOM	/FIND #OF K(CORE) IN SYSTEM.
	CLL!RAL
	JMS R6L
	AND (7
	DAC ZEROBB		/T STORE BANK VALUE(1,3,5.7)+POINTER.
	LAC X4KSW		/SET TO 400000 IF XTRA 4K SPRCIFIED.
	SNA			/OTHERWISE 0.
	LAC* (.SCOM+20		/EXTRA 4K?
	SPA!CLA			/NO.
	IDX ZEROBB		/YES - MUST ADJUST ^Q DUMP AREA.
	LAC ZEROBB
	TAD LM5		/FOR 24, 28 AND 32K,  THE NO. OF -1
	SMA!CLC		/WORDS IS ONE LESS THAN BITS 3-5 OF .SCOM.
	CLL!RAL		/THE OTHERS CORRESPOND EXACTLY.
	TAD ZEROBB
	CMA
	DAC ZCT		/#OF -1 WORDS
	LAC ZEROBB
	TAD (ZEROBB
	DAC ZEROBB		/ADDRESS OF LAST BIT MAP CONSTANT.
LM1	LAW -1		/32 BLOCKS = 8K (1 -1 WORD)
			/48 BLOCKS = 12 K 82 -1 WORDS)
ZCLER2	DAC* ZENTP	/64 BLOCKS = 16 K (3 -1 WORDS).
			/80 BLOCKS = 20K. (4 -1 WORDS).
	IDX ZENTP		/96 BLOCKS = 24 K (4 -1 WORDS).
			/112 BLOCKS= 28K. (5 -1 WORDS).
	ISZ ZCT		/128 BLOCKS = 32 K (6 -1 WORDS).
	JMP ZCLER2
	LAC* ZEROBB	/PICK UP LAST BIT MAP CONSTANT FROM
	DAC* ZENTP		/TABLE STARTING AT ZEROBB+1.
	CLL
	LAC DESDAT
	JMS ZSETTR
	JMS ZTRANS	/OUTPUT NEW DIRECTORY
	JMP* ZSCODE		/EXIT.
/ORDER FROM ZEROBB TO ZEROBB+7 MUST NO CHANGE!!!!!!!
ZEROBB	0
	774000			/CORE BANK 0,	8K.
	760000			/CORE BANK 0.5,	12K.
	700000			/CORE BANK 1,	16K.
MINUS	400000			/CORE BANK 1.5,	20K.
	777776			/CORE BANK 2.0,	24K.
	777770			/CORE BANK 2.5,	28K.
	777740			/CORE BANK 3.0	32K.
	.TITLE RENAME: RENAME FILE FUNCTION.
/
/RENAME FILE ROUTINE.
/   IF RENAMING A FILE(S) (COMMAND FORM: R DV NEWNAM_DV OLDNAM (P), WHERE P
/IS THE OPTIONAL PRRTECTION CODE), FALLS INTO DELETE CODE.  THE NEW NAME(S) IS IN
/'DESFLS' AND THE OLD NAME(S) IN 'SRCFLS'.  THE NAME IN 'SRCFLS+3' IS SAVED
/AND REPLACED WITH THE NEW NAME THAT CORRESPONDS TO THE OLDNAME IN 'SRCFLS'.
/THE .RENAM MACRO IS THEN ISSUED FOR THAT FILE, AFTERWHICH THE ORIGINAL FILE
/NAME AT 'SRCFLS+3' IS REPLACED.  IF A NEW PROTECTION CODE WAS SPECIFIED FOR THE
/FILE, PIP THEN .TRAN'S IN THE APPROPRIATE UFD BLOCK, UPDATES THE 
/PROTECTION CODE IN WORD 6 OF THE ENTRY AND REWRITES THE UPDATED UFD.
/   IF THE DIRECOTRY PROTECTION CODE IS TO BE CHANGED (PIP CHECKS TO SEE IF
/ANY FILE NAMES HAVE BEEN SPECIFIED AND IF NOT, ASSUMES ONLY A DIRECTORY CHANGE),
/(COMMAND FORM: R DK <UIC:P>, WHERE P IS 0(UNPROTECTED) OR 1(PROTECTED))
/THE MFD IS BROUGHT IN (USES 'CHKPRO') AND THE PROTECTION CODE (BIT 0 OF
/WORD 3 OF THE MFD ENTRY FOR THE SPECIFIED UIC) CHANGED.  THE UPDATED MFD
/IS THEN REWRITTEN.
/
RENAME	LAC (DESFLS		/DEST FILE POINTER
	DAC DSFPTR		/SET UP FOR RENAME
	DAC MODN07		/TO CHECK FOR MULTIPLE FILE NAMES
	LAC SRFCNT		/IF NO FILE COUNT, WANT ONLY TO CHANGE
	SNA			/DIRECTORY PROTECTION CODE.
	JMP NAMPRO
	LAC SRCUIC
	DAC DESUIC
	DAC CURUIC
	LAC DESDAT
	JMS FSTATZ		/CHECK IF NEW FILE ALREADY PRESENT
		/EDIT 100:  DELETE TWO INSTRUCTIONS AND INSERT FOLLOWING
		/TO ALLOW CHANGE OF PROTECTION CODE WITHOUT RENAMING
/	SZA			/NAMED NEW FILE NOT PRESENT
/	JMP ERR36		/NEW FILE NAME ALREADY PRESENT
	SNA
	JMP RENAM2
	LAC (SRCFLS
	DAC ZEROBB
	LAC DSFPTR
	DAC ZENTP
	LAW -3
	DAC ZCT
RENAM1	LAC* ZEROBB
	SAD* ZENTP
	SKP
	JMP ERR36	/NOT THE SAME BUT NEW NAME ALREADY EXISTS
	IDX ZENTP
	IDX ZEROBB
	ISZ ZCT
	JMP RENAM1
		/FALL THROUGH IF NAME UNCHANGED
	/END OF EDIT 100 INSERTION EXCEPT THAT FOLLOWING INSTRUCTION IS NOW NAMED
RENAM2	LAC ZOUTCP		/RE. SW=2000
	JMP DELET1
NAMPRO	LAC DESDEV		/FUNCTION LEGAL ONLY TO DISKS.
	SAD DECDSK
	SKP
	SAD DSKPAK
	SKP
	SAD DECPAK
	SKP
	JMP ERR04
	LAC NEWPRO
	SMA
	JMP ERR30			/NO NEW PROTECTION CODE SPECIFIED.
	AND (77
	SAD (60			/ONLY 0 OR 1 LEGAL.
	SKP
	SAD (61
	SKP
	JMP ERR30
	RTR
	AND MINUS
	DAC NEWPRO
	LAC DESDAT
	DAC CHKDAT
	JMS INITOT		/INIT DEVICE FOR OUTPUT SO GET WRITE CHECK.
	LAC DESUIC
	DAC CURUIC
	CLL
	LAC DESDEV
	JMS CHKPRO		/GET MFD AND CHECK LEGALITY OF FUNCTION.
	LAC CMFDPT		/WHEN COME BACK FROM CHKPRO, ALL POINTERS
	TAD LIT2		/SET UP TO DESIRED AREA.
	DAC CMFDPT
	LAC* CMFDPT		/WORD 3 OF ENTRY HAS PROTECTION CODE IN BIT 0.
	AND (377777
	XOR NEWPRO		/PUT IN NEW PROTECTION CODE.
	DAC* CMFDPT
	LAC ZTRANZ
	XOR (1000
	DAC ZTRANZ
	JMS ZTRANS		/REWRITE UPDATED MFD.
	JMP DELOUT		/CLOSE DEVICE AND EXIT.
	.TITLE DELETE: DELETE FILE FUNCTION.
/
/DELETE FILE ROUTINE
/THE FILE NAME(S) TO BE DELETED IS IN 'SRCFLS'. A .DELET MACRO IS ISSUED FOR
/EACH FILE IN THE LIST.
/
DELETE	LAC DESUIC
	DAC SRCUIC
	DAC CURUIC		/SET UP 'CHKPRO'.
	LAC (740000	/EDIT 100: ADD THESE TWO INSTRUCTIONS
	DAC SKPRNM
	LAC (1000
	DZM XDEL	/EDIT 099  INSURE CLEAR
	.TITLE    DELETE/RENAME COMMON ROUTINES.
DELET1	DAC ZDRSW		/REN/DEL SWITCH
	JMS INITOT		/INIT DEVICE FOR OUTPUT.
	LAC DESDEV
	JMS CHKPRO		/CHECK FOR LEGAL FUNCTION TO THIS UFD.
		/EDIT 099 INSERT TO ALLOW (X) WITH SPECIFIED FILES
	LAC SRFCNT
	SZA
	JMP DELET2
		/END EDIT 099 INSERTIONS
	LAC XSWTCH		/NON-ZERO IF TO DELETE ALL TRUNCATED FILES.
	SZA
	JMP DELALL
	JMP ERR34	/EDIT 099 INSERTION
DELET2	LAC (SRCFLS		/SOURCE FILE POINTER
	DAC SRFPTR
	DAC MODN01		/.OPER ENTRY POINTER
	LAC ZDRSW		/CHECK FOR RENAME (2000)
	SAD ZOUTCP		/TO SET UP
	JMS ZDRENS		/NEW FILE NAME
	XOR SRCDAT		/SET UP CAL
	DAC ZDFILD
/DELETE OR RENAME I/O MACRO
/
SKPRNM	NOP			/OR 'JMP MODN01+1' IF ONLY CHANGING PROTECTION CODE.
ZDFILD	XX			/DAT SLOT (MODIFIED)
	2
MODN01	XX			/SOURCE FILE POINTER
NORENM	SNA			/AC=0 IF FUNCTION NOT DONE.
	JMP DELET3
	LAC (740000
	DAC SKPRNM
	LAC ZDRSW
	SAD ZOUTCP		/IF RENAME (2000)
	JMS DRENRS		/RESET POINTERS AND FILE NAMES
	ISZ SRFCNT
	JMP ZDLMOR		/MORE FILES TO DELETE OR RENAME
	LAC XSWTCH	/MAY HAVE MORE FILES TO DO
	SZA
	JMP DELALL	/EDIT 099:  FORMERLY JMP DELAL2
DELOUT	LAC DESDAT		/DONE - GO CLOSE DEVICE AND
	JMP CLOUT		/EXIT.
ZDLMOR	LAC XDEL		/NO NEED TO UPDATE POINTER IF DELETING ALL.
		/EDIT 099:  FORMER INSTRUCTION WAS XSWTCH
	SZA
	JMP DELET2
	LAC MODN01
	AND (77777
	TAD (3
	JMP DELET2+1
/
DELET3	LAC XDEL		/COME HERE IF FUNCTION NOT DONE.
		/EDIT 099:  FORMER INSTRUCTION WAS LAC XSWTCH
	SNA
	JMP ERR06		/REALLY IS SOMETHING WRONG.
	LAC MSWTCH		/MAY HAVE OTHER UFDS TO LOOK AT.
	SNA
	JMP DELOUT		/NO - LEAVE.
	JMP BMPMFD		/GO LOOK AT ANOTHER ENTRY.
/
/SUBR TO PLACE DEST FILE NAME IN SRC FILE LIST FOR RENAME FUNCTION.
/
ZDRENS	0
	LAC SRFPTR		/SEE IF BOTH FILE NAMES THE SAME. IF SO,
	DAC ZEROBB		/DONE'T ISSUE RENAME MACRO (SET 'SKPRNM'
	LAC DSFPTR		/TO 'JMP MODN01+1') - ONLY CHANGE FILE
	DAC ZENTP		/PROTECTION.
	LAW -3
	DAC ZCT
ZDREN1	LAC* ZEROBB
	SAD* ZENTP
	SKP
	JMP ZDREN2		/NOT THE SAME - WILL ISSUE RENAME MACRO.
	IDX ZENTP
	IDX ZEROBB
	ISZ ZCT
	JMP ZDREN1
	LAC (JMP NORENM
	DAC SKPRNM
ZDREN2	LAW -3
	DAC ZCT
	LAC (TMPFLE		/MUST SAVE THE NAME IN SRCFLS+3 BECAUSE MAY NEED IT
	DAC ZENTP		/IF DOING MANY RENAMES AT ONCE.
	LAC SRFPTR		/SO PUT THE NAME INTO A TEMPORARY STORAGE 
	TAD (3			/AREA AND REPLACE IT WITH THE NEWLY SPECIFIED NAME.
	DAC ZEROBB		
DRENS1	LAC* ZEROBB
	DAC* ZENTP
	LAC* DSFPTR
	DAC* ZEROBB
	IDX SRFPTR
	IDX DSFPTR
	IDX ZENTP
	IDX ZEROBB
	ISZ ZCT
	JMP DRENS1
	LAC ZOUTCP
	JMP* ZDRENS	/(2000 MUST BE IN AC ON EXIT.
/
/RESET SUBR. AFTER RENAME AND CHECK FOR SPECIFIED PROTECT CODE.
/
DRENRS	0
	LAC DKSW		/PROTECT CODE MATTERS ONLY ON DISK.
	SNA
	JMP DRENR2
	LAC NEWPRO
	SPA
	JMP RPROCT		/IT IS SET SO NEED NEW PROTECT CODE.
DRENR2	LAW -3
	DAC ZCT
	LAC SRFPTR
	DAC ZEROBB
	LAC (TMPFLE		/SAVE AREA POINTER.
	DAC ZENTP
DRENR1	LAC* ZENTP
	DAC* ZEROBB
	IDX ZENTP
	IDX ZEROBB
	ISZ ZCT
	JMP DRENR1
	JMP* DRENRS
/
RPROCT	STL			/ROUTINE TO RESET THE PROTECTION
	LAC SRFPTR
	DAC ZSFILP
	LAC DESDEV		/CODE (SPECIFIED IN COMMAND STRING) OF FILE JUST
	JMS CHKPRO		/GET MFD AND FIND MATCH ON UIC AND FILE.
	LAC NEWPRO
	RTR; RTR
	AND MASK2
	DAC ZEROBB		/TEMP STORAGE.
	LAC* CMFDPT
	AND (77777		/STRIP OFF OLD PROTECTION CODE.
	XOR ZEROBB
	DAC* CMFDPT
	LAC ZTRANZ		/CHANGE DIRECTION TO OUTPUT.
	XOR (1000
	DAC ZTRANZ
	JMS ZTRANS		/REWRITE UFD BLOCK.
	JMP DRENR2
/
/ROUTINE TO SET UP TO DELETE ALL TRUNCATED FILES.
/USING THE 'NEWDIR' CODE, IT READS IN THE MFD AND FINDS A MATCH ON THE UIC.
/IT THEN READS IN THE UFD AND CHECKS EACH FILE TO SEE IF IT IS TRUNCATED.
/IF IT IS, THE FILE NAME IS CHANGED TO ?????? ???.  WHEN EACH FILE HAS BEEN 
/EXAMINED,  THE .DELET MACRO WILL BE ISSUED FOR THE FILE NAME ?????? ??
/UNTIL THE AC IS 0 ON RETURN.
/IF THE MIC IS IN, ALL TRUNCATED FILE WILL BE DELETED FOR EVERY
/UFD IN THE SYSTEM.
/
DELALL	SET CNTSW		/SET UP TO USE LIST DIRECTORY.
	SET XDEL	/EDIT 099 INSERTION
	LAC PIPMIC		/400000 IF MIC LOGGED IN; 0 OTHERWISE.
	DAC MSWTCH
	LAC (SRCFLS		/SET UP DUMMY FILE NAME OF ?????? ???
	DAC SRFPTR
	LAW -1
	DAC* SRFPTR
	IDX SRFPTR
	DAC* SRFPTR
	IDX SRFPTR
	DAC* SRFPTR
	DZM SRFCNT
	JMP DELIN
/
/
DELAL1	LAC UFDPT1		/HAVE A NON-ZERO FILE NAME.
	TAD (3			/WORD 4, BIT 0=1 IF TRUNCATED.
	DAC XSWTCH		/TEMP STORAGE.
	LAC* XSWTCH
	SMA
	JMP INROT		/THIS FILE NOT TRUNCATED - GET ANOTHER.
	LAW -1
	DAC* UFDPT1
	IDX UFDPT1
	DAC* UFDPT1
	IDX UFDPT1
	DAC* UFDPT1
	JMP INROT		/SEE IF THERE ARE MORE FILES.
/
/COME HERE IF NO MORE FILES IN THE DIRECTORY.
DELAL2	LAC DESDAT		/RESET TRAN ROUTINE.
	XOR (1000
	DAC ZTRANZ
	JMS ZTRANS		/REWRITE UFD WITH MODIFIED FILE NAMES.
	LAC MSWTCH		/IF MIC IN, MUST ISSUE .USER CAL TO GET TO
	SNA			/CURRENT UIC.
	JMP DELET2		/LOGGED-IN UIC, SO .USER ALREADY CURRENT.
	LAC USEUIC		/UIC NOW BEING PROCESSED - SET UP IN 'NEWDIR'.
	JMS USER
	JMS INITOT		/REINIT (ONLY NES 1ST TIME THRU TO GET NEW UIC).
	JMP DELET2		/NOW DO ACTUAL DELETION OF FILES.
/
ZDRSW	0			/DELETE (1000), RENAM (2000).
XSWTCH	0			/NON-0 IF TO DELETE ALL TRUNCATED FILES.
XDEL	0
	.TITLE LSTDIR: LIST DIRECTORY FUNCTION.
/LIST (L) DIRECTORY ROUTINE
/
LSTDIR	JMS INITIN		/INIT SOURCE DEVICE.
	DZM PIPAGN		/SO PIP WON'T BE PRINTED AT THE END.
	LAC DESDAT
	DAC PRWAT		/OUTPUT WAIT.
	DAC ZCLOSD		/OUTPUT CLOSE.
	XOR ZOUTCP		/(2000.
	DAC PRDAT		/SET UP OUTPUT DAT SLOT FOR IOPS ASCII. (.WRITE)
	JMS INITOT
	STL
	LAC SRCDAT
	JMS ZSETTR		/SET UP ZTRAN FOR INPUT.
	LAC SRCDEV
	SAD DECDSK		/DECDISK?
	JMP LISTDK
	SAD DSKPAK		/DISK PACK?
	JMP LISTDK
	SAD DECPAK		/DISK CARTRIDGE?
	JMP LISTDK
	DZM PSWTCH		/IGNORE P SWITCH ON DECTAPE.
	LAC (100
	DAC DIRBLK
	LAC LSWTCH		/IF L REQUESTED, DON'T LIST DIRECTORY.
	SZA
	JMP SYSBLK
	.TITLE    DECTAPE DIRECTORY ROUTINES.
	LAC LIT4
	DAC UFDSZE		/SIZE OF DECTAPE DIRECTORY ENTRIES.
	LAW -7
	DAC CNTSW	/FILE BIT MAP BLOCK COUNT.
	LAC Z2BUFP
	DAC PBLKCT		/STORAGE AREA FOR FILE BLK COUNTS.
	LAC (71			/INIT FILE BIT MAP BLOCK.
	DAC ZBLNUM
ZNXBLK	JMS ZTRANS	/BRING IN FILE BIT MAP BLK
/
/ROUTINE TO COUNT DECTAPE FILE BLOCKS OCCUPIED.
/
	LAW -10
	DAC ZCT		/FILE BIT MAP PER BLOCK COUNT
	CLC
	TAD Z1BUFP		/FILE BIT MAP POINTER
	DAC* LIT12		/AUTO 12
ZLDMAP	LAC LSPRAL	/COUNT BLOCK OCCUPIED (SPA!RAL
	JMS BITCNT		/COUNT OCCUPIED BLOCKS FOR THIS FILE
	IDX PBLKCT		/UPDATE COUNT POINTER.
	ISZ ZCT		/FILE BIT MAP PER BLOCK COUNT.
	JMP ZLDMAP
	IDX ZBLNUM		/INDEX BL.# (71-77)
	ISZ CNTSW
	JMP ZNXBLK
/ROUTINE TO COUNT DECTAPE FREE BLOCKS.
/
	JMS ZTRANS
	CLC
	TAD Z1BUFP		/DIR BIT MAP POINTER
	DAC* LIT12
	LAC LSMRAL	/COUNT FREE BLOCKS.  (SMA!RAL
	JMS BITCNT
	LAC* PBLKCT		/SAVE # OF FREE BLKS.
	DAC FREEBK
PRNTHD	LAC (BUFFER+2
	JMS SETPUT
	JMS PACK40		/INSERT 4 SPACES BEFORE DATE.
	JMS PACK40
	JMS PACK40
	JMS PACK40
	LAC* (SDATE		/OUTPUT DATE IF THERE IS ONE.
	SZA
	JMS CALUDA		/PACK DATE IN OUTPUT BUFFER.
	SNA			/AC=0 IF DATE NOT GOOD.
	JMP NODATE
	JMS LNEOUT		/OUTPUT LINE.
NODATE	LAC (BUFFER+2
	JMS SETPUT
	LAC MSWTCH		/IF LISTING MFD, OUTPUT "MFD DIRECTORY LISTING".
	SNA
	JMP PRTHD1
	LAC NAMFD
	JMS KLFSIX
	JMS PACK40		/INSERT SPACE.
PRTHD1	LAC (LDIRHD		/"DIRECTORY LISTING<15>"
	JMS PACKBF
	LAC MSWTCH
	SZA
	JMP SKPUIC
	LAC DKSW
	SNA
	JMP SKPUIC		/NO UIC FOR DECTAPES.
	DZM PUTC			/STRIP CARRIAGE RETURN FROM 'DIRECTORY LISTING'.
	LAC OPAREN
	JMS KLPUT		/INSERT LEFT PAREN.
	LAC SRCUIC		/INSERT CURRENT UIC NAME.
	JMS KLFSIX
	LAC CPAREN		/INSERT CLOSE PAREN.
	JMS KLPUT
SKPUIC	JMS LNEOUT		/OUTPUT LINE.
	LAC DKSW		/DECTAPE?
	SZA
	JMP PUSPR		/NO, DISK AND ALREADY KNOW # USER FILES.
	JMS ZFIL56	/CHECK FOR 24 OR 56 FILES.
	DAC KLCNTD
	DAC CNTSW		/SET TO NON-ZERO.
	JMP FILOUT	/COUNT NUMBER OF USER FILES.
/
/PRINT # OF FREE BLOCKS.
/
PUSPR	DZM CNTSW
	LAC (LFREE
	JMS PRCOMP
FREEBK	0		/NUMBER FREE BLOCKS IN SYSTEM.
/
/PRINT # OF USER FILES
/
	LAC (LUSEFL
	JMS PRCOMP	/SUBR TO SET UP OUTPUT LINE
FILNUM	0		/TEMP STOR,;#OF USER FILES.
	LAC DKSW
	SZA
	JMP USEBLK		/DISK LISTS NUMBER OF USER BLOCKS.
/
/PRINT # OF SYSTEM PGM BLOCKS. (DECTAPE ONLY).
/
	LAW -1101		/1100-(FREE+USER)=SYS PGM BLKS
	TAD TEMP2		/USER BLKS
	TAD FREEBK		/FREE BLKS.
	CMA
	DAC SYSCT
	LAC (BUFFER+2
	JMS SETPUT
	LAC SYSCT
	JMS KLFOCT
	LAC (LSYSBK
	JMS PACKBF
	LAC SYSCT
	SPA!SNA		/ILLEGAL # SYSTEM BLOCKS? (MINUS OR 0)
	JMP SYSER1	/YES - APPEND 'ILL CNT' TO PRINT OUT.
	CMA
	TAD (1101		/CHECK NOT GREATER THAN 1100 BLOCKS.
	SMA
	JMP SYSOUT		/NO PROBLEM - OUTPUT LINE.
SYSER1	DZM PUTC		/STRIP CR FROM MESSAGE.
	LAC (LILLCT
	JMS PACKBF
SYSOUT	LAC (BUFFER
	JMS PROUT
/PRINT FILE NAMES.
/
FILOUT	LAC Z2BUFP	/INIT BLOCK COUNT TABLE.
	DAC PBLKCT		/POINTER TO (BUF2, WHICH HAS # BLKS FOR EACH FILE.
	DAC BLPRNT	/SET BLOCK PRINT SWITCH
	JMS ZFIL56
	DAC KLCNTD
	DZM TEMP2		/TOTAL USER PGM. BLOCK COUNT
	DZM FILNUM		/USER FILE COUNT.
	LAC (Z1BUF+40
	JMS PFILE		/PRINT FILE NAMES
TAPEBK	LAC DKSW
	SZA
	JMP BEFCLO		/DISK.
	LAC BLPRNT		/IF NON-ZERO, PERHAPS HAVE TO LIST SYS PROGS.
	DZM BLPRNT
	SNA
	JMP BEFCLO
	LAC* (Z1BUF+203
	SAD LM1		/SYSTEM TAPE HAS WD 203 = 777777.
	SKP
	JMP BEFCLO	/NON SYSTEM TAPE.
	LAW -30
	DAC KLCNTD
	LAC (Z1BUF+200
	TAD LIT40
	JMS PFILE		/PRINT SYS. PGM. NAMES.
BEFCLO	LAC LSWTCH		/L SWITCH (PRINT SYSBLK) REQUESTED?
	SZA
	JMP SYSBLK		/YES - GO PRINT SYSBLK.
CLOSE	JMS ZCLOS		/CLOSE OUTPUT DEV.
	LAC SRCDAT		/CLOSE SOURCE DEV.
CLOUT	DAC ZCLOSD
	JMS ZCLOS
	JMP ZCEXIT
	.TITLE    DISK DIRECTORY ROUTINES.
/
/ROUTINES FOR LISTING DISK DIRECTORIES.
/
LISTDK	LAC SRCUIC
	DAC CURUIC		/SET UP 'CHKPRO'.
	LAC SRCDAT
	DAC CHKDAT
	LAC SRCDEV
	JMS CHKPRO		/CHECK LEGALITY OF THIS FUNCTION TO THIS UFD.
				/ALSO SETS UP SATBLK,DIRBLK,MFDSZE AND MFNUM.
	DZM NOUFDB
	DZM NOUICS
	LAC LSWTCH		/IF L ONLY, DON'T LIST DIRECTORY.
	SNA
	SKP!CLC
	LAC MSWTCH		/HOWEVER, IF M ON, DO M FIRST.
	SNA
	JMP SYSBLK		/ONLY L SET.
	DAC CNTSW		/SET TO NON-ZERO FOR COUNTING ONLY (1ST TIME THRU).
	DAC FIRST		/SET TO -1 SO WILL GET MFD ENTRY SIZE FIRST TIME ONLY.
	DZM FREEBK
	LAC SATBLK
NXTSAT	DAC ZBLNUM
	JMS ZTRANS		/BRING IN SAT BLOCK TO GET # FREE BLKS.
	LAC* Z1BUFP
	DAC TOTBLK		/WD 0= TOTAL BLOCKS IN SYSTEM.
	LAC Z1BUFP
	TAD LIT2
	DAC SATPT1
	LAC* SATPT1		/WD3= TOTAL BLKS USED IN THIS SAT.
	TAD FREEBK
	DAC FREEBK
	LAC* (Z1BUF+377		/ANOTHER SAT BLK?
	SAD LM1			/777777 = END.
	SKP
	JMP NXTSAT		/THERE IS ANOTHER BLOCK.
	LAC TOTBLK
	CMA
	TAD FREEBK
	CMA
	DAC FREEBK		/# FREE BLOCKS.
CLRCON	DZM FILNUM
	DZM NUMBLK
DELIN	LAC Z1BUFP		/SET UP ZTRANS. (DELETE ROUTINE COMES IN HERE).
	DAC TRNBUF
	LAC DIRBLK
NEWMFD	DAC ZBLNUM
		/EDIT 098  ADD FOLLOWING 3 INSTRUCTIONS
		/PREVIOUSLY WIPE OUT MFD WHEN MORE THAN 1 BLOCK
	LAC ZTRANZ
	AND (777
	DAC ZTRANZ	/COULD PREVIOUSLY HAVE BEEN SET TO WRITE
	JMS ZTRANS		/BRING IN MFD.
	LAC Z1BUFP
TRYAGN	TAD MFDSZE
	DAC MFDPT1
	DAC MFDPT2
	TAD MFNUM
	SPA!SZA
	JMP MFDOK
	LAC* (Z1BUF+377
	SAD LM1
	SKP
	JMP NEWMFD		/ANOTHER MFD - AC= BLOCK #.
	LAC MSWTCH		/IF M, NO PROBLEM.
	SZA!CLC
	JMP DONEYT
	DAC NOUICS
	JMP NOUFD
MFDOK	LAC MSWTCH		/LIST MFD SWITCH ON?
	SZA			/NO.
	JMP TKENTY		/YES - COUNT ENTRY.
	LAC* MFDPT1
	SAD SRCUIC
	JMP TKENTY		/GOT ENTRY MATCH - GO GET UFD.
IDXMFD	LAC MFDPT2
	JMP TRYAGN		/MORE ENTRIES TO LOOK AT.
TKENTY	LAC* MFDPT1		/CAN ONLY BE ZERO IF M SWITCH USED.
	SNA
	JMP IDXMFD		/GET ANOTHER ENTRY.
	IDX MFDPT1
	DAC USEUIC		/SAVE FOR POSSIBLE USE BY DELETE ROUTINE.
	LAC* MFDPT1
	SAD LM1			/IF BLOCK # -1, NO UFD BLOCK PRESENT.
	JMP NOUFD
	DAC ZBLNUM		/UFD FIRST BLOCK NUMBER.
	IDX MFDPT1		/BUMP TO GET UFD ENTRY SIZE.
	LAC* MFDPT1
	AND (77
	DAC UFDSZE
	SNA			/MUST BE GREATER THAN 0, LESS THAN 30.
	JMP USZERR
	TAD LM30
	SMA
	JMP USZERR
	LAC Z2BUFP
	DAC TRNBUF		/SET UP 'ZTRANS' TO BRING UFD INTO BUF2.
NEWUFD	LAC ZTRANZ		/MUST CLEAR OUTPUT BIT
	AND (777		/WHICH IS SET IF DELETING.
	DAC ZTRANZ
	JMS ZTRANS		/BRING IN UFD.
	LAC Z2BUFP
	DAC UFDPT1
	DAC UFDPT2
	TAD (376		/CALCULATE LIMITS OF SEARCH FOR BLOCK.
	CMA
	TAD UFDSZE
	DAC UFNUM
UFDAGN	LAC* UFDPT1		/GET FILE NAME.
	SNA
	JMP INROT		/ZERO ENTRY - GO GET ANOTHER ONE.
	LAC XSWTCH		/IF DELETING,
	SZA
	JMP DELAL1		/RETURN THERE TO PROCESS FILE NAME.
	LAC MSWTCH
	SNA
	JMP MATCH		/NO.
CNTETY	IDX FILNUM		/COUNT FILE.
	LAC UFDPT1
	TAD LIT4
	DAC UFDPT1
	LAC* UFDPT1		/WD 4 OF ENTRY = #BLKS USED BY THIS FILE.
	AND (377777		/(JMW:109) BIT 0 NOT PART OF COUNT.
	TAD NUMBLK
	DAC NUMBLK
INROT	LAC UFDPT2
	TAD UFDSZE
	DAC UFDPT1
	DAC UFDPT2
	LAC DKSW
	SZA
	JMP DKNOMT
	IDX PBLKCT		/BUMP TO NEXT FILES'S BLK CNT.
	ISZ KLCNTD		/MORE FILES?
	JMP UFDAGN		/YES.
	JMP TAPEBK		/NO.
DKNOMT	LAC UFDPT2
	TAD UFNUM		/FINISHED WITH THIS BLOCK?
	SPA!SZA
	JMP UFDAGN		/NO - LOOK AT NEXT ENTRY.
	LAC* (Z2BUF+377
	SAD LM1
	JMP SEEMD1
		/EDIT 098   ADD FOLLOWING INSTRUCTIONS TO ALLOW
		/TRUNCATE SWITCH ON DELETE TO WORK WHEN UFD MORE
		/THAN 1 BLOCK  -  PREVIOUSLY NEVER WROTE PREVIOUS BLOCK OUT
	LAC XSWTCH

	SNA
	JMP RESZBL	/ANOTHER BLOCK, NO X SWTCH
	LAC DESDAT	/WRITE OUT BLOCK
	XOR (10000
	DAC ZTRANZ
	JMS ZTRANS
RESZBL	LAC* (Z2BUF+377
	DAC ZBLNUM
	JMP NEWUFD
		/EDIT 098  DELETE  DAC ZBLNUM, JMP NEWUFD
SEEMD1	LAC XSWTCH		/IF DELETING, GO DO IT.
	SZA
	JMP DELAL2
SEEMFD	LAC MSWTCH
	SNA
	JMP DNEYET
	LAC CNTSW
	SNA
	JMS PRNTNM		/NOT COUNTING - PRINT ENTRY.
BMPMFD	LAC MFDPT2
	TAD MFDSZE
	DAC MFDPT1
	DAC MFDPT2
	TAD MFNUM		/MORE ENTRIES IN MFD?
	SPA!SZA
	JMP MFDOK		/YES - GO GET THE NEXT ONE.
	LAC Z1BUFP
	DAC TRNBUF		/RESET ZTRANS FOR BUF1
	LAC* (Z1BUF+377
	SAD LM1
	SKP
	JMP NEWMFD
DONEYT	LAC XSWTCH		/IF DELETING, CLOSE FROM THERE.
	SZA
	JMP DELOUT
DNEYET	LAC XSWTCH		/HAVE FINISHED AT LEAST 1 UFD.
	SZA
	JMP DELAL2		/GO DELETE ALL TRUNCATED FILES.
	LAC CNTSW
	SNA
	JMP TAPEBK		/DONE - SEE IF L SWITCH ON.
	JMP PRNTHD		/PRINT DIRECTORY HEADER INFO.
MATCH	LAC CNTSW
	SZA
	JMP CNTETY		/COUNTING ONLY.
	LAC LNAME1		/LOOKING FOR SPECIFIC MATCH?
	SNA
	JMP EXTMTH		/NO - SEE IF WANT MATCH ON EXTENSION.
	SAD* UFDPT1
	SKP
	JMP INROT
	IDX UFDPT1
	LAC LNAME2
	SAD* UFDPT1
	SKP
	JMP INROT
EXTMTH	LAC UFDPT2		/WANT MATCH ON EXTENSION?
	TAD LIT2
	DAC UFDPT1
	LAC LEXT
	SNA
	SKP		/NO - DONE.
	SAD* UFDPT1
	JMS PRNTNM		/GOT MATCH - PRINT IT.
	JMP INROT
NOUFD	LAC MSWTCH
	SZA
	JMP SEEMFD
	LAC XSWTCH		/IF DELETING ALL FILES AND FOUND NO UFD, AN ERROR.
	SZA
	JMP ERR25		/'UIC NOT PRESENT IN MFD'.
	DZM FILNUM
	DZM NUMBLK
	CLC
	DAC NOUFDB
	JMP PRNTHD
/
/
/PRINT # USER BLOCKS (DISK ONLY).
/
USEBLK	LAC (LUSEBK
	JMS PRCOMP
NUMBLK	0
	ISZ NOUFDB		/SET TO -1 IF THERE IS NO USD BLOCK.
	JMP CLRCON
	ISZ NOUICS		/SET TO -1 IF UIC NOT PRESENT IN MFD.
	JMP BEFCLO		/EXIT.
	JMP ERR25			/ISSUE ERROR IF NO UIC AT ALL.
/SUBR TO CHECK FOR 24 FILES (SYSTEM TAPE) OR 56 FILES (NON-SYSTEM TAPE).
/
ZFIL56	0
	LAC* (Z1BUF+203		/WD 3OF SYS DIR BIT MAP(WORD 203).
	SAD LM1			/SYSTEM TAPE HAS WORD 203 = 777777.
	JMP SYSTAP
	LAW -70
	SKP
LM30=.
SYSTAP	LAW -30
	JMP* ZFIL56
/
/SUBROUTINE TO COUNT BLOCK OCCUPIED OR FREE.
/AC = SPA!RAL (OCCUPIED COUNT) OR
/AC = SMA!RAL (FREE COUNT).
/
BITCNT	0
	DAC ZLDBIT		/SWITCH
	DZM* PBLKCT		/CLEAR FILE BLOCK COUNT.
LM40	LAW -40		/FILE BITMAP COUNT
	DAC MFDPT1		/CAN USE MFDPT1 BECAUSE NOT USING DISK.
ZLDWRD	LAW -22		/1 WD BIT COUNT
	DAC MFDPT2
	LAC* 12		/NEXT BIT MAP WD
ZLDBIT	XX		/SPA!RAL OR SMA!RAL
	IDX* PBLKCT		/BLOCK COUNT.
	ISZ MFDPT2
	JMP ZLDBIT		/NEXT BIT
	ISZ MFDPT1
	JMP ZLDWRD		/NEXT WORD
	JMP* BITCNT
	.TITLE    DIRECTORY OUTPUT ROUTINES.
/
/SUBROUTINE TO PRINT FILE NAMES
/AC = DIR ENTRY SECT. POINTER
/
PFILE	0
	DAC UFDPT2
KLNXTF	TAD (3
	DAC UFDPT1
	LAC* UFDPT1	/GET FILE COMPLETE BIT
	SPA
	JMP KLFILE		/GOOD FILE
KLNXT	LAC UFDPT1
	TAD (1
	DAC UFDPT2	/NEXT FILE.
	IDX PBLKCT		/UPDATE TO NEXT BLOCK COUNT.
	ISZ KLCNTD
	JMP KLNXTF
	LAC CNTSW		/RETURN TO PUSPR
	SZA		/IF ONLY COUNTING FILES.
	JMP PUSPR
	JMP* PFILE		/DONE.
KLFILE	LAC CNTSW
	SNA
	JMP MATCH
	IDX FILNUM		/USER FILE COUNT.
	LAC* PBLKCT	/BLOCK COUNT.
	TAD TEMP2		/TALLY NON-SYSTEM BLOCK COUNT.
	DAC TEMP2
	JMP KLNXT
/
/SUBROUTINE TO PRINT FILE NAMES AND ASSOCIATED DATA.
/FORM: DISK WITHOUT P SWITCH: FILE NAME *(IF TRUNCATED); #BLKS; DATE.
/  DISK W/ P: NAME *(IF TRUNCATED); START BLK; #BLKS; DATE;RIB PNTR; WD N RIB.
/   DECTAPE: FILE NAME; START BLK; #BLKS.
/
PRNTNM	0
	LAC (BUFFER+2		/USE COMMAND STRING BUFFER.
	JMS SETPUT		/SET UP KLPUT
	LAC MSWTCH
	SZA
	JMP PRNMFD
	LAC UFDPT2
	DAC UFDPT1
	LAC* UFDPT1	/1ST PART OF NAME
	IDX UFDPT1
	JMS KLFSIX		/FROM SIXBT
	LAC* UFDPT1	/LAST PART OF NAME
	IDX UFDPT1
	JMS KLFSIX		/FROM SIXBT
	JMS PACK40		/SPACE.
	LAC* UFDPT1	/EXTENSION
	IDX UFDPT1
	JMS KLFSIX		/FROM SIXBT
	LAC DKSW
	SNA
	JMP BLKOUT
	LAC* UFDPT1
	SMA			/TRUNCATED FILE? (BIT0=1=TRUNCATED).
	JMP BLKOUT
	LAC STAR		/YES - OUTPUT * AFTER FILE NAME.
	JMS KLPUT
	SKP
BLKOUT	JMS PACK40
	JMS PACK40
	LAC DKSW
	SNA
	JMP STRTBK
	LAC PSWTCH		/IF DISK AND PSWTCH NOT SPECIFIED,
	SNA			/DON'T OUTPUT STARTING BLOCK NUMBER.
	JMP DKPRNT
STRTBK	LAC* UFDPT1		/STARTING BLOCK NUMBER.
	AND (177777
	JMS KLFOCT		/OCTAL TO 7BIT ASCII
	LAC DKSW		/DECTAPE DIRECTORY?
	SZA			/YES.
	JMP DKPRTP		/NO.
	LAC BLPRNT		/BLK PRINT SWITCH SET?
	SNA
	JMP KLCR		/NO - OUTPUT CR
	JMS PACK40		/SPACE.
	LAC* PBLKCT		/BLOCK COUNT - CURRENT FILE.
	AND (177777		/LOOK AT ONLY 16 BITS.
	JMP KLCR1
DKPRTP	LAC OPAREN		/OUTPUT FILE PROTECTION CODE.
	JMS KLPUT
	LAC UFDPT2
	TAD (6
	DAC OCTDEC		/VERY TEMP STORAGE.
	LAC* OCTDEC
	RTL; RTL
	AND (7
	TAD (60
	JMS KLPUT
	LAC CPAREN
	JMS KLPUT
DKPRNT	IDX UFDPT1		/NUMBER BLOCKS USED.
	LAC* UFDPT1
	AND (377777	/EDIT 099 INSERTION     ALLOWS FOR RSX CONTIGUOUS FILES
	JMS KLFOCT
	JMS PACK40
	JMS PACK40
	LAC UFDPT2		/OUTPUT DATE WITH DISK DIRECTORIES.
	TAD (7			/DATE IN WORD 10(8).
	DAC COMWPC		/TEMP STORAGE.
	LAC* COMWPC
	SZA
	JMS CALUDA		/PACK DATE.
	LAC PSWTCH		/WANT 'RIB' INFO?
	SNA
	JMP KLCR		/NO.
	JMS PACK40		/SPACE.
	IDX UFDPT1
	LAC* UFDPT1		/RIB POINTER. (WORD 6)
	JMS KLFOCT
	JMS PACK40		/SPACE.
	IDX UFDPT1
	LAC* UFDPT1		/WORD IN RIB.  (WORD 7)
	AND (777		/ONLY BIT 9-17.
KLCR1	JMS KLFOCT
KLCR	JMS LNEOUT		/OUTPUT LINE.
	JMP* PRNTNM
/PRINT DIFFERENT INFO FOR MFD.
/FORM:  UIC NAME; UFD BLOCK #(PROTECTION); # FILES; # BLOCKS
PRNMFD	LAC MFDPT2
	TAD LIT2
	DAC MFDPT1
	LAC PIPMIC		/IF LOGGED-IN UIC=MIC, PRINT ALL INFORMATION.
	SZA
	JMP PRNTAL
	LAC* MFDPT1		/OTHERWISE, PRINT UIC NAME ONLY IF PROTECTION=0.
	SMA
	JMP PRNTAL
	DZM FILNUM
	DZM NUMBLK
	JMP* PRNTNM
PRNTAL	LAC MFDPT2
	DAC MFDPT1
	LAC* MFDPT1		/UIC NAME.
	JMS KLFSIX
	JMS PACK40		/SPACE.
	IDX MFDPT1
	LAC* MFDPT1		/UFD BLOCK #.
	SAD LM1
	JMP PRTNON		/NO UFD BLOCK #.
	JMS KLFOCT
OUTPRO	LAC OPAREN		/LEFT PAREN.
	JMS KLPUT
	IDX MFDPT1
	LAC* MFDPT1		/OUTPUT DIRECTORY PROTECTION CODE.
	RAL			/BIT 0=1=1.
	LAC (60		/BIT 0=0=0.
	SZL
	LAC (61
	JMS KLPUT
	LAC CPAREN		/RIGHT PAREN.
	JMS KLPUT
	JMS PACK40
	LAC FILNUM		/# FILES FOR THIS UIC.
	JMS KLFOCT
	LAC NUMBLK		/# BLOCKS USED BY THIS UIC.
	JMS KLFOCT
	JMS PACK40
	DZM FILNUM
	DZM NUMBLK
	JMP KLCR
PRTNON	JMS PACK40		/NEED 3 SPACES TO LINE UP ENTRY.
	JMS PACK40
	JMS PACK40
	LAC NON
	JMS KLFSIX
	JMP OUTPRO
/
	.TITLE    SYSBLK LISTING ROUTINE.
/
/ROUTINE TO LIST SYSBLK.
/SYSBLK IS POINTED TO BY WORD 3 OF MFD (DISKS) AND WORD 202 OF THE DECTAPE
/DIRECTORY.  IT IS CONTAINED ON 1 BLOCK ON DECTAPE, BUT TAKES 2
/CONTIGUOUS BLOCKS ON BOTH DISKS.  EACH ENTRY IS 7 WORDS LONG: 1,2=6 CHAR NAME IN
/.SIXBT; 3=STARTING BLOCK NUMBER; 4=NUMBER BLOCKS USED BY THE FILE; 5=FIRST ADDRESS;
/6=PROGRAM SIZE; AND 7=START ADDRESS.
/
SYSBLK	LAC (BUFFER+2
	JMS SETPUT		/SET UP TO OUTPUT DIRECTORY.
	JMS LNEOUT		/OUTPUT CR TO SEPARATE POSSIBLE MFD LISTING
	LAC (BUFFER+2		/FROM SYSBLK LISTING.
	JMS SETPUT
	LAC (SYSHDR		/'SYSBLK LISTING', CR AND DESCRIPTIVE HEADER.
	JMS PACKBF
	JMS COMWPC
	LAC (BUFFER
	JMS PROUT
	LAC (BUFFER+2
	JMS SETPUT
	JMS LNEOUT
	LAC (BUFFER+2
	JMS SETPUT
	LAC (SYSHD1
	JMS PACKBF
	JMS COMWPC
	LAC (BUFFER
	JMS PROUT
	STL
	LAC SRCDAT
	JMS ZSETTR
	JMS ZTRANS		/BRING IN DIRECTORY.
	LAC DKSW
	SNA
	JMP DTSYSB		/GO SET UP FOR DECTAPE.
	LAC Z1BUFP
	TAD LIT2
	DAC MFDPT1		/WORD 3 OF MFD = SYSBLK # (OR 777777 IF NONE).
	LAW -1000
	DAC TRANWD		/SET UP TO BRING IN TWO BLOCKS FROM DISK.
DTBACK	LAC* MFDPT1		/GET SYSBLK NUMBER.
	SAD LM1
	JMP ERR31			/THERE IS NO SYSBLK.
	DAC ZBLNUM
	JMS ZTRANS		/BRING IN SYSBLK (1 BLK ON DECTAPE, 2 ON DISK).
	LAC Z1BUFP		/CALCULATE LIMITS FOR SEARCH ON DIRECTORY BLOCK.
	TAD* Z1BUFP		/FIRST WORD OF SYSBLK POINTS TO FIRST FREE LOC.
	CMA
	TAD (7
	DAC MFNUM		/LAST LEGAL ADDRESS OF SEARCH.
	LAC Z1BUFP
	TAD (1			/SKIP OVER FIRST WORD OF SYSBLK.
	DAC MFDPT1
	DAC MFDPT2
MORSYS	LAC (BUFFER+2
	JMS SETPUT
	LAC* MFDPT1
	SNA
	JMP IDXSYS
	JMS KLFSIX		/OUTPUT FIRST 3 CHARS OF SIXBIT NAME.
	IDX MFDPT1
	LAC* MFDPT1
	JMS KLFSIX		/SECOND 3 CHARS OF NAME.
	JMS PACK40		/SPACE.
	LAW -5
	DAC TIMES
SYSBOT	IDX MFDPT1		/OUTPUT WORDS 3-7 OF ENTRY.
	LAC* MFDPT1
	JMS KLFOCT
	ISZ TIMES
	JMP SYSBOT
	JMS PACK40			/SPACE.
	JMS LNEOUT		/OUTPUT ASSEMBLED LINE.
IDXSYS	LAC MFDPT2
	TAD (7
	DAC MFDPT1
	DAC MFDPT2
	TAD MFNUM		/POSSIBILITIES OF MORE ENTRIES?
	SPA!SZA
	JMP MORSYS		/YES - GO GET THE NEXT ONE.
	JMP CLOSE		/NO - CLOSE .DAT SLOTS AND LEAVE.
DTSYSB	LAC Z1BUFP		/SET UP TO GET SYSBLK FROM DECTAPE.
	TAD (202
	DAC MFDPT1
	TAD (1
	DAC MFDPT2
	LAC* MFDPT2
	SAD LM1
	JMP DTBACK		/WORD 203 OF DECTAPE DIRECTORY IS -1 IF SYSTEM.
	JMP ERR31		/'SYSBLK NOT ON DEVICE'.
SYSHDR	.ASCII 'SYSBLK LISTING'<15>
SYSHD1	.ASCII ' NAME      FB    NB    FA    PS    SA'<15>
/VARIABLES USED EXCLUSIVELY IN LIST ROUTINE.
/
SYSCT	0			/NUMBER SYSTEM BLOCKS ON DECTAPE.
CNTSW	0			/SET TO NON-ZERO IF COUNTING ONLY.
MFNUM	0			/NUMBER ENTRIES IN MFD (MINUS).
MFDSZE	0			/LENGTH OF EACH ENTRY IN MFD.
UFDSZE	0			/LENGTH OF EZCH ENTRY IN WORKING UFD.
UFNUM	0			/LENGTH OF UFD BLK MINUS ONE ENTRY.
TOTBLK	0			/TOTAL NUMBER BLOCKS IN SYSTEM.
LNAME1	0		/THESE THREE REGISTERS HOLD NAME AND
LNAME2				/EXTENSION IF EXACT MATCH DESIRED.
LEXT	0			/OTHERWISE, ZERO.
MFDPT1	0			/POINTER USED TO LOOK AT MFD ENTRIES.
MFDPT2	0
UFDPT1	0			/POINTER USED TO LOOK AT UFD ENTRIES.
UFDPT2	0
SATPT1	0			/POINTER TO LOOK AT SAT INFO.
PBLKCT	0			/POINTER TO BLOCK COUNT (DECTAPE).
MSGPNT	0		/POINTER TO ERROR MSG TO OUTPUT.
ERRSZE	0		/HOLDS ILLEGAL ENTRY SIZE (UFD OR MFD).
NOUFDB	0		/SET TO -1 OF NO USD BLOCK BUT UFD IN MFD.
NOUICS	0		/SET TO -1 IF UFD NOT IN MFD.
NAMFD	.SIXBT /MFD/
NON	.SIXBT /NON/
YEAR	0
DAY	0
DATE	0
DATE1	0
TIMES	0
KLCNTD	0
	.TITLE CHKPRO:SUBROUTINE TO CHECK FUNCTION AGAINST UFD.
/SUBROUTINE TO CHECK THAT FUNCTION IS LEGAL TO THIS UFD.
/IF THE DESTINATION DEVICE IS THE DK OR DP AND THE FUNCTION INVOLVES
/OUTPUT (OR INTPUT FOR T), THE DIRECTORY MUST BE UNPROTECTED OR THE LOGGED-IN
/UIC =MIC (PIPMIC=400000) OR THE SPECIFIED UIC = PIPUIC.
/AC = DEVICE TO BE CHECKED ON ENTRY.
/CHKDAT MUST BE SET TO EITHER DESDAT (DEFAULT) OR SRCDAT.
/CURUIC MUST BE SET TO EITHER SRCUIC OR DESUIC.
/ON T OR R FUNCTIONS, L=1 CAUSES CHECKING OF PROTECTION OF SPECIFIC FILE.
/SET UP DIRBLK,SATBLK,MFDSZE,MFNUM,UFDSZE WHICH CAN BE USED BY CALLING ROUTINE.
CHKPRO	0
	DAC CHKDEV		/AC= DEVICE CODE.
	DZM DKSW
	SAD DSKPAK		/DISK PACK?
	JMP CHKPAK
	SAD DECDSK		/DEC DISK?
	SKP
	SAD DECPAK		/DISK CARTRIDGE?
	JMP DPACK
	JMP* CHKPRO		/NOT DISKS - EXIT.
DPACK	LAC (RFMFD		/SET UP FOR DECDISK./DISK CART.
	SKP
CHKPAK	LAC (DPMFD		/SET UP FOR DISK PACK.
	DAC DIRBLK
	GLK			/GET LINK IN CASE OF T FUNCTION.
	DAC FILESW
	CLC
	DAC FIRST
	DAC DKSW
	LAC CHKDAT
	STL			/L=1 FOR INPUT.
	JMS ZSETTR		/SET UP TO BRING IN MFD.
CNWMFD	JMS ZTRANS		/GET MFD BLOCK.
	ISZ FIRST
	JMP CKPRO1
	LAC Z1BUFP		/ON FIRST MFD BLOCK, MUST GET MFD ENTRY SIZE.
	TAD (3
	DAC CMFDPT
	LAC* CMFDPT		/FIRST SAT BLOCK IN BITS 3-17.
	AND (77777
	DAC SATBLK
	LAC* CMFDPT		/ENTRY SIZE IN THIRD WORD OF MFD. (BITS 0-2)
	RTL; RTL
	AND (7
	DAC MFDSZE
	SNA			/ENTRY SIZE MUST BE GREATER THAN 0 AND LESS THAN 30.
	JMP MSZERR
	TAD LM30
	SMA
	JMP MSZERR
CKPRO1	LAC Z1BUFP		/SET UP LIMITS FOR SEARCH ON MFD BLOCK.
	TAD (376
	CMA
	TAD MFDSZE
	DAC MFNUM
	LAC Z1BUFP
NXTUIC	TAD MFDSZE		/INDEX TO NEXT ENTRY.
	DAC CMFDPT
	TAD MFNUM		/LOOKED AT ENTIRE BLOCK?
	SPA!SZA
	JMP CMFDOK
	LAC* (Z1BUF+377		/YES - ANOTHER MFD BLOCK?
	SAD LM1			/LINKAGE ENDS WITH 777777.
	JMP CHKERR
	DAC ZBLNUM		/BLOCK NUMBER OF NEXT MFD BLOCK.
	JMP CNWMFD
CMFDOK	LAC* CMFDPT
	SAD CURUIC		/MATCH?
	JMP GOTUIC
	LAC CMFDPT		/NO MATCH - TRY AGAIN.
	JMP NXTUIC
GOTUIC	LAC CMFDPT		/THIRD WORD OF UIC ENTRY IN MFD HAS PROTECTION:
	TAD (2			/   BIT 0=0 FOR NO PROTECTION.
	DAC CHKDEV		/   BIT 0=1 FOR PROTECTION.
	LAC* CHKDEV
	DAC CHKDEV		/TEMP STORAGE FOR PROTECT CODE.
	AND (77			/UFD ENTRY SIZE IN BITS 12-17.
	DAC UFDSZE
	SNA
	JMP USZERR		/MUST BE GREATER THAN 0 AND LESS THAN 30.
	TAD LM30
	SMA
	JMP USZERR
	LAC CHKDEV
	SMA
	JMP* CHKPRO		/(JMW: 108) NOT PROTECTED, FILE PROT. CODES DON'T COUNT.
	LAC CURUIC
	SAD PIPUIC
	JMP CHKPO2		/OK - DOING FUNCTION TO OWN UIC.
	LAC PIPMIC		/IF LOGGED-IN UIC=MIC, NO PROTECTION.
	SPA
	JMP CHKPO2		/OK -MIC IN.
	LAC FUNCDE
	SAD FUNCC		/IF C FUNCTION AND SOURCE, FILE PROTECTION
	JMP CHKSRC		/IS WHAT COUNTS.
	SAD FUNCL		/NOT ALLOWED TO LIST A PROTECTED DIRECTORY.
	JMP ERR23		/ILLEGAL FUNCTION FOR UIC.
	SZA			/IF T AND SRC, FILE PROTECTION IS WHAT MATTERS.
	JMP CHKERR
	LAC FILESW
	SZA
	JMP LOKFLE
CHKERR	RAL			/IF FAILED ON FOREWARD DATA LINK=-1, L=1. (UIC NOT IN MFD)
	LAC FUNCDE		/IF L FUNCTION AND NO MATCH, RETURN SO CAN
	SAD FUNCL		/LIST TOP PART OF DIRECTORY ANYWAY.
	JMP* CHKPRO
	SAD FUNCC		/IF C FUNCTION, GO BACK AND DO FUNCTION.
	JMP* CHKPRO
	LAC DIRSWH		/IF NEWDIR OR N SWITCH, RETURN AND PROCESS
	DZM DIRSWH
	SZA			/SITUATION THERE.
	JMP NOUIC		/DIRSWH = NON-0 IF N OR S.
	SNL
	JMP ERR23		/ILLEGAL FUNCTION FOR UIS.
	LAC FUNCDE		/IF T FUNCTION, GO BACK.
	SZA
	JMP ERR25		/UIC NOT PRESENT IN MFD.
	JMP* CHKPRO
CHKSRC	LAC FILESW			/MUST BE SET TO INDICATE SOURCE SIDE.
	SZA
	JMP* CHKPRO		/OK.
	JMP ERR23		/ILLEGAL FUNCTION FOR UIC.
CHKPO2	LAC FUNCDE		/IF T OR R FUNCTION, MAY WANT TO CHECK PROTECTION ON FILE.
	SZA
	SAD FUNCR
	SKP
	JMP* CHKPRO		/NOT T OR R- SUCCESS EXIT.
	LAC FILESW		/L=1 ON ENTRY IF TO CHECK FILE.
	SNA
	JMP* CHKPRO		/NO - DONE SUCCESSFULLY.
LOKFLE	LAC CMFDPT
	TAD (1
	DAC CHKDEV
	LAC* CHKDEV		/UFD BLOCK NUMBER.
	SAD LM1
	JMP ERR06			/NONE EXISTS; THEREFORE, FILE NOT ON DEVICE.
CHKUFD	DAC ZBLNUM
	LAC Z2BUFP
	DAC TRNBUF		/PUT UFD IN Z2BUF.
	JMS ZTRANS
	LAC Z2BUFP
	DAC CMFDPT
	DAC CMFDP2
	TAD (376		/SET UP LIMITS FOR SEARCH ON BLOCK.
	CMA
	TAD UFDSZE
	DAC UFNUM
CHKAGN	LAC ZSFILP		/POINTER TO FILE NAME.
	DAC CHKNAM
	LAC* CMFDPT
	SAD* CHKNAM
	JMP CHKMAT		/GOT MATCH ON FIRST 3 LETTERS.
CHKIDX	LAC CMFDP2
	TAD UFDSZE
	DAC CMFDPT
	DAC CMFDP2
	TAD UFNUM
	SPA!SZA
	JMP CHKAGN
	LAC* (Z2BUF+377
	SAD LM1
	JMP ERR06			/FILE NOT FOUND ON DEVICE.
	JMP CHKUFD
CHKMAT	IDX CMFDPT
	IDX CHKNAM
	LAC* CMFDPT
	SAD* CHKNAM
	SKP
	JMP CHKIDX
	IDX CMFDPT
	IDX CHKNAM
	LAC* CMFDPT
	SAD* CHKNAM
	SKP
	JMP CHKIDX
	LAC CMFDP2
	TAD LIT6			/PROTECTION CODE IN BITS 0-2 OF WORD 6.
	DAC CMFDPT
	LAC* CMFDPT
	AND MASK2		/(700000.
	SNA
	JMS PROTER		/PROTECTION CODE OF 0 ILLEGAL.
	XOR (300000
	SZA
	JMP* CHKPRO		/SOMETHING OTHER THAN 3 -OK.
	LAC CURUIC		/CODE OF 3 DOESN'T LOCK OUT OWNER OR
	SAD PIPUIC		/MIC.
	JMP* CHKPRO
	LAC PIPMIC
	SPA
	JMP* CHKPRO
	JMP ERR27		/PROTECTION VIOLATION.
PROTER	0			/ILLEGAL PROTECTION CODE - SIMPLY ANNOUNCE IT
	LAC (BUFFER+2		/AMD GO ON.
	JMS SETPUT
	LAC (ILPCOP
	JMS PACKBF
	JMS COMWPC
	JMS PRSET
	LAC (BUFFER
	JMS PROUT
	CLA
	JMS* PROTER
USZERR	LAC (LILUIC		/ILLEGAL UFD ENTRY SIZE.
	DAC MSGPNT
	LAC UFDSZE
	JMP LEROUT
MSZERR	LAC (LILMFD		/ILLEGAL MFD ENTRY SIZE.
	DAC MSGPNT
	LAC MFDSZE
LEROUT	DAC ERRSZE
	LAC (BUFFER+2
	JMS SETPUT
	LAC MSGPNT
	JMS PACKBF
	DZM PUTC		/STRIP CARRIAGE RETURN FROM MESSAGE.
	LAC ERRSZE		/APPEND ENTRY SIZE IN ERROR.
	JMS KLFOCT
	JMS PRSET		/SET UP PROUT.
	JMS LNEOUT		/OUTPUT LINE.
	JMP RESTRT
/
CMFDPT	0			/POINTER (INDEXED) TO LOOK AT MFD.
CHKDEV	0			/DEVICE IN QUESTION (IN AC ON ENTRY).
CURUIC	0
CHKDAT	0
FILESW	0
CHKNAM	0
CMFDP2	0
PIPBUF=.			/USED BY RCOPY AS A BUFFER POINTER.
	.TITLE ERROR: ERROR HANDLING ROUTINES.
	.TITLE    ERROR MESSAGE DISPATCH
/
/AS MANY ERROR CONDITIONS AS POSSIBLE ARE DISPATCHED FROM HERE.  IN CASES WHERE
/THE LOCATION OF AN ERROR IS IMPORTANT FOR RESUMING OPERATION UPON RECEIPT
/OF CORRECTED INFORMATION (MOST APPLICABLE ONLY DURING COMMAND STRING DECODING),
/IT IS NOT POSSIBLE TO DISPATCH FROM HERE.
/NOTE THAT ZECHO IS CLEARED ONCE THE COMMAND DECODER IS FINISHED.
/
ERR00	CLA
	JMS ECHOCS
	JMP GTFUNC
ERR02	LAC LIT2			/'ILLEGAL TERMINATOR'
	JMS ECHOCS
	JMP LSTCAR
ERR01	LAC (1		/'ILLEGAL DEVICE OR UNIT.
	SKP
ERR03	LAC (3		/DEVICE NOT IN +.DAT TABLE.
	SKP
ERR04	LAC LIT4		/'DEVICE ILLEGAL FOR OPTION OR FUNCTION'
	JMS ECHOCS
	JMP GTDEV2
ERR05	LAC (5		/FILE NAME TOO LONG.
	SKP
ERR06	LAC LIT6		/FILE NOT ON INPUT DEVICE.
	JMS ECHOCS
ERRBAK	DZM DATAMD
	SAD LFTCRT		/ALLOW FOR SPECIFIED UIC HERE.
	JMS CAROT
	JMP FLEA
ERR10	LAC LIT10			/SWITCH CONFLICT.
	SKP
ERR11	LAC LIT11		/NEED DATA MODE.
	SKP
ERR07	LAC (7		/ILLEGAL SWITCH.
	JMS ECHOCS
	JMP ER7BAK
ERRPAR	XOR LIT40		/PARITY OR CHECKSUM ERROR.
	SZA!CLA
	LAC (1		/PARITY ERROR. (ERR13)
	TAD LIT12		/CHECKSUM ERROR.  (ERR12)
	JMS ECHOCS
ERR14	LAC LIT14		/S FUNCTION NOT DONE.
	JMS ECHOCS
ERR15	LAC LITCR		/TOO FEW DESTINATION FILES.
	JMS ECHOCS
ERR16	LAC LIT16		/TOO MANY FILES.
	JMS ECHOCS
ERR17	LAC (17		/INPUT LINE TOO LONG.
	JMS ECHOCS
ERR21	LAC (21		/ILLEGAL BLOCK NUMBER.
	JMS ECHOCS
	JMP ERRBAK
ERR22	LAC LIT22		/ONLY STRINGS 1-16 ACCEPTED.
	DZM ECHOCS
	JMS ECHOCS
ERR23	LAC (23		/ILLEGAL FUNCTION FOR UIC.
	JMS ECHOCS
ERR24	LAC LIT24		/ILLEGAL UIC.
	JMS ECHOCS
	JMP IGNRSP
ERR25	LAC (25		/UIC NOT PRESENT IN MFD.
	JMS ECHOCS
ERR26	LAC (26		/NEED BLOCK NUMBER.
	DZM ECHOCS
		/EDIT 100:  FORMERLY  JMP GTFILE
		/CHANGED TO HANDLE UPDATE WITHOUT A SPECIFIED BLOCK
	JMS ECHOCS
ERR27	LAC (27		/PROTECTION VIOLATION.
	JMS ECHOCS
ERR30	LAC (30		//ILLEGAL PROTECTION CODE.
	JMS ECHOCS
	JMP CPROTA
ERR31	LAC (31		/SYSBLK NOT PRESENT ON DEVICE.
	JMS ECHOCS
ERR32	LAC (32		/DISK FULL.
	JMS ECHOCS
ERR33	LAC (33			/NULL FILE NAME ILLEGAL.
	JMP ERR06+1
ERR34	LAC (34			/'ILLEGAL COMMAND STRUCTURE'
	DZM ZECHO		/NO RESTART ON THIS ERROR.
	JMS ECHOCS
ERR35	LAC (35
	JMS ECHOCS
ERR36	LAC (36			/FILE ALREADY PRESENT
	JMS ECHOCS
ERR37	LAC (37
	JMS ECHOCS
	.TITLE    ERROR MESSAGE TABLE.
ERMSGS	ERMSG0
	ERMSG1
	ERMSG2
	ERMSG3
	ERMSG4
	ERMSG5
	ERMSG6
	ERMSG7
	ERMSG8
	ERMSGB
	ERMSGD
	ERMSGE
	ERMSGF
	ERMSGG
	ERMSGH
	ERMSGJ
	ERMSGK
	ERMSGL
	ERMSGM
	ERMSGN
	ERMSGO
	ERMSGP
	ERMSGQ
	ERMSGR
	ERMSGT
	ERMSGU
	ERMSGV
	ERMSGW
	ERMSGX
	ERMSGY
	ERMSGZ
	ERMSGA
	.TITLE    ECHOCS: ERROR MESSAGE PROCESSOR.
/SUBROUTINE TO OUTPUT DESCRIPTIVE ERROR MESSAGE AND THEN ECHO
/COMMAND UP TO BUT NOT INCLUDING ERRONEOUS CHARACTER OR ELEMENT
/FOLLOWED BY A QUESTION MARK (?).
/ENTER WITH ERROR MESSAGE NUMBER IN AC.
/EXITS WITH 1ST NEW CHARACTER IN THE AC
/
ECHOCS	0
	TAD (LAC ERMSGS	/PICK UP ADDRESS
	DAC .+1		/OF ERROR MESSAGE LINE BUFFER
LACALB	XX
	DAC ERRLNE
	DZM PIPAGN		/SUPPRESS 'PIP'
	LAW 77		/?
	DAC* VALOUT
	ISZ VALOUT
	LAW 177
	DAC* VALOUT	/RUBOUT - IN CASE CHAR. COUNT UNEVEN
	LAC (CMECHO	/COMPUTE WORD PAIR
	CMA		/COUNT AND PLACE
	TAD VALOUT	/IN LINE BUFFER
	TAD (5		/HEADER
	JMS R8L
	AND (377000
	DAC CMDOUT
/
/	.WRITE -3,2,XX,34	/OUTPUT APPROPRIATE
	CAL+2775		/ERROR MESSAGE IN IOPS
	11		/ASCII MODE
ERRLNE	XX
	-42
/	LAC* (BOSS		/BIT0=1 IF BOSS MODE.		/RKB-113
/	SPA							/RKB-113
/				/(RKB-113) ABOVE TWO LINES REPLACED
/				/(RKB-113) WITH FOLLOWING FOUR LINES:
	.WAIT	-3		/(RKB-113) WAIT FOR TTY
	LAC*	(SC.NMF)	/(RKB-113) GET BATCH OR BOSS BIT
	AND	(SC.BCH)	/(RKB-113) TEST IT
	SZA			/(RKB-113) SKIP IF NEITHER BATCH OR BOSS
BOSJMP	JMP BOSEXT		/EXIT ON ERROR IN BOSS MODE. (MODIFIED)
	ISZ ZECHO
ERRJMP	JMP RESTRT		/NO ECHO (MODIFIED)
/
/	.WRITE -3,3,CMDOUT,84	/ECHO VALID PORTION
	CAL 3775		/OF ERRONEOUS
	11		/COMMAND STRING
	CMDOUT		/IMAGE ALPHA MODE
	-124
/	LAC 17777		/CHECK BATCH (NON-BOSS).	/RKB-133
/	AND (700000						/RKB-113
/	SZA		/NOT BATCH, WAIT FOR CORRECTION		/RKB-113
/	JMP RESTRT	/BATCH, RESTART				/RKB-113
/			/(RKB-113) ABOVE FOUR LINES DELETED.
	JMS READTT	/GO READ KEYBOARD
	LAW -1		/REPLACE
	DAC ZECHO
	TAD VALOUT		/QUESTION MARK
	DAC LACALB		/WITH
	LAW 40			/SPACE.
	DAC* LACALB
	LAC VALOUT		/RESET POINTERS TO REFLECT ONLY VALID
	DAC ALLOUT		/PART OF COMMAND STRING.
	JMS GETCHR
	SAD LITCR		/IS 1ST CHAR. CARRIAGE RETURN
LITJMP	JMP RESTRT		/YES --- COMMAND TO BE RETYPED
	SAD ALTMODE		/ALSO RESTART ON AN ALTMODE.
	JMP RESTRT
	JMP* ECHOCS	/NO --- COMMAND TO BE CONTINUED.
	.TITLE    ERROR MESSAGE TEXTS.
ZOUTCP	002000		/WPC=2
TEMP2	0
	.ASCII	<12><136>'P'<15>	/LF ^P CR
OUTBRK	002000		/WORD PAIR COUNT OF 2
	0
LIT12=.
LF=.
FUNCB	12		/L.F
RTCRT	76		/>
EOTLIN	EOTEND-EOTLIN/2*1000
	0
	.ASCII <11>'.EOT'<15>
EOTEND=.
FFLIN	FFEND-FFLIN/2*1000	/FF,CR
	0
	.ASCII <14><15>
FFEND=.
/
LDIRHD	.ASCII 'DIRECTORY LISTING  '<15>
/
LUSEFL	.ASCII 'USER FILES'<15>
	.LOC .-1
LSYSBK	.ASCII ' SYSTEM BLKS '<15>
LILLCT	.ASCII '  ILL CNT'<15>
LFREE	.ASCII 'FREE BLKS'<15>
LUSEBK	.ASCII 'USER BLKS'<15>
LILUIC	.ASCII 'ILL UFD ENTRY SIZE: '<15>
	.LOC .-1
LILMFD	.ASCII 'ILL MFD ENTRY SIZE: '<15>
	.LOC .-1
ILPCOP	.ASCII 'WARNING: FILE HAS ILL P CODE'<15>
/NOTE THAT ALL HEADER WORDS ARE EQUATED TO THE LAST WORD OF THE PRECEDING
/MESSAGE.  THE WORD CANNOT HAVE BITS 1-8=0; IF A MESSAGE IS CHANGED, BE
/CAREFUL TO INSURE THAT THOSE BITS ARE NOT 0 (THE TTY HANDLER TERMINATES
/ON A 0 WORD COUNT).
/
ERRMSG=.-1				/-2
TEMPQ	0			/TEMP.
	.ASCII 'COMMAND STRING TOO LONG'<15>
FULLER=.-1				/-1
DESTSW	0		/NON0=DEST BLKS IN COMM STRING
	.ASCII 'TOO MANY FILES OR BLOCKS'<15>
/
ERMSG0=.-1			/0
GSWTCH	0		/NON0= G SWITCH ENCOUNTERED
	.ASCII 'ILL FUNCTION'<15>
ERMSG1=.-1			/1	(1)
ALLOUT	0			/POINTER TO NEXT CHAR IN COMMAND STRING.
	.ASCII 'ILL DEV/UNIT'<15>
LH5=.-1			/USED AS CONSTANT.
ERMSG2=.-1					/2
STRCNT	0		/SPLIT STRING COUNT
	.ASCII 'ILL TERMINATOR'<15>
ERMSG3=.-1			/3	(3)
PAPER	0			/LAW 1=PR; LAW 2=PP; LAW 3=BOTH.
	.ASCII 'DEV NOT IN +.DAT'<15>
	.LOC .-1
ERMSG4=.-1					/4
DMPSW	0			/DUMP + PR SWITCH = 2.
	.ASCII 'DEV ILL FOR OPTION/FUNCTION'<15>
ERMSG5=.-1			/5	(5)
SPROOM	0		/SPLIT COUNT
	.ASCII ' FILE NAME TOO LONG'<15>
ERMSG6=.-1			/6	(6)
DIRECT	0			/0=DESTINATION SIDE OF COMMAND STRING; 1=SOURCE.
	.ASCII 'FILE NOT ON INPUT DEV'<15>
	.LOC .-1
ERMSG7=.-1					/7
YSWTCH	0		/NON0=Y SWITCH ON
	.ASCII 'ILL SWITCH'<15>
	.LOC .-1
ERMSG8=.-1					/10
TDATA=.
TCOUNT	0
	.ASCII ' SWITCH CONFLICT'<15>
	.LOC .-1
ERMSGB=.-1					/11
ZLSAV1	0		/T. STORE
	.ASCII 'NEED DATA MODE'<15>
/
ERMSGD=.-1			/10	(12)
DELSW	0		/DELETE OUTPUT LINE SWITCH (NON 0 = DEL)
	.ASCII 'CHKSUM ERR'<15>
	.LOC .-1
ERMSGE=.-1			/11	(13)
DEVPNT	0			/USED IN CCMMAND STRING TO POINT TO DEV TABLE.
	.ASCII 'PARITY ERR'<15>
	.LOC .-1
ERMSGF=.-1					/14
BLPRNT	0		/BLOCK PRINT SWITCH (0=CLEAR, NOT 0=SET)
	.ASCII 'S FUNCTION NOT DONE'<15>
ERMSGG=.-1					/15
VALOUT	0			/POINTER TO NEXT VALED CHAR IN COMMAND STRING.
	.ASCII 'TOO FEW FILES'<15>
ERMSGH=.-1			/14	(16)
WSWTCH	0			/NON-0 = W OPTION REQUESTED WITH T FUNCTION.
	.ASCII 'TOO MANY FILES'<15>
ERMSGJ=.-1			/15	(17)
QSWTCH	0			/NON-0 = Q OPTION REQUESTED WITH T FUNCTION.
	.ASCII 'INPUT LINE TOO LONG'<15>
ERMSGK=.-1			/16	(20)
DIRSWH	0			/S,N SWITCH: 1=S, 2=N.
CMPERR	.ASCII 'READ-COMP ERR ON BLK:'<15>
	.LOC .-1
ERMSGL=.-1					/21
CETSW	0		/1=E, 2=C, 4=T
	.ASCII 'ILL BLK #'<15>
ERMSGM=.-1			/18	(22)
VCMD	0		/NON0 = VERIFY ON
	.ASCII 'STRINGS 1-16 ACCEPTED'<15>
	.LOC .-1
ERMSGN=.-1					/23
TEMP	0
	.ASCII 'ILL FUNCTION FOR UIC'<15>
	.LOC .-1
ERMSGO=.-1					/24
TCHAR	0
	.ASCII 'ILL UIC'<15>
ERMSGP=.-1					/25
TEMP1	0
	.ASCII 'UIC NOT IN MFD'<15>
ERMSGQ=.-1					/26
ZECHO	0			/ERROR MSG SWITCH: -1=ECHO; 0=NO ECHO.
	.ASCII 'NEED BLK#'<15>
ERMSGR=.-1					/27
ZENTP	0			/TEMP. POINTER.
	.ASCII 'P VIOLATION'<15>
	.LOC .-1
ERMSGT=.-1				/30.
USWTCH	0			/SET TO NON-ZERO IF DOING UPDATE.
	.ASCII 'ILL P CODE'<15>
	.LOC .-1
ERMSGU=.-1					/31
OTROOM	0			/BLOCK COUNTER (FILES).
	.ASCII 'SYSBLK NOT ON DEV'<15>
ERMSGV=.-1					/32
CORSPC	0			/.SCOM VALUE OF SPECIFIED CORE IN S SWITCH.
	.ASCII 'DISK FULL'<15>
ERMSGW=.-1				/33
KSWTCH	0			/NON-0 = K REQUESTED WITH N FUNCTION.
	.ASCII 'NULL FILE NAME ILL'<15>
ERMSGX=.-1				/34
PSWTCH	0			/NON-0 = P REQUESTED WITH L FUNCTION.
	.ASCII 'ILL CMD STRUCTURE'<15>
ERMSGY=.-1
LSWTCH	0			/NON-ZERO IF WANT SYSBLK LISTING.
	.ASCII 'FILE STRUCTURE CONTAMINATED'<15>
ERMSGZ=.-1			/36
TEMP3	0
	.ASCII	'FILE ALREADY PRESENT'<15>
	.LOC .-1
ERMSGA=.-1
X4KSW	0		/400000 IF X4K SPECIFIED IN S SWITCH.
	.ASCII 'DATA MODE MISMATCH'<15>
	.TITLE IMAGE COPY ROUTINES.
	.TITLE    ZCOPY: DISPATCH TO IMAGE COPY ROUTINES.
/COPY ROUTINE
/
ZCOPY	JMS INITOT	/SET UP AND INIT DEST DEV.
	JMS INITIN		/INIT SOURCE DEVICE.
	LAC (1		/# BLOCKS TO TRANSFER AT ONCE FOR
	DAC DELBLK	/B OR (INITIALLY) C FUNCTIONS.
	DZM MAGSW
	DZM DKOUT
	DZM CURBLK
	LAC (1100		/SET UP FOR DECTAPE INITIALLY.
	DAC BLKCNT
	TAD LM1
	DAC BLKCT1
	SET RSTRTP		/SET FOR USE WITH ^P (SO PIP GETS RELOADED).
	SET COPYSW
	LAC DESNUM		/PUT DEVICE CODES AND DAT SLOTS INTO LOCATIONS
	DAC RDESNM		/THAT WON'T BE CLOBBERED.
	LAC DESDAT
	DAC RDESDT
	LAC DESDEV
	DAC RDESDV
	LAC SRCDAT
	DAC RSRCDT
	JMS SETIN		/SET UP TRAN MACRO FOR INPUT.
	LAC BSWTCH	/B OPERATION?
	SZA
	JMP BCOPY		/YES - SET UP FOR BLOCK COPY.
	JMP HCOPY
	.TITLE    BCOPY: SET UP FOR IMAGE BLOCK TRANSFER.
/
/BLOCK TRANSFER FUNCTION	
/
BCOPY	LAC DESDEV		/IF OUTPUT DEVICE IS DK OR DP, ONLY MIC
	SAD DECDSK		/ALLOWED THIS FUNCTION.
	SKP
	SAD DECPAK		/RK?
	SKP
	SAD DSKPAK
	SKP
	JMP BCOPY1
	LAC PIPMIC		/BIT 0=1 IF UIC=MIC.
	SMA
	JMP ERR23			/'ILLEGAL FUNCTION FOR UIC'.
BCOPY1	LAC DESTSW	/DEST SW SET?
	SNA!CLC		/YES,USE DEST BLOCK COUNT
	JMP ZBLT1
	TAD DSFCNT	/CHANGE BLOCK COUNT TO 1'S COMP
ZBLT2	DAC DSFCNT
	DZM TIMES		/MUST CHECK VALIDITY OF BLOCK NUMBERS.
	LAC DESDAT
	DAC CURDEV
	LAC DESDEV
CMPAGN	SAD DECTAP
	JMP BSETDT		/HIGHEST BLOCK NUMBER FOR DECTAPE = 1077.
	SAD DSKPAK
	JMP BSETDP		/HIGHEST BLOCK NUMBER FOR PACK=117227.
	LAC (RFMFD		/BY DEFAULT, DEALING WITH DECDISK.
	DAC DIRBLK		/DON'T KNOW NUMBER BLOCKS IN THIS SYSTEM
	LAC CURDEV
	STL			/UNTIL GET WORD 0 OF SAT.
	JMS ZSETTR
	JMS ZTRANS		/READ IN MFD BLOCK TO FIND SAT BLOCK.
	LAC* (Z1BUF+3		/FIRST SAT BLK IN BITS 3-17.
	AND (77777
	DAC ZBLNUM
	JMS ZTRANS
	LAC* Z1BUFP		/WORD 0 CONTAINS # BLKS IN SYSTEM
	TAD (1
HIBLK	DAC BLKCNT
	LAC TIMES		/0 IF CHECKING DESTINATION DEVICE.
	SZA
	JMP SRCBLK
	LAC (DESFLS		/LIST OF DECTINATION BLOCKS.
	SKP
SRCBLK	LAC (SRCFLS		/LIST OF SOURCE BLOCKS.
	DAC BPOINT
	LAC DSFCNT		/# BLOCKS.
	DAC BCOUNT
LOKBLK	LAC* BPOINT
	CMA
	TAD BLKCNT		/IS THIS BLOCK LARGER THAN HIGHEST BLOCK ALLOWED
	SPA			/FOR THE SYSTEM?
	JMP ERR21			/YES - ERROR 21. (ILLEGAL BLOCK)
	IDX BPOINT		/NO, LOOK AT ANOTHER, IF THERE ARE ANY MORE.
	ISZ BCOUNT
	JMP LOKBLK
	LAC TIMES		/BOTH SOURCE AND DESTINATION BLOCKS CHECKED?
	SZA
	JMP ZBLT3		/YES - FINISH SETUP.
	SET TIMES		/NO- SET UP FOR SOURCE AND REPEAT PROCESS.
	LAC SRCDAT
	DAC CURDEV
	LAC SRCDEV
	JMP CMPAGN
BSETDT	LAC (1100		/SET UP FOR DECTAPE.
	JMP HIBLK
BSETDP	LAC (117230
	JMP HIBLK
ZBLT3	JMS BSETUP	/INIT BLOCK COUNT AND POINTER
	JMP ZSYSDB
ZBLT1	TAD SRFCNT
	JMP ZBLT2
/
/BLOCK COPY SETUP SUBR
/
BSETUP	0
	LAC DSFCNT	/BLOCK COUNT (2'S COMP)
	DAC BCOUNT
	LAC (DESFLS	/DEST BLOCK LIST POINTER
	DAC BDPNT
	LAC (SRCFLS	/SRC LIST POINTER
	DAC BPOINT
	JMP* BSETUP
SETIN	0
	DAC ZTRWAT
	DAC ZTRANZ
	LAC Z2BUFP
	DAC TRNBUF
	LAC SATBLK
	DAC ZBLNUM
	LAW -400
	DAC TRANWD
	JMP* SETIN
	.TITLE    HCOPY: IMAGE COPY WITH (H) SWITCH.
/
/IMAGE MODE BLOCK BY BLOCK COPY
/DECTAPE TO DECTAPE OR DISK PACK TO DISK PACK ONLY.
/
HCOPY	LAC SRCDEV		/BOTH DEVICES MUST BE THE SAME
	SAD DESDEV
	JMP CDEVOK
	JMP ERR04
HCOPY2	LAC (11410		/DISK CARTRIDGE. 11407 BLOCKS PER DRIVE
	JMP HCOPY3
CDEVOK	SAD DECTAP		/ONLY LEGAL DECTAPE TO DECTAPE
	JMP HCOPY1		/(ALREADY ALL SET UP)
	SAD DECPAK		/RK?
	JMP HCOPY2		/YES.
	SAD DSKPAK		/OR DISK PACK TO DISK PACK.
	SKP
	JMP ERR04
	LAC (117230
HCOPY3	DAC BLKCNT		/117227 BLOCKS ON A DISK PACK.
	TAD LM1
	DAC BLKCT1
HCOPY1	LAW -2			/COMPUTE AVAILABLE CORE IN 256 WD UNITS
	TAD* (.SCOM+2		/TO ENABLE USE OF ALL CORE INCLUDING PIP UPTO HBFEND.
	CMA			/FOR TRANSFER BUFFERS RATHER
	TAD (HBFEND		/THAN JUST Z1BUF AND Z2BUF.
	AND (777000
	CLL!RAR		/DIVIDE BY 2
	DAC BUFSZE		/SIZE OF EACH BUFFER ( Z1BUF, Z2BUF).
	RTR
	JMS R3R
	JMS R3R
	DAC DELBLK	/# OF BLKS TO TRANSFER AT ONE TIME
	LAC* (.SCOM+2		/(.SCOM+2
	DAC Z1BUFP
	TAD BUFSZE
	DAC Z2BUFP
	CLC
	TAD BUFSZE		/COMPUTE TRAN WORD COUNT.
	CMA
	DAC HTRNWC		/SET UP WORD COUNT IN
	DAC TRANWD		/BOTH TRAN MACROS USED BY HCOPY.
ZSYSDB	LAC DESDAT		/DEST DAT SLOT
	DAC HTRWAT		/INTO DEST DEV WAIT.
	LAC (JMP COMPER	/SET UP TO PRINT HEADER.
	DAC RCMPSW
HBFEND	DAC LASTBK	/DUMMY VALUE FOR READ/COMP ERROR ROUTINE.
ZSYSD3	LAC Z2BUFP	/INIT DEST BUF POINTER
	DAC HTRBUF		/PUT BUFFER ADDRESS INTO PROPER PLACE IN
	DAC TRNBUF		/TRAN MACROS USED BY HCOPY.
	LAC (1000		/INIT TO PASS 1 (TRANSFER PASS)
	DAC ZPASS		/PASS 1=1000, PASS 2=0
	LAW -3
	DAC TRYCNT		/READ-COMPARE COUNT (TRY 3 TIMES).
	LAC BSWTCH	/B?  YES = NON-ZERO.
	SNA
	JMP ZSYSD6	/NO.
	LAC SRFCNT	/SOURCE BLOCK COUNT = 0?
	SZA!CLC		/YES, USE DEST COUNT, AC=0 IN CASE OF COUNT OVERFLOW
	JMP .+4
	LAC* BDPNT	/PICK UP DEST BLOCK
	DAC* BPOINT
	CLC
	ISZ BCOUNT
	LAC* BPOINT	/NEXT BLOCK TO TRANSFER
	SKP!STL		/SET LINK TO INDICATE B FUNCTION
ZSYSD6	JMS DTMAP		/GET NEXT BLOCK TO TRANSFER
	ISZ BPOINT	/FOR HMODE: DUMMY COUNTER, WILL NEVER OVERFLOW.
	SPA		/DONE?
	JMP COPCLO		/YES, CLOSE FILES.
	DAC ZBLNUM		/GET THIS BLOCK FROM SOURCE TAPE.
	SZL		/L=0 ON H MODE COPY.
	LAC* BDPNT	/DEST BLK POINTER
	ISZ BDPNT		/WILL NEVER OVERFLOW ON H MODE COPY.
	DAC HBLNUM		/GET OR PUT ON DEST DEVICE.
ZSYSD9	JMS ZTRANS			/BRING IN SOURCE BLOCK.
	JMP ZSYSD8
ZSYSD7	LAC Z1BUFP
	DAC HTRBUF
ZSYSD8	LAC HTRWAT
	XOR ZPASS		/SET I/O BIT (8) = 1 ON PASS 1
	DAC HTRAN	/FOR OUTPUT, 0 ON PASS 2 FOR INPUT.
HTRAN	XX		/DEST DEV TRAN CAL.
	13
HBLNUM	XX			/BLOCK NUMBER.
HTRBUF	XX		/Z2BUF ON PASS 1, Z1BUF ON PASS 2.
HTRNWC	-400
HTRWAT	XX			/WAIT ON DEST DEVICE.
	12
	LAC ZPASS
	DZM ZPASS
	SZA		/PASS 2 - READ/COMPARE
	JMP ZSYSD7		/GET DATA BLOCK FOR COMPARE.
	LAC Z1BUFP		/COMPARE BLOCKS
	DAC ZTEMP1
	LAC Z2BUFP
	DAC ZTEMP2
	LAC HTRNWC		/COMPARE COUNT.
	DAC ZCOUNT
YTRCK	LAC* ZTEMP1
	XOR* ZTEMP2
	SZA!CLA
	JMS RCOMP		/READ COMPARE ERROR
	IDX ZTEMP1
	IDX ZTEMP2
	ISZ ZCOUNT
	JMP YTRCK
	JMP ZSYSD3		/NEXT BLOCK
/GET NEXT BLK # SUBR
DTMAP	0
	LAC CURBLK	/CURRENT BLK #
	SPA		/IF (-), LAST BLOCK
	JMP* DTMAP
	DAC NEWBLK
	TAD DELBLK
	DAC CURBLK
	CMA
	TAD BLKCNT		/CHECK FOR GREATER THAN 1077
	SMA!CLL		/L=0 FOR EXIT WITH LEGAL BLK #
	JMP MAPOUT
/LAST BLOCK TRANSFER CODE.
	DAC CURBLK	/SET TO (-) FOR NEXT PASS
	CMA
	RTL; RTL; RTL; RTL		/CONVERT EXTRA BLKS(BEYOND 1077) TO # WORDS.
	TAD HTRNWC
	DAC HTRNWC		/DEDUCT FROM .TRAN WORD COUNTS.
	DAC TRANWD
MAPOUT	LAC NEWBLK
	JMP* DTMAP
/
/READ-COMP SUBR
/
RCOMP	0
	CLC
	ISZ TRYCNT		/3 TRIES?
	JMP RESET		/TRY AGAIN
	DAC TRYCNT		/INSURE OVERFLOW NEXT TIME.
	CLA
RCMPSW	XX		/JMP FECHOK (1ST TIME) OR NOP
RCRET	LAC (740000
	DAC RCMPSW		/CLEAR PRINT READ-COMP SWITCH
	LAC (BUFFER+2
	JMS SETPUT		/SET UP KLPUT
	JMS PACK40
	CLC
	TAD HBLNUM		/BLOCK NUMBER.
	TAD DELBLK	/# BLOCKS TO BE TRANSFERRED AT ONE TIME.
	DAC KLFOCT	/LAST BLOCK NUMBER IN CURRENT GROUP.
	CMA
	TAD BLKCNT		/CHECK FOR GREATER THAN 1077.
LSMRAL	SMA!RAL		/RAL ONLY THERE SO CAN USE AS LITERAL.
	JMP RCRET1
	LAC BLKCT1
	DAC KLFOCT
RCRET1	LAC ZCOUNT	/READ-COMPARE COUNT AT TIME OF ERROR.
	TAD (400		/DECREMENT TO FIND ACTUAL BLOCK IN ERROR.
	SMA
	JMP RCRET2	/ERROR BLOCK FOUND.
	DAC KLPUT		/TEMP STORAGE.
	CLC
	TAD KLFOCT	/DECREMENT LAST BLK IN CURRENT GROUP BY 1.
	DAC KLFOCT
	LAC KLPUT		/PICK UP TEMP. WORD COUNT.
	JMP RCRET1+1	/CONTINUE DECREMENTING.
RCRET2	LAC KLFOCT	/BLOCK # IN ERROR.
	SAD LASTBK	/FIRST ERROR FOUND IN THIS BLOCK, PRINT.
	JMP* RCOMP	/ALREADY PRINTED - DON'T PRINT AGAIN.
	DAC LASTBK	/SET TO AVOID PRINTING THIS BLK # MORE THAN ONCE.
	JMS KLFOCT		/OCTAL TO ASCII
	LAC LITCR		/CR
	JMS KLPUT
	JMS COMWPC		/CALCULATE WPC.
	LAC (BUFFER
	JMS PROUT		/PRINT ONE BLOCK #.
	JMP* RCOMP
RESET	LAC (1000		/SET UP TO READ SOURCE BLOCK AGAIN.
	DAC ZPASS
	JMP ZSYSD9
/
COMPER	LAC (BUFFER+2
	JMS SETPUT
	JMS PRSET
	LAC (CMPERR
	JMS PACKBF
	JMS PROUT
	JMP RCRET
/
/DONE COPYING - CLOSE DEVICES AND RELOAD PIP.
COPCLO	LAC RDESDT
	DAC ZCLOSD
	JMS ZCLOS
	LAC RSRCDT
	DAC ZCLOSD
	JMS ZCLOS
	LAC XITFLG		/(JMW:116) COMMAND ENDED WITH ALTMODE?
	SNA			/(JMW:116)
	JMP BOSEXT		/(JMW:116) YES - RELOAD MONITOR.
	LAC RDESNM		/(JMW:116) WAS SY0 DESTINATION DEVICE?
	SZA			/(JMW:116)
	JMP OVRPIP		/(JMW:116) NO - RELOAD PIP.
	LAC RDESDV		/(JMW:116)
	SAD SYDEVC		/(JMW:116)
	JMP BOSEXT		/(JMW:116) YES - MAY NOT BE ABLE TO RELOAD PIP 
				/(JMW:116)  SO DON'T TRY.
/	.OVRLA PIP		/RELOAD PIP.
OVRPIP	CAL
	24
	PIP
PIP	.SIXBT 'PIP'
	0
MAGSW	0
DKOUT	0
FIRST	0
BLKIN	0
BUFINP	0
RPONT1	0
RWDCNT	0
RBTCNT	0
MTSTAT	0
DECDNE	0
MAGEOT	0
TMPCNT	0
PNUMBK	0			/PERMANENT # BLKS TO TRANSFER EACH TIME.
PBUFSZ	0			/PERMANENT BUFFER SIZE.
ACCONT	0
COPDNE	0			/SWITCH SET TO INDICATE THAT LAST BUFFER IS GOING OUT.
ZTEMP1	0		/TEMP
ZTEMP2	0		/TEMP
CURBLK	0
NEWBLK	0
DELBLK	0
BLKCNT	0
BLKCT1	0
LASTBK	0
BUFSZE	0
ZPASS	0
BCOUNT	0
BPOINT	0
BDPNT	0
CURDEV	0
TRYCNT	0
RDESDT	0
RDESDV	0
RSRCDT	0
RDESNM	0			/(JMW:116)
	.TITLE GENERAL OUTPUT ROUTINES.
	.TITLE    PRCOMP,PACKBF,PACK40,COMWPC: BUFFER PACKING ROUTINES.
/
/SUBR TO INSERT VARIABLE IN OUTPUT LINE AND PUT OUT THE LINE
/CALLING SEQ.:
/	(AC=DATA POINTER,E.G., LBUF+2)
/	JMS PRCOMP
/COUNT	N		/N=# TO BE INSERTED
/
PRCOMP	0
	DAC PACKBF		/VERY TEMP STORAGE.
	LAC (BUFFER+2
	JMS SETPUT
	LAC* PRCOMP
	IDX PRCOMP
	JMS KLFOCT
	JMS PACK40
	LAC PACKBF
	JMS PACKBF
	JMS PROUT
	JMP* PRCOMP
/
/SUBROUTINE TO PACK BUFFER.
/AC = ADDRESS OF BUFFER ( (BUFFER+2) ON ENTRY.
/AC = (BUFFER ON EXIT.
/
PACKBF	0
	JMS ZSET
	DZM ZSPACE		/WE WANT SPACES HERE.
NOTHCR	JMS GETCHR
	JMS KLPUT
	SAD LITCR
	SKP
	JMP NOTHCR
	JMS COMWPC
	LAC (BUFFER
	JMP* PACKBF
/
PACK40	0			/PACK A SPACE (40) INTO OUTPUT BUFFER.
	LAC (40
	JMS KLPUT
	JMP* PACK40
/
/SUBROUTINE TO COMPUTE OUTPUT HEADER W.P.C.
/
COMWPC	0
	LAC PUTCT
	TAD LIT2		/ADD 2 FOR HEADER
	CLL!RAL
	JMS R8L
	DAC BUFFER
	JMP* COMWPC
	.TITLE    KLFOCT: OCTAL TO ASCII CONVERSION SUBROUTINE.
/OCTAL (AC) TO ASCII SUBROUTINE USING  KLPUT.
/KLSUPR = 40 FOR 0 SUPPRESSION;
/
KLFOCT	0
	DAC KLCHAR		/OCTAL VALUE TEMP STORE.
	SZA
	JMP KLNTZO
	LAW -5		/ZERO LOC  (LAW -3 IF LISTING DIRECTORY).
	DAC KLCNT		/OCTAL PLACE COUNT
	LAC KLSUPR		/SUPPRESS
	JMS KLPUT
	ISZ KLCNT
	JMP .-3
	LAC (60		/PRINT ZERO.
	JMS KLPUT
	JMP KLSET
KLNTZO	LAC (740000
	DAC KLZERO
	LAW -6
	DAC KLCNT
KLNXTD	LAC KLCHAR		/GET WORD
	RCL
	RTL
	DAC KLCHAR		/SAVE WORD
	RAL
	AND (7
	DAC KLCHR2
KLZERO	NOP
	SNA
	JMP KLOCTZ
	LAC .+3
	DAC KLZERO
	LAC KLCHR2
	JMP KLNZRO
KLOCTZ	LAC KLSUPR
LITSKP	SKP
KLNZRO	XOR (60		/MAKE ASCII.
	JMS KLPUT		/OUTPUT CHAR
	ISZ KLCNT
	JMP KLNXTD		/NEXT DIGIT
KLSET	LAC (40
	DAC KLSUPR
	JMP* KLFOCT
KLCHR2	0
KLCNT	0			/OCTAL PLACE COUNT.
KLCHAR	0		/OCTAL TEMP STORAGE.
KLSUPR	0			/0 SUPPRESS SWITCH: 0= SUPP, 40= NO.
	.TITLE    KLPUT: IOPS ASCII PACKING SUBROUTINE.
/IOPS 5/7 ASCII PACKING ROUTINE
/INITIALIZE:
/          PUTC TO 0
/          PUTP TO 1ST WORD
/          PUTCT TO 0
/
KLPUT	0
	AND (177
	DAC PUT1		/TSTORE CHAR
	CLL
	LAC PUTC		/CHAR POSITION
	TAD (JMP* PUTJ
	DAC .+2
	LAC PUT1		/PICK UP CHAR
	XX		/MODIFIED JMP
PUTJ	PUT571		/CHAR 1
	PUT572		/CHAR 2
	PUT573		/CHAR 3
	PUT574		/CHAR 4
	PUT575		/CHAR 5
/
PUT571	RTR		/8 RIGHT
	JMS R3R		/3 RIGHT
	JMS R3R
PUT57A	DZM* PUTP		/CLEAR DATA WORD
	JMP PUTEND
/
PUT572	RTL		/4 LEFT
	RTL
	JMP PUTEND
/
PUT573	JMS R3R		/3 RIGHT - 1ST HALF
	AND (17
	XOR* PUTP
	DAC* PUTP
	ISZ PUTP		/LAST WORD OF PAIR
	LAC PUT1
	RTR		/4 RIGHT - 2N  HALF
	RTR
	AND (700000
	JMP PUT57A
/
PUT574	JMS R8L		/8 LEFT.
	JMP PUTEND
PUT575	RAL		/1 LFT
	DZM PUTC		/RESET 5/7 COUNTER
	SKP
PUTEND	ISZ PUTC
	XOR* PUTP
	DAC* PUTP
	LAC PUTC
	SZA		/2ND WD COMP
	JMP .+3
	IDX PUTCT		/WD. PR. CT.
	ISZ PUTP		/2ND WD COMPLETE
	LAC PUT1
	JMP* KLPUT		/RETURN.
/
/SUBROUTINE TO SET UP KLPUT ROUTINE
/AC = POINTER TO OUTPUT BUFFER DATA AREA ON ENTRY
/
SETPUT	0
	DAC PUTP		/DATA AREA POINTER
	DZM PUTC		/CHAR POSITON COUNT
	DZM PUTCT		/WORD PAIR COUNT
	LAC (40			/START LINE WITH SPACE
	DAC KLSUPR	/SWITCH TO SUPPRESS LEADING 0'S
	JMS KLPUT
	JMP* SETPUT
/
PUTCT	0			/WORD PAIR COUNT.
PUTP	0			/DATA POINTER.
PUT1	0			/TEMP STORAGE.
PUTC	0		/CHARACTER POSITION COUNT.
/
	.TITLE    KLFSIX: SIXBIT TO 7-BIT ASCII CONVERSION SUBROUTINE.
/
/SIXBIT TO 7 BIT ASCII
/AC = 3 SIXBIT CHAR'S
/SUBR. USES KLPUT
/
KLFSIX	0		/FROM SIXBT
	DAC TVCNT
	LAW -3
	DAC KLCNT		/SETUP 3 CHAR CT.
KLFSXT	LAC TVCNT
	JMS R6L
	DAC TVCNT		/NEXT CHAR
	RAL
	AND (77
	SNA
	LAC (40			/SPACE INSTEAD OF RO.
	DAC KLCNTB		/SAVE - TEMP.
	AND (40
	SNA!CLL
	STL
	LAC KLCNTB
	SZL		/NO BIT 7
	XOR (100		/BIT 7.
	JMS KLPUT
	ISZ KLCNT
	JMP KLFSXT		/NEXT CHAR
	JMP* KLFSIX	/EXIT
KLCNTB	0			/TEMP STORE FOR SPACE CHAR.
TVCNT	0			/TEMP STORAGE.
	.TITLE    PROUT: SUBROUTINE TO OUTPUT LINE.
/OUTPUT LINE SUBROUTINE
/AC = LINE HEADER POINTER ON ENTRY
/
PROUT	0
	DAC MODN10
PRDAT	XX		/OUTPUT DAT SLOT
	11
MODN10	XX		/L.B. POINTER
	LAW -376
PRWAT	XX		/OUTPUT DAT SLOT
	12
	JMP* PROUT
/
/SUBROUTINE TO SET UP PROUT.
/
PRSET	0
	LAC (2775		/PROUT DAT SLOT = -3, IOPS ASCII.
	DAC PRDAT
	AND (777
	DAC PRWAT
	JMP* PRSET
/
/SUBROUTINE TO PACK LAST CR AND PRINT 'BUFFER'.
/
LNEOUT	0
	LAC LITCR
	JMS KLPUT		/PACK CR.
	JMS COMWPC		/CALCULATE WORD PAIR COUNT.
	LAC (BUFFER
	JMS PROUT		/PRINT LINE.
	JMP* LNEOUT
	.TITLE    INITOT,INITIN,ZSETTR,ZTRANS,ZCLOS,NUORRE.
/
/INIT DEST DEVICE SUBROUTINE.
/
INITOT	0
	LAC DESDAT		/DEST DAT SLOT.
	SAD DSKPAK		/IF DECDISK OR DISK PACK, WRITE CHECK.
	XOR (10000
	SAD DECDSK
	XOR (10000
	SAD DECPAK
	XOR (10000
	XOR (1000		/OUTPUT BIT.
	DAC ZIFILD		/INIT SUBROUTINE.
	JMS ZIFIL
	JMP* INITOT
/INIT SUBROUTINE : INPUT.
/
INITIN	0
	LAC SRCDAT
	DAC ZIFILD
	JMS ZIFIL
	JMP* INITIN
/
/INIT SUBR.
/
ZIFIL	0
ZIFILD	XX		/DAT SLOT (MODIFIED)
	1
	NUORRE		/CONTROL ON ^P
	0		/BUF. SIZE RETURNED
	JMP* ZIFIL
/ON EXIT:  AC=C(ZTRANZ); LINK UNTOUCHED.
ZSETTR	0
	DAC ZCLEAR		/CLEAR
	DAC ZTRWAT		/TRAN WAIT
	SNL		/INPUT
	XOR (1000		/OUTPUT.
	DAC ZTRANZ		/TRAN
	LAC DIRBLK		/DIR BL#.
	DAC ZBLNUM		/TRAN. BL#
	LAC Z1BUFP
	DAC TRNBUF
	LAC ZTRANZ		/DEST. DAT SLOT + I/O BIT IN AC ON EXIT
	JMP* ZSETTR
/
/TRAN SUBROUTINE, INCLUDES .WAIT
/
ZTRANS	0		/ALSO USED AS TEMP. STOR.
ZTRANZ	XX
	13
ZBLNUM	100
TRNBUF	XX		/NORMALLY Z1BUF
TRANWD	-400
ZTRWAT	XX			/WAIT
	12
	JMP* ZTRANS
/
/CLOSE SUBR
/
ZCLOS	0
	LAC FSWTCH	/IS F SWITCH SET?
	SNA
	JMP ZCLOSD
	LAC ZCLOSD	/OUTPUT CLOSE?
	XOR DESDAT
	SZA
	JMS FFOUT		/YES, ISSUE FF,CR
ZCLOSD	XX
	6
	JMP* ZCLOS
/CONTROL COMES HERE ON ^P TO THE
/TELETYPE KEYBOARD.
/
NUORRE	LAC RSTRTP
	DZM RSTRTP	/SET UP FOR RESTART ON NEXT ^P.
	SNA
	JMP RESTRT	/RESTART.
/	.INIT,-2,0,NUORRE
	CAL 776		/INIT TTY FOR
	1		/CR,LF AFTER ^P
	NUORRE
	0
	LAC COPYSW		/IF IMAGE COPYING, MUST RELOAD PIP.
	SZA
	JMP COPCLO
	ISZ YEOFSW	/777777 IF YSWITCH ON
	JMP ZEOF		/NEW MEDIUM-INPUT
	JMP NEWOUT	/NEW OUTPUT MEDIUM FOR SEGMENT FILE
RSTRTP	0			/0 IF TO 'RESTRT' ON ^P; NON-0 OTHERWISE.
/
/OUTPUT ^P SUBR
/
CONTLP	0
/.WRITE -3,2,ZOUTCP,4
	CAL+2775		/OUTPUT LF ^P CR
	11		/IOPS ASCII
	ZOUTCP
	-4
	JMP* CONTLP
	.TITLE    ZCEXIT,READTT,LFOUT,INITPT
/
/EXIT ROUTINE.
/
ZCEXIT	XX		/COPY SWITCH(JMP ZCOPY1 FOR COPY OF 25 OR MORE FILES
	DZM STRCNT	/CLEAR SEGMENT STRING COUNT
	LAC XITFLG		/0=ALTMODE TERMINATED COMMAND;
	SZA		/1=CR TERMINATED COMMAND.
	JMP RESTRT
/	.EXIT		/RETURN TO MONITOR
BOSEXT	CAL
LITCR	15
/SUBROUTINE TO READ KEYBOARD FOR COMMAND
/STRING INPUT, WAIT FOR ITS COMPLETION, AND
/INITIALIZE ALL PERTINENT REGISTERS.
/
READTT	0
/	.READ -2,2,BUFFER,34
	CAL 2776			/READ KEYBOARD FOR
	10			/PIP COMMAND STRING
	BUFFER			/IN IOPS ASCII MODE.
	-42
/	.WAIT -2
	CAL 776			/WAIT FOR COMPLETION OF
	12			/COMMAND STRING
/
/ROUTINE TO INITIALIZE POINTERS AND COUNTERS
/FOR COMMAND STRING EXAMINATION AND ECHOING. CALLED AFTER
/STRING IS IN BUFFER.
/
	LAC (BUFFER+2	/1ST DATA WORD OF COMMAND STRING.
	JMS ZSET		/INIT GETCHR
	JMP* READTT
/
/SUBROUTINE TO OUTPUT LF>, READ KEYBOARD, GET 1ST CHAR
/
LFOUT	0
	DZM BOSTTY		/WILL USE AS SWITCH: 0= NOT TTY OUTPUT FOR BOSS.
	LAC* (BOSS		/BIT 0=1 IF IN BOSS MODE.
	SMA			/BOSS - SEE IF WANT I/O TO GO TO TTY.
	JMP LFOUTA
	AND (20000		/I/O TO TTY IF BIT 4=1.
	DAC BOSTTY		/TEMP SAVE.
	SNA
	JMP LFOUT1
/          .WRITE -3, 3, OUTBRK, 4	/OUTPUT LF >
LFOUTA	CAL+3775		/IMAGE ALPHA
	11
	OUTBRK
	-4
	LAC BOSTTY		/NON-ZERO IF NEED TO SET UP TTY UNDER BOSS.
	SZA
	JMP BOSPEC
LFOUT1	JMS READTT		/READ KEYBOARD
LFOUT2	JMS GETCHR		/PICK UP 1ST CHAR
	JMP* LFOUT
/SUBROUTINE TO INIT SRC., DEST. FILE POINTERS AND COUNTS
/
INITPT	0
	DZM DSFCNT		/DEST. FILE COUNT
	DZM SRFCNT		/SOURCE FILE COUNT
	LAC (DESFLS
	DAC DSFPTR		/DEST. FILE BLOCK (24 ENTRIES) POINTER
	LAC (SRCFLS
	DAC SRFPTR		/SOURCE FILE BLOCK (24 ENTRIES) POINTER
	JMP* INITPT
/
/
/SETS UP TO REALLY GO TO TTY IF IN BOSS MODE (BOSS CHANGES CONSOLE I/O
/TO GO TO THE LINE PRINTER).
/
BOSTTY	0
	LAC* (BOSS		/BIT 0=1 IF IN BOSS MODE.
	SMA
	JMP BOSTT1
	AND (757777		/SET BIT 4=1 SO GO TO TTY AND NOT LP.
	XOR (20000
	DAC* (BOSS
BOSTT1	JMP* BOSTTY
/
/ON PARITY ERROR UNDER G SWITCH AND BOSS, WANT TO BE ABLE TO READ USERS RESPONSE.
/SINCE BOSS ONLY ALLOWS USER I/O FROM THE CONSOLE TTY ON .DAT -3, PIP MUST
/READ FROM -3.  
/
BOSPEC	JMS BOSTTY		/SET BIT 4.
/	.READ-3,2,BUFFER,34
	CAL 2775
	10
	BUFFER
	-42
	JMS BOSTTY		/SET BIT 4 AGAIN.
/	.WAIT -3
	CAL 775
	12
	LAC (BUFFER+2
	JMS ZSET
	JMP LFOUT2
	.TITLE    R8L,R6L,R3R: ROTATE SUBROUTINES.
/
/SUBR TO ROTATE 8 LEFT
/
R8L	0
	JMS R6L
	RTL
	JMP* R8L
/
/SUBR TO ROTATE 6 LEFT
/
R6L	0
	RTL
	RTL
	RTL
	JMP* R6L
/
/SUBROUTINE TO ROTATE 3 RIGHT.
/
R3R	0
	RTR
	RAR
	JMP* R3R
	.TITLE    GETCHR: SUBROUTINE TO GET THE NEXT ASCII CHARACTER.
/SUBROUTINE TO GET THE NEXT 7-BIT ASCII CHARACTER
/FROM THE 5/7 COMMAND STRING BUFFER AT 'BUFFER'.
/IT RETURNS WITH IT RIGHT JUSTIFIED IN AN OTHERWISE CLEAR AC.
/SPACES ARE IGNORED IF ZSPACE IS NON 0
GETCHR	0
	ISZ PAIRCT
	JMP NUCHAR	/CURRENT 5/7 PAIR NOT EXHAUSTED.
	ISZ WORDCT
	JMP NUPAIR
COMSW	SKP		/SKP OR CLA IF COMMAND DECODER NOT IN PROGRESS
	JMP ERR17			/ASCII INPUT LINE TOO LONG
	CAL 775		/.CLOSE -3: CAUSES CR/LF
	6
	DZM ZECHO		/OUTPUT ERROR - COMMAND STRING
	LAC (ERRMSG		/BUFFER EXHAUSTED PREMATURELY.
	JMP LACALB+1
NUPAIR	LAC* CMDPTR	/PICK UP NEXT WORD PAIR
	DAC LFHALF	/AND PLACE IN 5/7
	IDX CMDPTR	/TWO WORD AC.
	LAC* CMDPTR
	DAC RTHALF
	ISZ CMDPTR
	LAW 17773		/RESET CHAR. COUNTER
	DAC PAIRCT	/FOR NEW PAIR
NUCHAR	LAW 17770		/GO THROUGH SHIFT LOOP
	DAC GETTMP		/7 1/2 TIMES.
GETBCK	LAC RTHALF
	RAL
	ISZ GETTMP
	JMP GETMRE
	AND (177		/GOT CHARACTER.
VALSW	XX		/PLACE IN (DAC* ALLOUT) OR (NOP)
	ISZ ALLOUT	/ECHO BUFFER.
	CLL
	SAD (40			/IGNORE
	SKP		/SPACES
	JMP* GETCHR	/EXIT
	XOR ZSPACE		/SPACE SWITCH (0 = DO NOT IGNORE)
	SAD (40
	JMP* GETCHR	/EXIT WITH SPACE IN AC
	JMP GETCHR+1
GETMRE	DAC RTHALF
	LAC LFHALF
	RAL
	DAC LFHALF
	JMP GETBCK
LFHALF	0		/5/7 TWO WORD
RTHALF	0		/BUFFER FOR EXTRACTING 7-BIT CHARS.
CMDPTR	0		/CURRENT DATA WORD OF COMMAND STRING.
PAIRCT	0		/CHAR. COUNTER IN 5/7 PAIR.
WORDCT	0		/DATA WORD PAIR COUNTER (1'S COMP.).
GETTMP	0			/TEMP STORAGE.
ZSPACE	0			/SPACE SWITCH: NON-0=IGNORE SPACE.
/
/SUBROUTINE TO INITIALIZE GETCHR.
/AC = POINTER TO FIRST DATA WORD ON ENTRY.
/
ZSET	0		/INIT GETCHR.
	DAC CMDPTR
	LAW -1
	DAC PAIRCT	/CHAR. COUNTER IN 5/7 PAIR.
	LAW -32		/DATA WORD PAIR COUNTER (1'S COMP.).
	DAC WORDCT
	JMP* ZSET
	.TITLE    CALUDA: DATE CONVERSION SUBROUTINE.
/
/SUBROUTINE TO CONVERT DATE AND PACK IN THE OUTPUT BUFFER.
/SUCCESS EXIT (GOOD DATE): AC=NON-ZERO.
/FAILURE EXIT (NO GOOD DATE): AC=0.
/
CALUDA	0
	DZM KLSUPR		/ALLOW PRINTING OF LEADING ZEROS.
	DAC DATE		/DATE IN FORM MMDDYY.
	AND (77
	DAC YEAR		/YEAR IN BITS 12-17.
	LAC DATE
	JMS R3R
	JMS R3R
	DAC DATE
	AND (77
	DAC DAY			/DAY IN BITS 12-17.
	SZA
	TAD LM40		/MUST BE IN RANGE 1-31(10).
	SMA!CLA
	JMP* CALUDA		/FAIL EXIT.
	LAC DATE
	JMS R3R
	JMS R3R
	AND (77
	DAC DATE		/MONTH IN BITS 12-17.
	SZA
	TAD LM15		/MUST BE IN RANGE 1-12(10).
	SMA!CLA
	JMP* CALUDA		/FAIL EXIT.
	LAC DAY
	JMS OCTDEC		/CONVERT FROM OCTAL TO DECIMAL AND OUTPUT.
	LAC DASH
PTLIT	JMS KLPUT
	LAC DATE
	TAD (LAC MTABLE-1
	DAC .+1
	XX			/LAC OF PROPER .SIXBT MONTH.
	JMS KLFSIX		/OUTPUT MONTH.
	LAC DASH
	JMS KLPUT
	LAC YEAR
	SZA		/IF ZERO, OUTPUT 70.
	JMP NOTY70
	LAC (67
	JMS KLPUT
	LAC (60
	JMS KLPUT
	JMP DATEDN
NOTY70	TAD (106		/MODULO 70.
	JMS OCTDEC
DATEDN	LAC LIT40
	DAC KLSUPR		/RESTORE 0 SUPRESSION.
	JMP* CALUDA		/SUCCESS EXIT.
/
/SUBROUTINE TO CONVERT OCTAL TO DECIMAL.  NOT GENERALIZED: EXPECTS ONLY
/2 DIGITS AT MOST (A DATE).
/AC = NUMBER TO BE CONVERTED ON ENTRY.
/
OCTDEC	0
	CMA
	TAD (1
	DAC DATE1
	DZM TIMES
OCTAL2	TAD LIT12			/LOOKING FOR 'TENS'.
	SMA
	JMP GOTTEN		/ALL DONE - HAVE DIGIT.
	ISZ TIMES
	DAC DATE1
	JMP OCTAL2
GOTTEN	SNA
	DZM DATE1
	LAC DATE1
	SNA
	IDX TIMES			/IF 0, NUMBER =12.
	CMA
	TAD (1
	DAC DATE1
	LAC TIMES
	TAD (60		/MAKE CHAR ASCII AND OUTPUT.
	JMS KLPUT
	LAC DATE1
	AND (17
	TAD (60
	JMS KLPUT
	JMP* OCTDEC
MTABLE	.SIXBT 'JAN'
	.SIXBT 'FEB'
	.SIXBT 'MAR'
	.SIXBT 'APR'
	.SIXBT 'MAY'
	.SIXBT 'JUN'
	.SIXBT 'JUL'
	.SIXBT 'AUG'
	.SIXBT 'SEP'
	.SIXBT 'OCT'
	.SIXBT 'NOV'
	.SIXBT 'DEC'
	.TITLE PIPDOS: BUFFERS, VARIABLES, LITERALS.
SATL	0
FUNCDE	0		/FUNCTION CODE: T=0
			/               L=2
			/               D=4
			/               C=6
			/	     R=10
			/		B=12
			/		S=14
			/		V=16
			/		N=20
BUFFER	.BLOCK 40		/I/O BUFFER FOR COMMAND STRING AND ERROR MESSAGES.
DESFLS	.BLOCK 124		/FILE NAMES AND EXTENSIONS (28(10) MAX)-3 WDS PER FILE.
SRCFLS	.BLOCK 124		/FILE NAMES AND EXTENSIONS (28 MAX)
SNAMES	.BLOCK 40		/SPLIT STRINGS (16 MAX)
DSFPTR	0		/INITIALLY DESFLS
DATAMD	0		/DATA MODE SWITCH OPTION:
			/1 = IOPS BINARY   (B)
			/2 = IMAGE BINARY  (H)
			/3 = IOPS ASCII    (A)
			/4 = IMAGE ALPHA   (I)
			/5 = DUMP          (D)
SRFPTR	0		/INITIALLY SRCFLS
FSWTCH	0		/NON-0 IF F SWITCH ENCOUNTERED.
DSFCNT	0		/DEST FILE COUNT.
LIT2=.
FUNCL	2		/#2 ASSIGNED TO L FUNCTION.
LIT4=.
FUNCD	4		/#4 ASSIGNED TO D FUNCTION.
LIT6=.
FUNCC	6		/#6 ASSIGNED TO R FUNCTION.
LIT10=.
FUNCR	10		/#10 ASSIGNED TO R FUNCTION.
VT	13		/VERTICAL TAB.
FF=.
LIT14=.
FUNCS	14		/#14 ASSIGNED TO S FUNCTION.
LIT16=.
FUNCV	16		/#16 ASSIGNED TO V FUNCTION.
LIT20=.
FUNCN	20		/#20 ASSIGNED TO N FUNCTION.
LIT22=.
FUNCI	22		/#22 ASSIGNED TO I FUNCTION.
LIT24=.
FUNCU	24		/#24 ASSIGNED TO U FUNCTION.
HASH	43		/HASH #.
OPAREN	50		/OPEN PAREN.
CPAREN	51		/CLOSED PAREN.
STAR	52			/*
COMMA	54
DASH	55			/-.
COLON	72
SEMICO	73
LFTCRT	74
LITU	125		/U
LFTARW	137		/LEFT ARROW 
ALTMOD	175
YEOFSW	0		/0=NEW INPUT, NON-0=NEW OUTPUT MEDIUM.
PIPUIC	0		/LOGGED-IN UIC.
PIPMIC	0		/MIC.
PROTCT	0		/PROTECTION CODE.
BSWTCH	0		/NON-ZERO IF DOING A B MODE COPY.
MSWTCH	0		/NON-ZERO IF M REQUESTED WITH LIST FUNCTION.
			/ALSO USED TO INDICATE NO ENTERS WHEN DOING T WITH W SWITCH.
DIRPRO	0			/DIRECTORY PROTECTION CODE. 1=PROTECTED, 0=NOT.
DIRBLK	0		/100 IF DECTAPE, FIRST MFD BLK IF DISKS.
SATBLK	0		/CURRENT SAT BLK (DISKS ONLY).
SRCUIC	0			/UIC TO USE FOR SOURCE SIDE.
DESUIC	0			/UIC TO USE FOR DECTINATION SIDE.
DEVSZE	0			/SIZE OF POSITIVE .DAT TABLE.
NEWPRO	0		/SET IF BIT0=1 & BITS 12-17=ASCII CODE OF SPECIFIED PROTECTION CODE.
DKSW	0
XITFLG	0			/0=ALTMODE, 1=CARRIAGE RETURN.
SRFCNT	0			/# SOURCE FILES.
INROOM	0			/BLOCK COUNTER (FILES).
Z1BUFP	0			/POINTER TO BUFFER1 (Z1BUF).
Z2BUFP	0			/POINTER TO BUFFER 2 (Z2BUF).
ZCOUNT	0			/GENERAL PURPOSE COUNTER.
COPYSW	0			/FOR ^P: IF SET, RELOADS PIP.
BUFFSZ	0			/BUFFER SIZE FOR TRANSFER.
SYDEVC	0		/(RKB:111) MNEMONIC FOR SYSTEM DISK.
TTCMDS	0		/(RKB:111) HOLDS 777 FOR TT, 776 FOR CM.
/
	.IFDEF TEST
	.DBREL
	.ENDC
	.END BEGIN
