TITLE PIP V.030 MOD SANDERS/DBP 19-AUG-71
SUBTTL	VJC/PMH/AK-DAG/DMN	8-JUL-70

;PERIPHERAL INTERCHANGE PROGRAM
;"COPYRIGHT 1968, 1969, DIGITAL EQUIPMENT CORP.,MAYNARD,MASS.,U.S.A.

VPIP==30		;VERSION NUMBER
SVER==5		; SANDERS VERSION


;WCH==0  PIP IS ASSEMBLED FOR PDP-10 AND ASSUMES NEW FORMAT DECTAPES.
;WCH==1  PIP IS ASSEMBLED FOR PDP-6 AND ASSUMES OLD FORMAT DECTAPES.

;DISK30==0 PIP IS ASSEMBLED TO RUN WITH 10/40, 10/50 MONITOR SYSTEMS.
;DISK30==1 PIP IS ASSEMBLED TO RUN WITH 10/30 DISK SYSTEM.

;BLOC0==0 PIP ALLOWS COPYING OF BLOCK0 (DECTAPE).
;BLOC0==1 PIP WILL NOT ALLOW BLOCK0 TO BE COPIED.

;RIMSW==0 /Y SWITCH OPTION UNAVAILABLE. (ALSO UNAVAILABLE FOR OLD FORMAT DECTAPES)
;RIMSW==1 /Y SWITCH OPTION AVAILABLE.

;FTDSK==0	NON DSK SYSTEM.NO CCL.SAVES CORE ON 10/40
;FTDSK==1	10/50 DSK SYSTEM,ALSO 10/30 DSK SYSTEM


;CONDITIONAL ASSEMBLY SWITCH SETUP (NORMAL CONFIGURATION)
;---------------------------------

IFNDEF WCH,	<WCH==0>
IFNDEF DISK30,	<DISK30==0>
IFNDEF BLOC0,	<BLOC0==0>
IFNDEF FTDSK,	<FTDSK==0>
IFN WCH,	<RIMSW==0>
IFNDEF RIMSW,	<RIMSW==0>
IFNDEF K,       <K==0>




	LOC 124
	PIP1		;SET REENTER ADDRESS
	RELOC
	LOC 137
	XWD SVER,VPIP
	RELOC


	MLON
IFDEF SALL,	<SALL>

EXTERN JOBFF,JOBSA,JOBREL

;FLAG ASSIGNMENTS (RIGHT HALF)

LINE==1		;ASCII LINE MODE PROCESSING
BMOD==2		;BINARY PROCESSING
TBMOD==4	;SUPPRESS TRAILING SP, CHANGE MULTIPLE SP TO TABS
DFLG==10	;DELETE FILES MODE
LFLG==20	;LIST DIRECTORY
NSMOD==40	;IGNORE INPUT SEQUENCE NUMBERS
RFLG==100	;RENAME FILE MODE
SQMOD==200	;GENERATE SEQUENCE NUMBERS
STS==400	;END OF LINE SEEN, OUTPUT SEQUENCE NUMBER NEXT
SPMOD==1000	;SUPPRESS TRAILING SPACES
XFLG==2000	;COPY DECTAPE MODE
ZFLG==4000	;CLEAR DECTAPE DIRECTORY
SUS==10000	;SEQUENCE NUMBER GENERATION IN PROGRESS
SPOK==20000	;SPACE WAS LAST CHARACTER
ESQ==40000	;STOP OUTPUTTING SEQ NUM, RESUME OUTPUTTING DATA
SNI==100000	;DO NOT INCREMENT SEQUENCE NUMBER
MTFLG==200000	;MTA REQUEST RECEIVED
OSFLG==400000	;GENERATE SEQ. NOS. INCR. BY ONE

;FLAG ASSIGNMENTS (LEFT HALF)

OFLG==1		;BLOCK 0 COPY
RIMFLG==2	;RIM FORMAT INPUT /OUT TO DTA. ILLEG IF RIMSW==0,OR WCH==1
PFLG==4		;FORTRAN PROGRAM OUTPUT FORMAT CONVERSION
PCONV==10	;COLUMN 1 CONVERSION IN PROGRESS
NEWFIL==20	;NEW FILE JUST INITIATED
CHKFLG==40	;PARENTHESES CHECK MODE
IFLG==100	;SELECT IMAGE MODE
GFLG==200	;KEEP GOING IF THERE ARE I/O ERRORS
IBFLG==400	;SELECT IMAGE BINARY MODE
JFLG==1000	;NON-STANDARD MODE
;AUXFLG ASSIGNMENTS (LEFT HALF)

QFLG==1		;PLEASE PRINT SWITCH SET
NSPROT==2	;NON-STANDARD DISK OUTPUT PROTECTION
SBIN==4		;36-BIT PR. ON REL. ETC. FILES
NOMORE==20	;IGNORE ANY SWITCHES BUT MTA FROM NOW ON
CDRFLG==40	;CONVERT COLS 73-80 TO SPACES + /C
INFOFL==100	;FLAG USED BY ERR3A:
RSDCFL==200	;USED FOR MERGING FILES, ==1 IF FILE HAS EXTENSION
		;REL,SAV,DMP,CHN OR OTHERWISE == 0
FRSTIN==400	;THIS IS THE FIRST INPUT FILE (USED IN FILE
		;MERGE COMMAND) == 0 FOR FIRST INPUT

;MTAREQ ASSIGNMENTS (RIGHT HALF)

MTAFLG==1	;MTA ADVANCE ONE FILE
MTBFLG==2	;MTA BACKSPACE ONE FILE
MTTFLG==4	;MTA SKIP TP LOGICAL EOT
MTWFLG==10	;MTA REWIND
MTFFLG==20	;MTA MARK EOF
MTUFLG==40	;MTA REWIND AND UNLOAD
MTDFLG==100	;MTA ADVANCE ONE RECORD
MTPFLG==200	;MTA BACKSPACE ONE RECORD
MT8FLG==400	;MTA SET 800 B.P.I.
MT5FLG==1000	;MTA SET 556 B.P.I.
MT2FLG==2000	;MTA SET 200 B.P.I.
MTEFLG==4000	;MTA SELECT EVEN PARITY

;AUXFLG ASSIGNMENTS (RIGHT HALF)

REDFLG==1	;==1 IF ANY FILES ARE INPUT (OTHER THAN DIRECTORIES)
SYSFLG==2	;DEVICE IS SYS
SYSLST==4	;LAST DEVICE WAS SYS
LPTOUT==10	;LPT OUTPUT
FFLG==20	;LIST SHORT DISK DIRECTORY
ONEOUT==40	;ONE OUTPUT FILE INITIALIZED
CDRIN==100	;CARDS IN
MTAOUT==200	;OUTPUT TO MTA
MTAIN==400	;INPUT FROM MTA
TTYIN==1000	;INPUT FROM TTY
READ1==2000	;LOOK FOUND NEW INPUT FILE, NO READ YET.
DTAOUT==4000	;OUTPUT TO DTA
DSKOUT==10000	;OUTPUT TO DSK
DTAIN==20000	;INPUT FROM DTA
DSKIN==40000	;INPUT FROM DSK
TTYOUT==100000	;OUTPUT TO TTY
PPTIN==200000	;INPUT FROM PTR
PPTOUT==400000	;OUTPUT TO PTP
;CALFLG ASSIGNMENTS (RIGHT HALF) FOR DESCRIBING A BLOCK OF INFORMATION
;FOUND BY THE COMMAND SCANNER.

FNEX==1		;==1 WHEN FN.EX==*.*, *.EXT, FN.* (WHEN MORE
		;THAN ONE FN.EX IS IMPLIED).
MATEX==2	;FILE EXTENSIONS MUST MATCH
MATFN==4	;FILE NAMES MUST MATCH
NEWDEV==10	;A NEW INPUT DEVICE WAS GIVEN
NEWPP==20	;A NEW #P-P WAS GIVEN
ASTFLG==40	;FLAG SET WHEN FILE NAMED IN CS FOUND
		;BY LOOK ROUTINE EVEN IF FN OR EXT =*
DEV==100	;DEVICE NAME INDICATOR
DVSWTH==200	;OUTPUT DEVICE SEEN
NSWTCH==400	;INDICATES NULL NAME
SSWTCH==1000	;LEFT ARROW SEEN
LISTTY==2000	;LIST TO TTY
TMPI==4000	;INPUT DEVICE TMPCOR SEEN
TMPO==10000	;OUTPUT DEVICE TMPCOR
RXFLG==20000	;(RX) SEEN

ALLCLF==FNEX!MATEX!MATFN!NEWDEV!NEWPP

;DEVICE CHANNEL ASSIGNMENTS

CON==1		;COMMAND INPUT CHANNEL
OUT==2		;OUTPUT DEVICE
IN==3		;INPUT DEVICE
TAPE==4		;MTA POSITIONING
DIR==5		;DISK DIR. READ
BLKIN==6	;INPUT FOR 10/30 DISK FILES
DTDIR==7	; DECTAPE DIR. READ(FOR PPN)

;ACCUMULATOR ASSIGNMENTS

T1=1		;GENERAL PURPOSE
T2=2		;G.P.
T3=3		;G.P.
CHR=4		;INPUT CHARACTER
P=5		;PUSHDOWN POINTER
FLAG=6		;FLAG REGISTER
T4=7		;G.P.
IOS=10		;IO STATUS BITS
T5=11		;G.P.
T6=12		; G.P.
AUXFLG=13	;AUXILIARY FLAG REGISTER
T7=14		;G.P.
DOUT=15		;DIVIDED NO. FOR OUTPUT
DOUT1=16	;REMAINDER, DOUT+1
CALFLG=17	;MORE FLAGS

;MISCELLANEOUS PARAMETERS

WRTLOK==400000	;WRITE LOCK (DECTAPE) /IMPROPER I/O
BIGBLK==40000	;BLOCK TOO LARGE
INBIT==2	;DEVCHR BIT FOR DEV CAN DO INPUT
OUTBIT==1	;DEVCHR BIT FOR DEV CAN DO OUTPUT
EOFBIT==20000	;END OF FILE
EOTBIT==2000	;END OF TAPE
DTABIT==4	;DEVCHR BIT FOR DECTAPE IDENTIFICATION
INHIB==1	;OUTPUT RELEASE INHIBIT BIT
TABSP==10	;SPACES PER TAB
PTRBIT==200	;DEVCHR BIT FOR PTR
PTPBIT==400	;DEVCHR BIT FOR PTP
DSKBIT==200000	;DEVCHR BIT FOR DSK
MTABIT==20	;DEVCHR BIT FOR MTA
LPTBIT==40000	;DEVCHR BIT FOR LPT
TTYBIT==10	;DEVCHR BIT FOR TTY
CDRBIT==100000	;DEVCHR FOR CDR
DENS2==200	;MTA 200 BPI
DENS5==400	;MTA 556 BPI
DENS8==600	;MTA 800 BPI
PARE==1000	;MTA EVEN PARITY
LDP==4000	;MTA LOAD POINT STATUS
HPAGE==20

;MACRO DEFINITIONS

DEFINE SKIP (J)<JRST	.+1+'J>

DEFINE	LSTLIN (Z),<
	SKIPA   T1,[POINT 7,Z]
	PUSHJ   P,PUT
	ILDB    CHR,T1
IFN WCH,<PUSHJ	P,CCASE>
	JUMPN	CHR,.-2>

DEFINE	ERRPNT	(X),<
	JSP	T1,PTEXT
	ASCIZ	X>

DEFINE	ERRPN2	(X),<
	JSP	T1,PTEXT2
	ASCIZ	X>

DEFINE	ERRPNX	(X),<
	JSP	T1,PRETXT
	ASCIZ	X>


LOW:

;ASCII CHARACTERS

CR==15		;CARRIAGE RETURN
LF==12		;LINE FEED
FF==14		;FORM-FEED
ALTMOD==33	;NEWEST ALTMODE
ALT175==175	;OLDEST ALTMODE
ALT176==176	;OLDER ALTMODE
LA==137		;LEFT ARROW
CZ==32		;CONTROL Z
XON==21		;^Q,START TTY PTR
XOFF==23	;^S,STOP TTY PTR MODE
COMMA==54
PERIOD==56	;PERIOD
COLON==72
SPACE==40
DEL==177	;DELETE,RUBOUT,REPEAT MOD.35
TAB==11		;TAB


;CALLI DEFINITIONS

OPDEF	RESET	[CALLI	 0]
OPDEF	DEVCHR	[CALLI	 4]
OPDEF	CORE	[CALLI	11]
OPDEF	EXIT	[CALLI	12]
OPDEF	UTPCLR	[CALLI	13]
OPDEF	DATE	[CALLI	14]
OPDEF	MSTIME	[CALLI	23]
OPDEF	GETPPN	[CALLI	24]
OPDEF	PJOB	[CALLI	30]
OPDEF	RUN	[CALLI	35]
OPDEF	GETTAB	[CALLI	41]
OPDEF	TMPCOR	[CALLI	44]
OPDEF	DSKCHR	[CALLI	45]
OPDEF	JOBSTR	[CALLI	47]
OPDEF	DEVPPN	[CALLI	55]
OPDEF	WAIT	[MTAPE   0]

;EXTENDED LOOKUP PARAMETERS

RBSIZ==5		;WRITTEN FILE LENGTH
RIBSTS==17		;STATUS BITS



PIP1:	MOVE	0,[LOW,,LOW+1]
	SETZM	LOW
	BLT	0,LOWTOP
	MOVSI	(SIXBIT /SYS/)
	DEVPPN			;FIND PP OF DEVICE SYS
	MOVE	PP13		;ASSUME 1,,3 IF NOT LEVELD
	MOVEM	SYSPP		;SAVE AS SYS PP
IFN FTDSK,<
	MOVE	[XWD 17,11]	;STATES WORD
	GETTAB			;GET IT
	SETZ			;ERROR RETURN
	TLNN	(7B9)		;TEST FOR LEVEL D
	TDZA			;NOT LEVEL D
	HRROI	-2		;THIS IS LEVEL D
	MOVEM	LEVEL		;SAVE  >
IFE FTDSK,<HLRZ	T1,JOBSA	;NO DSK SO USE JOBFF>
IFN FTDSK,<MOVEI T1,DSKDR	;ASSUME NO DISK FOR TEST, LOC OF DSK RTNS
	MOVSI	0,(SIXBIT /DSK/)
	DEVCHR			;DEVCHR REQUEST: IS THERE A DSK 
	JUMPE	0,P1		;0 IF NO DISK: USE DSKDR
	MOVE	T1,JOBFF	;DISK: PREPARE TO SAVE C(JOBFF)
	HRRZ	T2,JOBREL	;HIGHEST REL LOC AVAILABLE TO USER
	CAIL	T2,6000		;CURRENT SIZE 4K
	JRST	P1		;YES
	MOVEI	T2,7777		;NO. EXPAND TO 4K
	HRRZM	T1,SVJBFF	;SAVE JOBFF SO BUFFERS CAN BE CREATED
	CORE	T2,		;CORE UUO
	JRST	DERR7		;CORE UNAVAILABLE>
P1:	HRRZM	T1,SVJBFF	;SAVE JOBFF SO BUFFERS CAN BE CREATED
	JRST	PIP

IFN FTDSK,<
DERR7:	ERRPNT	</?4K needed/>
	EXIT			;EXIT TO MONITOR>

PIP:	RESET		;REINITIALIZE WHEN RESTARTED MANUALLY
			;NEW COMMAND STRING SCAN STARTS HERE
PIP2:	
PIP2A:	JSP T5,INICN1	;INITIALIZE THE TTY AND PDL
	MOVEI 0,CR	;TYPE CR
	IDPB 0,TFO+1
	MOVEI 0,LF	;AND LF
	IDPB	0,TFO+1
	MOVEI	0,"*"	;TYPE ASTERISK******
	IDPB 0,TFO+1	;READY TO ACCEPT
	OUTPUT CON,	;COMMAND FROM TTY
PIP2B:	SETZM TOTBRK	;CLEAR PAREN COUNTER
	MOVEI 0,TABSP	;SPACES PER TAB
	MOVEM 0,TABCT	;INITIALIZE TAB COUNT
	MOVE 0,ZRO	;ASCII /00000/
	MOVEM 0,SQNUM	;INITIALIZE SEQUENCE NUMBERS
	RELEAS CON,	;RELEASE TTY FOR USE AS IN-OUT DEVICE

MAINA1:	SETZB FLAG,FILNAM   ;INITIALIZE FOR FIRST/NEXT COMMAND STRING
	SETZB AUXFLG,DEVICE
IFN FTDSK,<HRRZI 0,(SIXBIT /SYS/) ;SYSTEM DIRECT DEV, DSK/DTA
	HRLZM 0,ADSK		;PUT IN SYSTEM DEVICE>
	MOVE 0,[XWD FILNAM,FILNAM+1]	;SET PROJECT, PROG NO.
	BLT 0,AB	;ZERO OUT FILNAM - AB
	SETZ	CALFLG,		;CLEAR OTHER FLOGS
	MOVE T3,COMPTR	;BYTE POINTER FOR STORING CS IN BUFFER

;ACCUMULATE CS CHARS IN COMBUF ALLOW LONG CS ONLY FOR TTY COMMAND

COMSTO:	PUSHJ	P,GETTA		;GET CS CHAR
	AOS	T4,COMCNT	;COUNT CHARS
	CAILE	T4,^D200	;ALLOW UP TO 200 CHARS
	JRST	ERR6B		;MORE THAN 200 CHARS
	CAIN	0,CZ		;CHECK FOR ^Z
COMASK:	PUSHJ	P,GETEN2	;SET  ^Z IN 0
	IDPB	0,T3		;STORE IN COMBUF
	SKIPE	COMEOF		;END-OF-FILE SET?
	JRST	COMPRO		;YES, PROCESS CS IN COMBUF
	CAIG	0,CR		;NOT EOF
	CAIGE	0,LF		;LF,VT,FF,CR?
	CAIN	0,ALTMODE	;NO, $?
	JRST	COMASK		;YES
	JRST	COMSTO		;NO, KEEP STORING

COMPTR:	POINT	7,COMBUF

;********************************************************************
;BEGIN SCAN OF DESTINATION PORTION OF COMMAND STRING
COMPRO:
IFN FTDSK,<
	MOVSI	0,(SIXBIT/DSK/)
	DEVCHR				;IS THERE A DSK?
	JUMPE	0,COMPRP
	MOVSI	0,(SIXBIT /DSK/)	;MAKE DEFAULT DEVICE
	MOVEM	0,DEVICE		;TENTATIVELY DSK>

COMPRP:	RELEASE	CON,		;RELEASE TTY
	MOVE	0,COMPTR	;INITIALIZE POINTER
	MOVEM 0,COMPTS		;TO PICK UP CS FROM COMBUF
	PUSHJ P,NAME	;GO SCAN DESTINATION PORTION OF COMMAND STRING
	SKIPE XNAME	;NO SCAN OVERSHOOT ALLOWED
	JRST ERR6A
	SKIPL	ESWTCH	;11/25/69  END OF CS ?
	JRST	MAINC	;NO
	TRNN	CALFLG,NSWTCH	;NON-NULL DESTINATION
	TRNE	CALFLG,SSWTCH	;_ NOT SEEN?
	SKIPE	FILNAM		;OR ANYTHING IN FILENAME
	JRST	ERR6A		;YES, ERROR
	JRST	PIP2		;NO, ALL OK

MAINC:	MOVE 0,DEVICE	;GET OUTPUT DEVICE NAME
	MOVEM 0,ODEV	;SAVE DEVICE NAME FOR LATER USAGE
	PUSHJ P,DEVTST	;SAVE DEVICE TYPE, SET XXXOUT.E.G. DTAOUT
	PUSHJ P,ABCHK	;CHECK MTA BACKSPACE/ADV VALUES
	PUSHJ P,PROTK	;CHECK PROTECTION
	MOVE 0,AB	;MTA VALUE SWITCHES
	MOVEM 0,ABOUT	;GET MTA CONTROL NUMBERS FO R OUT
	MOVE 0,AUX
	MOVEM 0,AUXOUT
	MOVE 0,[XWD FILNAM,DTON]
	BLT 0,DTON+3	;SAVE DESTINATION FILE NAME
IFN FTDSK,<TRNN AUXFLG,DSKOUT	;DISK OUTPUT?>
	SETZM DTON+3    ;ZERO 4TH WD OF DIRECTORY ENTRY
M3:	TRZ	CALFLG,SSWTCH	;TERMINATE DESTINATION FILE SCAN
	SETZM DEVICE	;DONT CARRY OVER INPUT DEVICE
IFN FTDSK,<MOVSI 0,(SIXBIT/DSK/)
	DEVCHR		;IS THERE A DISK
	JUMPE 0,M3A
	MOVSI 0,(SIXBIT /DSK/)	;DEFAULT CASE DSK
	MOVEM 0,DEVICE	;MUST NOT LET O/DEV. CARRY OVER AS I/DEV.>
M3A:	PUSHJ P,DESCRP	;GET A UNIT DESCRIPTOR (INPUT).
	TLNN AUXFLG,QFLG;Q?	;SCAN INPUT PORTION OF COMMAND STRING
	JRST M2		;NO
	HRRZI 0,(SIXBIT /SYS/)	;YES MAKE INPUT DEVICE SYS
	HRLZM 0,DEVICE
	HRLZM DEVA		;SAVE COPY OF INPUT DEVICE
	MOVE 0,QPIP		;MAKE INPUT FILENAME QPIP
	MOVEM 0,FILNAM
	MOVSI 0,(SIXBIT /*/)	;DONT RESTRICT QPIP
	MOVEM 0,FILEX	;EXT TO BEING NULL
	TRZ	CALFLG,MATEX	;DON'T MATCH EXTENSIONS
	TRO	AUXFLG,SYSFLG	;DEVICE IS SYS
	MOVE	0,SYSPP	;GET SYS PP
	MOVEM	0,PP	;AND SET IT
	SOS ESWTCH	;NO MORE COMMAND STRING
	TRZ AUXFLG,DTAIN+DSKIN+CDRIN+PPTIN+TTYIN+MTAIN
	PUSHJ P,CHECK1	;CHECK INPUT DEVICE

M2:	TLO AUXFLG,NOMORE	;NO MORE SWITCHES BUT MTA ALLOWED
	TLNE FLAG,OFLG	;BLOCK 0 COPY?
	JRST BLOCK0	;YES
	TRC FLAG,XFLG+RFLG;(RX)
	TRCN FLAG,XFLG+RFLG
	PUSHJ	P,M5	;YES,(RX)
IFN RIMSW,<
	TLNN FLAG,RIMFLG	;RIM OUTPUT?
	JRST M1		;NO
IFE WCH,<	
	TRNE AUXFLG,PPTOUT	;RIM IS ONLY DTA TO PTP
	TRNN AUXFLG,DTAIN!DSKIN!MTAIN
	JRST ERR5B>
IFN WCH,<JRST RIMTB  >>

M1:	MOVEI T4,1	;ASCII LINE MODE ASSUMED
	PUSHJ P,OUTLOOK	;SEE IF OUTPUT DEV MTA
	PUSHJ P,M4	;NOT MTA
	TLNE	FLAG,JFLG	;NON STARDARD MODE ?
	TRO	T4,100		;TO PUNCH 029 ON CDP
	HRRZM T4,OMOD	;SET MODE OF OUTPUT DEV
	MOVEI T4,1
	PUSHJ P,INLOOK	;SEE IF INPUT DEV MTA
	PUSHJ P,M4	;NOT MTA
	HRRZM T4,ININI1	;SET MODE OF INPUT DEV
	PUSHJ P,FNSET	;NOW DEVICE, DEVA CORRECT FOR START
	JRST OMOD1	;INIT OUTPUT DEVICE

;SET MODE IF /I,/B,/H,

M4:	TLNN FLAG,IFLG	;IMAGE BINARY MODE?
	JRST .+3	;NO
	TRO T4,10	;IM. MODE
	TRZ T4,1	;CLEAR ASCII LINE MODE

	TRNN FLAG,BMOD	;BINARY MODE?
	JRST .+3	;NO
	TRO T4,14	;BIN. MODE
	TRZ T4,1	;CLEAR ASCII LINE MODE

	TLNE FLAG,IBFLG	;ASCII TO START.  IB MODE?
	TRO T4,13	;YES
	TRNE FLAG,XFLG	;COPY MODE?
	POPJ P,		;YES, DON'T ALTER DATA MODE

	TRNE FLAG,DFLG+RFLG	;DELETE OR RENAME?
	TRO T4,20	;DIRECTORY WILL BE WRITTEN, DON'T
	POPJ P,		;COMPUTE WORD COUNT MODE NEEDED.
			;FORCE MONITOR TO USE WORD COUNT
			;IN FIRST DATA WORD OF BUFFER

M5:	TRZ	FLAG,RFLG	;CLEAR /R FLAG
	TRO	CALFLG,RXFLG	;SET (RX) FLAG
	MOVE	0,[XWD DTON,MATCH]
	BLT	0,MATCH+1	;SAVE NAME AND EXT
	POPJ	P,		;RETURN
;IF OUTPUT DEVICE IS MTA PERFORM ALL PRE-TRANSFER REQUESTS
;SUCH AS REWIND.  IF OUTPUT DEVICE IS MTA, AND THERE IS NO 
;INPUT DEVICE, EXIT.  FOR OTHER MTA OUTPUT, PREPARE INIT
;DENSITY AND PARITY.

OUTLOOK:
	MOVE T3,ABOUT	;AB FOR OUTPUT DEV
	MOVE T1,AUXOUT	;AUX FOR OUTPUT DEV
	MOVEI T6,INOMTA	;SET TO INIT
	JRST MT1	;MTA FOR OUTPUT




;SAME FOR INPUT DEVICE.

INLOOK:	SKIPE	T3,FILNAM	;IF NO FILENAME
	TRNN	FLAG,XFLG	;OR NOT /X
	JRST	INLUK1		;CONTINUE
	SKIPE	DTON		;IF OUTPUT NAME SET UP
	JRST	INLUK1		;CONTINUE
	HLRZ	T1,FILEX	;GET EXT
	CAIE	T1,(SIXBIT /*/)	;IF EITHER IS *
	CAMN	T3,STAR		;DON'T SET OUTNAME
	JRST	INLUK1		;BUT JUST CONTINUE
	MOVEM	T3,DTON		;SET OUT NAME
	HRLZM	T1,DTON+1	;AND EXTENSION
INLUK1:	MOVE T3,AB	;ADV OR BKSPACE
	MOVE T1,AUX	;AUX FOR INPUT DEV
	MOVEI T6,INIMTA	;SET TO INIT
	JRST MT1	;MTA FOR INPUT
;ROUTINE TO INITIALIZE OUTPUT DEVICE

OMODE:	MOVE T1,[XWD OBF,IBF]
	MOVEM T1,ODEV+1
	MOVE T1,DTJBFF	;JOBFF AFTER 2 TTY BUFS
	MOVEM T1,JOBFF	;SET UP

	OPEN OUT,OMOD	;INITIALIZE OUTPUT DEVICE
	JRST ERR1	;UNAVAILABLE ERROR
	OUTBUF OUT,1	;TRY ONE OUTBUFFER FOR SIZE
	EXCH T1,JOBFF	;JOBFF_DTJBFF+BUFSZ
			;NOTE JOBFF RESET TO DTJBFF
	SUB T1,DTJBFF	;T1=BUFSZ
	HRRZ 0,JOBREL	;HIGHEST CORE AVAILABLE
	SUB 0,DTJBFF	;0=TOTAL CORE AVAILABLE
	ASH 0,-1	;COMPUTE HOW MANY OUTPUT BUFFERS
	IDIVM 0,T1	;FIT IN HALF THE AVAILABLE SPACE
	MOVEI T4,OMODE	;SET RETURN FROM MORCOR
	CAIGE T1,1	;1 OR MORE THAN 1 FIT?
	JRST MORCOR	;NO, NEED MORE CORE
	OUTBUF OUT,(T1)	;SET UP OUTPUT BUFFERS
	MOVE 0,OBF+1
	MOVEM 0,SVOBF	;SAVE ORIGINAL MODE SETTING
	MOVE 0,JOBFF
	HRRZM 0,SVJBF1	;PREPARE TO RECLAIM INBUFFER SPACE
	POPJ P,

OMOD1:	PUSHJ P,OMODE	;GO INITIALIZE OUTPUT DEVICE
	TRZN FLAG,ZFLG	;Z COMMAND TYPED?
	JRST MAINA2	;NO,
	PUSHJ P,DTCLR	;YES, GO CLEAR DIRECTORY
	RELEASE OUT,
	RELEASE DIR,
	TRNN	CALFLG,NSWTCH	;SEE IF DEVICE WAS TYPED
	JRST OMOD1	;YES
	JRST PIP2	;GET NEXT COMMAND

MORCOR:	HRRZ 0,JOBREL	;TRY TO GET
	ADDI 0,2000	;1K MORE OF CORE
	CORE		;ASK MONITOR FOR 1K CORE
	JRST OMODER		;NOT AVAILABLE
	JRST (T4)	;GOT IT

OMODER: ERRPNT</?Not enough core/>
	EXIT
;MAIN LOOP TO PROCESS INPUT SIDE OF CS


MAINA2:	TRNE   FLAG,RFLG+DFLG	;RENAME OR DELETE FILE MODE?
	JRST   DTDELE		;YES./D,/X,OR(DX)
IFN RIMSW,<
	TLNE   FLAG,RIMFLG	;RIM?
	JRST   RIMTB		;YES./Y
	>
	TRNE   FLAG,XFLG	;TRANSFER EVERYTHING MODE?
	JRST   PRECOP		;YES./X
;LOOP TO COPY ALL FILES BEGINS HERE FROM MAIN2
MAINA3:	TRNN   AUXFLG,FFLG	;LIST DSK DIR SHORT?
	TRNE   FLAG,LFLG	;LIST DIRECTORY?
	JRST   DTPDIR		;YES./F OR /L
	PUSHJ  P,ININIT		;INITIALIZE INPUT FILE
	TRNE   AUXFLG,DTAIN	;DEC TAPE INPUT?
	PUSHJ  P,DTADIR		;INIT DTA DIR

IFN FTDSK,<TRNE   AUXFLG,DSKIN	;NO, DISK INPUT?
	PUSHJ  P,DSKDIR		;OR DSK>
MAINA4:	PUSHJ  P,LOOK		;GET A FILE TO COPY
	JRST   MAINA5		;NO MORE
	LOOKUP IN,ZRF
	JRST   ERR3		;LOOKUP FAILURE
IFN WCH,<
MAINA6:	TRNN  AUXFLG,DTAIN+DTAOUT
	JRST  .+5
	HLRZ  0,ZRF+1
	CAIE  0,(SIXBIT /DMP/)
	IFN DISK30,<CAIN 0,(SIXBIT/SVE/)>
	IFE DISK30,<CAIN 0,(SIXBIT/SAV/)>
	JRST  MAINA4		;DONT COPY DMP OR SAV FILES ON DTA>
	TLO   FLAG,NEWFIL
	PUSHJ P,FILTYP
	TRNE  AUXFLG,ONEOUT
	JRST  PSCANA		;OUT HAS BEEN INITIALIZED
IFE WCH,<
	PUSHJ P,OKBLKS>
	ENTER OUT,DTON		;CREATE OUTPUT FILE
	JRST  ERR4		;DIR. FULL OR 0 FILE NAME
	JRST  PSCANA

MAINA5: TRZN  AUXFLG,REDFLG
	JRST  IOERRN		;NEVER READ A FILE
	JRST  MAIN1
PSCANB:	TRNE AUXFLG,MTAIN!CDRIN!TTYIN!PPTIN	;ON NON-DIR DEVICE?
	TRZ	CALFLG,ALLCLF	;END OF THE ONE OR MANY FILES SPECIFIED
	TRON AUXFLG,ONEOUT	;HAS OUT JUST BEEN INIT?
	OUTPUT OUT,	;YES, AND FIRST FILE IS EOF ONLY, INIT OUT IN
			;CASE NO MORE SOURCE FILES
	JRST PSCAN5	;EMPTY FILE, CLOSE INPUT, RETURN FOR MORE

PSCANA:	TRO   AUXFLG,REDFLG	;SET FLAG FOR INPUT FILE READ
	PUSHJ P,INP		;GO READ INPUT FILE
	TRZ   AUXFLG,READ1
	PUSHJ P,TTYZ		;CHECK IF INPUT IS TTY
	TRNE IOS,EOFBIT		;EOF FIRST DATA?
	JRST PSCANB
	SKIPN IBF+2
	JRST PSCANA

PSCAN:	TRO AUXFLG,ONEOUT	;INDICATE ONE OUTPUT FILE INITED
	MOVE 0,OPTRA	;PRESCAN A LINE, INITIALIZE LINE BUFFER PTR
	MOVEM 0,OPTR
	SETZM CDRCNT
	PUSHJ P,CLRBUF	;CLEAR LINE BUFFER
	TROA FLAG,STS	;START A FRESH LINE
PSCAN3:	PUSHJ P,PUT	;HERE FOR BINARY DATA

PSCAN2:	PUSHJ P,GET	;GET CHARACTER
	JRST PSCAN1	;END OF FILE RETURN
	TDNN FLAG,[XWD IFLG+IBFLG,BMOD]	;BIN. OR NO CHAR. PROCESSING
	TLNE AUXFLG,SBIN
	JRST PSCAN3	;YES
	MOVE T1,OPTR
	CAIN CHR,DEL	;VJC 4/16/69
	JRST PSCAN2	; STR# 10-2615
	CAMN T1,OPTMAX	;CHECK LENGTH OF LINE
	JRST ERR10   	;LINE TOO LONG
	IDPB CHR,OPTR	;DEPOSIT CHAR. IN LINE BUFFER
	CAIG CHR,24
	CAIGE	CHR,20	;LINE PRINTERR CONTROL CHAR
	SKIP	1	;NO
	JRST PSCAN4	;YES, TREAT AS END OF LINE
	CAIG CHR,14
	CAIGE CHR,12	;END OF LINE CHARACTER?
	JRST PSCAN2	;NO, SO CONTINUE
PSCAN4:	PUSHJ P,OUTLBF	;YES, SO DUMP THE LINE BUFFER
	JRST PSCAN	;SCAN THE NEXT LINE

PSCAN1:	LDB	CHR,OPTR	;PICK UP LAST CHAR.
	CAIN	CHR,CZ		;IS IT ^Z
	TRNN	AUXFLG,TTYIN	;FROM TTY?
	JRST	PSCAN6		;NO
	SETZ	CHR,		;YES,CLEAR CHAR.
	DPB	CHR,OPTR	;AND REMOVE FROM BUFFER
PSCAN6:	PUSHJ P,OUTLBF	;DUMP THE REMAINING BUFFER
	TRNE FLAG,XFLG	;COPY MODE?
	JRST COPY2A	;YES, GO COPY THE NEXT FILE
PSCAN5: CLOSE IN,
	JRST MAINA4
;COME HERE AFTER /L,/D,/R ON DISK OR THROUGH COPYING

MAIN1:	RELEAS DIR,	;RELEASE THE DIRECTORY DEVICE
	RELEAS IN,INHIB	;RELEASE THE INPUT DEVICE
	SKIPL T4,ESWTCH	;MORE COMMAND STRING TO PROCESS?
	JRST MAIN2	;YES

;COME HERE AFTER /D,/R ON DTA. ALSO FROM ABOVE

MAINB:	CLOSE OUT,	;CLOSE THE OUTPUT FILE
	PUSHJ P,OUTP1	;CHECK THE FINAL ERROR BITS
IFN FTDSK,<TLNE AUXFLG,NSPROT	;NON-ST. PROT?
	TRNN AUXFLG,DSKOUT+DTAOUT	;DISK OUT/ OR DTA
	JRST MAINB1	;NO
	LDB 0,PRPTL
	DPB 0,PRPTD
	RENAME OUT,DTON	;SET UP RENAME REQUEST
	JRST DERR6	;DISK ERROR
MAINB1:>
	RELEAS OUT,	;RELEASE THE OUTPUT DEVICE
	JRST PIP2	;PROCESS THE NEXT COMMAND

MAIN2:	PUSHJ P,DESCRP	;GET THE NEXT INPUT FILE TO PROCESS
	PUSHJ P,INLOOK
	PUSHJ P,M4
	HRRZM T4,ININI1
	JRST MAINA3
;END OF LOOP BEGINNING AT MAINA3
;SUBROUTINE TO INITIALIZE THE INPUT FILE

ININIT:	MOVE T1,SVJBF1	;SVJBF1=END OF OUTPUT BUFFERS

	MOVEM T1,JOBFF	;COMPARE OMODE CODE
	MOVEI 0,IBF
	MOVEM 0,DEVICE+1
	OPEN IN,ININI1
	JRST ERR1A	;NOT AVAILABLE ERROR
	INBUF IN,1	;TRY ONE INPUT BUFFER FOR SIZE
	EXCH T1,JOBFF	;HOW MANY INBUFFERS WILL FIT?
	SUB T1,SVJBF1
	HRRZ 0,JOBREL
	SUB 0,JOBFF	;JOBREL-SVJBF1=TOTAL SPACE LEFT
	IDIVM 0,T1
	MOVEI T4,ININIT	;RETURN FROM MORCOR IS ININIT
	CAIGE T1,1	;1 OR MORE THAN 1 FITS?
	JRST MORCOR	;NO, GET MORE CORE
	INBUF IN,(T1)	;SET UP AS MANY BUFFS AS FIT
	MOVE 0,IBF+1	;SAVE ORIGINAL MODE
	MOVEM 0,SVIBF
	POPJ P,
;THIS ROUTINE GETS AN INPUT UNIT DESCRIPTOR AND, FOR
;ADVANCE FILE AND BSPF ON MTA, ENSURES THE VALUE 1 IF NO
;NUMBER WAS GIVEN.

DESCRP:	SETZM AUX	;WILL GET ANY MTA REQ. GOING TO AUXFLG.
	TRZE	AUXFLG,SYSFLG	;IS THIS DEVICE SYS.?
	TRO	AUXFLG,SYSLST	;YES,SET SYS AS LAST DEVICE
	SETZM AB	;MTA VALUE SWITCHES
	SETZM PR	;PROTECTION
	SETZM PP	;PROJ-PROG NUMBER
;********************************************************************
	PUSHJ P,NAME	;GO SCAN INPUT SIDE OF COMMAND STRING
	MOVE T1,PR	;PROTECTION
	HLLZM T1,PR	;IGNORE PR FLAG IN RHS FOR INPUT
	TRZ AUXFLG,DTAIN+DSKIN+PPTIN+MTAIN+CDRIN+TTYIN
	PUSHJ P,CHECK1	;CHECK UNIT, AND FOR _

IFN FTDSK,<TRNN AUXFLG,DSKIN	;DSK INPUT?
	JRST DESCR1	;NO
	TRNE	AUXFLG,SYSFLG	;IS THIS DEVICE SYS?
	JRST DESCR1	;YES
	TRNN	AUXFLG,SYSLST	;WAS LAST DEVICE?
	JRST DESCR1	;NO
	MOVE T2,FNPPNS	;YES, SAVE LAST [P,P]
	SKIPE PP	;[P,P] ZERO?
	JRST DESCR1
	MOVEM T2,PP	;YES, MAKE OLD [P,P] CURRENT [P,P]
	MOVEM T2,FNPPN	;RESERVE [P,P]>
DESCR1:	SKIPE XNAME	;NO OVERSHOOT ALLOWED
	JRST ERR6A

ABCHK:	HLRZ T2,AB	;NO RECS/FILES TO BACKSPACE
	JUMPN T2,.+2	;IF 0
	MOVEI T2,1	;GUARANTEE ONE
	HRLM T2,AB	;SET AB LH

	HRRZ T2,AB	;NO RECS/FILES TO ADV
	JUMPN T2,FNSET	;IF 0
	AOS AB		;GUARANTEE 1
	JRST	FNSET	;FIND OUT DETAILS OF FILENAME

;IF A NON-STANDARD OUTPUT PROTECTION IS REQUESTED, SAVE FOR RENAME.

PROTK:	MOVE T1,PR
	TRNN T1,1
	JRST PROTK1
	HLLZM T1,PROTS
	HLLZM T1,PR
	TLOA AUXFLG,NSPROT
PROTK1:	SETZB	T1,PR
	POPJ P,

;TEST "DEVICE" TO SEE IF DESTINATION DEVICE IS DTA, DSK, PTP, LPT, TTY, MTA
;IF ANY IS TRUE, SET RELEVANT BIT IN AUXFLG.  "0" CONTAINS
;"DEVICE" ON ENTRY.

DEVTST:	DEVCHR		;GET DEVICE CHARACTERISTICS
IFN FTDSK,<TLNN 0,DSKBIT	;IS OUTPUT DEV DSK?
	JRST DEVTSU	;NO
	TRO AUXFLG,DSKOUT	;YES, SET BIT
	PUSH	P,DEVICE	;SAVE DEVICE NAME
	POP	P,ADSK		;PUT NAME IN DSK INIT
	POPJ P,
DEVTSU:>
	JUMPE	0,DEVER2	;NON-EXISTENT DEVICE
	TLNN 0,OUTBIT	;CAN DEV DO OUTPUT?
	JRST ERR6A	;NO

	TLNE 0,DTABIT	;DECTAPE?
	TRO AUXFLG,DTAOUT	;YES

	TLNE 0,PTPBIT	;PAPER TAPE PUNCH?
	TRO AUXFLG,PPTOUT

	TLNE 0,LPTBIT	;LINE PRINTER?
	TRO AUXFLG,LPTOUT

	TLNE 0,TTYBIT	;TELETYPE?
	TRO AUXFLG,TTYOUT

	TLNE 0,MTABIT	;MAGTAPE?
	TRO AUXFLG,MTAOUT

	POPJ P,

;ROUTINE TO CHECK IF DEVICE SYS AND SET [P,P], IF NONE GIVEN

IFN FTDSK,<
PSYSP:	CAME	0,[SIXBIT /SYS/];IS DEVICE SYS?
	POPJ	P,		;NO
	MOVE	T1,SYSPP	;GET SYS PP
	MOVEM	T1,PP		;AND SET IT
	TRO	AUXFLG,SYSFLG	;SET FLAG TO INDICATE
	POPJ	P,		;CURRENT INPUT DEVICE IS SYS>

DEVER1:	
DEVER2:	MOVE	T1,DEVICE
DEVER:	MOVEM	T1,DEVERR
	ERRPNT	</?Device />
	PUSHJ	P,P6BIT
		DEVERR
	ERRPN2	</does not exist!/>
;ROUTINE TO INIT PDL POINTER AND TTY

INICN1:	MOVEI	P,PDL-1		;INITIALIZE PUSHDOWN POINTER
INICN2: MOVE	0,SVJBFF	;IS INITIALIZED AT PIP1
	MOVEM	0,JOBFF		;SET JOBFF TO BEGINNING OF BUFFER AREA
	PUSHJ	P,INICON	;INITIALIZE THE TTY
	INBUF	CON,1		;ONE INBUFFER
	OUTBUF	CON,1		;ONE OUTBUFFER
	MOVE	0,JOBFF
	HRRZM	0,DTJBFF	;JOBFF AFTER 2 TTY BUFFERS SET
	OUTPUT	 CON,		;INITIALIZE BUFFER POINTERS
	JRST	(T5)

;ROUTINE TO CLEAR LINE BUFFER

CLRBUF:	SETZM	LBUF		;SUBR. TO CLEAR LINE BUFFER
	MOVE	0,[XWD LBUF,LBUF+1]
	BLT	0,LBUFE
	POPJ	P,

;COMMAND SCANNER ROUTINE

NAME:	TRNN	CALFLG,SSWTCH	;RETURN NULL IF _ OR END-OF-LINE SEEN
	SKIPGE	ESWTCH
	JRST	NM13		;
	TRZ	CALFLG,NSWTCH
	SKIPE	T1,XNAME	;IF COMMAND SCAN OVERSHOOT PICKED UP
				;DEVICE NAME, USE IT NOW
	JRST	NM7
	TRZ	CALFLG,DEV
;LOOK FOR FILE NAME, EXT
NM1:	SETZM	FILEX
NM2:	SETZM	FILNAM
	MOVE	T1,NM15
;LOOP TO PICK OFF FILENAME, EXT
NM3:	PUSHJ	P,GETCOM	;GO GET 7 BIT ASCII CHAR. FROM COMMAND STRING
	CAIE	0,"*"		;TO ALLOW FN.EX = *.*
	CAIL	0,"A"		;ALPHABETIC CHARACTER?
	CAILE	0,"Z"
	JRST	NM4A		;NO
NM4:	SUBI	0,40		;CONVERT TO SIXBIT
	TLNE	T1,770000	;6 CHARS. YET?
	IDPB	0,T1		;NO
	JRST	NM3		;GET NEXT CHAR.
NM4A:	CAIL	0,"0"		;NUMERIC?
	CAILE	0,"9"
	JRST	NM5		;NO
	JRST	NM4
;CHARACTER NOT *,0-9,A-Z
NM5:	CAIG	0,CR		;CARRIAGE RETURN
	CAIGE	0,LF		;LINE FEED
	CAIN	0,ALTMOD	;ALTMODE
	JRST	NM5A		;YES
	CAIN	0,CZ		;END-OF-FILE(CCL)?
NM5A:	SOSA	ESWTCH		;YES, OR EOF
	CAIN	0,COMMA		;COMMA
	JRST	NM6		;YES
	CAIN	0,PERIOD	;PERIOD
	JRST	NM10		;YES
	CAIN	0,COLON		;COLON
	JRST	NM9		;YES
	CAIN	0,";"		;IS THE REST A COMMENT?
	JRST	NM16		;YES
	CAIN	0,"C"-100	;^C
	EXIT			;IN CASE JACCT ON ???
	CAIE	0,LA		;LEFT ARROW
	JRST	NM5B		;NO
	TRO	CALFLG,SSWTCH	;SET LEFT ARROW SWITCH
	TRNE	CALFLG,DEV	;HAS A DEVICE BEEN SEEN?
	TRO	CALFLG,DVSWTH	;YES-NEEDED FOR /Z/,/D

NM6:	SKIPN	T1,FILEX	;COMMA ROUTINE - FIGURE OUT WHAT WE HAVE
	JRST	NM11		;NO FILE NAME TEMPORARILY IN FILEX
	EXCH	T1,FILNAM	;PUT THE FILE NAME WHERE IT BELONGS
	HLLZM	T1,FILEX	;PUT THE EXTENSION WHERE IT BELONGS
	POPJ	P,

NM7:	SETZM	XNAME		;USE XNAME ONLY ONCE
	CAIN	T1,1		;1 FLAGS A NULL OVERSHOOT
	JRST	NM13		;RETURN NULL NAME
NM8:	MOVEM	T1,DEVICE	;NEW DEVICE
	TRO	CALFLG,DEV
	JRST	NM1		;LOOK FOR A FILE NAME AND EXTENSION

NM9:	TRNN	CALFLG,DEV	;COLON ROUTINE - IS DEVICE NAME IN YET?
	JRST	NM12		;NO
	SKIPN	T1,FILNAM	;SCAN OVERSHOOT - NULL OVERSHOOT?
	MOVEI	T1,1		;YES - FLAG NULL OVERSHOOT WITH A 1
	MOVEM	T1,XNAME	;XNAME = OVERSHOOT NAME
	JRST	NM14
NM10:	SKIPE	FILEX
	JRST	ERR6
	MOVE	0,FILNAM	;PERIOD ROUTINE - SAVE FILE NAME
	MOVEM	0,FILEX		;TEMPORARILY IN FILEX
	JRST	NM2		;LOOK FOR EXTENSION
NM11:	SKIPN	FILNAM		;WAS A FILE NAME SPECIFIED?
	TRNE	CALFLG,DEV	;WAS ANYTHING SPECIFIED?
	POPJ	P,		;YES
NM12:	SKIPE	T1,FILNAM	;NULL NAME SPECIFIED?
	JRST	NM8		;NO - SO REMEMBER AND LOOK FOR FILE NAME

NM13:	TRO	CALFLG,NSWTCH	;RETURN A NULL NAME
	SETZM	FILEX
NM14:	SETZM	FILNAM
	POPJ	P,

NM15:	POINT	6,FILNAM
NM5B:	CAIG	0,LA		;ALLOW ANY SIXBIT CHAR NOT CS DELIMITER
	CAIG	0,SPACE		;SPACES IGNORED
	JRST	NM3		;IGNORE NOT LEGAL SIXBIT
	JRST	NM4		;ACCEPT

	PUSHJ	P,GETBUF	;GET NEXT ASCII CHAR.
NM16:	CAILE	0,LF
	CAIG	0,CR		;IF LF,FF,VT,OR CR
	JRST	NM5A		;RETURN
	CAIE	0,ALTMOD	;SAME IF ALTMOD
	CAIN	0,CZ		;OR ^Z
	JRST	NM5A
	JRST	NM16-1		;GET NEXT CHARACTER

;ROUTINE TO OUTPUT ONE LINE FROM LBUF

OUTLBF:	TRNE FLAG,LINE
	JRST OUTLBA	;OUTPUT LINE-BY-LINE
OUTCH1:	MOVE T2,OPTRA	;OUTPUT CHARACTER-BY-CHARACTER
OUTLB1:	CAMN T2,OPTR	;ARE ALL CHARACTERS OUT?
	POPJ P,		;YES
	ILDB CHR,T2	;NO
	PUSHJ P,PUT	;GO OUTPUT CHARACTER
	JRST OUTLB1
OUTLBA:	TLNE FLAG,CHKFLG;PAREN COUNTING?
	JRST OUTCHK	;YES, SO DO IT
	TRNE AUXFLG,TTYOUT+LPTOUT
	JRST OUTCH1	;IF OUTPUT TO TTY OR LPT DO CHR BY CHR	
	MOVEI T1,4	;CLEAR UNUSED PORTION OF LAST WORD USED IN LBUF
	MOVEI T2,0
	MOVE T3,OPTR
	IDPB T2,T3
	SOJG T1,.-1
	MOVEI T2,5
	HRRZ T1,OPTR	;COMPUTE NUMBER OF WORDS FILLED
	SUBI T1,LBUF-1
	JUMPE T1,OUTLB3	;DO NOTHING IF BUFFER EMPTY
	IMULM T1,T2	;COMPUTE CHARACTER COUNT=5 TIMES WORD CT
;THIS IS WHERE OLD FORTRAN MODE WAS TESTED.
	CAMG T2,OBF+2	;WILL LINE FIT IN THE OUTBUFFER?
	JRST OUTLB2	;YES
	PUSHJ P,OUTP	;NO, SO DUMP BUFFER AND CHECK ERROR BITS
	MOVEI T6 ,1
	TDNE T6,LBUF	;SEQUENCED?   
	TRNN AUXFLG,DTAOUT	;YES, ON DTA?
	SKIP	1	;NO
	ADDI T2,40*5	;LEAVE EDITING ROOM
OUTLB2:	MOVNS T2
	ADDM T2,OBF+2	;UPDATE OUTBUFFER CHARACTER COUNT
	HRLI T2,LBUF
	HRR T2,OBF+1
	AOJ T2,
	ADDB T1,OBF+1	;UPDATE OUTBUFFER BYTE POINTER
	BLT T2,(T1)	;MOVE DATA TO OUTBUFFER
OUTLB3:	POPJ P,
;ROUTINE TO PUT ONE CHAR INTO OUT BUFFER

TABOUT:	MOVEI	CHR,TAB	;OUTPUT A TAB
PUT:	SOSG OBF+2	;SUBR. TO OUTPUT ONE CHARACTER IN AC CHR
	PUSHJ P,OUTP	;IF BUFFER FULL, DUMP AND CHECK ERR BITS
	IDPB CHR,OBF+1	;PUT CHARACTER IN BUFFER
	POPJ P,

;ROUTINE TO DUMP OUT BUFFER WHEN FULL

OUTP:	OUT OUT,	;SUBR. TO DUMP OUTBUFFER AND CHECK ERR BITS
	JRST	CPOPJZ	;NO ERRERS,BUT CLEAR IOS JUST IN CASE
OUTP1:	GETSTS OUT,IOS	;HERE FOR BIT CHECKING ONLY
	PUSHJ P,OUTP4
	SETSTS OUT,(IOS);ERRORS WERE DETECTED
	POPJ P,		;NO ERRORS

OUTP4:	TRNN AUXFLG,MTAOUT
	JRST .+3
OUTP3:	TRNE IOS,EOTBIT	;EOT?
	JRST .+3	;YES
	TRNN IOS,740000	;ANY ERROR BITS ON?
	JRST CPOPJ1	;NO
	PUSHJ P,COMERR	;YES

	JSP T5,INICN2	;INIT TTY
	PUSHJ P,QUEST
	ERRPN2	</Output device />
	PUSHJ	P,P6BIT
		ODEV
	SKIPN	DTON		;ONLY IF THERE IS A FILE NAME
	JRST	.+4		;DON'T PRINT IF NOT
	ERRPN2	</: file />
	MOVEI T3,DTON	;OUTPUT FILE NAME LOC
	PUSHJ P,FN.EX	;PRINT FILE NAME EXT
	MOVE T2,AUXFLG
	ANDI T2,MTAOUT+DSKOUT+DTAOUT

IOERR:	MOVEI T1,TXTC	;PHYSICAL END OF TAPE
	TRNE IOS,EOTBIT
	JRST PTEXT2	;YES

	MOVEI T1,TXTD2	;7-9 PUNCH MISSING
	TRNN T2,CDRIN

IFN FTDSK,<
	MOVEI	T1,TXTD3
	TRNN	T2,DSKIN!DSKOUT>

	MOVEI T1,TXTD	;WRITE LOCK ERROR
	TRNN T2,DSKIN+DSKOUT+DTAIN+DTAOUT+MTAIN+MTAOUT

	MOVEI T1,TXTD1
	TRNE IOS,WRTLOK
	JRST PTEXT2

	MOVEI T1,TXTA	;DEVICE ERROR
	TRNE IOS,200000
	JRST PTEXT2

	MOVEI T1,TXTB	;CHECKSUM/PARITY ERROR
	TRNE IOS,100000
	JRST PTEXT2

IFN FTDSK,<
	HRRZ	T1,TABLE+14
	TRNN	T2,DSKOUT	;QUOTA EXCEDED>

	MOVEI T1,TXTC1	;BLOCK TOO LARGE
	JRST PTEXT2
;DEVICE ERROR COMMENTS

TXTD:	ASCIZ /write (lock) error/
	JRST IOERRN	;NO RECOVERY

TXTD1:	ASCIZ /binary data incomplete/
	JRST IOERRG

TXTD2:	ASCIZ /7-9 punch missing/
	JRST IOERRG

TXTA:	ASCIZ /device error/
	JRST IOERRG

TXTB:	ASCIZ /checksum or parity error/
	JRST IOERRG

TXTC:	ASCIZ /physical eot/
	JRST IOERRG

TXTC1:	ASCIZ /block or block number too large/
	;FALLS THROUGH TO IOERRN

IOERRN:	RELEAS TAPE,	;NO RECOVERY ERRORS EXIT HERE
	RELEAS DIR,
	RELEAS OUT,
	RELEAS IN,
IFN DISK30,<
	RELEAS BLKIN,>
	JRST PIP2	;GET NEXT COMMAND

IFN FTDSK,<
TXTD3:	ASCIZ	/monitor detected software error/>

;TEST IF /G FLAG(IGNORE ERRORS) SET

IOERRG:	TLNN FLAG,GFLG		;PRINTED CURRENT MESSAGE
	JRST IOERRN		;NO RECOVERY

	ERRPN2</
/>				;PRINT CR, LF DON'T MOVE>

	RELEAS CON,
	TRNE AUXFLG,TTYOUT	;TTY OUTPUT DEVICE?
	PUSHJ P,OMODE		;YES, INIT OUTPUT DEVICE
	TRNE AUXFLG,TTYIN	;REINIT TTYIN,TTYOUT
	PUSHJ P,ININIT
	TRZ IOS,740000		;CLEAR FILE STATUS, I/O ERRORS
	TRNE T2,MTAIN+MTAOUT
	TRZ IOS,EOTBIT		;CLEAR PHYSICAL EOT I/O ERROR
	MOVS 0,[XWD 1,SAVAC]
	BLT 0,3
	MOVE T5,SAVAC+3
	MOVE T6,SAVAC+4
	POPJ P,

COMERR:	MOVE 0,[XWD 1,SAVAC]	;SAVE ACS T1,T2,T3,T5,T6
	BLT 0,SAVAC+2
	MOVEM T5,SAVAC+3
	MOVEM T6,SAVAC+4
	TRNE AUXFLG,TTYOUT	;RELEASE ANY TTYIO
	RELEAS OUT,
	TRNE AUXFLG,TTYIN
	RELEAS IN,
	POPJ P,
;PRINT FILE NAME AND EXTENSION FROM (T3), 1(T3).

FN.EX:	MOVE T1,(T3)	;T1=FILENAME
	HLRZ T6,1(T3)	;T6=FILE EXT
	CAIN T6,(SIXBIT /UFD/)
	SETZ T1,	;UFD FILES ONLY ARE ASSUMED TO HAVE FILENAME
	MOVEM T1,DERR2	;OF NUMERIC FORM (#,# P-P NUMBER).
	JUMPE T6,DERR2A	;FILE EXT=0?
	CAIE T6,(SIXBIT /UFD/)
	JRST DERR2B	;NO

	HLRZ DOUT,(T3)	;YES, GET PROJ. NO.
	MOVEI T2,PUTCON	;PRINT PROJ-PROG. NO.
	PUSHJ P,OUTDC1	;CONVERT TO ASCII

	MOVEI CHR,COMMA
	PUSHJ P,PUTCON

	HRRZ DOUT,(T3)	;GET PROG. NO.
	PUSHJ P,OUTDC1	;CONVERT TO ASCII

DERR2B:	TLO	T6,"."-40	;PUT SIXBIT PERIOD
DERR2A:	MOVEM	T6,DERR2+1	;INTO EXTENSION
	PUSHJ	P,P6BIT
		DERR2
	PUSHJ	P,P6BIT
		DERR2+1
	MOVEI	CHR," "
	JRST	PUTCON




;THIS ROUTINE GETS A 7 BIT ASCII CHARACTER FROM THE COMMAND STRING
;AND RETURNS IT TO THE COMMAND SCANNER ROUTINE (NAME) IN AC0

GETCOM:	PUSHJ P,GETBUF
	CAIN 0,"/"	;SINGLE CHARACTER SWITCH
	JRST GETT6
	CAIN 0,"("	;LOOK FOR (MULTI-CHAR.) SWITCH
	JRST GETT3
	CAIN 0,"<"	;GO LOOK FOR PROTECTION
	JRST GETT9
	CAIE 0,"["
	POPJ P,

GETT10:	PUSHJ P,GETDEC	;LOOK FOR PROJECT-PROGRAMMER NUMBER
	CAILE T7,-1	;GREATER THAN HALF WORD?
	JRST ERR2A	;YES, ERROR
	CAIE 0,","	;SEPARATOR?
	JRST GETUPJ	;OR TERMINATOR (NON-NUMERIC)
	HRLZM T7,PP
	PUSHJ	P,GETDEC
	CAILE	T7,-1
	JRST	ERR2A

GETT11:	HRRM T7,PP
	CAIN 0,"]"	;FORCE CORRECT TERMINATOR
	JRST GETCOM
	JRST ERR2

GETT9:	PUSHJ P,GETOCT
	CAIN 0,">"	;TERMINATE ON RIGHT BRKT ONLY
	CAILE T7,777	;PR. IN RANGE?
	JRST ERR2A
	ROT T7,-11
	HLLOM T7,PR	;RHS=1'S MEANS <> SEEN (PR MAY BE 0)
	JRST GETCOM

GETUPJ:	MOVE	T5,UPROJ
	HRLZM	T5,PP
	JRST	GETT11
GETOCT:	SKIPA	T5,[EXP 10]
GETDEC:	MOVEI	T5,12
GETNUM:	MOVEI T7,0	;TO PICK UP P-P NUMBER
GETN1:	PUSHJ P,GETBUF	;AND PROTECTION
	CAIN 0," "	;IGNORE SPACES
	JRST GETN1
	CAIL 0,"0"
	CAIL 0,"0"(T5)
	POPJ P,		;GOT A NON-NUMERIC
	IMUL	T7,T5	; MULTIPLY BY RADIX
	SUBI	0,"0"
	ADD	T7,0	; ADD DIGIT
	JRST GETN1
GETT3:	PUSHJ P,GETT5	;PROCESS SWITCH CHARACTER
	CAIN 0,")"	;CLOSING PAREN?
	JRST GETCOM	;YES
	CAIN 0,"M"	;MTA FLAG?
	TRO FLAG, MTFLG	;SET MTA, LOOK FOR MULTI CHAR. SWITCH
	CAIE 0,"#"	;MTA#
	JRST GETT3	;NO
	TRNN FLAG,MTFLG	;ONLY LOOK AFTER # IF MTFLG IS ON.
	JRST ERR6A	;I.E. IF MT SWITCH IS IN PROGRESS.
	PUSHJ P,GETNUD	;GET A NUMBER
	CAIE 0,"D"	;TERMINATED BY D?
	CAIN 0,"A"	;TERMINATED BY A?
	JRST GETT3A	;YES, MARK AB UPPER
	CAIE 0,"P"	;ONLY A,D,P AND B CAN BE
	CAIN 0,"B"	;PRECEDED BY #.
	SKIP	1
	JRST ERR6A
	HRRM T7,AB	;NO. FILES/RECS TO ADVANCE
			;GOES IN AB (RH)
GETT3B:	PUSHJ P,GETT5A
	JRST GETT3

GETT3A:	HRLM T7,AB	;NO. FILES/RECS TO BACK SPACE
	JRST GETT3B	;GOES IN AB (LH)

GETT6:	PUSHJ P,GETT5	;PROCESS ONE SWITCH CHAR
	CAIE 0,"M"
	CAIN 0,")"	;THESE ARE ILLEGAL 1-SWITCH CHARS.
	JRST ERR6A
	JRST GETCOM

GETNUD:	MOVEI T7,0	;GET A DECIMAL NUMBER
GETN2:	PUSHJ P,GETBUF	;GET CHAR FROM COMMAND STRING
	CAIN 0,SPACE	;SPACE?
	JRST GETN2	;YES, IGNORE
	CAIL 0,"0"	;NUMBER?
	CAILE 0,"9"
	POPJ P,		;NO
	IMULI T7,^D10	;T7*10
	ANDI 0,17	;ADD ON LAST DIGIT
	ADD T7,0	;+ LOW 4 BITS
	JRST GETN2

;GET NEXT COMMAND STRING CHAR(SWITCH),CHECK WITH TABLE,SET FLAGS

GETT5:	PUSHJ P,GETBUF	;GET CHAR FROM COMMAND STRING
GETT5A:	MOVE T2,[XWD 350700,DISPTB]	;SET DISPTB NEXT SEARCH
	MOVEI T6,MTAREQ	;SET MTAREQ NEXT SEARCH

	TRNN FLAG,MTFLG	;SET UP TABLE TO SEARCH AND FLAG TO SET.
	HRRI T2,DISPTA	;PUT IN BYTE POINTER, NOT MTA REQUEST

;SET TO LOOK AT NON-MTA LETTERS FIRST

	TRNN FLAG,MTFLG	;IF MTFLG SET, START AT DISPTB AND STORE RESULT IN
	MOVEI T6,AUXFLG	;MTAREQ, ELSE START AT DISPTA AND STORE RESULT IN
			;AUXFLG OR FLAG
;GET FIRST CHAR DISPTA OR DISPTB, LOOK FOR MATCH, SET SWITCH FLAGS.

GETT7:	LDB T3,T2	;COMPARE WITH LEFT 7 BITS OF
	JUMPN T3,GETT8	;TABLE ENTRIES
	TRZ FLAG, MTFLG	;SEARCHED TABLE 1 (DISPTB) DROP MTA FLAG
	MOVEI T6,AUXFLG	;SET AUXFLG NEXT TABLE SEARCH
	TLNE AUXFLG,NOMORE	;AFTER FIRST INPUT DEVICE ONLY ACCEPT MTA FLAGS
	POPJ P,

GETT8:	CAIN T3,1	;END OF DISPTA 1ST HALF?
	MOVEI T6,FLAG	;YES, SEARCH DISPTA 2ND HALF FROM NOW ON
	CAIN T3,2	;END OF DISPTA 2ND HALF?
	JRST ERR6A	;SEARCHED TABLE 3, ERROR EXIT
	CAME T3,0	;MATCHING CHARACTER?
	AOJA T2,GETT7	;NO, GET NEXT SWITCH IN TABLE.

	MOVE T5,(T2)	;YES, SET FLAG OR AUXFLG OR MTAREQ
	ORM T5,(T6)	;FLAG OR AUXFLG
	TRNE FLAG,MTFLG
	ORM T5,AUX	;MTA REQUESTS SAVED IN AUX
IFE RIMSW,<
	TLNE FLAG,RIMFLG
	JRST RIMTB	;NO RIM IF RIMSW=0
	>		;PRINT ERROR MESSAGE
	POPJ P,		;EXIT ON MATCHING CHAR


;ROUTINE TO GET ONE TTY OR CCL COMMAND STRING CHAR INTO AC 0

GETTA:

	SOSLE TFI+2	;SUBR TO GET ONE TTY CHAR IN AC 0
	JRST GETT2	;BUFFER NOT EMPTY
	MOVE 0,TFI	;BUFFER EMPTY, SAVE
	MOVE T5,TFO	;CURRENT BUFFER LOCS
	PUSHJ P,INICON	;BUFFER EMPTY SO RE-ATTACH TTY
	HRROM 0,TFI	;RESTORE OLD BUFFER LOCS
	HRROM T5,TFO	;USE PREVIOUSLY ASSIGNED I/O BUF. FOR TTY
	MOVE T5,COMCNT	;DONT TYPE CR,LF
	CAIG T5,^D69	;FOR SHORT LINE
	JRST GETTIN
	PUSHJ	P,INFO2	;TYPE CR,LF
GETTIN:	INPUT CON,	;GET THE NEXT LINE
	MOVE T5,TFI+2	;SAVE CHAR COUNT
	RELEAS CON,	;LET GO OF TTY FOR USE AS IN-OUT DEVICE
	MOVEM T5,TFI+2	;RESTORE CHAR COUNT LOST DURING RELEASE
GETT2:	ILDB 0,TFI+1	;FETCH CHAR
GETT4:	CAIE 0,ALT175	;OLD ALTMODE?
	CAIN 0,ALT176
	MOVEI 0,ALTMOD	;YES,MAKE NEW ALTMOD
	JUMPE	0,GETTA	;IGNORE NULL CHARS
	CAIL 0,140	;LOWER CASE?
	TRZ	0,40	;YES MAKE UPPER CASE?
	CAIE	0,XON	;IGNORE XON,XOFF ONLY FOR
	CAIN	0,XOFF	;TTY SERVICE TO SIGNAL TTY
	JRST	GETTA	;PTR READ IN MODE
	POPJ P,

;ROUTINE TO GET ONE TTY CHAR FROM COMBUF INTO AC0

GETBUF:	SOSGE COMCNT	;ANY CHARS LEFT?
	JRST ERR6B	;NO, COMMAND ERROR
	ILDB 0,COMPTS	;PICK UP CHAR FROM COMBUF
	POPJ P,

;ROUTINE TO INITIALIZE THE TTY, ASCII LINE MODE

INICON:	INIT CON,1	;SUBR TO INITIALIZE THE TTY
	SIXBIT /TTY/
	XWD TFO,TFI	;TTY OUT/IN BUFFER HEADERS
	EXIT		;IF TTY NOT AVAILABLE,FATAL.JOB DET?
	POPJ P,
;GET 7 BIT ASCII CHARACTER - INPUT FROM CCL COMMAND FILE

GETEN2:	SETOM	COMEOF		;INDICATE END OF FILE
	MOVEI	0,CZ		;NEEDED TO TERM CCL CS SCAN
	POPJ	P,
;TABLE OF RECOGNIZED COMMAND LETTERS AND CORRESPONDING FLAG BITS

DEFINE DISP (A,B)
<	XWD <"A">*4000,B>
;MAGTAPE SWITCHES AND FLAG BITS. TABLE 1 (MTAREQ)
DISPTB:	DISP A,MTAFLG
	DISP B,MTBFLG
	DISP T,MTTFLG
	DISP W,MTWFLG
	DISP 8,MT8FLG
	DISP 5,MT5FLG
	DISP 2,MT2FLG
	DISP E,MTEFLG
	DISP U,MTUFLG
	DISP F,MTFFLG
	DISP D,MTDFLG
	DISP P,MTPFLG
	DISP #,0
	OCT 000000000000
;1ST BYTE 0=END OF DISPTB
;------------------------
;COMMAND STRING LETTERS AND FLAG BITS. TABLE 2 (AUXFLG)
DISPTA:			XWD <"Q">*4000+QFLG,0
			XWD <"E">*4000+CDRFLG,0
	DISP F,FFLG
	OCT 004000000000
;1ST BYTE 1=END OF DISPTA 1ST HALF
;------------------------
;COMMAND STRING LETTERS AND FLAG BITS. TABLE 3 (FLAG)
	DISP A,LINE
	DISP B,BMOD
IFN,K,<	DISP C,TBMOD
	DISP D,DFLG
	DISP L,LFLG>
	DISP M,0
	DISP ),0
	DISP N,NSMOD
	DISP O,SQMOD+NSMOD+STS+OSFLG
			XWD <"P">*4000+PFLG+PCONV,0
IFN,K<	DISP R,RFLG>
	DISP S,SQMOD+NSMOD+STS
IFN,K<	DISP T,SPMOD
			XWD <"V">*4000+CHKFLG,LINE
	DISP X,XFLG>
	DISP Z,ZFLG
			XWD <"U">*4000+OFLG,0
			XWD <"Y">*4000+IBFLG+RIMFLG,0
			XWD <"J">*4000+JFLG,0
			XWD <"I">*4000+IFLG,0
			XWD <"H">*4000+IBFLG,0
			XWD <"G">*4000+GFLG,0
	OCT 010000000000
;FIRST BYTE 2=END OF DISPTA 2ND HALF
;SUBR TO GET NEXT CHAR INTO AC CHR
;NO SKIP RETURN IS END OF FILE, SINGLE SKIP IS NORMAL RETURN

GET:	TLNN FLAG,NEWFIL	;NEW FILE?
	TLZN FLAG,PCONV+NEWFIL	;NO,CONVERT THIS CHAR?
	JRST GETPC1	;YES
	LDB CHR,IBF+1	;GET CHAR
	CAIN CHR," "	;SPACE?
	JRST GETPC2	;YES, CONVERT TO LINE FEED
	CAIG CHR,"3"	;IS THE CHAR A PROPER FORMAT CONTROL CHAR?
	CAIGE CHR,"*"
	JRST GETPC3	;NO, SO OUTPUT LINE FEED FOLLOWED BY BAD CHAR
	CAIG CHR,"."	;USE LEFT HALF OF TABLE?
	SKIPA CHR,PCHTAB-<"*">(CHR)
	MOVS CHR,PCHTAB-<"/">(CHR)
GETPC4:	DPB CHR,IBF+1	;CLOBBER OLD CHAR, USUALLY BECOMES NULL
	LSH CHR,-7	;BUT OTHERWISE BECOMES ANOTHER FORMAT CHAR
	ANDI CHR,377	;EXTRACT THE CHAR TO BE OUTPUT
	TRZE CHR,200	;=1 FOR GENERATING MULTIPLE LINE FEEDS
	TLO FLAG,PCONV	;CONTINUE TO CONVERT
	JUMPN CHR,CPOPJ1;OUTPUT THE GENERATED CHAR UNLESS NULL
	POP	P,(P)	;IGNORE NULL CHARS
	JRST	PSCAN4	;DUMP THE LINE BUFFER
GETPC1:	TRNN FLAG,SUS	;SUPPLYING SEQ. NUM. NOW?
	JRST GET2	;NO
	ILDB CHR,PTRPT	;YES, SO GET CHAR OF SEQ NUM
	JUMPN CHR,CPOPJ1;0 MARKS LAST CHAR
	LDB T1,IBF+1	;GET FIRST CHAR OF THIS LINE
	MOVEI CHR,15
	CAIG T1,15	;PREPARE TO OUTPUT A CR,LF
	CAIGE T1,12	;IS FIRST CHAR OF LINE AN END OF LINE CHAR?
	MOVEI	CHR,TAB	;NO, SO OUTPUT A TAB
	TRZ FLAG,SUS	;TURN OFF SUS SUPPLY
	JRST	GETA5
GET5:	AOS IBF+1	;HERE IF A SEQ NUM FOUND IN INBUFFER
	SUBI T1,5	;IGNORE SEQ NUM, TAB AND DECREMENT CHAR COUNT
	MOVEM T1,IBF+2
	TRNE FLAG,NSMOD	;REMOVE SEQ NUMS MODE?
	JRST GET2	;YES, SO GET NEXT CHAR
	MOVEM T2,SQNUM	;SEQ NUM FROM BUFFER BECOMES NEW SEQ NUM
	PUSHJ P,OUTLBF	;DUMP THE LINE BUFFER (IF REQUIRED)
	TRON FLAG,STS+SNI	;TURN ON START OF LINE
			;AND NO-INCREMENT SEQ NUM FLAG
	PUSHJ P,CLRBUF	;CLEAR LBUF IF IN THE MIDDLE OF A LINE

GET2:	TRZE FLAG,ESQ	;REPROCESS LAST CHAR?
	JRST GET1	;YES
	SOSL T1,IBF+2	;CHARS REMAINING IN INBUFFER?
	JRST GET4	;YES
	PUSHJ P,INP	;NO, SO REFILL AND CHECK ERR BITS
	TRNE IOS,EOFBIT	;END OF FILE? IOS HAS STATUS BITS
	POPJ P,		;YES
	JRST GET2	;NO, SO PROCESS INBUFFER

GETPC3:	TRO FLAG,ESQ	;REPROCESS BAD CHAR
	TROA CHR,12*200	;PRECEED BAD CHAR WITH LINE FEED
GETPC2:	MOVEI CHR,12*200;CHANGE SPACE TO LINE FEED
	JRST GETPC4

PCHTAB:	XWD 24*200,23*200+"."	;/ *
	XWD 212*200+" ",177*200	;0 +   VJC 4/16/49
	XWD 14*200,21*200	;1 ,
	XWD 20*200,212*200+"0"	;2 -
	XWD 13*200,22*200	;3 .

GET4:	ILDB CHR,IBF+1	;FETCH CHAR FROM INBUFFER
	TDNN FLAG,[XWD IFLG+IBFLG,BMOD]	;BIN, IB, I OR SBIN MODE?
	TLNE AUXFLG,SBIN
	JRST CPOPJ1	;YES, SO NO PROCESSING REQUIRED
GET1:	LDB CHR,IBF+1	;AFTER SEQ NUM, HERE FOR 1ST CHAR
	JUMPE CHR,GET2	;IGNORE NULL CHARS
	CAIN CHR,LF	;IGNORE LINE FEED IN FORTRAN OUTPUT
	TLNN FLAG,PFLG	;/P SWITCH IN EFFECT?
	JRST GET1A	;NO
	TLO FLAG,PCONV	;CONVERT THE NEXT LIVE CHAR
	JRST GET2	;GET NEXT CHAR
GET1A:	MOVE T2,@IBF+1	;BIT 35 OF BUFFER SET?
	TRZE T2,1
	JRST GET5	;YES, THIS IS A SEQ NUM
	TRZE FLAG,STS	;START SEQ (NEW LINE) FLAG ON?
	TRNN FLAG,SQMOD+SNI	;YES, SEQ MODE OR SEQ COPY?
	JRST GET7	;NO, SO PROCESS CHAR
	MOVE T2,SQNUM	;NO, SO ADD 10. TO SEQ NUM
	MOVE T1,K1
	TRNE FLAG,OSFLG	;TEST FOR INCR. BY ONE
	MOVE T1,K4
	ADD T2,T1	;ASCII INCREMENT
	AND T2,K3	;MASK SIGNIFICANT DIGITS
	MOVE T1,T2
	AND T1,ZRO	;MASK CARRY BITS
	ASH T1,-3
	SUB T2,T1	;ADJUST CARRIES
	IOR T2,ZRO
	TRZN FLAG,SNI	;NON-INCREMENT SEQ NUM FLAG ON?
	MOVEM T2,SQNUM	;NO, SO SAVE THE RESULT
	TRO FLAG,LINE+SUS+ESQ	;TURN ON SUPPLY SEQ, REPROCESS
				;LAST CHAR, AND LINE-BY-LINE FLAGS
	AOS LBUF		;SET BIT 35 IN LBUF TO MARK SEQ NUM
	MOVE T1,[POINT 7,SQNUM]
	MOVEM T1,PTRPT	;INITIALIZE SEQ NUM PICK-UP POINTER
	JRST GET	;GO OUTPUT FIRST CHAR OF SEQ NUM
;ROUTINE TO INPUT INPUT FILE

INP:	IN	IN,	;INPUT DATA
	JRST	CPOPJZ	;NO ERRORS ,BUT CLEAR IOS JUST IN CASE
INERR:	GETSTS IN,IOS	;SUBR TO CHECK INPUT ERR BITS
	TRNN AUXFLG,MTAIN	;MTA INPUT?
	TRNE IOS,740000	;ANY ERROR BITS SET?
	TRNN IOS,740000+EOTBIT	;EOT FOR MTA?
	POPJ P,		;NO

	PUSHJ P,COMERR	;SAVE AC'S RELEASE TTY
	JSP T5,INICN2	;YES SO PRINT OUT COMPLETE FILE DESCRIPTOR
	PUSHJ P,QUEST
	ERRPN2	</Input device />
	PUSHJ	P,P6BIT
		DEVICE
	SKIPN	ZRF		;IS THERE A FILE NAME
	JRST	.+4		;NO,SO DON'T PRINT
	ERRPN2	</: file />
	MOVEI T3,ZRF	;LOC OF INPUT FILE NAME TO T3
	PUSHJ P,FN.EX	;DEPOSIT FILE NAME, EXT INTO TTY OUT BUFFER
	MOVE T2,AUXFLG
	ANDI T2,CDRIN+DTAIN+DSKIN+MTAIN
	PUSHJ P,IOERR	;GO PRINT ERROR DESCRIPTOR
	SETSTS IN,(IOS)
	POPJ P,

;ROUTINE TO TEST IF BLOCK TOO LARGE, OR WRITE LOCKED

QUEST:	MOVEI CHR,"?"	;DEPOSIT "?" IN ERROR MSG
	TLNN FLAG,GFLG	;ONLY IF /G NOT ON
	JRST PUTCON	;/G NOT ON, PRINT ?(FATAL) BEFORE ERR MSG

	TRNN IOS,BIGBLK	;BLOCK NO. TOO LARGE?
	JRST QUEST2	;NO
	TRNN AUXFLG,DTAIN+DTAOUT	;YES
	POPJ P,		;BLOCK TOO LARGE

	JRST PUTCON	;DEPOSIT "?" FATAL EVEN IF /G ON

QUEST2:	TRNE IOS,WRTLOK	;WRITE LOCKED?
	TRNN AUXFLG,DTAIN+DTAOUT+MTAIN+MTAOUT+DSKOUT
	POPJ P,		;NO
	JRST PUTCON	;DEPOSIT "?" FATAL EVEN IF /G ON

GET7:	TLNE FLAG,PCONV	;CONVERTING FORTRAN CARRAIGE CONTROL CHAR?
	JRST GET+1	;YES, GO DO IT
	AOS T1,CDRCNT
	TLNE AUXFLG,CDRFLG
	JRST GET7B	;CARD READER INPUT

GET7C:	CAIN CHR,SPACE	;SPACE?
	JRST GETA2	;YES
	CAIN CHR,CR	;CAR. RET.?
	JRST GETA3	;YES
	TRZ FLAG,SPOK	;CHAR NOT A SPACE STOP COUNTING CONSEC. SPACES
	CAIN CHR,TAB	;TAB?
	JRST GETA5	;KEEP TRACK OF TAB STOPS
	CAIG CHR,137
	CAIGE CHR,SPACE	;NON-SPACING CHARACTER?
	JRST CPOPJ1	;YES, SO RETURN IMMEDIATELY
	SOSG TABCT	;COUNT DOWN THE TAB STOP COUNTER
	JRST GETA5	;RESET THE COUNTER IF TAB STOP IS PASSED
CPOPJ1:	AOSA	(P)	;SKIP RETURN
CPOPJZ:	SETZ	IOS,	;CLEAR IOS JUST IN CASE
CPOPJ:	POPJ	P,


GET7B:	CAIL T1,^D73	;LT COL 73?
	CAILE T1,^D80	;NO, LE COL 80?
	JRST	GET7C	;CANT BE A CARD SEQUENCE NUMBER
	MOVEI CHR,SPACE	;REPLACE CARD SEQUENCE NOS. BY SPACE
	JRST GET7C

GETA3:	TRZE FLAG,SPOK	;CAR. RET. SEEN, ANY TRAILING SPACES?
	TRNN FLAG,SPMOD+TBMOD	;YES, ARE WE FLUSHING TRAILING SPACES
	JRST GETA5	;NO, RESET TAB COUNTER ONLY
	MOVE 0,SVPTR1
	MOVEM 0,OPTR	;CLOBBER THE OUTPUT POINTER TO LBUF
GETA5:	MOVEI 0,TABSP
	MOVEM 0,TABCT	;RESET THE TAB COUNTER
	JRST	CPOPJ1
GETA2:	TROE FLAG,SPOK	;SPACE WAS SEEN, IS THIS ONE OF A SEQUENCE?
	JRST GETA7	;YES
	MOVE 0,OPTR	;THIS IS THE FIRST SPACE SEEN, SAVE LBUF
			;POINTER IN CASE THIS SPACE MUST BE FLUSHED
	MOVEM 0,SVPTR1	;THIS POINTER FOR FLUSHING FINAL SPACES
	MOVEM 0,SVPTR2	;THIS POINTER FOR CHANGING MULT. SPACES TO TABS
	SETZM SPCT	;INITIALIZE THE SPACE COUNTER
GETA7:	AOS T1,SPCT
	SOSLE TABCT	;ARE WE AT THE NEXT TAB STOP?
	JRST CPOPJ1	;NO
	CAIL T1,2	;DONT BOTHER CHANGING ONE SPACE TO A TAB
	TRNN FLAG,TBMOD	;TAB GENERATING MODE?
	JRST GETA5A	;NO, GO RESET TAB COUNTER
	MOVE 0,SVPTR2
	MOVEM 0,OPTR	;BACK UP THE OUTPUT POINTER OVER THE LAST
			;GROUP OF SPACES
	MOVEI CHR,TAB	;OUTPUT A TAB
	SETZM SPCT	;RESET THE SPACE COUNTER
GETA5A:	IBP SVPTR2	;UPDATE THE CHANGE-SPACES-TO-TABS POINTER
	JRST GETA5	;RESET THE TAB COUNTER
;ERROR ROUTINES

IFE WCH,<IFN RIMSW,<
ERR8A:	MOVEI	T4,ERR382
	JRST	E10B
ERR3B:	MOVEI	T4,ERR381
	JRST	E10B>>

ERR10:	MOVEI	T4,E10A
E10B:	SKIPN	ZRF
	SKIP	3
	ERRPNT	</?File />
	MOVEI T3,ZRF
	PUSHJ P,FN.EX
	JRST	(T4)

IFE WCH,<IFN RIMSW,<
ERR381:	ERRPN2	</illegal extension!/>

ERR382:	ERRPN2	</illegal format!/>

ERR5B:	ERRPN2	</? DTA to PTP only!/>>>

ERR9:	ERRPNT	</?/>
	MOVEI T3,DTON
	PUSHJ P,FN.EX
	JRST	ERR4B
ERR1:	SKIPA T2,ODEV	;OUTPUT UNAVAILABLE
ERR1A:	MOVE T2,DEVICE	;INPUT UNAVAILABLE
ERR1B:	ERRPNT	</?Device />
	PUSHJ	P,P6BIT
		T2
	ERRPN2	</ not available!/>
ERR3:
IFN FTDSK,<TRNE AUXFLG,DSKIN
	JRST DERR5	;ERR ON DSK>
	PUSHJ P,ERR3A
	JRST IOERRN	;EXIT
ERR3A:	TLO AUXFLG,INFOFL	;SIGNAL RETURN TO ERR3AA
	JRST INFO
ERR3AA:	ERRPN2	</? No file named />
	MOVEI	T3,FILNAM
	PUSHJ	P,FN.EX	;PRINT NAME OF FILE THAT CANNOT BE FOUND
	PUSHJ	P,INFO2		;OUTPUT MESS. WITH CR-LF
	TRNN	AUXFLG,TTYIN!TTYOUT	;WAS TTY IN USE?
	POPJ	P,		;NO
	TRNE	AUXFLG,TTYIN	;INPUT DEVICE?
	JRST	ININIT		;YES ,RE-INIT
	JRST	OMODE		;MUST BE OUTPUT

ERR4:	SKIPN DTON
	JRST ERR4A
IFN FTDSK,<TRNE AUXFLG,DSKOUT	;ERR ON DSK
	JRST DERR6>
	ERRPNT	</? Directory full!/>
ERR4A:
IFN FTDSK,<TRNE AUXFLG,DSKOUT
	JRST ERR4C>
ERR4B:	ERRPNT	</?Illegal file name!/>
IFN FTDSK,<
ERR4C:	ERRPNT	</?(0) Illegal file name!/>>

ERR6:
ERR6A:	ERRPNT	</?PIP command error!/>

ERR6B:	ERRPNT	</?PIP command too long!/>

E10A:	ERRPN2	</ line too long!/>
ERR5A:	ERRPNT	</?Too many input devices!/>
;FILE MANIPULATION COMMANDS TO NON-DIRECTORY DEVICES COME HERE

ERR5:	ERRPNT	</?Disk or DECtape input required!/>
ERR2:	ERRPNT </?Incorrect Project-Programmer number!/>
ERR2A:	ERRPNX	</?Illegal protection!/>
IFE BLOC0,<
ERR7A:	ERRPNT	<Z?DECtape I/O only!Z>>

ERR8:	ERRPNT	</?Explicit output device required!/>

;ROUTINE TO CHECK INPUT DEV, SET XXXIN.E.G.DTAIN

CHECK1:	MOVE 0,DEVICE	;INPUT DEVICE NAME TO AC 0
	JUMPE 0,CHECK	;IGNORE IF NO INPUT DEVICE
IFN FTDSK,<PUSHJ	P,PSYSP	; STR# 10-3178>
	DEVCHR		;GET INPUT DEVCHR
IFN FTDSK,<TLNN 0,DSKBIT ;INPUT DEVICE DISK?
	JRST CHECK2	;NO
	TRO AUXFLG,DSKIN;INPUT DEVICE IS DSK, SET BIT
	MOVE	T1,DEVICE
	CAMN	T1,[SIXBIT/SYS/]	; INIT SYS AS DSK
	MOVSI	T1,(SIXBIT/DSK/)
	MOVEM	T1,ADSK
	JRST	CHECK>

CHECK2:	JUMPE 0,DEVER1	;NON-EX. DEVICE

	TLNN 0,INBIT	;CAN DEVICE DO INPUT?
	JRST ERR6A	;NO, COMMD ERROR

	TLNE 0,PTRBIT	;PAPER TAPE READER?
	TRO AUXFLG,PPTIN;YES

	TLNE 0,DTABIT	;DECTAPE?
	TRO AUXFLG,DTAIN

	TLNE 0,MTABIT	;MAGTAPE?
	TRO AUXFLG, MTAIN

	TLNE CDRBIT	;CARD READER?
	TRO AUXFLG,CDRIN

	TLNE 0,TTYBIT	;TELETYPE?
	TRO AUXFLG,TTYIN

CHECK:	TRNE	CALFLG,SSWTCH   ;_FLAG STILL ON?
	JRST ERR6A      ; YES ,COMMAND ERROR
	POPJ P,		; NO, RETURN 
;SUBR TO PRINT ERROR MESSAGES
;! MARKS THE END OF MESSAGE & SIGNALS GO TO PIP2
;NULL IS A FLAG TO RETURN TO THE NEXT LOCATION

PRETXT:	
PTEXT:	RELEAS DIR,	;RELEASE DIRECTORY DEVICE

	RELEAS TAPE,	;RELEASE MAGTAPE
	RELEAS OUT,	;LET GO OF BOTH OUTPUT AND
	RELEAS IN,	;INPUT DEVICES
	JSP T5,INICN1	;INITIALIZE THE TTY
	MOVEI	0,CR
	IDPB	0,TFO+1	;OUTPUT A CR-LF
	MOVEI	0,LF
	IDPB	0,TFO+1	;FOR BATCH
PTEXT2:	HRLI T1,440700	;GET SET TO SCAN 7-BIT DATA
PTEXT1:	ILDB 0,T1	;GET CHAR OF ERR MESSAGE
	JUMPE 0,1(T1)	;RETURN ON ZERO
	CAIN 0,"!"	;!?
	JRST PIP2	;YES, END OF MESSAGE, APPEND CAR.RET., LF
	IDPB 0,TFO+1	;DEPOSIT CHAR IN OUTBUFFER
	JRST PTEXT1	;GET NEXT CHAR

;ROUTINE TO DEPOSIT CHARACTER IN TTY OUT BUFFER

PUTCON:	SOSG TFO+2	;STORED MORE THAN BUFFER HOLDS?
	OUTPUT CON,	;YES
	IDPB CHR,TFO+1
	POPJ P,

;ROUTINE TO CONVERT ONE WORD OF SIXBIT
;FROM ADDRESS IN LOCATION AFTER CALL AND DEPOSIT INTO TTY OUT BUFFER

P6BIT:	MOVE T1,@(P)	;PICK UP WORD OF 6-BIT
	HRLI T1,440600	;SET UP POINTER
P6BIT1:	ILDB CHR,T1
	JUMPE CHR,P6BIT2
	ADDI CHR,40
	PUSHJ P,PUTCON	;DEPOSIT IN TTY
P6BIT2:	TLNE T1,770000	;DONE SIX?
	JRST P6BIT1	;NO
	JRST CPOPJ1	;SKIP RETURN

;ROUTINE TO CLEAR DSK OR DTA DIRECTORY (/Z SWITCH)

DTCLR:	TRNN	CALFLG,DVSWTH	;HAS A DEVICE BEEN SEEN?
	JRST	ERR8		;NO,SO DON'T SCREW USER
IFN FTDSK,<TRNE AUXFLG,DSKOUT	;CLEAR DSK OR DTA DIR.
	JRST DSKZRO>
	TRNN AUXFLG,DTAOUT	;MUST BE DTA
	JRST ERR5
	UTPCLR	OUT,		;CLEAR DIRECTORY
	POPJ P,
;ROUTINE TO SET UP TO COPY EVERYTHING

PRECOP:	PUSHJ	P,ININIT	;INIT INPUT FILE
	TRNN	AUXFLG,DTAIN	;DECTAPE INPUT
	SKIP	2		;NO
	PUSHJ	P,DTCH2		;YES, GET DIRECT, SET POINTERS TO DIRECT

DTCOPY:	PUSHJ	P,DTADI1	;START (T5)
IFN FTDSK,<TRNE	AUXFLG,DSKIN	;DSK INPUT. ENTER HERE FROM DTD2
	PUSHJ	P,DSKDIR	;YES, PREPARE TO LOOKUP FILES>
COPY1A:	SETZM	ZCNT		;CLEAR COUNT FOR DSK ZERO REQUESTS
	MOVEI	T2,6		;FILL 0 CHARS. IN DEST-FILE
	MOVE	T1,[POINT 6,DTON]	;NAME WITH X'S. THIS IS
XSS:	ILDB	0,T1		;THEN THE BASE FOR GENERATED
	JUMPN	0,.+2		;DESTINATION FILES FROM
	MOVEI	0,"X"-40	;NON-DIR. DEVICES IN /X
	DPB	0,T1
	SOJG	T2,XSS		;DON'T YET KNOW IF ONE
				;OF THE INPUT DEV. WILL
	MOVE	0,DTON		;BE NON-DIR
	MOVEM	0,DTONSV
	MOVE	0,DTON+1
	MOVEM	0,DTONSV+1

COPY1:	PUSHJ   P,SR2		;SET INIT. COPYING MODE
	PUSHJ	P,LOOK		;GET A FILE TO COPY
	JRST	CAL6		;NO MORE
IFN FTDSK<PUSHJ	P,XDDSK		;GOT ONE, CHECK (XD) FROM DSK, NAMTAB
	JRST	COPY1		;IN LIST, DON'T COPY>
	TRNN	AUXFLG,MTAIN+PPTIN+CDRIN+TTYIN	;OK, COPY FILE
	JRST	COPY6A		;MUST BE DIRECTORY DEVICE
	PUSHJ	P,MTPTCR	;SET UP A DEST. FN.
	JRST	COPY6
COPY6A:	LOOKUP	IN,ZRF		;LOOKUP INPUT FILE NAME
	JRST	CAL5		;INPUT FILE FILE PROTECTED
COPY6:	PUSHJ	P,FILTYP	;CHECK FOR DMP,SAV,REL,CHN
IFN WCH,<
	TRNN    AUXFLG,DTAIN+DTAOUT
	JRST    .+5
	HLRZ    0,ZRF+1
	CAIE    0,(SIXBIT /DMP/)
IFN DISK30,<CAIN 0,(SIXBIT/SVE/)>
IFE DISK30,<CAIN 0,(SIXBIT/SAV/)>
	JRST    COPY1>
	PUSHJ	P,COPY3
COPY6B:	MOVE	0,ZRF		;INPUT FILE NAME
	MOVEM	0,DTON		;IS OUTPUT FILE NAME
	HLLZ	0,ZRF+1		;LIKEWISE EXT
	HLLZM	0,DTON+1

;THIS CODE OPERATES AS FOLLOWS - FOR E+2, SET = 0
;TO START (ASSUMING /X)
;DSK TO DSK IF EDIT SWITCHES PUT E+2 = 0 IF NO EDITS TRANSFER
;	DATE, TIME, BITS 13-35
;DSK TO DTA FOR EDITS E+2 = 0, NO EDITS TRANSFER 24-35 FOR
;DATE, FOR"SAV" FILES TRANSLATE NO.  1K BLOCKS
;DTA TO DSK FOR NO EDITS XFER BITS 24-35, ELSE E+2 = 0
;DTA TO DTA ALWAYS XFER 18-23, (1K BLOCK) NO EDITS XFER 24-35(DATE)

	SETZM	DTON+2		;CLEAR DATE. OUTPUT FILE, DSK/DTA
	LDB	0,DATE		;GET DSK/DTA DATE CREATED
	TDNN	FLAG,[XWD PFLG,LINE+TBMOD+NSMOD+SQMOD+SPMOD]
	TLNE	AUXFLG,CDRFLG
	JRST	COPY6C
	DPB	0,DATED		;DEPOSIT IF NO EDITS
IFN FTDSK,<LDB	0,TIME
	TRC	AUXFLG,DSKIN+DSKOUT
	TRCN	AUXFLG,DSKIN+DSKOUT
	DPB	0,TIMED		;DSK TO DSK TIME>
COPY6C: IFE WCH,<
	PUSHJ   P,OKBLKS	;SETUP 1K BLOCKS>
	ENTER	OUT,DTON	;GOT DATA, CREATE NEW FILE
	JRST	ERR4		;DIRECTORY FULL
	MOVE	0,ZRO		;GET ASCII/00000/AND
	MOVEM	0,SQNUM		;RESET SEQUENCE NO.
	TLO     FLAG,NEWFIL	;SET NEW FILE FLAG
	SETZM	TOTBRK		;CLEAR PAREN COUNTER
	TLNN	AUXFLG,CDRFLG+SBIN	;SPECIAL PROCESSING?
	TDNE	FLAG,[XWD PFLG+IFLG+IBFLG,LINE+BMOD+TBMOD+NSMOD+SQMOD+SPMOD]	
	JRST	PSCAN		;YES, DO IT
COPY5:	SOSGE	IBF+2		;INPUT BUFFER EMPTY?
	JRST	COPY4		;YES
	ILDB	CHR,IBF+1	;GET NEXT WORD AND
	PUSHJ	P,PUT		;OUTPUT IT
	JRST	COPY5
COPY4:	PUSHJ	P,COPY3		;GET NEXT FULL SOURCE BLOCK
	PUSHJ   P,OUTP		;OUTPUT PREV. BLOCK-DONT ALTER DATA
	AOS	OBF+2		;MAKE PUT HAPPY BECAUSE OF
	JRST	COPY5		;OUTPUT HERE.
COPY2A:	CLOSE	IN,
	CLOSE	OUT,
IFN FTDSK,<TLNE  AUXFLG,NSPROT	;NON-STANDARD PROTECTION?
	TRNN    AUXFLG,DSKOUT	;RENAME ALL OUTPUT FILES IF
	JRST    COPY2B		;NON-STANDARD PROTECTION
	MOVE    0,PROTS		;GET NEW PROTECTION
	MOVEM   0,DTON+2

	RENAME  OUT,DTON	;RENAME OUTPUT FILE
	JRST    DERR6>
COPY2B:	PUSHJ	P,OUTP1
	JRST	COPY1		;GO GET NEXT FILE

CAL5:	AOS	ZCNT		;INPUT FILE READ PROT.
	JRST	COPY1		;COUNT READ FAILURES

;NO MORE FILES TO COPY

CAL6:	TLZ     AUXFLG,NSPROT
IFN FTDSK,<	SKIPN	ZCNT	;FILES READ PROTECTED ?>
	JRST	MAIN1		;NO
IFN FTDSK,<MOVSI T4,(SIXBIT /X/)	;YES,PRINT FAILURE DURING
	JRST	DSKZ5		;/X REQUEST>

COPY3B:	SKIPE	IBF+2		;EMPTY BLOCK?
	POPJ	P,		;NO, RETURN

COPY3:	PUSHJ   P,INP		;READ NEXT BLOCK
	TRZE    AUXFLG,READ1
	PUSHJ   P,TTYZ		;END OF FILE FROM TTY?
	TRNN    IOS,EOFBIT	;END OF FILE? IOS HAS STATUS BITS
	JRST    COPY3B		;NO.
	POP	P,0		;FIND WHERE CALLED FROM
	HRRZS	0
	TRNE	AUXFLG,MTAIN+CDRIN+TTYIN+PPTIN
	CAIE	0,COPY6B	;DID WE COME FROM COPY6B-1
	JRST    COPY2A		;NO, EOF NOT FIRST DATA IN FILE 
	TRZ   CALFLG,ALLCLF	;END OF INFO ON NON-DIR. DEVICE
	JRST    COPY1

;CREATE DESTINATION FILE NAME. RANGE IS ...001 TO ...999

MTPTCR:	AOS T1,NO.
	CAILE T1,^D999
	JRST MPC2
	PUSHJ P,MTPTC1
	MOVE 0,DTONSV	;FILNAM=DTON IS ONLY WAY TO IDENTIFY
	MOVEM 0,ZRF	;INPUT FILE
	MOVE 0,DTONSV+1
	MOVEM 0,ZRF+1
	POPJ P,
MPC2:	ERRPNT <Z?Terminate /X, max. of 999 files processed!Z>

MTPTC1:	MOVEI DOUT,^D1000(T1)
	MOVE T1,[POINT 6,DTONSV,17]
	JSP T2,OUTDC1
	AOJA T2,CPOPJ
	SUBI CHR,40
	IDPB CHR,T1
	POPJ P,

;ROUTINE TO RESTORE BYTE POINTERS TO INITED MODE
;FOR INPUT AND OUTPUT DEVICES

SR2:	MOVE 0,SVIBF
	HLLM 0,IBF+1
	MOVE 0,SVOBF
	HLLM 0,OBF+1
	POPJ P,

;ROUTINE TO SEE IF ^Z FIRST CHAR ON TTY

TTYZ:	TRNN AUXFLG,TTYIN	;SEE IF FIRST CHAR. IS ^Z
	POPJ P,			;NOT TTY INPUT
	HRRZ T1,IBF+1		;ON TTY
	HLRZ 0,1(T1)		;GET FIRST CHARACTER
	TRZ	0,3777		;CLEAR ANY OTHER CHAR.
	CAIN	0,(<CZ>B6)	;IS IT ^Z?
	TROA	IOS,EOFBIT	;YES,SET END OF FILE
	CAIE	0,(<XON>B6)	;IS IT XON "^Q"
	POPJ	P,		;NO
	MOVSI	0,(<DEL>B6)	;A RUBOUT
	IORM	1(T1)		;CLEAR "^Q" FROM BUFFER
	POPJ	P,		;AND RETURN
IFE	WCH,<
;DTA TO DTA MAINTAIN BITS 18-23 OF E+2 IF SET
;DSK TO DSK NO TRANSLATION (E+2)
;DSK TO DTA TRANSLATE E+3 (LHS) INTO E+2 (18-23)
;DTA TO DSK NO TRANSLATION (E+2)
;THIS ROUTINE ENSURES "SAVE" FILES MAINTAIN
;CORRECT DATA FOR LOADING.  FOR DSK INPUT
;A "SAVE" FILE IS ONE WITH THE EXTENSION
;"SAV". E+3 = (-[(200XN)+NO. WDS IN LAST BLOCK]
;IN LHS TRANSLATE TO NO. 1K BLOCKS NEEDED
;TO LOAD FILE - BEFORE IT IS EXPANDED IN CORE.

OKBLKS:	TRNN	CALFLG,RXFLG	;(RX)?
	JRST	OKBLK0		;NO
	MOVE	0,MATCH		;GET FILE NAME
	HLRZ	T1,MATCH+1	;AND EXT.
	CAME	0,STAR		;SKIP IF NAME IS "*"
	MOVEM	0,DTON		;OTHERWISE REPLACE NAME
	CAIE	T1,(SIXBIT /*/)	;SAME FOR EXT
	HRLM	T1,DTON+1
OKBLK0:	MOVE	0,DTON		;GET OUTPUT FILE NAME
	HLRZ	T1,DTON+1	;AND EXT
	CAIE	T1,(SIXBIT /*/)	;IS IT "*"
	CAMN	0,STAR		;IS IT "*"
	JRST	ERR4B		;YES, ERROR

REPEAT 0,<			;NEEDS FIX TO TENDMP OR MONITOR
	TRNE	AUXFLG,DTAOUT	;OUTPUT TO DTA?
	CAIE	T1,(SIXBIT /SAV/) ;AND A SAV FILE?
	SKIP	1		;NO
	UGETF	OUT,0		;SET TO FIRST FREE BLOCK
>

IFN FTDSK,<TRC	AUXFLG,DSKIN+DSKOUT	;DSK I/O
	TRCN	AUXFLG,DSKIN+DSKOUT
	POPJ	P,			;YES, EXIT
	TRC	AUXFLG,DTAIN+DTAOUT	;NO
	TRCE	AUXFLG,DTAIN+DTAOUT	;DTA I/O
	JRST	OKBLK1			;NO>
	LDB	0,OKB			;DTA I/O - 1K BLKS
	DPB	0,OKBD			;DEPOSIT IN DTON
	POPJ	P,

IFN FTDSK,<
OKBLK1:	TRC	AUXFLG,DTAIN+DSKOUT	;DTA-TO-DSK
	TRCN	AUXFLG,DTAIN+DSKOUT
	POPJ	P,			;YES
	TRC	AUXFLG,DSKIN+DTAOUT	;NO,DSK-TO-DTA?
	TRCE	AUXFLG,DSKIN+DTAOUT	;NO
	POPJ	P,
	HLRZ	0,ZRF+1			;YES DSK-TO-DTA
IFE DISK30,<
	CAIE	0,(SIXBIT /SAV/)	;GET LOOKED UP EXT,(INPUT).
	>
IFN DISK30,<CAIE 0,SIXBIT /SVE/>
	POPJ	P,
	HLRO	T1,ZRF+3		;EXTENSION=SAV
	MOVNS	T1			;WORD COUNT
	IDIVI	T1,2000			;DIVIDE BY 1K CORE(OCTAL LOCS.)
	JUMPN	T2,.+2
	SOJ	T1,			;N-1
	DPB	T1,OKBD
	POPJ    P,>>

IFN FTDSK,<
;ARE WE DOING (XD) FROM DSK? IF NOT, EXIT.
;SEE IF CURRENT FILE SELECTED IN ZRF IS IN THE
;LIST OF FILES NOT TO BE COPIED. (POPJ IF IT IS)

XDDSK:	TRC	FLAG,XFLG+DFLG		;COMPLEMENT
	TRCN	FLAG,XFLG+DFLG		;RESET AND TEST
	TRNN	AUXFLG,DSKIN		;/X AND /D WERE SET
	JRST	CPOPJ1			;NOT DSKIN SO COPY FILE
	HRROI	T1,-12			;SET TO LOOP NAMTAB
XDDSK2:	MOVE	T2,ZRF			;GET FILE NAME
	SKIPN	T3,NAMTAB+12(T1)	;END OF TABLE ENTRIES?
	JRST	CPOPJ1			;YES, EXIT
	CAME	T2,T3			;FN IS * OR MATCH?
	CAMN	T3,STAR
	SKIP	1			;YES, * OR MATCH?
	JRST	XDDSK1			;NO MATCH
	HLLZ	T2,ZRF+1		;GET EXT
	SKIPN	T3,NAMTAB+24(T1)	;NO EXT MATCH WANTED
	POPJ	P,			;EXIT THEN
	CAME	T2,T3			;EXT IS * OR MATCH?
	CAMN	T3,STAR
	POPJ	P,			;FN EX MATCH, NO COPY
XDDSK1:	AOJL	T1,XDDSK2		;TRY ANOTHER FOR MATCH
	JRST	CPOPJ1			;SEARCHED TABLE, NO MATCH>
;ROUTINE TO DELETE OR RENAME FILES ON DTA OR DSK OR SET UP NAMTAB
;FOR (DX) (DISK ONLY)

DTDELE:	TRNE	FLAG,XFLG	;/X
	JRST    DELE1		;YES
	TRNN	FLAG,DFLG	;/D NEED EXPLICIT DEVICE
	SKIP	2
	TRNN	CALFLG,DVSWTH	;-1 IF DEVICE SEEN
	JRST	ERR8		;NO, ERROR
	MOVE	0,ODEV		;OUTPUT DEVICE
	MOVEM	0,DEVICE	;NO,SET DEVICE FOR INPUT
	MOVEM   0,DEVA
DELE1:	TRZ	AUXFLG,DTAIN+CDRIN+TTYIN+PPTIN+MTAIN+DSKIN
	PUSHJ	P,CHECK1	;RESET INPUT DEVICE DESCRP
	MOVEI   0,NAMTAB	;FOR /R GET NEW NAME
	HRLI    0,DTON		;SET TO BLT OUTPUT DIRECT ENTRY
	BLT     0,NAMTAB+3	;TO NAMTAB

	TRNN    AUXFLG,DTAIN+DSKIN
	JRST    ERR5		;NOT DTA OR DSK
	PUSHJ   P,FNSET		;SET UP CALFLG CORRECTLY
	TRNE	FLAG,XFLG	;/X?
	JRST	DTD1		;YES, (DX). RX ILLEGAL
IFN FTDSK,<TRNE AUXFLG,DSKOUT	;NO, HAS TO BE /D OR /R
	JRST	DSKDR0		;ON DSK>
	JRST	DTADR		;OR DTA

DTD1:
IFN FTDSK,<TRNE	AUXFLG,DSKIN	;DSK INPUT?
	JRST	DTD1A		;YES>
	PUSHJ	P,DTCHECK	;NO, HAS TO BE DTA, GET DIR
	JRST	DELE3		;DELETE, FILES FROM DIR
IFN FTDSK,<
DTD1A:	SETZM	NAMTAB		;COLLECT NAMES FOR DX, DSK SOURCE
	MOVE	T1,[XWD NAMTAB,NAMTAB+1]
	BLT	T1,NAMTAB+23	;FIRST CLEAR TABLE
	MOVEI	T1,NAMTAB	;LOCATION OF NAMTAB
	MOVEM	T1,LOCNAM
DTD4:	MOVE	0,FILNAM
	JUMPE	0,DTD4A		;FN=0 ILLEGAL
	MOVE	T1,LOCNAM
	MOVEM	0,(T1)		;STORE FILENAME FROM CS
	MOVE	0,FILEX		;STORE FILE EXT
	MOVEM	0,12(T1)	;TABLE FULL?
	MOVEI	T2,NAMTAB+11
	CAMN	T2,T1
	SOS	ESWTCH		;YES
	SKIPE	ESWTCH		;NO, END OF CS SCAN?
	JRST	DTD2		;END OF NAME PROCESSING
	AOS	T1,LOCNAM	;SET TO STORE IN NEXT SLOT NAMTAB
DTD4B:	PUSHJ	P,DESCRP	;NO, GET NEXT FILENAME FROM CS
	TRNE	CALFLG,NEWPP!NEWDEV
	JRST	ERR5A		;ERROR, NEW DEV OR# PP
	JRST	DTD4
DTD4A:	PUSHJ	P,ERR3A
	JRST	DTD4B

;END OF CS OR NAMTAB FULL
DTD2:	PUSHJ   P,ININIT	;INIT INPUT FILE
	MOVEI   T1,1		;SET TO RETURN DTCOPY+1
	JRST    DTD5>
;ROUTINE TO DELETE OR RENAME FILES ON DTA

DTADR:	PUSHJ	P,DTCHECK	;GO GET DTA DIRECTORY
	MOVE T1,IBF		;CURRENT INPUT BUFFER
IFN WCH,<
	USETO OUT,1		;TRY TO WRITE OUTPUT TAPE
	>			;DETERMINE IF WRITE LOCKED
IFE WCH,<
	USETO OUT,144>		;THIS SHOULD GIVE ERROR MSG
	OUTPUT OUT,(T1)		;IF DTA WRITE LOCKED
	PUSHJ P,DTCHECK		;GO GET DTA DIRECTORY

	PUSHJ	P,INFO		;WRITE "FILES DELETED/RENAME

;*********************************************************************


;LOOP TO DELETE/RENAME. FOR (DX) DELETE FILES FROM DTA DIR
;THEN USE REVISED DIRECTORY TO COPY ALL REMAINING FILES


DELE3:	PUSHJ	P,LOOK		;GET FILE TO DELETE OR RENAME FROM CS
	JRST	DELE5		;NO MORE FILES
	TRNN	FLAG,XFLG	;/X?
	PUSHJ	P,INFO3		;PRINT FILENAME-EXT
	MOVE	T1,DIRST	;GOT A MATCH - PROCESS IT
	TRNE	FLAG,RFLG	;AND IT IS AT (T5) IN (DTA) DIR
	JRST	DTRNAM		;RENAME
IFN WCH,<
	SKIPA	T2,T1
	ADDI	T2,4
	SKIPE	4(T2)
	JRST	.-2
	HRLS	T1
	ADDI	T1,4		;GET TO END OF NAMES
	MOVSS	T1		;BLOCK UP DIR
	BLT	T1,-1(T2)	;ZERO OUT LAST 4 WORDS
	SETZM	(T2)
	SETZM	1(T2)
	SETZM	2(T2)
	SETZM	3(T2)
	MOVE    T1,DIRST1
	MOVEM   T1,DIRST
	JRST	DELE3>
IFE WCH,<
	SETZM   (T1)		;DELETE FILENAME IN CORE DIRECT
	SETZM   26(T1)		;DELETE EXT
	SUB     T1,DIRST1	;GET FILE "NUMBER" (POS IN DIRECT)
	MOVEI   T3,1102		;TO LOOK AT ALL BLOCKS
	MOVSI	T2,(POINT 5,0)
	HRR	T2,DIRST1	;TO CALCULATE ADDRESS OF FIRST WORD
	SUBI    T2,122		;OF BLOCK TABLE IN DIRECTORY
DELE2:	SOJLE   T3,DELE3	;LOOK AT 1101 BLOCKS
	ILDB    0,T2		;GET BLOCK NUMBER
	CAME    0,T1		;IS IT SAME AS FILE "NUMBER"
	JRST    DELE2		;NO IGNORE
	SETZ	0,		;FREE THE BLOCKS OF THIS FILE
	DPB     0,T2		;CLEAR OUT BLOCK NUMBER
	JRST    DELE2>		;LOOP ON 1102 BLOCKS
DELE5:	MOVE	T1,IBF		;LOC OF INPUT BUFFER
	TRNE	FLAG,XFLG	;DX SWITCH?
	JRST	DTD6		;YES, NOW MUST COPY REMAINING FILES
IFN WCH,<
	USETO	OUT,1>
IFE WCH,<
	USETO	OUT,144>
	OUTPUT	OUT,(T1)	;OUTPUT DTA DIRECTORY
	RELEAS	CON,		;OUTPUT DELETE OR RENAME INFO TO TTY
	JRST	MAINB
;ROUTINE TO RENAME FILE ON DECTAPE

DTRNAM:	PUSHJ   P,RENAME
	SETZM   DTON+2		;MAKE MONITOR SUPPLY
	SETZM   DTON+3		;DATE TIME
	LOOKUP  OUT,DTON	;LOOK UP FILENAME-EXT ON OUTPUT DEV
	SKIP	1		;NO FILE ALREADY OF DESTINATION NAME
	JRST	DTRNM1
	MOVE	0,DTON		;RENAME, FILENAME
	JUMPE	0,DELE3		;BUT NOT IF ZERO
	MOVEM	0,(T1)		;PUT IN DIRECTORY
	MOVE	0,DTON+1	;GET EXT
IFE WCH,<
	HLLM    0,26(T1)>	;RENAME, EXT
IFN WCH,<
	HLLM	0,1(T1)>
	JRST	DELE3
DTRNM1:	HRRZ	T2,IBF	; GET PROTECTION DIR SLOT
	LDB	0,[POINT 5,17(T2),14]
	CAIE	0,36		; FILE PROTECTION ?
	JRST	ERR9		; NO,ILLEGAL FILE NAME
	JRST	DELE3		; RENAME DONE AT MAINB

;END OF LOOP
;*********************************************************************
;DX SWITCH ON, COPY ALL BUT SPECIFIED FILES. I.E. THOSE NOT DELETED

DTD6:	MOVEI   T1,0		;SET TO RETURN TO DTCOPY
DTD5:	MOVSI	0,(SIXBIT /*/)
	MOVEM	0,FILNAM	;FORCE COPY-ALL
	MOVEM	0,FILEX		;BY MAKING FILE-EXT=*.*
	PUSHJ   P,FNSET		;FIND DETAILS OF FILE-EXT
	TRNE    AUXFLG,DTAIN	;DTA INPUT
	PUSHJ   P,DTCH1		;INIT DIRST,DIRST1
IFN RIMSW,	<
	TLNE    FLAG,RIMFLG	;NO
	JRST	RIMTB
	>
	JRST	DTCOPY(T1)


;SET UP OUTPUT DIRECTORY ENTRY FOR RENAME
;ONLY ONE FILE NAME ALLOWED, BUT MAY BE *.EXT OR FN.*

RENAME:	SKIPL	ESWTCH		;SKIP IF CR,LF SEEN IN C.S.
	JRST	ERR6A		;ONLY 1 SOURCE FILE DESCRIPTOR ALLOWED
	HLRZ	0,NAMTAB+1	;GET EXT
	CAIN	0,(SIXBIT /*/)	;USE SPEC. EXTENSION, BUT IF
	HLRZ	0,ZRF+1		;EXT.=*, USE SOURCE EXTENSION
	HRLM	0,DTON+1	;USE SPECIFIED EXT
	MOVE	T2,NAMTAB	;USE SPEC. FN, BUT IF
	CAMN    T2,STAR		;FN=* OR 0, USE SOURCE FILENAME
	MOVE	T2,ZRF		;SOURCE FILE NAME=DEST
	MOVEM	T2,DTON		;USE SPECIFIED FILENAME
	POPJ	P,



;THIS ROUTINE GETS NEXT FILENAME.EXT FROM CS
;THEN SEES IF ONE IN DIRECTORY MATCHES
;IF IT DOES - EXIT IS CPOPJ1
;NO-MORE-FN.EX-TO-HANDLE-EXIT IS POPJ
;PREPARE ZRF FOR A "LOOKUP" ON THE NEXT REQUESTED FILE.

LOOK:	TRNE	CALFLG,FNEX	;DOES FILNAM, FILEX CONTAIN
	JRST	LOOK6		;A FILE TO THINK ABOUT? YES
LOOK01:	PUSHJ	P,LOOKA		;GET ONE (NOTE: DEVICE MAY ALTER)
	POPJ	P,		;NONE, END OF CS
		 		;RETURN SKIP FROM LOOKA
LOOK6:	MOVE    T2,FILEX	;GET FILE EXT INTO T2
	SKIPN   T1,FILNAM	;FILNAME AND EXT=0?
	SKIPE   T2,FILEX
	SKIP	1		;EITHER FN OR EX N.E.0
	JRST    LOOK7C		;FN.EX=0, ONE FILE COPY
	CAME    T1,STAR		;FILNAME OR EXT=*?
	CAMN    T2,STAR
	JRST    LOOK7A		;FN OR EX=*, MANY FILES 

	TRNE	AUXFLG,DTAIN+DSKIN	;DONT REQUIRE FILENAME
	JUMPE	T1,LOOK6C	;HERE FOR 0.EX,FN.EX OR FN.0,0.EX ILLEGAL
LOOK7B:	TRZ     CALFLG,FNEX	;IF HERE, ONLY ONE FILE WAS ENTAILED IN REQUEST.
	TRNN	AUXFLG,DTAIN+DSKIN
	JRST	LOOK4		;GOT A FILE TO HANDLE

LOOK8:	PUSHJ	P,PICUP		;GET A FILE (ANY) FROM DIRECTORY
	JRST	LOOK2		;WE GOT A FILE, DOES IT MATCH?
	TRZE	CALFLG,FNEX	;SEE IF A PARTIC. FILE WAS REQUESTED?
	JRST	LOOK6D		;NO
	JRST	LOOK6C		;YES

LOOK6A:	PUSHJ	P,ERR3A
	JRST	IOERRN		;NO RECOVERY
LOOK6C:	PUSHJ	P,ERR3A
	JRST	LOOK01		;GET NEXT FILE FROM CS

LOOK6D:	TRZN	CALFLG,ASTFLG	;DID WE FIND AT LEAST ONE
	PUSHJ	P,ERR3A		;NO, PRINT MSG.
	JRST	LOOK		;GET NEXT FILE FROM CS
;CHECK IF FILE.EXT IN DIRECTORY MATCHES FILE TO /D,/R
;NOTE WE MAY HAVE *.EXT,FIL.*, OR *.*


LOOK2:	TRNN	CALFLG,MATFN	;SHOULD FILENAMES MATCH
	JRST	LOOK3		;NO
	MOVE	T1,FILNAM	;YES
	CAME	T1,ZRF
	JRST	LOOK8		;NO MATCH

LOOK3:	TRNN	CALFLG,MATEX	;SHOULD EXTENSIONS MATCH
	JRST    LOOK5		;NO
	MOVE	T1,FILEX	;YES
	CAME	T1,ZRF+1
	JRST	LOOK8		;NO MATCH
LOOK5:	IFN DISK30,<
	TRNN	AUXFLG,DSKIN	;DSK INPUT?
	JRST	LOOK4		;NO
	LDB     T1,UFDIN+1	;PICKUP P-P# IN DIRECTORY
	HRRZM   T1,T2
	CAME    T2,MASK		;COMPARE WITH OWN P-P#
	JRST    LOOK8		;NO MATCH>
LOOK4:	TRO	AUXFLG,READ1	;READY FOR FIRST READ
	TRO	CALFLG,ASTFLG	;FOUND A FILE *.EXT, F.*,*.*
	JRST	CPOPJ1		;MATCH OR NO CARES

;FILENAME OR EXT=*
LOOK7A:	JUMPE   T2,.+2		;EXT=0?
	CAMN    T2,STAR		;NO,
	CAME    T1,STAR
	SKIP	1
	JRST    LOOK1		;*.* ALWAYS O.K. AND *
	TRNN    AUXFLG,DSKIN+DTAIN
	JRST LOOK6A	;*.A OR * ON NON-DIRECT DEV
	JRST    LOOK8

LOOK7C:	TRNE    AUXFLG,DSKIN+DTAIN
	JRST	LOOK6C		;0.0 ON DIR DEVICE
	SETZM   ZRF
	SETZM   ZRF+1
	JRST    LOOK7B		;0.0 ON NON-DIR. DEV.

LOOK1:	TRNE    AUXFLG,DTAIN+DSKIN
	JRST    LOOK8
	SETZM   ZRF
	SETZM   ZRF+1
	JRST    LOOK4
;ROUTINE TO GET NEXT FILE NAME FROM DIRECTORY
;FILNAM, FILEX CONTAIN THE FILE NAME. EXT TO BE
;MATCHED WITH DIR. NAMES. PUT SUGGESTED FILE
;NAME EXT IN ZRF, ZRF+1 AND #P-P IN ZRF+3
;NOTE THAT WE HAVE TO HANDLE *.EXT,FILE.*

PICUP:
IFN FTDSK,<TRNN	AUXFLG,DSKIN	;DSK INPUT?
	JRST	PICUP2		;N0, DTA
	SOSLE	UFDIN+2		;YES
	JRST	.+3
PICUP1:	PUSHJ	P,UIN		;INPUT USER'S FILE DIRECTORY
	JRST	CPOPJ1		;EOF ON DSK
	ILDB	0,UFDIN+1	;PICK UP FILENAME
	JUMPE	0,PICUP1	;IGNORE NULL
	MOVEM	0,ZRF		;SET FILE NAME
	MOVE    0,FNPPN
	MOVEM   0,ZRF+3		;SET DSK #P-P
	SOS	UFDIN+2		;COUNT DOWN FOR NEXT TIME
	ILDB	0,UFDIN+1	;SET FILE EX
	HLLZM	0,ZRF+1
IFN DISK30,<
	IBP     UFDIN+1		;INCREMENT POINTER TO GET PROJ,PROG #
	IBP     UFDIN+1>
	POPJ    P,>

PICUP2:
IFN WCH,<
	MOVE    T5,DIRST	;DIRST=LOC 4 FIRST TIME THRU
	ADDI    T5,4		;CALCULATE FIRST/NEXT FILENAME
	MOVEM   T5,DIRST
	MOVE    0,(T5)
	JUMPE   0,CPOPJ1		;NO MORE FILENAMES IN DIRECTORY
	MOVEM   0,ZRF
	MOVE    0,1(T5)>
IFE WCH,<
	MOVE    T3,DIRST1	;SETUP TO CHECK ALL FILENAME SLOTS
	ADDI    T3,26		;IN DIRECTORY (22 FILE NAMES)
	MOVE    T5,DIRST	;LOC OF FIRST/NEXT FILE
PICUP4:	ADDI    T5,1		;
	CAMLE   T5,T3		;END OF FILE SLOTS?
	JRST    CPOPJ1		;END OF FILE NAMES
	MOVEM   T5,DIRST	;NEXT SLOT TO LOOK AT
	MOVE    0,(T5)		;GOT FILE NAME FROM DIRECT
	JUMPE   0,PICUP4	;IGNORE IF 0
	MOVEM   0,ZRF
	MOVE    0,26(T5)>	;GET EXT ETC
	HLLZM	0,ZRF+1
	MOVE	0,PP
	MOVEM	0,ZRF+3
	POPJ	P,

;READ DTA DIR. AND PREPARE T5 TO PICK UP FIRST ENTRY.

DTADIR:	PUSHJ	P,DTCH2		;READ DTA DIR INTO INPUT BUF
DTADI1:	MOVEI	T3,DBUF		;SET BLT FROM INBUF TO DBUF
	HRL	T3,T5		;FIRST DATA WORD OF DIRECTORY IN T5
IFN WCH,<
	MOVNS	T2
	BLT	T3,DBUF+176(T2)
	SETZM	DBUF+177(T2)
	MOVEI	T5,DBUF-4>
IFE WCH,<
	BLT	T3,DBUF+176	;MOVE FROM INBUF TO DBUF
	MOVEI	T5,DBUF+123-1>	;LOC OF FIRST FILE NAME
	MOVEM	T5,DIRST	;T5 POINTS TO FILNAME JUST HANDLED
	MOVEM   T5,DIRST1	;TO RESTORE DIRST
	POPJ	P,		;(IE NONE BUT NEXT WILL BE FIRST)


;ROUTINE TO OUTPUT FILENAMES THAT WERE DELETED OR RENAMED
;PRINT "FILES DELETED:" OR "FILES RENAMED:"
;ALSO USED TO PRINT "NO FILE NAMED XXX.XXX"


INFO:	MOVE	T1,TFO		;SETUP TTY FOR OUTPUT
	MOVE	T2,TFI		;SAVE BUFFER LOCS
	PUSHJ P,INICON		;INIT TTY
	HRROM	T2,TFI		;SET BUFFER LOCS
	HRROM	T1,TFO
	OUTPUT CON,
	TLZE	AUXFLG,INFOFL	;ERROR PRINT ONLY?
	JRST	ERR3AA		;YES
	TRNN	FLAG,DFLG	;DELETE?
	JRST	INFO1		;NO, MUST BE RENAME
	ERRPN2	</Files deleted:/>
	JRST	INFO2
INFO1:	SETOM	RENSN		;DON'T PRINT IT TWICE
	ERRPN2	</Files renamed:/>	;RENAME (/R)
INFO2:	MOVEI	CHR,CR		;OUTPUT CR/LF
	PUSHJ	P,PUTCON	;ON TTY
	MOVEI	CHR,LF
	PUSHJ	P,PUTCON
	OUTPUT CON,
	POPJ	P,

;**********************************************************************
;PRINT FILENAME.EXT OR [P,P].UFD OF FILE DELETED

INFO3:	MOVEI	T3,ZRF		;LOCATION OF FILENAME
	PUSHJ	P,FN.EX
	JRST	INFO2
;/X OR /D. FIND OUT DETAILS OF FILE NAME AND
;EXTENSION (0 FN.EX=*.*) AND ANY CHANGE IN
;SOURCE DEV. SET BITS IN CALFLG.

FNSET:	TRZ	CALFLG,ALLCLF	;CLEAR FLAGS ON ENTRY
	TRO	CALFLG,FNEX
	MOVSI	0,(SIXBIT /*/)	;* TO AC0
	CAME	0,FILNAM	;FILNAM=* OR 0?
	SKIPN	FILNAM
	SKIP	1		;FILENAME = * OR 0
	TRO	CALFLG,MATFN	;FILENAME MUST BE MATCHED
	SKIPN   FILEX		;EXT=0?
	TRNN    AUXFLG, MTAIN+CDRIN+PPTIN+TTYIN	;YES
	CAMN    0,FILEX		;NO, EXT = *?
	SKIP	1		;YES
	TRO     CALFLG,MATEX	;FILE EXTENSION MUST BE MATCHED
IFN FTDSK,<TRNN    AUXFLG,DSKIN
	JRST    FNSET1
	SKIPN	T2,PP
	JRST    FNSET2		;IF #P-P=0 IT IS COUNTED AS UNCHANGED
	CAME	T2,FNPPN
	TRO	CALFLG,NEWPP	;CHANGE IN # P-P
	JRST    FNSET1
FNSET2:	MOVE    T2,FNPPN	;IF P-P#=0, SET TO PREVIOUS VALUE
	MOVEM   T2,PP>
FNSET1:	MOVE	T2,DEVICE
	CAME	T2,DEVA
	TRO	CALFLG,NEWDEV	;CHANGE IN SOURCE DEV.
	MOVEM	T2,DEVA		;SET DEVA=DEVICE
	POPJ	P,
;POPJ EXIT IF END OF COMMAND STRING, OTHERWISE RESET
;POINTER TO START OF DIRECTORY, READING IN NEW DIR.
;IF DEV OR #P-P CHANGED (EXIT CPOPJ1)
;IF DIR. IS ON DSK RESET BY REINIT.

LOOKA:	SKIPE	T4,ESWTCH		;MORE C.S.?
	POPJ	P,			;NO
	PUSHJ	P,DESCRP		;YES, GET NEXT FN.EX FROM CS
	PUSHJ	P,INLOOK		;CHECK FOR MTA REQUESTS, MODE
	PUSHJ   P,M4			;CHECK FOR /I,/B,/H
	HRRZM    T4,ININI1		;SET MODE
	RELEAS  DIR,
	TRNN	AUXFLG,MTAIN+CDRIN+PPTIN+TTYIN	;NON-DIR DEVICE?
	JRST	LOOKF

	TRNE	CALFLG,MATEX!MATFN	;YES, NO FN EX BUT *.* OR * ALLOWED
	JRST	ERR6A

LOOKF:	TRNN	FLAG,DFLG		;FOR DELETE, ONE SOURCE FILE
	JRST	LOOKB			;...

	TRNE	CALFLG,NEWDEV!NEWPP	;ONLY IS PERMITTED
	JRST	ERR5A

LOOKB:	TRNN	CALFLG,NEWDEV!NEWPP	;PREPARE TO LOOK FOR NEW FILE
	JRST	LOOKC			;NAME AT HEAD OF DIRECTORY

	PUSHJ   P,ININIT		;INIT INPUT FILE
	TRNN	AUXFLG,DTAIN+DSKIN
	JRST    CPOPJ1
IFN FTDSK,<TRNN	AUXFLG,DTAIN		;DTA INPUT?
	JRST	LOOKD			;NO, MUST BE DSK>
	PUSHJ	P,DTADIR		;YES, READ IN DTA DIRECT

LOOKC:
IFN FTDSK,<TRNE    AUXFLG,DSKIN		;DSK INPUT?
	JRST    LOOKD			;YES>
	MOVE	T5,DIRST1		;NO, RESET DIRECTORY START
	MOVEM   T5,DIRST
	JRST	CPOPJ1

IFN FTDSK,<
LOOKD:	PUSHJ   P,DSKDIR		;GET USER'S FILE DIRECTORY
	SETZM	UFDIN+2			;DSK DIR BUF EMPTY
	JRST	CPOPJ1>
;ROUTINE TO LIST DTA OR DSK DIRECTORIES


DTPDIR:	ENTER   OUT,DTON	;OUTPUT DEV,NROCT ENTRY
	JRST    ERR4		;DIRECTORY FULL
IFN FTDSK,<TRNE    AUXFLG,FFLG	;/F? SHORT FORM?
	SKIPE   DEVICE		;INPUT DEVICE SPECIFIED?
	JRST    PDIR1A		;YES
	MOVSI	0,(SIXBIT/DSK/)
	DEVCHR
	JUMPE	0,PDIR1A	;NO DISK
	HRRZI   0,(SIXBIT /DSK/);ASSUME DSK IF NO DEVICE GIVEN
	HRLZM   0,DEVICE
	TROA   AUXFLG,DSKIN	;SET DSK INPUT
PDIR1A:	TRNE    AUXFLG,DSKIN	;DSK INPUT?
	JRST    DSKLST		;YES, GO AND TRY TO LIST DSK>
	TRNN    AUXFLG,DTAIN	;DECTAPE INPUT?
	JRST    ERR5		;NOT DSK OR DTA. ERROR

;ROUTINE TO LIST DTA DIRECTORY. /L OR /F SWITCH

DTALST:	PUSHJ   P,DTCHECK	;CHECK FOR DTA INPUT-MUST BE DECTAPE AND
				;GET DIRECTORY
	PUSHJ   P,CRLF		;PRINT NO. OF FREE BLOCKS LEFT
	LDB	T1,[POINT 5,16(T5),14]
	CAIE	T1,36		; SKIP DIR HEADER IF
	JRST	PDIR1B		; DECTAPE HAS NO PROTECTION
;	LSTLIN	HEDL1		; PRINT HEADER
	MOVE	T2,DTAID
	JUMPE	T2,DTALS4
	MOVEI	T2,5		; CHARACTER COUNT
	MOVE	0,[POINT 6,DTAID]
	ILDB	CHR,0		; GET CLASSIFICATION
	CAIE	CHR,23		; STD (I.E.=3) ?
	AOJA	T2,DTALS3
DTALS1:	ILDB	CHR,0		; GET NEXT DIGIT
	ADDI	CHR,40		; CONVERT TO ASCII
	CAIN	CHR,"0"		; SUPPRESS LEADING ZEROS
	SOJG	T2,DTALS1
	PUSHJ	P,PUT
DTALS2:	SOJLE	T2,DTALS4
	ILDB	CHR,0
DTALS3:	ADDI	CHR,40
	PUSHJ	P,PUT
	JRST	DTALS2
DTALS4:	MOVEI	CHR,"["
	PUSHJ	P,PUT
	HLRZ	DOUT,DIRPPN
	PUSHJ	P,OUTDEC
	MOVEI	CHR,","
	PUSHJ	P,PUT
	HRRZ	DOUT,DIRPPN
	PUSHJ	P,OUTDEC
	MOVEI	CHR,"]"
	PUSHJ	P,PUT
	PUSHJ	P,CRLF
PDIR1B:

IFN WCH,<
	MOVE    T1,IBF
	HLRZ    DOUT,1(T1)	;GET FREE BLOCK POINTER
	MOVNS   DOUT
	ADDI    DOUT,1101	;GET NO. OF FREE BLOCKS LESS FREE BLOCK NO.
	PUSHJ   P,OUTDEC	;PRINT RESULT>
IFE WCH,<
	SETZ   DOUT,		;CLEAR NO. FREE BLOCKS
	MOVEI   T4,1102		;OCTAL NO. OF BLOCKS ON DECTAPE
	MOVSI   T1,(POINT 5,0)	;5 BIT BYTES
	HRRZ    T5,IBF		;CURRENT INPUT BUFFER
	ADDI    T1,1(T5)	;POINTER TO 1ST DATA WORD IN DIRECT


PDIR8:	SOJLE   T4,PDIR1	;ALL THROUGH?
	ILDB    T3,T1		;CALCULATE NO. OF FREE BLOCKS
	JUMPN   T3,PDIR8

				;THIS BLOCK FULL
	AOJA    DOUT,PDIR8	;COUNT NO. WITH ZERO IN
PDIR1:	PUSHJ   P,OUTDEC	;PRINT RESULT>
	MOVE    0,[POINT 6,PDIR7]
	MOVEI   T2,^D18		;SET LOOP TO DEPOSIT 18 CHARS
	PUSHJ   P,PDIR2		;PRINT "FREE BLOCKS LEFT" MESSAGE
	PUSHJ   P,CRLF		;CARRIAGE RET, LINEFEED
	PUSHJ   P,DTCH1		;FIX T5, TO POINT AT BEGIN OF DIR
;LOOP TO EXAMINE FILE NAMES DTA DIRECTORY
PDIR4:
IFE WCH,<
	SKIPN   123(T5)		;NULL (=0) FILE NAME?
	JRST    PDIR6		;YES SO LOOK FOR ANOTHER>
IFN WCH,<
	SKIPN   (T5)		;NULL (=0) FILE NAME?
	JRST    MAIN1		;YES, SO END OF DIR.>
	MOVEI   T2,6		;TRANSMIT UP TO 6 CHARACTERS
	MOVSI   0,440600+T5	;SET UP SOURCE BYTE POINTER
IFE WCH,<
	HRRI    0,123>		;SET TO PICK UP FILE NAME
	SETZ   T4,
;FOLLOWING CODE TO OUTPUT PROJ, PROG FILENAME
;*****************************************************************
IFE WCH,<
	HLRZ	CHR,151(T5)	;GET EXT
	CAIE	CHR,(SIXBIT/UFD/)	;UFD?
	JRST	PDIR4A		;NO

	HLRZ	DOUT,123(T5)	;PROJ NO.
	MOVEI	T2,PUT
	PUSHJ	P,OUTDC1

	MOVEI	CHR,COMMA	;COMMA
	PUSHJ	P,PUT

	HRRZ	DOUT,123(T5)	;PROG NO.
	PUSHJ	P,OUTDC1
	JRST	PDIR4B
	>
;*********************************************************************
PDIR4A:	PUSHJ   P,PDIR2		;OUTPUT 6-BIT DATA AND INCR DIRECTORY PTR
IFE WCH,<
PDIR4B:	HLLZ    CHR,151(T5)>	;PICK UP EXTENSION
IFN WCH,<
	HLLZ    CHR,(T5)>
	MOVSI   0,440600+T5	;SET BYTE POINTER
IFE WCH,<
	HRRI    0,151>		;PICK UP EXTENSION
	MOVEI   T2,4		;PRINT UP TO 4 CHRS. (PERIOD+3*EXT)
	JUMPN	CHR,.+3		;EXTENSION NULL?
	PUSHJ	P,PDIR2A+1	;YES
	SKIP	2		;NO
	MOVEI   CHR,PERIOD-40	;NO, SO PRINT A PERIOD
PDIR3:	PUSHJ	P,PDIR2A	;OUTPT 6 BIT OR INCR T5
IFE WCH,<
	MOVEI	CHR,SPACE	;OUTPUT 2 SPACES
	PUSHJ	P,PUT
	PUSHJ	P,PUT
	TRNE AUXFLG,FFLG	;SHORT FORM DIRECT ?
	JRST PDIR3A		;YES VJC 4/16/69

	SETZ	DOUT,		;CALCULATE NBR OF BLOCKS PER FILE
	MOVEI	T4,1101
	MOVSI	0,(POINT 5,0)
	HRRZ	T2,IBF
	ADDI	0,1(T2)
	HRRZ	T7,T5
	SUBI	T7,(T2)
	ILDB	T6,0		;LOAD CONTENTS OF S.A.T. BLOCK
	CAMN	T6,T7		;COMPARE WITH FILE SLOT NBR
	ADDI	DOUT,1		;ADD 1 TO COUNT IF EQUAL
	SOJG	T4,.-3
	PUSHJ	P,OUTDEC	;OUTPUT NBR OF BLOCKS PER FILE
	MOVEI	CHR,TAB
	>
IFN WCH,<
	AOJ     T5,		;STEP DIR. POINTER
	MOVEI   CHR,11
	PUSHJ   P,PUT		;OUTPUT A TAB
	CAIG    T4,7>
	PUSHJ   P,PUT
	LDB	T1,[POINT 5,DBUF+16,14]
	CAIE	T1,36
	JRST	PDIR3B
	HRRZ	T1,IBF
	SUBM	T5,T1
	LDB	0,[POINT 9,DBUF+200(T1),8]
;	PUSHJ	P,PROTO		; OUTPUT PROTECTION
PDIR3B:
IFE WCH,<
	MOVE    0,151(T5)	;GET ENTRY DATE>
IFN WCH,<
	MOVE    0,-1(T5)	;GET ENTRY DATE>
	ANDI    0,7777		;LEFT BITS ARE IRRELEVENT
	PUSHJ   P,DATOUT	;OUTPUT THE DATE
PDIR3A:	PUSHJ	P,CRLF		;GIVE CR,LF 4/16/69
IFN WCH,<
	AOJA    T5,PDIR4	;PROCESS NEXT ENTRY>
IFE WCH,<
PDIR6:	HRRZ    T1,IBF		;PROCESS NEXT ENTRY
	SUBM    T5,T1
	CAIL    T1,26		;FILE "NUMBER" OK?
	JRST    MAIN1		;NO, END OF ENTRIES
	AOJA    T5,PDIR4	;END OF LOOP, GET NEXT FILENAME>

IFN FTDSK,<
CLRF:	SOS	LIN>
CRLF:	MOVEI   CHR,CR		;OUTPUT CAR. RET.
	PUSHJ   P,PUT
	MOVEI   CHR,LF		;LINE FEED
	JRST    PUT

PDIR2:	ILDB    CHR,0		;ROUTINE TO OUTPUT 6-BIT DATA
	TRNN    0,-1		;PRINT SPACES WHEN PRINTING THE FREE BLOCKS
PDIR2A:	JUMPE   CHR,PDIR21	;TERMINATE ON SPACE
	ADDI    CHR,40		;CONVERT TO 7 BIT
	PUSHJ   P,PUT		;OUTPUT CHARACTER
	ADDI    T4,1
	SOJG    T2,PDIR2	;COUNT DOWN MAX-CHARS COUNTER
IFN WCH,<
PDIR21:	AOJA    T5,CPOPJ	;STEP AND CONTINUE>
IFE WCH,<
PDIR21:	POPJ    P,		;CONTINUE>
PDIR7:	SIXBIT /. FREE BLOCKS LEFT/
;OUTPUT THE DATE FOUND IN AC 0.

DATOUT:	MOVEI T2,PUT		;PUT CHAR IN OUT
	IDIVI 0,^D31
	MOVEI T3,1(1)
	IDIVI 0,^D12
	MOVE DOUT,T3		;DOUT=DAY
	PUSHJ P,OUTDC1		;PRINT DAY
	PUSHJ P,DATO2		;PRINT -MONTH-
	MOVE DOUT,0
	ADDI DOUT,^D64		;DOUT=YEAR
OUTDC1:	SKIPA DOUT+1,TWL	;RADIX 10
;*******************************************************************
;ROUTINE TO CONVERT OCTAL TO ASCII
;DOUT CONTAINS OCTAL VALUE ON ENTRY

OUTOCT:	MOVEI DOUT+1,10		;RADIX 8
PRNUMA:	HRRZM DOUT+1,T4
	MOVEI CHR,"0"
	CAMGE DOUT,DOUT+1	;PRINT AT LEAST 2 DIGITS
	PUSHJ P,(T2)		;PUT OR PUTCON
PRN:	IDIVI DOUT,(T4)		;DIVIDE BY RADIX
	HRLM DOUT+1,(P)		;SAVE NO. FOR PRINT
	JUMPE DOUT,.+2		;ENUF DIGITS?
	PUSHJ P,PRN		;NO, GET MORE
	HLRZ CHR,(P)		;YES, GET LEFTMOST
	ADDI CHR,60		;CONVERT TO ASCII
	JRST (T2)		;PUT OR PUTCON

OUTDE4:	MOVEI	CHR," "		;SET UP FOR SPACES
	CAIL	DOUT,^D1000	;PRINT 4 CHAR.
	JRST	OUTDEC		;AT LEAST 4 SEEN
	PUSHJ	P,PUT		;OUTPUT ONE SPACE
	CAIGE	DOUT,^D100	;3 CHAR.?
	PUSHJ	P,PUT		;NO,SO ANOTHER SPACE
OUTDEC:	MOVEI T2,PUT		;PUT CHAR IN OUT BUF
	JRST OUTDC1

DATO2:	MOVEI T4,5
	MOVE T6,MNPT
	ADDM 1,T6
	ILDB CHR,T6
	PUSHJ P,(T2)		;PUT OR PUTCON
	SOJG T4,.-2
	POPJ P,
;READ DTA DIRECTORY AND INITIALIZE DIRST AND DIRST1

DTCHECK:PUSHJ P,ININIT	;INITIALIZE INPUT DEVICE
DTCH2:
IFN WCH,<
	USETI IN,1	;GET DTA DIR>
IFE WCH,<
	USETI IN,144	;GET DTA DIR>
	PUSHJ P,INP	;INPUT DIRECTORY
	CLOSE	IN,
	PUSHJ	P,GETPPN	; GET PPN OF DECTAPE
	PUSHJ	P,ININIT	; REINITIALIZE INPUT DEVICE
IFN WCH,<
DTCH1:	MOVE T5,IBF
	HRRZ T2,1(T5)
	ADDI T5,1(T2)	;GET ADD. OF FIRST ENTRY
	MOVE 0,T5
	SUBI 0,4>
IFE WCH,<
DTCH1:	HRRZ T5,IBF	;LOC. OF CURRENT BUF, 2ND WORD
	MOVEI 0,123(T5)	;83 WORDS,7, FIVE-BIT BYTES
	ADDI T5,1	;COMPUTE ADD. OF DIR. START>
	MOVEM 0,DIRST	;FIRST FILE NAME LOC
	MOVEM 0,DIRST1	;TO RESTORE DIRST
	POPJ P,

;ROUTINE TO CHECK BRACKET COUNT/MATCHING

OUTCHK:	SETZB T3,TLBRKT	;COUNT <> ON THIS LINE, CLEAR THINGS
	MOVE T1,OPTRA	;BYTE POINTER FOR READING OUT THE LINE
OUTCH2:	CAMN T1,OPTR	;LINE DONE?
	JRST OUTCH3	;YES, SO DECIDE WHETHER TO PRINT
	ILDB T2,T1	;GET CHAR
	CAIN T2,"<"	;LEFT BRACKET?
	AOS TLBRKT	;YES, SO INCREMENT BRACKET COUNT
	CAIN T2,">"	;RIGHT BRACKET?
	SOSL TLBRKT	;YES, SUBTRACT BRACKET COUNT, GONE NEG?
	JRST OUTCH2	;NO, SO DO NEXT CHAR
	AOJA T3,OUTCH2	;YES, SO FLAG COUNT GONE NEG.

OUTCH3:	SKIPN T2,TLBRKT	;BRACKET COUNT OFF THIS LINE?
	JUMPE T3,CPOPJ	;NO, WENT NEG.?
	ADDM T2,TOTBRK	;YES, SO ADD INTO CUMULATIVE COUNT
	MOVEI CHR,"-"	;PRINT MINUS FOR NEG TOTAL
	SKIPGE TOTBRK
	PUSHJ P,PUT
	MOVM DOUT,TOTBRK;PRINT MAGNITUDE OF TOTAL
	PUSHJ P,OUTDEC
	MOVEI CHR,TAB	;FOLLOW WITH TAB
	PUSHJ P,PUT
	JRST OUTCH1	;AND PRINT THE LINE

GETPPN:	MOVEI	T5,117	; NON STD DUMP MODE
	MOVEM	T5,DTBLK
	MOVE	T5,DEVICE	; GET INPUT DEVICE
	MOVEM	T5,DTDEV
	OPEN	DTDIR,DTBLK
	POPJ	P,
	USETI	DTDIR,144	; READ BLOCK 100 AND
	MOVE	T5,[IOWD 227,DBUF]
	MOVEI	T6,0
	INPUT	DTDIR,T5	; WORD 1 OF BLOCK 101.
	MOVE	T5,177+DBUF
	MOVEM	T5,DTAID
	MOVE	T5,200+DBUF
	MOVEM	T5,DIRPPN	; SAVE PPN FOR LISTING
	RELEASE	DTDIR,
	POPJ	P,
FILTYP:	TDNE FLAG,[XWD IFLG+IBFLG,BMOD]
	POPJ P,			;BIN MODE DON'T CARE IF DMP, ETC
	TRNN	AUXFLG,DSKIN!DTAIN!MTAIN	;BINARY INPUT POSSIBLE?
	JRST	FIL11		;NO
	TRNN	AUXFLG,DSKOUT!DTAOUT!MTAOUT	;BINARY OUTPUT?
	JRST	FIL11		;NO
	TDNN	FLAG,[XWD PFLG,LINE!TBMOD!NSMOD!SQMOD!SPMOD]
	TLNE	AUXFLG,CDRFLG	;/E FROM DSK IS NOT BINARY
	JRST	FIL11		;SO TURN OFF SBIN
	JRST	FIL3		;FORCE BINARY MODE
FIL11:	TLZ AUXFLG,SBIN		;IS
	HLRZ 0,ZRF+1		; INPUT EXTENSION
	CAIE 0,(SIXBIT /DMP/)	;DMP?
IFE DISK30,<CAIN 0,(SIXBIT /SAV/)	;SAV?>
IFN DISK30,<CAIN 0,(SIXBIT/SVE/)>
	JRST FIL3		;YES
	CAIE 0,(SIXBIT /CHN/)	;CHN?
	CAIN 0,(SIXBIT /REL/)	;REL?
	JRST FIL3		;YES
	CAIE	0,(SIXBIT /SHR/)
	CAIN	0,(SIXBIT /HGH/)
	JRST	FIL3
	CAIE	0,'BIN'	; GENERAL BINARY EXTENSION?
	CAIN	0,(SIXBIT /LOW/)
	JRST	FIL3
	TRNN FLAG,XFLG		;DO NORMAL PROCESSING ON ALL
	JRST FIL2		;BUT DMP ETC FILES IF NOT /X
	TLNN AUXFLG,CDRFLG
	TDNE FLAG,[XWD PFLG,LINE+TBMOD+NSMOD+SQMOD+SPMOD]
	POPJ P,			;NO SIGNIFICANT SWITCHES
FIL1:	HRLZI 0,004400		;FORCE 36-BIT.
	HLLM 0,IBF+1		;INPUT BYTE POINTER
	HLLM 0,OBF+1		;OUTPUT BYTE POINTER
	POPJ P,			;CHANGE TO FORCED BINARY
FIL3:	TLO AUXFLG,SBIN		;INPUT EXT = DMP,SAV,CHN,REL
	TRNE FLAG,XFLG
	JRST FIL1
	TLON AUXFLG,FRSTIN	;NOT /X TEST FURTHER
	JRST FIL4		;IS THIS FIRST SOURCE, YES
	TLOE AUXFLG,RSDCFL	;NOT FIRST, WAS PREVIOS FILE RSCD?
	JRST	FIL5		;YES, NO CHANGE UNLESS DEVICE HAS CHANGED
	OUTPUT OUT,		;NO CHANGE TO 36-BIT
	MOVE 0,OBF+2		;CURRENTLY 7-BIT I/O, MUST CHANGE TO 36-BIT
				;OUTPUT CURRENT BUFFER
	IDIVI 0,5		;DIVIDE OBF+2 BY 5 (CHAR. COUNT)
	MOVEM 0,OBF+2
	JRST FIL1
FIL2:	TLOE AUXFLG,FRSTIN	;NOT A RSCD FILE
	TLZN AUXFLG,RSDCFL	;NO, WAS PREV. FILE RSCD?
	POPJ P,			;NO, NO CHANGE
	OUTPUT OUT,		;YES, CHANGE 36-BIT TO 7-BIT
	MOVEI 0,5
	IMULM 0,OBF+2
	MOVE 0,SVIBF		;RESTORE 7-BIT
	HLLM 0,IBF+1
	MOVE 0,SVOBF
	HLLM 0,OBF+1
	POPJ P,
FIL4:	TLO AUXFLG,RSDCFL	;SET REL,SAV,DMP,CHN FLAG
	JRST FIL1
FIL5:	HRLZI 0,004400		;NEW DEVICE, SET 36-BIT INPUT
	TRNE CALFLG,NEWDEV	;SOURCE DEVICE CHANGED
	HLLM 0,IBF+1
	POPJ P,			;OUTPUT ALREADY SET


SUBTTL BLOCK 0 CODE

IFE BLOC0,<
IFE WCH,<;THIS CODE COPIES BLOCK 0,1,2 ONLY. I/O MUST BE DECTAPE.>
IFN WCH,<;THIS CODE COPIES BLOCK 0 ONLY. I/O MUST BE DECTAPE.>
;MODE SELECTED MUST BE BIT 100, 20 AND NOT DUMP MODE (134).

BLOCK0:	TRC AUXFLG,DTAIN+DTAOUT
	TRCE AUXFLG,DTAIN+DTAOUT;FORCE DTA I/O
	JRST ERR7A
	MOVEI 0,134
	MOVEM 0,OMOD
	MOVEM 0,ININI1
	MOVSI 0,OBF
	MOVEM 0,ODEV+1
	MOVEI 0,IBF
	MOVEM 0,DEVICE+1
	OPEN OUT,OMOD
	JRST ERR1		;UNAVAILABLE
	OUTBUF	OUT,1
	OUTPUT	OUT,
	OPEN IN,ININI1
	JRST ERR1A
	INBUF IN,1
	SETZB T1,BL0CNT
BL4:	USETI IN,(T1)
	INPUT IN,		;READ
	GETSTS IN,IOS
	TRNN IOS,740000		;ANY ERRORS
	JRST BL1		;NO
	JSP T5,INICN2
	PUSHJ P,QUEST
	ERRPN2 </Input device />
	PUSHJ P,P6BIT
	      DEVICE
	ERRPN2 </: />
	MOVE T2,AUXFLG		;DECTAPE FOR ERROR MESSAGE
	ANDI T2,DTAIN
	PUSHJ P,IOERR		;PRINT ERROR TYPE
BL1:	HRLZ T5,IBF+1
	HRR T5,OBF+1
	MOVEI T4,177(T5)
	BLT T5,(T4)		;SHIFT DATA TO OUTPUT BUFFER
	USETO	OUT,@BL0CNT
	OUTPUT OUT,		;WRITE BLOCK
	PUSHJ P, OUTP1		;CHECK ERRORS
IFE WCH,<
	AOS T1,BL0CNT
	CAIGE T1,3
	JRST BL4>
BL3:	RELEASE OUT,		;IF ANY, PDL IS RESET
	JRST PIP2>

IFN BLOC0,<
BLOCK0:	ERRPNT	</?No block 0 copy!/>
		>
SUBTTL	MAGTAPE ROUTINES

;TEST TO SEE IF MORE THAN ONE OF THE LOWEST EIGHT MTA FLAGS
;HAVE BEEN SELECTED. IF SO ERROR. OTHERWISE, IMPLEMENT
;REQUEST.  T1, T3, T6 SET AT ENTRY BY INLOOK OR OUTLOOK
;TO EQUAL AUX/AUXOUT, AB/ABOUT,INIMTA/INOMTA

MT1:	HRRZ T2,T1		;T1 CONTAINS REQUEST
	ANDI T2,-1(T2)		;KNOCK OFF RIGHT MOST 1
	TRNE T2,377
	JRST MTR1		;PRINT ERROR MESSAGE

	TRNN T1,MTAFLG+MTBFLG+MTWFLG+MTTFLG+MTFFLG+MTUFLG+MTDFLG+MTPFLG
	JRST MTC1
	PUSHJ P,(T6)		;THERE IS A  REQUEST
				;GO TO INIMTA/INOMTA

;PERFORM POSITIONING REQUESTS
	TRNE T1,MTUFLG
	JRST UNLOAD

	TRNE T1,MTWFLG
	JRST REWIND

	TRNE T1,MTFFLG
	JRST MARKEF

	TRNE T1,MTTFLG
	JRST SLEOT

	TRNE T1,MTBFLG+MTPFLG	;MULTIPLE REQUESTS ALLOWED
	JRST BSPF

	TRNE T1,MTAFLG+MTDFLG	;MULTIPLE REQUESTS ALLOWED
	JRST ADVF

;T1=AUX,AUXOUT. T3=AB,ABOUT.  T6=INIMTA,INOMTA.

MTCONT:	RELEAS TAPE,
	TRNN T1,MTUFLG		;UNLOAD?
	TRNE CALFLG,NSWTCH 	;IS THERE AN INPUT DEVICE?
	CAIE T6,INOMTA		;OUTPUT TAPE?
	POPJ P,			;NO
	JRST PIP2		;YES, END OF COMMAND

;ROUTINE TO CHECK AND SET DENSITY FOR NEW DEVICE

MTC1:	MOVE T4,T1		;GET AUX/AUXOUT
	ANDI T4,MT2FLG+MT5FLG+MT8FLG
	ANDI T4,-1(T4)		;REMOVE RIGHT MOST 1
	JUMPN T4,MTR1		;MORE THAN 1 REQ, ERROR

	MOVEI T4,1		;ASCII LINE STANDARD MODE

	TRNE T1,MT2FLG
	TRO T4,DENS2		;SET 200 BPI

	TRNE T1,MT5FLG
	TRO T4,DENS5		;SET 556 BPI

	TRNE T1,MT8FLG
	TRO T4,DENS8		;SET 800 BPI

	TRNE T1,MTEFLG
	TRO T4,PARE		;EVEN PARITY

	POPJ P,

;REWIND AND UNLOAD

UNLOAD:	MTAPE TAPE,11
	JRST MTCONT

;REWIND ONLY

REWIND: MTAPE TAPE,1
MTWAIT:	WAIT TAPE,
	JRST MTCONT




;MARK END OF FILE

MARKEF:	MOVE T5,MTANAM
	EXCH T5,ODEV
	MTAPE TAPE,3
	GETSTS TAPE,IOS
	PUSHJ P,OUTP3
	SETSTS TAPE,(IOS)
	MOVEM T5,ODEV
	JRST MTCONT




;SKIP TO LOGICAL END OF TAPE.

SLEOT:	MTAPE TAPE,10
	JRST MTWAIT
;BACKSPACE MTA 1 FILE, T3=AB OR ABOUT
;AB/ABOUT = INPUT/OUTPUT DEVICE

BSPF:	HRRZ T3,T3	;T3=NO. OF FILES/RECORDS TO BACK
BSPF2:	WAIT TAPE,	;WAIT
	GETSTS TAPE,IOS
	TRNN IOS,LDP	;AT LOAD POINT?
	JRST BSPF3	;NO LDP
	ERRPNT </?Load point before end of (MB) or (MP) request!/>
BSPF3:	MOVEI T5,7	;BSPR
	TRNN T1,MTPFLG	;BSPR?
	MOVEI T5,17	;BSPF
	MTAPE TAPE,(T5)	;BACKSPACE FILE/RECORD
	SOJGE T3,BSPF2	;MORE FILES/RECORDS TO BSP?
			;NO, END OF LOOP
	WAIT TAPE,
	GETSTS TAPE,IOS
	TRNN T1,MTBFLG	;BACKSPACE FILE?
	JRST MTCONT	;NO
	TRNN IOS,LDP	;IF AT LOAD POINT
	MTAPE TAPE,16	;(MOVE FWD. OVER EOF)
	JRST MTCONT	;DON'T SKIP A RECORD



;ADVANCE MTA 1 FILE, T3=AB OR ABOUT
;AB/ABOUT = INPUT/OUTPUT DEVICE

ADVF:	HLRZ T3,T3	;T3=NO. FILES (OR REC) TO ADVANCE
ADVF2:	MOVEI T5,6	;ADVR
	TRNN T1,MTDFLG	;ADVR ?
	MOVEI T5,16	;ADVF
	MTAPE TAPE,(T5)	;ADVANCE FILE/RECORD
	SOJG T3,ADVF2	;MORE FILES/RECORDS TO ADV?
			;NO, END OF LOOP
	WAIT TAPE,	;WAIT...
	GETSTS TAPE,IOS
	TRZE IOS,EOFBIT
	SETSTS TAPE,(IOS)	;END OF FILE
	JRST MTCONT
;ROUTINE TO INITIALIZE MAGTAPE FOR INPUT OR OUTPUT

INOMTA:	SKIPA T2,ODEV	;INIT OUTPUT DEVICE
INIMTA:	MOVE T2,DEVICE	;INIT INPUT DEVICE
	SETZM MTANAM+1
	MOVEM T2,MTANAM
	TRNN CALFLG,NEWDEV
	JRST INMTA	;SAME DEVICE
	PUSHJ P,MTC1	;NEW DEVICE
	HRRZM	T4,INMTA1	;SET MODE,DENSITY,PARITY

INMTA:	OPEN TAPE,INMTA1
	JRST ERR1B
	POPJ P,

;ROUTINE TO PRINT ERROR MSG IF MORE THAN 1/8 FLAGS SET

MTR1:	MOVE T4,DEVICE	;TENTATIVELY SET I/DEV

	CAIE T6,INIMTA	;INPUT DEVICE?
	MOVE T4,ODEV	;NO, SET O/DEV
	ERRPNT </?Too many requests for />
	PUSHJ P,P6BIT
		T4
	JRST	PIP2
	SUBTTL	CONSTANTS/STORAGE/VARIABLES

;CONSTANTS

IFE WCH,<
OKBD:	POINT 6,DTON+2,23	;FOR NO. 1K BLOCKS
OKB:	POINT 6,ZRF+2,23>
DATE:	POINT 12,ZRF+2,35
DATED:	POINT 12,DTON+2,35	;CREATION DATE /X
ZRO:	ASCII /00000/
OPTMAX:	POINT 7,LBUFE-1,34
OPTRA:	XWD 700,LBUF-1		;INITIAL POINTER TO LINE BUFFER
K1:	432150643240		;MAGIC ASCII INCREMENT BY 10
K3:	375767737576		;CHARACTER MASK 077
K4:	432150643216		;MAGIC ASCII INCREMENT BY 1
QPIP:	SIXBIT /QPIP/		;DATA FOR Q SWITCH
STAR:	SIXBIT /*/		;LOOK FOR *.* FILNAM.EXT
TWL:	OCT 12
PP11:	XWD 1,1
PP13:	XWD 1,3			; SANDERS SYS
UPROJ:	EXP	^D101	; SANDERS UNIVERSAL PROJECT
IFN FTDSK,<
PRPTL:	POINT 9,PROTS,8		;PROTECTION FOR RENAME
PRPTD:	POINT 9,DTON+2,8
PRNM:	POINT 9,ZRF+2,8		;PROT FOR /R
TIME:	POINT 11,ZRF+2,23	;CREATE TIME /X
TIMED:	POINT 11,DTON+2,23	;DEPOSIT CREATE TIME>



;PROGRAM STORAGE AREA

IFE BLOC0,<
BL0CNT:	BLOCK	1		;COUNT>
DTAID:	BLOCK 1	; STORE DTA SERIAL NUMBER
DIRPPN:	BLOCK 1		; STORE OWNERSHIP
SVIBF:	BLOCK	1	;SAVE INIT MODE (INPUT)
SVOBF:	BLOCK	1	;SAVE INIT MODE (OUTPUT)
IBF:	BLOCK   3	;INPUT BUFFER HEADER
OBF:	BLOCK   3	;OUTPUT BUFFER HEADER
OBI:	BLOCK   3	;OUTPUT BUFFER INPUT HEADER FOR DSK /Z
TFI:	BLOCK   3	;CONSOLE INPUT HEADER
TFO:	BLOCK   3	;CONSOLE OUTPUT HEADER
SAVAC:	BLOCK   5	;SAVE SOME ACS
NAMTAB:	BLOCK   24	;FOR (XD) ON DSK OR RENAME
IFN FTDSK,<
LOCNAM:	BLOCK	1	;POINTER FOR NAMTAB>
DIRST:	BLOCK	1	;LOC. OF LAST DIR. FILE NAME REFERENCED
DIRST1:	BLOCK	1	;SAVE INITIAL DIRST
SQNUM:	BLOCK	1	;CURRENT SEQUENCE NUMBER
DTJBFF:	BLOCK	1	;VALUE OF JOBFF AFTER CONSOLE I/O BUFFERS
SVJBFF:	BLOCK	1	;INITIAL VALUE OF JOBFF
SVJBF1:	BLOCK	1	;VALUE OF JOBFF AFTER OUTBUF UUO
OPTR:	BLOCK	1	;CURRENT POINTER FOR LINE PRESCAN
DTONSV:	BLOCK   2	;OUTPUT DIRECTORY ENTRY COPY
SVPTR1:	BLOCK	1	;POINTER TO LAST PRINTING CHARACTER
SVPTR2:	BLOCK	1	;POINTER TO LAST GENERATED TAB
TLBRKT:	BLOCK	1	;TOTAL PARENS ON THIS LINE
TOTBRK:	BLOCK	1	;TOTAL CUMULATIVE PARENS
TABCT:	BLOCK	1	;SPACES TO NEXT TAB STOP
SPCT:	BLOCK	1	;CONSECUTIVE SPACES COUNTER
ABOUT:	BLOCK	1	;AB FOR OUTPUT UNIT
AUXOUT:	BLOCK	1	;AUX FOR OUTPUT UNIT
PROTS:	BLOCK	1	;SAVE PROTECTION
ZCNT:	BLOCK	1	;COUNT FOR DSK ZRO REQ.
CDRCNT:	BLOCK	1	;COUNT CARD COLS.
PTRPT:	BLOCK	1	;STORE SEQ. NO. POINTER
SYSPP:	BLOCK	1	;PP OF DEVICE SYS

;THIS IS A BLOCK OF VARIABLE LOCATIONS, ZEROED AT THE START OF EACH
;PIP RUN, I.E EACH TIME PIP TYPES *.

;*****	DO NOT SPLIT THIS BLOCK	*****
IFN FTDSK,<
RIBFIR:	BLOCK	1	;NUMBER OF WORDS IN LOOKUP
PPP:	BLOCK	1	;PROJ-PROG FOR EXTENDED LOOKUP>
FILNAM:	BLOCK	1	;FILE NAME FROM COMMAND SCANNER
FILEX:	BLOCK	1	;EXTENSION
PR:	BLOCK	1	;PROTECTION
PP:	BLOCK	1	;P-P NUMBER TYPED BY USER
IFN FTDSK,<BLOCK 20+RIBFIR-.>	;TOTAL LENGTH OF LOOKUP BLOCK
;*****	END OF BLOCK	*****
DTON:	BLOCK   4	;OUTPUT DIR. ENTRY
DEVA:	BLOCK	1	;SAVE INPUT DEV. NAME
NO.:	BLOCK	1	;GENERATE FILE NAMES
ZRF:	BLOCK   4	;LOOKUP FILE NAMES
MTAREQ:	BLOCK	1	;STORE MTA REQUESTS

COMEOF:	BLOCK	1	;EOF INDICATOR
COMBUF:	BLOCK	^D41	;COMMAND BUFFER. ALLOWS 205 CHARS.
COMCNT:	BLOCK	1	;COMBUF CHARS COUNT
COMPTS:	BLOCK	1	;POINTER FOR STORING/EXTRACTING CS


AUX:	BLOCK	1	;COPT AUXFLG (MTA)
IFN FTDSK,<
FNPPN:	BLOCK	1	;RESERVE #P-P
FNPPNS:	BLOCK	1	;COPY FNPPN FOR LATEST NON-SYS #P-P>
ESWTCH:	BLOCK	1	;-1 INDICATES END OF LINE
XNAME:	BLOCK	1	;-1 INDICATES SCAN OVERSHOOT WITH A NULL NAME
			;0  INDICATES NO SCAN OVERSHOOT
			;CONTAINS OVERSHOOT NAME IF NOT NULL
AB:	BLOCK	1	;MTA VALUE SWITCHES
			;THIS IS THE END OF THE INIT. ZEROED BLOCK.
MONTH:	ASCII /-Jan-/
	ASCII /-Feb-/
	ASCII /-Mar-/
	ASCII /-Apr-/
	ASCII /-May-/
	ASCII /-Jun-/
	ASCII /-Jul-/
	ASCII /-Aug-/
	ASCII /-Sep-/
	ASCII /-Oct-/
	ASCII /-Nov-/
	ASCII /-Dec-/

MNPT:	POINT 7,MONTH

PDL:   BLOCK 20		;PUSHDOWN LIST

LBUF:  BLOCK 204	;LINE BUFFER. ALLOW FOR FORTRAN DATA
LBUFE==.-1

DBUF:  BLOCK 204	;DIRECTORY BUFFER
	BLOCK	27	; ALLOW ENOUGH FOR DTA PROT.

OMOD:	BLOCK 1		;OUTPUT DEVICE MODE, STATUS
ODEV:	BLOCK 2		;OUTPUT DEVICE NAME
			;BUFFER HEADER(S) LOC

ININI1:	BLOCK 1		;INPUT DEVICE
DEVICE:	BLOCK 2


DEVERR:	BLOCK 1
DERR2:	BLOCK 2

INMTA1:	BLOCK 1
MTANAM:	BLOCK 2
MATCH:	BLOCK	2	;NAME AND EXT FOR /L OR (RX)
RENSN:	BLOCK	1	;-1 IF RENAME MESSAGE SEEN
DTBLK:	BLOCK 1		; OPEN DTA DIRECTORY BLOCK
DTDEV:	BLOCK 2		; SIXBIT /DTAN/

SUBTTL	RIM LOADER
IFE RIMSW,<
RIMTB:	ERRPNT	<Z? /Y switch option not available this assembly!Z>
XLIST>
IFN RIMSW,<
LODAL==16			;LENGTH OF RIM LOADER
HLTBIT==200			;CHANGES JRST TO HALT
BLKSZ==17			;NORMAL BLOCK LENGTH IN RIM10B
JOBDA==140			;START OF USER AREA
CHKSM:	BLOCK	1		;CHECKSUM ACCUMULATED (RIM10B)
POINTA:	BLOCK	1		;SAVE POINTER FOR RIM10B BLOCK
LENGTH:	BLOCK	1		;CALC. LENGTH OF RIM10 FILE
ZERO:	BLOCK	1		;NO OF 0'S NEEDED TO FILL SPACES IN
COUNT:	BLOCK	1		;RIM10B COUNT WORDS OUT
XFERWD:	BLOCK	1		;RIM-10-B XFER WD. ;FILE.

RIMTB:	TRNN	AUXFLG,DTAIN!DSKIN!MTAIN
	JRST	ERR5B
	PUSHJ	P,ININIT
	OUTPUT	OUT,
	TRNE	AUXFLG,DTAIN
	PUSHJ	P,DTADIR
IFN FTDSK,<
	TRNE	AUXFLG,DSKIN
	PUSHJ	P,DSKDIR>
	PUSHJ	P,FNSET
RIMTB0:	MOVEI	0,254000
	HRLM	0,XFERWD	;ASSUME JRST
	PUSHJ	P,LOOK		;GET FILE TO CONVERT
	JRST	MAIN1		;NONE LEFT
	LOOKUP	IN,ZRF
	JRST	ERR3
	HLRZ	0,ZRF+1
	CAIN	0,(SIXBIT ,RTB,)
	JRST	RIMTB1
	CAIE	0,(SIXBIT ,SAV,)
	CAIN	0,(SIXBIT ,RMT,)
	JRST	RIMTB2
	JRST	ERR3B		;NO LEGAL EXTENSION - SAVE JOBFF TOO
RIMTB1:	MOVE	T1,OBF+1	;PUNCH RIM10B LOADER
	HRLI	T1,RMLODA
	AOS	T2,T1		;XFER IT TO OUTPUT BUFFER
	BLT	T1,LODAL(T2)
	ADDI	T2,LODAL
	HRRM	T2,OBF+1	;FIX BUFFER POINTER
	MOVNI	T2,LODAL
	ADDM	T2,OBF+2	;AND COUNTER
	CLOSE	OUT,		;BLANK TAPE
RIMTB2:	PUSHJ	P,RINP		;GET FIRST BUFFER
	JRST	ERR8A		;FILE OF ZERO LENGTH
	JUMPGE	CHR,ERR8A	;FIRST WORD MUST BE POINTER
	HLRZ	0,ZRF+1
	CAIN	0,(SIXBIT ,SAV,)
	JRST	RIMTB4		;"SAV" FILE
	MOVEI	T2,^D126(CHR)	;FIND VALUE OF JOBSA
	MOVEI	T3,JOBDA-1
	CAMGE	T2,T3		;(JOBDA) IS FIRST LOC. OF USER PROF,
	JRST	ERR8A		;NO, ERROR
	MOVE	T1,IBF+1
	MOVEI	T3,JOBSA
	PUSHJ	P,RMS1
	HRRM	CHR,XFERWD	;SAVE TRANSFER WORD
	MOVEI	T3,JOBFF
	MOVE	T1,IBF+1
	PUSHJ	P,RMS1
	HRRZM	CHR,LENGTH	;SAVE (JOBFF)
	HLRZ	0,ZRF+1
	CAIN	0,(SIXBIT .RTB.);RIM 10B CONVERSION
	JRST	RIMTB4
;RIM10 1ST WD IS -N,X X IS 1ST WORD IN DATA BLOCK
;CONTAINING FIRST NON-ZERO WORD AFTER END
;OF JOBDATA AREA, FROM THERE TO JOBFF GIVES
;VALUE OF N. XFER ADD. COMES FROM JOBSA.

RMT1:	MOVEI	T1,JOBDA	;FIRST LOC. AVAILABLE TO USER
	LDB	CHR,IBF+1
	SUBI	T1,1(CHR)
	JUMPLE	T1,RMT2	;CURRENT "X" GT OR EQ JOBDA
	HLRO	T2,CHR
	MOVNS	T2		;GET "N"
	AOJ	T1,		;GET REL. LOC. OF JOBDA IN BLOCK
	CAMG	T1,T2
	JRST	RMT2
	AOJ	T2,		;NOT IN BLOCK, TRY NEXT
	ADDM	T2,IBF+1
	MOVNS	T2
	ADDM	T2,IBF+2	;READY TO GET NEXT POINTER
	JRST	RMT1
RMT2:	LDB	CHR,IBF+1	;POINTS TO FIRST USEFUL I/O WORD
	MOVNI	T1,(CHR)
	ADDB	T1,LENGTH
	MOVNS	T1		; -N
	HRLM	T1,POINTA
	HRRM	CHR,POINTA	;(-N,X) IN POINTA
	SETZM	ZERO

;NOW OUTPUT RIM10 FILE.  IBF+1 POINTS TO FIRST I/O WORD.  POINTA HAS I/O
;WORD FOR FILE.  LENGTH = NO. WDS TO GO OUT INCLUDING XFER WD.
;COUNT COUNTS NO. WDS IN CURRENT LOGICAL BLOCK
;ZERO COUNTS ZERO FILL

	MOVE	CHR,POINTA
	PUSHJ	P,PUT		;PUNCH I/O WORD
RMT8:	LDB	CHR,IBF+1	;-N,X
	MOVEM	CHR,POINTA
	HLRO	T1,CHR
	MOVNM	T1,COUNT
RMT6:	SETZ	CHR,		;PUNCH ZERO IF NECESSARY
	SOSL	ZERO
	JRST	RMT4		;DEPOSIT ZERO
	SOSGE	COUNT
	JRST	RMT5		;GET NEW LOGICAL BLOCK
	PUSHJ	P,RINP1
	JRST	ERR8A
RMT4:   SOSG	LENGTH
	JRST	RIMTB8
	PUSHJ	P,PUT
	JRST	RMT6
RMT5:   HRRZ	T1,POINTA
	HLRO	T2,POINTA
	SUBM	T1,T2
	PUSHJ	P,RINP1
	JRST	RMT9
	JUMPGE	CHR,ERR8A
	HRRZ	CHR,CHR
	SUB	CHR,T2
	JUMPL	CHR,ERR8A
	MOVEM	CHR,ZERO
	JRST	RMT8
RMT9:   MOVE	CHR,LENGTH
	SOJ	CHR,
	MOVEM	CHR,ZERO
	SETZ	CHR,
RMT10:  SOSGE	ZERO
	JRST	RIMTB8
	PUSHJ	P,PUT
	JRST	RMT10
;RIM10B: COMES FROM RTB AND SAV FILES. SAV=RTB EXCEPT IT HAS NO
;RIM LOADER AND NO TRANSFER WORD

RIMTB3:	PUSHJ	P,RINP1		;NONE, GET NEW POINTER
	JRST	RIMTB8		;EOF
	JUMPL	CHR,RIMTB4	;POINTER WORD
	CAME	CHR,XFERWD	;IS IT FINAL JRST XXX
	JRST	ERR8A		;NO,ERROR
	JRST	RIMTB8		;YES,OUTPUT IT

RIMTB4:	LDB	CHR,IBF+1
	HRRZM	CHR,POINTA	;LOAD WORDS HERE
	HLROM	CHR,COUNT
	MOVNS	COUNT		;NO. WDS IN THIS BLOCK
RIMTB7:	SKIPN	T1,COUNT	;ANY WORDS LEFT IN BLOCK?
	JRST	RIMTB3		;NONE
	SETZM	CHKSM		;INITIALIZE CHECKSUM
	CAIL	T1,BLKSZ
	MOVEI	T1,17
	MOVN	T2,T1		;T1 HAS NO. OF WDS TO GO OUT
	ADDM	T2,COUNT	;ADJUST COUNT
	HRL	CHR,T2
	HRR	CHR,POINTA	;I/O WD IN CHR
	ADDM	T1,POINTA	;SET POINTA FOR NEXT TIME
	ADDM	CHR,CHKSM	;ADD I/O WD TO CHECKSUM
RIMTB5:	PUSHJ	P,PUT		;PUTPUT I/O WORD
	SOJL	T1,RIMTB6		;FINISHED THIS BLOCK
	PUSHJ	P,RINP1		;GET DATA
	JRST	ERR8A		;EOF (ILLEGAL)
	ADDM	CHR,CHKSM	;CHECKSUM
	JRST	RIMTB5
RIMTB6: MOVE    CHR,CHKSM
	PUSHJ	P,PUT
	OUTPUT	OUT,
	JRST	RIMTB7
RIMTB8:	MOVE	CHR,XFERWD	;EOF HERE, XFERWD=JOBSA
	TRNN	CHR,-1
	TLO	CHR,HLTBIT
	HLRZ	0,ZRF+1
	CAIN	0,(SIXBIT .SAV.);NO XFER WD FOR "SAV" FILES
	JRST	RIMA
	PUSHJ	P,PUT
	SETZ	CHR,
	PUSHJ	P,PUT		;TRAILING ZERO
	OUTPUT	OUT,
RIMA:	CLOSE	IN,
	TRNE	FLAG,XFLG
	CLOSE	OUT,
	JRST	RIMTB0

;THIS IS THE I/O SECTION

RINP:	PUSHJ	P,INP
	TRNE	IOS,EOFBIT	;EOF?
	POPJ	P,		;EOF EXIT
RINP1:	SOSGE	IBF+2
	JRST	RINP
	ILDB	CHR,IBF+1
	JRST	CPOPJ1

RMS2:	SUB	T1,T4		;(IBF+1)+N
	AOJ	T1,
RMS1:	LDB	CHR,T1		;GET POINTER
	HRRZ	T2,CHR		;X
	HLRO	T4,CHR		;-N
	SUB	T2,T4		;X+N IN T2
	CAMGE	T2,T3
	JRST	RMS2
	SUBI	T3,(CHR)	;HOW FAR FROM POINTER?
	ADD	T1,T3		;INCREMENT POINTER
	LDB	CHR,T1		;(JOBSA/FF)
	POPJ	P,

;THIS IS THE RIM LOADER FOR THE PDP-10

RMLODA:	PHASE	0

	XWD	-16,0
ST:	CONO	PTR,60
ST1:	HRRI	A,RD+1
RD:	CONSO	PTR,10
	JRST	.-1
	DATAI	PTR,@TBL1-RD+1(A)
	XCT	TBL1-RD+1(A)
	XCT	TBL2-RD+1(A)
A:	SOJA	A,
TBL1:	CAME	CKSM,ADR
	ADD	CKSM,1(ADR)
	SKIPL	CKSM,ADR
TBL2:	JRST	4,ST
	AOBJN	ADR,RD
ADR:	JRST	ST1
CKSM:	BLOCK	0

IF2,<	PURGE ST,ST1,RD,A,TBL1,TBL2,ADR,CKSM>
DEPHASE>
LIST

IFE FTDSK,<	
	VAR
LOWTOP:
	END	PIP1>
SUBTTL	DISK ROUTINES
;* * * ALL THE FOLLOWING ARE DISK ROUTINES * * *

;DISK DELETE AND RENAME ROUTINES

DSKDR0:	MOVE	T1,DTON+3	;GET OUTPUT PPN
	SKIPN	PP		;ALREADY SET?
	MOVEM	T1,PP		;OUTPUT=INPUT FOR /D,/R
DSKDR:	PUSHJ   P,ININIT	;GET DSK AS INPUT DEVICE
	PUSHJ   P,DSKDIR	;GET USER'S FILE DIRECTORY
	PUSHJ	P,INFO		;PRINT FILES DELETED:/RENAMED:
	SETZM   ZCNT		;COUNT OF FAILURES
DSKDR5:	PUSHJ   P,LOOK		;PREPARE FOR LOOKUP/ENTER
				;OF FILE TO /D OR /R
	JRST    DSKDR1		;ALL THROUGH WITH UFD
	LOOKUP	IN,ZRF		;IS SOURCE FILE THERE?
	JRST    DERR5		;ERROR
	CLOSE   IN,		;YES
	TRNN    FLAG,DFLG	;DELETE?
	JRST    DSKDR4		;NO, RENAME
	SETZM   DTON		;YES
	MOVE    0,FNPPN		;SET DEST. DEVICE SAME AS SOURCE FOR DELETE,
	MOVEM   0,DTON+3	;I.E. PROJ-PROG NUMBER
	JRST    DSKDR7

DSKDR4:	PUSHJ   P,RENAME
	JUMPN	T2,.+3		;JUMP IF FILE NAME SEEN
	MOVE	0,[XWD ZRF,DTON];NO NAME SET SO USE LOOKUP NAME
	BLT	0,DTON+1	;AND EXT SO FILE NOT DELETED
	MOVE	0,ZRF+2		;GET DATE,MODE,PROT ETC.
	MOVEM	0,DTON+2	;SAVE AS BEFORE
	MOVE	0,NAMTAB+3	;GET PROJ-PROG
	MOVEM	0,DTON+3
	LDB	0,[POINT 9,NAMTAB+2,8]
	TLNE    AUXFLG,NSPROT	;USE THE CURRENT PROTECTION
	DPB     0,PRPTD		;UNLESS NEW PROT. SPECIFIED
DSKDR7:	RENAME  IN,DTON
	AOSA     ZCNT		;RENAME (OR DELETE) FAILS
	PUSHJ	P,INFO3		;PRINT FILENAME DELETED/RENAMED
	JRST    DSKDR5

DSKDR1:	TLZ     AUXFLG,NSPROT	;NON-ST. PROT FIXED
	SKIPE   ZCNT		;SKIP IF NO FAILURES
	JRST    DSKDR6		;ERROR
	SOS     ESWTCH		;ENSURE ESWTCH NEGATIVE
	RELEAS	CON,
	JRST    MAIN1
;ZERO DSK DIRECTORY OF ALL POSSIBLE FILES.  IF ANY ARE PROTECTED, GIVE
;A MESSAGE AND DO NOT PROCESS ANY OTHER SWITCHES.

DSKZRO:	SKIPE	T1,ODEV		; STR# 10-2892
	MOVEM	T1,ADSK
	PUSHJ   P,DIRSK1
	SETZM   ZCNT
	INBUF   OUT,1		;FOR LOOKUPS ON OUT
DSKZ1:	SOSLE   UFDIN+2
	SKIP	2
DSKZ3:	PUSHJ   P,UIN
	JRST    DSKZ2
	ILDB    0,UFDIN+1
	JUMPE   0,DSKZ3
	MOVEM   0,ZRF
	SOS     UFDIN+2
	ILDB    0,UFDIN+1
	HLLZM   0,ZRF+1		;EXTENSION
	MOVE    0,FNPPN
	MOVEM   0,ZRF+3
	LOOKUP  OUT,ZRF
	AOS     ZCNT		;COUTN REJECTS,TRY MORE FILES
	CLOSE   OUT,
	SETZM   ZRF
	MOVE    0,FNPPN
	MOVEM   0,ZRF+3
	RENAME  OUT,ZRF
	AOS     ZCNT
	JRST    DSKZ1		;REPEAT
DSKZ2:	SKIPN	ZCNT		;ANY FAILURES?
	POPJ    P,		;NO
				;PRINT ERROR MESSAGE
	MOVSI	T4,(SIXBIT /Z/)
	JRST    DSKZ5
DSKDR6:	MOVSI   T4,(SIXBIT /D/)
	TRNN    FLAG,DFLG
	MOVSI   T4,(SIXBIT /R/)
DSKZ5:	ERRPNT	<X?Failure(s) during /X>
	PUSHJ	P,P6BIT
		T4
	ERRPN2	</ request!/>
;PREPARE TO LOOKUP FILES IN PARTICULAR DISK DIRECTORY

DIRSK1:	SKIPA   T1,DTON+3
DSKDIR:	MOVE    T1,PP		;GET [P,P] INTO T1
	JUMPN   T1,.+2		;IS IT ZERO?
	GETPPN   T1,		;YES, GET USER'S [P,P]
	TRNE	AUXFLG,SYSFLG	;DEVICE SYS
	MOVE	T1,SYSPP	;GET SYS  [PP]
	MOVEM	T1,FNPPN
	MOVE	0,[XWD FILNAM,UFD]
	BLT	0,UFD+3		;SAVE LOOKUP BLOCK
IFE DISK30,<
	MOVEM   T1,FILNAM	;[P,P] TO UFD
	MOVSI	0,(SIXBIT /UFD/)
	MOVEM	0,FILEX		;USER HAS SPECIFIED [P,P]>
IFN DISK30,<
	HRRZM   T1,T2		;SAVE PROGRAMMER NBR.
	LSH     T1,-14		;SHIFT PROJECT NBR.
	IOR     T1,T2		;REPLACE PROGRAMMER NBR
	MOVEM   T1,MASK
	MOVE    0,[SIXBIT /*FD*/]
	MOVEM   0,FILNAM
	MOVSI   0,(SIXBIT /SYS/)
	MOVEM   0,FILEX>
	TRNN    CALFLG,SYSFLG	;CURRENT DEVICE SYS?
	MOVEM   T1,FNPPNS	;SAVE LATEST NON-SYS #P-P
	MOVE    0,PP11		;MAKE [P,P]=[1,1]
	MOVEM   0,PP
	MOVEM	0,PPP		;SAVE FOR EXTENDED LOOKUP
	PUSHJ   P,DSKDST	;INIT TO READ DIRECTORY
	MOVEI	T1,RIBSTS	;NO. OF WORDS FOR EXTENDED LOOKUP
	MOVEM	T1,RIBFIR
	MOVE	T1,LEVEL	;LEVEL D = -2
	LOOKUP  DIR,FILNAM(T1)	;GET USERS FILE DIRECTORY
	JRST    DERR5A		;ONE OF 8 LOOKUP ERRORS
	JUMPE	T1,DIRSK2	;IF LEVEL C
	HRRZ	T1,RIBFIR+RIBSTS
	ANDI	T1,777		;GET ERROR BITS
	JUMPN	T1,DIRSK2	;JUMP IF ERRORS IN UFD
	MOVEI	T1,RBSIZ	;SET LOOKUP
	MOVEM	T1,RIBFIR	;FOR SHORT EXTENDED
DIRSK2:	MOVS	T1,[XWD FILNAM,UFD]
	BLT	T1,PP		;RESTORE LOOKUP BLOCK
	POPJ    P,		;LOOKUP OK
;SETUP BUFFER TO READ 10/30 DISK BLOCKS

IFN DISK30,<
BLKSET:				;MAKE MONITOR USE BLKBUF
	MOVEI	T1,BLKBUF	;FOR 10/30 DISK BLOCKS
	EXCH	T1,JOBFF
	INIT	BLKIN,14
	SIXBIT	/SYS/
	XWD	0,BLKHD
	JRST	ERR1A
	INBUF	BLKIN,1
	MOVEM	T1,JOBFF
	POPJ	P,

BLKBUF:	BLOCK 204		;10/30 DISK BLOCK BUFFER

;ROUTINE TO READ 10/30 DISK

BLKRD:	SETZM	FILNAM+2
	SETZB	BLKTMP
	INPUT	BLKIN,		;INPUT 10/30 DISK BLOCKS
	STATUS	BLKIN,IOS
	TRNN	IOS,760000
	JRST	BLKRD1
	TRZN	IOS,20000	;EOF
	JRST	BLKERR		;ERROR
	SETSTS	BLKIN,(IOS)
	MOVEM   0,BLKTMP
	ADDM    0,BLKSUM
	POPJ    P,
BLKRD1:	AOJA	0,BLKRD+2	;COUNT BLOCKS PER FILE
BLKERR:	PUSHJ	P,COMERR
	JSP	T5,INICN2
	TRNN	IOS,400000	;CHECK FOR WRITE LOCK
	JRST	BLKER2		;NO
	ERRPN2	</?/>
BLKER2:	ERRPN2	</Input device DSK file />
	MOVEI	T6,FILNAM
	PUSHJ	P,FN.EX
	MOVE	T2,AUXFLG
	ANDI	T2,DSKIN
	PUSHJ	P,IOERR
	SETSTS	BLKIN,(IOS)
	POPJ	P,>
;ROUTINE TO LIST DISK DIRECTORY. /L OR /F SWITCH

DSKLST:	PUSH	P,DEVICE
	PUSHJ	P,ININIT	;ASSIGN "IN" FOR RETRIEVAL INFO
	SETZM	BLKSUM		;CLEAR TOTAL BLOCKS FOR ALL FILES
IFN DISK30,<TRNN AUXFLG,FFLG	;SHORT LISTING
	PUSHJ   P,BLKSET	;NO>
	SETZM	LIN		;SET UP APPROPRIATE CONTROLS
	MOVS	T1,ODEV		;FOR THIS LISTING DEVICE
	CAIN	T1,(SIXBIT/TTY/);IF ODEV IS TTY
	TRO	CALFLG,LISTTY	;SET LISTTY=1 (TTY)
	SKIPN	FILNAM		;IF NO FILNAM GIVEN
	TRZ	CALFLG,MATFN!MATEX	;LIST ALL OF DIRECTORY
	MOVE	T1,FILNAM
	MOVEM	T1,MATCH
	HLRZ	T1,FILEX
	MOVEM	T1,MATCH+1
	PUSHJ	P,DSKDIR
	PUSHJ	P,CRLF		;GIVE A BLANK LINE
	TRNN	AUXFLG,FFLG	;SHORT LISTING
	PUSHJ	P,HEADER	;PUT OUT HEADER LINES
	SKIPN	LEVEL		;ONLY IF LEVEL D
	JRST	LSTU0A		;LEVEL C
	MOVEI	T1,ADSK		;ADDRESS OF DEVICE
	DSKCHR	T1,		;SEE IF DSK
	TDZA	T1,T1		;NOT LEVEL D DSK
	TLNE	T1,(7B17)	;GENERIC DEVICE DSK
	TDZA	T1,T1		;NO
	SETO	T1,		;YES
	MOVEM	T1,GENERI	;SAVE IT
	JUMPE	T1,LSTU0A	;LEVEL C
LSTU0:	MOVEI	T1,GENERI	;GET ADDRESS
	JOBSTR	T1,		;GET FILE STRUCTURE
	TDZA	T1,T1		;ERROR
	SKIPN	T1,GENERI	;GET DEVICE
	JRST	DIRFIN		;FINISHED
	MOVEM	T1,ADSK		;FOR DIR INIT
	MOVEM	T1,DEVICE	;FOR RETRIEVAL INFO
	PUSHJ	P,ININIT	;INIT
	MOVE	0,GENERI	;YES, GET IT
	PUSHJ	P,SIXOUT	;PRINT IT
	MOVEI	CHR,":"		;FOLLOW WITH COLON
	PUSHJ	P,PUT
	PUSHJ   P,DSKDIR	;LOOKUP UFD
	PUSHJ	P,CRLF		;AND A CR-LF
LSTU0A:	MOVE	T1,PP		;GET PROJ-PROG
	MOVEM	T1,PPP		;SAVE FOR EXTENDED LOOKUP
LSTU1:	SOSLE   UFDIN+2
	SKIP	2
LSTU2:	PUSHJ   P,UIN		;GO READ DIRECTORY
	JRST    BLKLST		;(EOF) - OUTPUT BLOCKS USED
	ILDB	0,UFDIN+1
	JUMPE   0,LSTU2
	MOVEM	0,FILNAM	;PREPARE TO GET RETRIEVAL INFO
	MOVE	T1,FNPPN	;EACH LOOKUP DESTROYS P-P NO.
	MOVEM	T1,FILNAM+3	;RESTORE P-P NO.
	SKIPG	LIN
	PUSHJ	P,HEDR3		;YES, PUT OUT HEADER LINES
	SOS	UFDIN+2
	ILDB	DOUT,UFDIN+1	;PICK UP EXTENSION
	HLRZS	DOUT		;CLEAR RIGHT HALF
	HRLZM	DOUT,FILNAM+1	;KEEP FOR LOOKUP
	TRNN	CALFLG,MATEX	;MATCH EXTENSIONS?
	SKIP	2		;NO,TRY MATFN
	CAME	DOUT,MATCH+1	;MATCH?
	JRST	LSTU1		;NO,GET NEXT FILE
	TRNN	CALFLG,MATFN	;MATCH FILENAME?
	JRST	LSTU2A		;NO
	CAME	0,MATCH		;FILNAM MATCH?
	JRST	LSTU1		;NO
LSTU2A:	IFE DISK30,<
	CAIE	DOUT,(SIXBIT ?UFD?)	;IS FILE MFD
	JRST	LSTU3		;GO PRINT NAME HELD IN 0.
	HLRZ	DOUT,FILNAM	;HERE FOR MFD ONLY
	MOVEI   T2,PUT
	PUSHJ	P,OUTDC1	;PRINT #,#. PROJ. NO.
	MOVEI	CHR,COMMA	;","
	PUSHJ	P,PUT		;...
	HRRZ	DOUT,FILNAM	;PROG. NO.
	PUSHJ	P,OUTDC1
	JRST	LSTU3A	;...>
IFN DISK30,<
	ILDB    0,UFDIN+1	;PICKUP THIRD AND FOURTH WORD
	MOVEM   0,FILNAM+2	;IN 10/30 DISK FILE DIRECTORY
	ILDB    0,UFDIN+1
	TDC     0,MASK
	TRNE    0,3777
	JRST    LSTU1>
LSTU3:	MOVE	0,FILNAM
	PUSHJ	P,SIXOUT	;OUPUT FILENAME
LSTU3A:	MOVEI	T4,4		;SET LOOP FOR OUTPT EXT
	MOVE	0,FILEX
	JUMPE	0,LSTU4
	PUSHJ	P,TABOUT
	PUSHJ	P,SIXOUT	;OUTPUT EXTENSION
LSTU4:	TRNN    AUXFLG,FFLG	;SHORTEST LISTING?
	SKIP	2
	PUSHJ	P,CLRF		;YES
	JRST	LSTU1
	SKIPN	FILEX
	PUSHJ	P,TABOUT
	PUSHJ	P,SPACES
IFE DISK30,<
	MOVE	T4,LEVEL	;-2 IF LEVEL D,0 IF LEVEL C
	LOOKUP	IN,FILNAM(T4)	;GET RETRIEVAL INFO.
	JRST	LSTU5		;NOT AVAILABLE
	JUMPE	T4,LSTU4A	;LEVEL C OR NO UFD ERRORS
	HRRZ	DOUT,RIBFIR+RIBSTS	;FILE ERROR STATUS
	ANDI	DOUT,777		;ONLY ERROR BITS
	JUMPE	DOUT,LSTU4A	;NO ERRORS
	MOVEI	CHR,"("		;PUT ERROR CODE IN PARENS
	PUSHJ	P,PUT
	SKIPA	T4,[POINT 7,[ASCII /a*cm**rwf*/]]
	LSH	DOUT,-1		;SHIFT ERROR BIT TOWARDS BIT 35
	ILDB	CHR,T4		;GET AN ERROR CHARACTER
	TRNN	DOUT,1		;IS IT THIS ERROR?
	JRST	.-3		;NO
	PUSHJ	P,PUT		;YES,OUT IT GOES
	MOVEI	CHR,")"
	PUSHJ	P,PUT
LSTU4A:	>
IFN DISK30,<
	MOVE    DOUT,FILNAM+2	;SAVE
	LOOKUP  BLKIN,FILNAM
	JRST    LSTU5
	PUSHJ   P,BLKRD
	MOVEM   DOUT,FILNAM+2>
	PUSHJ   P,TABOUT
IFE DISK30,<
	PUSHJ   P,BLKS>		;DETERMINE NO. BLK IN FILE
				;AND TOTAL FOR UFD
IFN DISK30,<
	PUSHJ   P,BLKOUT>
	LDB	0,PROT		;GET PROTECTION BITS
	PUSHJ	P,PROTO		;PRINT OCTAL NUMBERS
	TRNE	CALFLG,LISTTY	;OUTPUT DEVICE A TTY?
	JRST	LSTU7		;YES, SKIP LONG DIRECTORY
	LDB	0,ADATE		;PRINT ACCESS DATE
	PUSHJ	P,DATOUT
	PUSHJ	P,TABOUT
	LDB	0,CTIME		;PRINT CREATION TIME
	PUSHJ	P,TIMOUT
	LDB	0,CDATE
	PUSHJ	P,DATOUT	;PRINT CREATION DATE
	PUSHJ	P,TABOUT
	LDB	0,MODE		;PRINT MODE
	PUSHJ	P,OCTLS2
	JRST	LSTU8

LSTU5:	PUSHJ	P,TABOUT	;THE FILE WAS PROTECTED
	HRRZ    T7,FILEX	;GET PARTICULAR ERROR TYPE
	CAIL	T7,TABLND-TABLE	;IS IT LEGAL ERROR
	SKIPA	T1,TABLND	;NO,PICK UP CATCH ALL MESSAGE
	MOVE    T1,TABLE(T7)	;PICK UP POINTER FOR ERROR MSG
LSTU6:	ILDB    CHR,T1		;PICK UP CHAR FROM ERROR MSG
	JUMPE   CHR,LSTU8	;PRINT ERROR MESSAGE, END SEEN
	CAIN    CHR,"!"
	JRST	LSTU8		;ALTERNATE END SEEN (!)
	PUSHJ	P,CCASE		;DEPOSIT CHARACTER
	PUSHJ   P,PUT
	JRST    LSTU6


LSTU7:	LDB     0,CDATE
	PUSHJ   P,DATOUT	;PRINT CREATION DATE ONLY FOR TTY
LSTU8:	IFE DISK30,<
	CLOSE	IN,>
	PUSHJ	P,CLRF
	JRST	LSTU1



;ROUTINE TO OUTPUT SPACES, T4=NO. TO OUTPUT

SPACES:	MOVEI	CHR,SPACE
	PUSHJ	P,PUT
	SOJG	T4,.-1
	POPJ	P,

;ROUTINE TO DEPOSIT T4.SIXBIT CHARACTERS
;FROM AC0 INTO OUTPUT BUFFER
SIXOUT:	MOVSI	T2,(POINT 6,0)
	JUMPE	0,SIXO1		;ZERO WORD
	TLNE	0,770000	;LEADING SPACE
	JRST	LSTO0		;NO
	LSH	0,6		;GET NEXT CHAR.
	MOVEI	CHR," "		;BUT OUTPUT SPACE
	SKIP	3
LSTO0:	ILDB	CHR,T2
	JUMPE	CHR,SIXO1
	ADDI	CHR,40		;MAKE ASCII
	PUSHJ	P,PUT
	SOJ	T4,
	TLNN	T2,770000
SIXO1:	POPJ	P,
	JRST	SIXOUT+2
;DETERMINE NUMBER OF BLOCKS PER FILE AND TOTAL NUMBER OF
;BLOCKS USED BY USERS PROJECT,PROGRAMMER NUMBER

BLKS:	MOVE	DOUT,RIBFIR+RBSIZ
	SKIPE	LEVEL		;SKIP IF LEVEL C
	SKIP	3		;LEVEL D WORD COUNT
	HLRE    DOUT,PP		;GET WORD COUNT OF FILE
	JUMPGE	DOUT,BLKADD	;IF POS = NO. OF BLOCKS
	MOVNS   DOUT		;MAKE POSITIVE
	TRZE    DOUT,177	;TAKE CARE OF PARTIAL BLOCKS
	ADDI    DOUT,200
	IDIVI   DOUT,200	;CALCULATE BLOCK COUNT
BLKADD:	ADDM    DOUT,BLKSUM	;CALCULATE TOTAL FOR ALL FILES
	PUSHJ   P,OUTDE4	;OUTPUT NUMBER OF BLOCKS IN DECIMAL
	JRST	TABOUT		;OUTPUT TAB

;END OF FILE ON UFD OUTPUT TOTAL BLOCKS XXX

BLKLST:	SKIPN   BLKSUM		;ANY INFORMATION TO OUTPUT
	JRST    BLKLS1		;NO - FINISHED
	LSTLIN	TOTAL		;OUTPUT CR,LF "TOTAL BLOCKS"
	MOVE    DOUT,BLKSUM
	PUSHJ   P,OUTDE4	;PRINT TOTALS
	PUSHJ	P,CRLF		;BONUS CR-LF
BLKLS1:	SKIPN	GENERI		;MORE FILE STRUCTURES?
DIRFIN:	JRST	[POP	P,DEVICE
		JRST	MAIN1]
	SETZM	BLKSUM		;START AFFRESH
	MOVE	T1,PPP		;RESTORE PP
	MOVEM	T1,PP
	JRST	LSTU0		;YES

TOTAL:	ASCIZ	/
Total Blocks    /

CCASE:	CAIL	CHR,"a"	;FLUSH LOWER CASE LETTERS
	CAILE	CHR,"z"	;FROM OUTPUT IN CASE PDP-6 LPT
	POPJ	P,
	SUBI	CHR,40
	POPJ	P,
;INPUT USERS FILE DIRECTORY

UIN:	SETZ	IOS,		;JUST IN CASE
	IN	DIR,
	JRST	CPOPJ1		;NO ERRORS
	STATUS	DIR,IOS
	TRZN	IOS,EOFBIT
	JRST	UIN2		;ERROR PRINT
	POPJ	P,

;INIT DIRECTORY DEVICE

DSKDST:	MOVE	T2,JOBFF	;SAVE JOBFF IN T2

	MOVEI	T1,DBUF
	MOVEM	T1,JOBFF	;MAKE MONITOR USE DBUF FOR DISK DIR.

	MOVEI	T1,14		;BINARY MODE
	MOVEM	T1,ADSK1

	MOVEI	T1,UFDIN	;LOC OF DIRECTORY ENTRY
	MOVEM	T1,ADSK+1	;FOR UFD

	OPEN	DIR,ADSK1
	JRST	ERR1A
	INBUF	DIR,1		;RESET JOBFF SAME AS ENTRY
	MOVEM	T2,JOBFF
	POPJ	P,
;OUTPUT THE DIRECTORY LISTING HEADER

HEADER:	PUSHJ	P,HEDR4
HEDR1:	LSTLIN	HEDL1
	HLRZ	DOUT,FNPPN
	PUSHJ	P,OUTDEC	;PROJ, PROG
	MOVEI	CHR,","
	PUSHJ	P,PUT
	HRRZ	DOUT,FNPPN
	PUSHJ	P,OUTDEC
	PUSHJ	P,TABOUT
	PUSHJ	P,NOWOUT	;PRINT CURRENT TIME, DATE
	DATE			;DATE REQ.
	PUSHJ	P,DATOUT
	PUSHJ	P,CLRF
	TRNE	CALFLG,LISTTY
	JRST	HEDR2		;JUMP IF LISTING TO CONSOLE
	SOS	LIN
	LSTLIN	HEDLIN
HEDR2:	JRST	CLRF

HEDR3:	TRNN	AUXFLG,FFLG	;POP BACK IF SHORT LISTING
	TRNE	CALFLG,LISTTY
	POPJ	P,
	PUSHJ	P,HEDR4
	LSTLIN	HEDL2
	JRST	HEDR1
HEDLIN: ASCIZ /
    File	     Protection   Access	Creation    
 Name	Ext	Blks		   Date		Time	Date		Mode
/
HEDL1:	ASCIZ	/Directory     /
HEDL2:	ASCIZ	/Continuation of /

UIN2:	PUSHJ	P,COMERR
	JSP     T5,INICN2
	ERRPN2	</?Disk directory read />
	MOVEI   T3,UFD	;LOCATION OF FILENAME(AND EXT)
	PUSHJ   P,FN.EX	;PRINT FILE NAME EXTENSION
	MOVE    T2,AUXFLG
	ANDI    T2,DSKIN
	PUSHJ   P,IOERR
	SETSTS  DIR,(IOS)
	JRST    CPOPJ1

;OUTPUT THE TIME FOUND IN AC 0

NOWOUT:	MSTIME			;CALL MILLISEC TIMER
	IDIVI	0,^D60000	;CONVERT TO MINUTES
TIMOUT:	IDIVI	0,^D60
	MOVE	DOUT,0
	PUSHJ	P,OUTDEC
	MOVEI	CHR,":"		;SEPARATE BY A COLON
	PUSHJ	P,PUT
	MOVE	DOUT,1
	PUSHJ	P,OUTDEC
	JRST	TABOUT
;SKIP TO HEAD OF FORM OR NEXT HALF PAGE, RESET COUNT

HEDR4:	TRNE	CALFLG,LISTTY
	POPJ	P,		;EXIT IF TTY
	SKIPLE	LIN
	JRST	HEDR6		;ANYTHING ON THIS PAGE?
HEDR5:	MOVEI	CHR,FF		;FORM FEED IF FULL OR
	MOVEI	T2,^D50
HEDR5A:	MOVEM	T2,LIN		;ALMOST FULL
	PUSHJ	P,PUT
	MOVEI	CHR,LF
	PUSHJ	P,PUT
	PUSHJ	P,PUT
	JRST	PUT		;PRINT LINEFEEDS AND EXIT
HEDR6:	CAIGE	T2,^D25
	JRST	HEDR5
	MOVEI	CHR,HPAGE
	MOVEI	T2,^D16
	JRST	HEDR5A

;OUTPUT OCTAL WORD FOUND IN AC 0

OCTLS2:	MOVEI	CHR," "
	CAIGE	0,10		;AT LEAST 2 CHAR.?
	PUSHJ	P,PUT		;NO,SO OUTPUT A BLANK
OCTLST:	MOVSI	T1,(POINT 3,0)
	ILDB	CHR,T1
	TLNE	T1,770000	;ALLOW UPTO 12 OCTAL NOS
	JUMPE	CHR,.-2		;GET MOST SIG. NUMBER
OCTL1:	ADDI	CHR,60		;CONVERT TO ASCII
	PUSHJ	P,PUT		;OUTPUT CHAR
	ILDB	CHR,T1		;GET SUCCEEDING CHARS
	TLNN	T1,400000	;WAIT TILL POINTING TO NEW
	JRST	OCTL1		;WORD, THEN EXIT. MEAN WHILE
	POPJ	P,		;PRINT OCTAL NUMBERS

;OUTPUT PROTECTION BITS FOUND IN AC 0

PROTO:	MOVEI	CHR,"<"
	MOVSI	T1,(POINT 3,,26)
	PUSHJ	P,OCTL1+1
	MOVEI	CHR,">"
	PUSHJ	P,PUT
	JRST	TABOUT		;EXIT

;THIS IS THE DISK ERROR ROUTINE.  CALL DERR4 WITH T3=FIRST WORD ADDRESS
;OF LOOKUP OR ENTER. USE T7 FOR SAVING THE ERROR CODE.

DERR5A:	MOVEI   T3,FILNAM	;LOCATION OF FILENAME
	HRRZ	T7,1(T3)	;GET ERROR CODE
	SKIPE	GENERI		;FATAL IF NOT GENERIC "DSK"
	CAILE	T7,1		;NO UFD IF 0 OR 1
	JRST	DERR4		;ANY OTHER ERROR
	LSTLIN	NOUFD
	MOVEI	T1,LSTU0	;RETURN ADDRESS
	HRRM	T1,(P)		;OF POPJ
	JRST	DIRSK2		;GET NEXT FILE STRUCTURE
NOUFD:	ASCIZ	/	no UFD created
/

DERR6:	MOVEI   T3,DTON		;LOCATION OF FILENAME (OUTPUT)
	SKIP	1
DERR5:	MOVEI   T3,ZRF		;LOCATION OF FILENAME (INPUT)
	HRRZ	T7,1(T3)	;ERROR TYPE
DERR4:	ERRPNT	</? />
	PUSHJ   P,FN.EX		;PRINT FILE NAME .EXT
	CAIL	T7,TABLND-TABLE	;LEGAL ERROR?
	SKIPA	T1,TABLND	;NO,USE CATCH ALL MESSAGE
	MOVE	T1,TABLE(T7)	;PICK UP BYTE POINTER
	JRST	PTEXT1		;AND PRINT MESSAGE

TABLE:	POINT	7,[ASCII /(0) file was not found!/]
	POINT	7,[ASCII /(1) no such project-programmer number!/]
	POINT	7,[ASCII /(2) protection failure!/]
	POINT	7,[ASCII /(3) file was being modified!/]
	POINT	7,[ASCII /(4) rename file name already exists!/]
	POINT	7,[ASCII /(5) illegal sequence of UUOs!/]
	POINT	7,[ASCII /(6) bad UFD or bad RIB!/]
	POINT	7,[ASCII /(7) not a SAV file!/]
	POINT	7,[ASCII /(10) not enough core!/]
	POINT	7,[ASCII /(11) device not available!/]
	POINT	7,[ASCII /(12) no such device!/]
	POINT	7,[ASCII /(13) not two reloc reg. capability!/]
	POINT	7,[ASCII /(14) no room or quota exceeded!/]
	POINT	7,[ASCII /(15) write lock error!/]
	POINT	7,[ASCII /(16) not enough monitor table space!/]
	POINT	7,[ASCII /(17) partial allocation only!/]
	POINT	7,[ASCII /(20) block not free on allocation!/]

TABLND:	POINT	7,[ASCII /(?) lookup,enter,or rename error!/]

ADATE:	POINT 12,FILNAM+1,35	;ACCESS DATE
CTIME:	POINT 11,FILNAM+2,23	;CREATION TIME
CDATE:	POINT 12,FILNAM+2,35	;CREATION DATE
PROT:	POINT 9,FILNAM+2,8	;PROTECTION
MODE:	POINT 4,FILNAM+2,12	;RECORDING MODE
ADSK1:	BLOCK	1		;OPEN DIRECTORY, MODE
ADSK:	BLOCK	2		;FILENAME, EXT
LIN:	BLOCK 1			;COUNT FOR DSK DIR LIST
UFDIN:	BLOCK 3			;HEADER FOR READING DISK DIRECTORY
UFD:	BLOCK 4			;[P,P] OR *FD*
				;UFD OR SYS
IFN DISK30,<
BLKHD:	BLOCK 3			;HEADER FOR READING BLOCKS OFF 10/30 DISK
MASK:   BLOCK 1			;PROJ,PROG # 10/30 DISK>
BLKSUM:	BLOCK 1			;TOTAL NBR BLOCKS PER PROJ. PROG NBR
LEVEL:	BLOCK	1		;-2 IF LEVEL D DISK SERVICE
GENERI:	BLOCK	1		;FILE STRUCTURE NAMES IF GENERIC DSK

	VAR
LOWTOP:
PIPEND:	END PIP1