TITLE PIP V.022  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==22               ;VERSION NUMBER
SVER==0  


;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.

;CCLSW==0 PIP WILL NOT PROCESS CCL COMMANDS.(ALSO TRUE FOR 10/30 DISK SYSTEM)
;CCLSW==1 PIP WILL EXECUTE CCL COMMANDS FROM DISK.

;TEMP==1 PIP WILL GET CCL COMMANDS FROM CORE (TMPCOR UUO)

;REENT==1 PIP IS REENTRANT (AK-DAG)

;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==1>
IFE FTDSK,      <CCLSW==0>
IFNDEF CCLSW,   <CCLSW==1>
IFN DISK30,     <CCLSW==0>
IFN WCH,        <RIMSW==0>
IFE CCLSW,      <TEMP==0>
IFNDEF TEMP,    <TEMP==1>
IFNDEF REENT,   <REENT==1>
IFNDEF RIMSW,   <RIMSW==0>



IFN REENT,<HISEG>

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


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

;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
;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)
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


;DEVICE CHANNEL ASSIGNMENTS

IFN CCLSW,<
COM==0          ;STORED COMMAND INPUT CHANNEL>
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

;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
BOTBIT==4000	;BEGINNING 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>

DEFINE  PURE <
IFN REENT,      <RELOC>>

DEFINE  IMPURE <
IFN REENT,	<LOC>>
        IMPURE
LOW:
        PURE

;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:	IFN CCLSW,<
	TDZA FLAG,FLAG		;NORMAL ENTRY TO ACCEPT COMMANDS FROM TTY
 	SETO FLAG,		 ;CCL ENTRY TO READ COMMANDS FROM DISK FILE
 	SETZM COMFLG>
IFE REENT,<
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>
	>
IFN REENT,<
	MOVEI	T1,LOWTOP
 	HRLM	T1,JOBSA	;GET JOBFF>
P1:		HRRZM	T1,SVJBFF	;SAVE JOBFF SO BUFFERS CAN BE CREATED
IFE CCLSW,<JRST	PIP>
IFN CCLSW,<JUMPE FLAG,PIP	;ENTER PIP IF NO COMMAND FILE
	RESET			;RESET. MOVES JOBSA (LH) TO C (JOBFF)

;THIS IS MODIFICATION FOR USING TMPCOR WITH CCL
IFN TEMP,<MOVE T1,[XWD 2,TMPFIL];SET BLOCK POINTER FOR TMPCOR UUO
				;1=READ ONLY, LOC OF FILENAME
	MOVSI	T2,(SIXBIT /PIP/)
	MOVEM	T2,TMPFIL
	MOVSI	T2,-200
	HRR	T2,SVJBFF	;CALCULATE TMPFIL ADDRESS FOR BUFFER
	MOVEM	T2,TMPFIL+1	;STORE IN TMPFIL+1
	SOS	TMPFIL+1	;MAKE IT AN IOWD
	TMPCOR	T1,		;READ AND DELETE PIP FILE
				;T1 ON RETURN=NOWDS IN CS
	JRST	P11		;NO PIP FILE IN CORE TRY DSK
	HRLI	T2,440700	;SET UP BYTE POINTR FOR COMMANDS
	MOVEM	T2,TMPPNT	;USE LATER IN GETSC
	SETOM	TMPFLG		;SIGNAL THAT TMPCOR WAS USED
	ADDB	T1,SVJBFF	;CALCULATE END OF TMPCOR BUFFER
	MOVEM	T1,TMPEND	;STORE FOR LATER USE
	SETOM	COMFLG		;MARK THAT CCL IS IN ACTION
	JRST	PIP2A		;START PIP
P11:	>
	PJOB	T1,		;GET JOB NBR.
	MOVEI	0,3		;SET TO GENER. 3 DIGIT JOB NO
	IDIVI	T1,^D10		;DIVIDE BY 10
	ADDI	T2,"0"-40	;REMAINDER MAKE SIXBIT
	LSHC	T2,-6		;SHIFT T2 RIGHT INTO T3
	SOJG	0,.-3		;DECREMENT AND LOOP
	HRRI	T3,(SIXBIT /PIP/)
	MOVEM	T3,CFILE	;INSERT JOB NBR IN CCL INIT
	MOVSI	T3,(SIXBIT /TMP/)
	MOVEM	T3,CFILE+1	;DEFAULT DEVICE
	SETZM	0,CFILE+2
	SETZM	0,CFILE+3
	INIT	COM,		;INIT DEVICE FOR CCL OR @
	SIXBIT	/DSK/
	XWD	CFI
	JRST	CER1		;CAN'T INIT
	LOOKUP	COM,CFILE	;LOOKUP COMMAND FILE
	JRST	PIP2A		;NOT FOUND,ERROR
	INBUF	COM,1		;1 BUFFER ONLY
	MOVE	0,JOBFF		;SAVE JOBFF NOW
	HRRZM	0,SVJBFF	;TO LEAVE COMMANDS INTACT WHEN BUFFERS RECREATED
	SETOM	COMFLG		;SUCCESS: COMMAND FILE REQUESTED
	JRST	PIP2A

CER1:	ERRPNT	</?FILE />
	PUSHJ	P,P6BIT
		CFILE
	ERRPN2	</.TMP INIT FAILURE!/>

PIP2:	SKIPE	COMFLG	;LAST COMMAND CCL?
	EXIT
	JRST	PIP2A	;JUST INCASE MONITOR RETURNS>

IFE REENT,<IFN FTDSK,<
DERR7:	ERRPNT	</?4K needed/>
        EXIT                    ;EXIT TO MONITOR>>

PIP:	RESET		;REINITIALIZE WHEN RESTARTED MANUALLY
			;NEW COMMAND STRING SCAN STARTS HERE
IFE CCLSW,<PIP2:	>
PIP2A:	JSP T5,INICN1	;INITIALIZE THE TTY AND PDL
IFN CCLSW,<SKIPE COMFLG	;ACCEPT NEW PIP COMMAND?
	JRST PIP2B	;NOT PIP (TTY) COMMD, BUT CCL>
	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
	RELEASE 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
	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 CHARS
	AOS	T4,COMCNT	;COUNT CHARS
	CAILE	T4,^D200	;ALLOW UP TO 200 CHARS
	JRST	ERR6B		;MORE THAN 200 CHARS
COMASK:	IDPB	0,T3		;STORE IN COMBUF
	SKIPE	COMEOF		;END-OF-FILE SET?
	JRST	COMPRP		;YES, PROCESS CS IN COMBUF
	CAIG	0,CR		;NOT EOF
	CAIGE	0,LF		;LF,VT,FF,CR?
	CAIN	0,ALTMODE	;NO, $?
	JRST	COMPRO		;YES
	JRST	COMSTO		;NO, KEEP STORING

COMPTR:	POINT	7,COMBUF-1,35

;********************************************************************^
;BEGIN SCAN OF DESTINATION PORTION OF COMMAND STRING
COMPRO:
IFN FTDSK,<PUSHJ P,GETEND>
	JRST	COMASK
COMPRP:	
IFN FTDSK,<
	MOVSI 0,(SIXBIT /DSK/)	;IS THERE A DSK?
	MOVEM	0,DEVICE	;TENTATIVELY DSK>

	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	ERR6
	TRNN	FLAG,ZFLG+XFLG+DFLG
	JRST	MAINC
	SKIPN	CALFLG
	JRST	ERR6A

MAINC:	SKIPN T5,NSWTCH	
	SKIPN 0,SSWTCH
	JRST ERR6A
	MOVE 0,DEVICE	;GET OUTPUT DEVICE NAME
	MOVEM 0,ODEV	;SAVE DEVICE NAME FOR LATER USAGE
	PUSHJ P,DEVTST	;SAVE DEVICE TYPE, SET XXX0UT.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 FOR OUT
	MOVE 0,AUX
	MOVEM 0,AUXOUT
	MOVE 0,[XWD FILNAM,DTON]
	BLT 0,DTON+1	;SAVE DESTINATION FILE NAME
	SETZM DTON+3
IFN FTDSK,<TRNN AUXFLG,DSKOUT	;DISK OUTPUT?>
	JRST M3
	MOVE 0,[XWD PR,DTON+2]
	BLT 0,DTON+3
M3:	SETZM SSWTCH	;TERMINATE DESTINATION FILE SCAN
	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
	MOVE 0,STAR		;DONT RESTRICT QPIP
	MOVEM 0,FILEX	;EXT TO BEING NULL
	MOVE 0,[XWD 1,1];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
	JRST ERR6
	MOVEI T4,1
	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 >>

	PUSHJ P,M4	;NOT MTA
	HRRZM T4,OMOD	;SET MODE OF OUTPUT DEV
M1:	MOVEI T4,1
	PUSHJ P,INLOOK	;SEE IF INPUT DEV MTA
	PUSHJ P,M4	;NOT MTA
	HRRZM T4,ININI1	;SET MODE IF 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:	TRNN AUXFLG,MTAOUT	;CLEAR /R FLAG
	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:	TRNN AUXFLG,MTAIN
	POPJ P,
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
	CAIG T1,1	;1 OR MORE THAN 1 FIT?
	MOVEI T1,2	;YES USE 2.
	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 TYPES?
	JRST MAINA2	;NO,
	PUSHJ P,DTCLR	;YES, GO CLEAR DIRECTORY
	RELEASE OUT,
	RELEASE DIR,
	SKIPN 0,NSWTCH	;SEE IF DEVICE WAS TYPED
	JRST OMOD1	;YES
	JRST PIP2	;GET NEXT COMMAND
;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./Y
;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 TAEP INPUT?
	PUSHJ	P,DTADIR	;INIT DTA DIR

IFN FTDSK,<TRNN  AUXFLG,DSKIN	;NO, DISK INPUT?
	JRST	MAINA4		;NO
	PUSHJ	P,DSKDIR	;OK, 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  ERR3AA		;NEVER READ A FILE
	JRST  MAIN1
PSCANA:	TRO	AUXFLG,REDFLG	;SET FLAG FOR INPUT FILE READ
	PUSHJ P,INP		;GOT 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
	JRST PSCAN

PSCANB:	TRNE AUXFLG,MTAIN!CDRIN!TTYIN!PPTIN	;ON NON-DIR DEVICE?
	SETZM	ALLCLF
	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

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 PSCAN6	;END OF FILE RETURN
	TDNN FLAG,[XWD IFLG+IBFLG,BMOD]	;BIN. OR NO CHAR. PROCESSING
	TLNE AUXFLG,SYSLST
	JRST PSCAN3	;YES
	MOVE T1,OPTR
	CAIN CHR,DEL	;VJC 4/16/69
	JRST PSCAN4	; STR# 10-2615
	CAMN T1,OPTMAX	;CHECK LENGTH OF LINE
	JRST E10A	;LINE TOO LONG
	IDPB CHR,OPTR	;DEPOSIT CHAR. IN LINE BUFFER
	CAIG CHR,24
	CAIGE CHR,20	;LINE PRINTERR CONTROL CHAR
	SKIPA 		;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

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
IFN FTDSK,<TLNN AUXFLG,NSPROT
	JRST MAINB1
	TRNN AUXFLG,DSKOUT ;DISK OUT/ OR DTA
	JRST MAINB1	;NO
	PUSHJ P,OUTP1
	LDB 0,PRPTL
	DPB 0,PRPTD
	RENAME OUT,DTON	;SET UP RENAME REQUEST
	JRST DERR6	;DISK ERROR
MAINB1:>
	PUSHJ P,OUTP1
	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
	CAIG T1,1	;1 OR MORE THAN 1 FITS
	MOVEI T1,3	;TRY 3.
	INBUF IN,(T1)	;SET UP AS MANY BUFFS AS FIT
	MOVE 0,IBF+1	;SAVE ORIGINAL MODE
	MOVEM 0,SVIBF
CPOPJ:	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.
	MOVE 0,SYSFLG
	HLRZM 0,SYSFLG
	SETZM AB	;MTA VALUE SWITCHES
	SETZM PR	;PROTECTIONS
	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,<MOVE 0,DEVICE
	TRNN AUXFLG,DSKIN	;DSK INPUT?
	JRST DESCR1	;NO
	PUSHJ P,PSYSP		;IS THIS DEVICE SYS?
	MOVE 0,SYSFLG
	TLNE 0,1
	JRST DESCR1
	TRNN 0,1
	JRST DESCR1
	MOVE T2,FNPPNS	;MAKE OLD [P,P] CURRENT [P,P]
	SKIPE 0,PP
	JRST DESCR1
	MOVEM T2,PP	;RESERVE [P,P]
	MOVEM T2,FNPPN	;NO OVERSHOOT ALLOWED>
DESCR1:	SKIPE XNAME
	JRST ERR6

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

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

PROTK:	MOVE T1,PR
	TRNN T1,1
	JRST PROTK1
	HLLZM T1,PROTS
	TLOA AUXFLG,NSPROT
PROTK1:	MOVE T1,DPR
	HLLZM 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?
	JUMPA 0,DEVTSU	;NO
	TRO AUXFLG,DSKOUT	;YES, SET BIT
	EXCH 0,DEVICE
	MOVEM 0,ADSK
	EXCH 0,DEVICE
	TLNN 0,1
	JRST ERR6
	POPJ P,
DEVTSU:>
	JUMPE 0,DEVER2		;NON-EXISTING DEVICE
	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

	TRNN AUXFLG,PPTOUT+TTYOUT+DSKOUT+DTAOUT+MTAOUT+LPTOUT
	JRST ERR6

	TRNN AUXFLG,DSKOUT

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

IFN FTDSK,<
PSYSP:	HRLZI	T1,(SIXBIT /SYS/);IS DEVICE SYS?
	CAME	0,T1
	POPJ	P,		;NO
	SKIPN	T1,PP		;PP GIVEN?
	MOVE	T1,[XWD 1,1]	;GET SYS PP
	MOVEM	T1,PP		;AND SET IT
	HRLI	0,1
	HLLM	0,SYSFLG	;SET FLAG TO INIDICATE
	POPJ	P,		;CURRENT INPUT DEVICE IS SYS>

DEVER2:	SKIPA T1,ODEV
DEVER:	MOVE T1,DEVICE
	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		;INITIALZE PUSHDOWN POINTER
INICN2:	MOVE	0,SVJBFF	;IS INITIALZED AT PIP1
	MOVEM	0,JOBFF		;SET JOBFF TO BEGINNING OF BUFFER AREA
	HRRZ	0,JOBSA
	MOVEM	0,JOBREN
	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 POINTER
	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:	SKIPL	SSWTCH		;RETURN NULL IF _ OR END-OF-LINE SEEN
	SKIPGE	ESWTCH
	JRST	NM13		;
	SETZM	NSWTCH
	SKIPE	T1,XNAME	;IF COMMAND SCAN OVERSHOOT PICKED UP
				;DEVICE NAME, USE IT NOW
	JRST	NM7
	SETZM	CALFLG
;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"
	SKIPA			;NO
	JRST NM4
;CHARACTER NO *,0-9,A-Z
NM5:	CAIG	0,CR		;CARRIAGE RETURN
	CAIGE	0,LF		;LINE FEED
	CAIN	0,ALTMOD	;ALTMODE
	JRST	NM5A		;YES
	CAIE	0,CZ		;END-OF-FILE(CCL)?
	SKIPA	ESWTCH
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
	CAIE	0,LA		;LEFT ARROW
	JRST	NM3		;NO
	SETOM	SSWTCH

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
	SETOM	CALFLG
	JRST	NM1		;LOOK FOR A FILE NAME AND EXTENSION

NM9:	SKIPN	CALFLG		;COLON ROUTINE - IS DEVICE NAME IN YES?
	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:	MOVE	0,FILNAM	;PERIOD ROUTINE - SAVE FILE NAME
	MOVEM	0,FILEX		;TEMPORARY IN FILEX
	JRST	NM2		;LOOK FOR EXTENSION
NM11:	SKIPN	FILNAM		;WAS A FILE NAME SPECIFIED?
	SKIPE	CALFLG		;WAS ANYTHING SPECIFIED?
	POPJ	P,		;YES
NM12:	SKIPE	T1,FILNAM	;NULL NAME SPECIFIED?
	JRST	NM8		;NO - SO REMEMBER AND LOOK FOR FILE NAME

NM13:	SETOM	NSWTCH		;RETURN NULL NAME
	SETZM	FILEX
NM14:	SETZM	FILNAM
	POPJ	P,

NM15:	POINT	6,FILNAM
;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 LBUG
	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,DSKOUT+DTAOUT ;YES, ON DTA?
	SKIPA 		;NO
	ADDI T2,40*5	;LEAVE EDITING ROOM
OUTLB2:	MOVNS 0,T2
	ADDM T2,OBF+2	;UPDATE OUTBUFFER CHARACTER COUNT
	HRLI T2,LBUF
	HRR T2,OBF+1
	AOS 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

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:	OUTPUT OUT,	;SUBR. TO DUMP OUTBUFFER AND CHECK ERR BITS
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,WRTLOK+DSKBIT+CDRBIT+BIGBLK	;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
	ERRPN2	</: FILE />
	MOVEI T6,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

	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

	MOVEI T1,TXTC1	;BLOCK TOO LARGE
	TRNN T2,EOFBIT+BOTBIT

	MOVEI T1,TXTC2
	JRST PTEXT2
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 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

TXTC2:	ASCIZ /INPUT BUFFER OVERFLOW/

;TEST IF /G FLAG(IGNORE ERRORS) SET

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

	JSP	T1,PTEXT2
	ASCIZ	/
/				;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,WRTLOK+DSKBIT+CDRBIT+BIGBLK	;CLEAR FILE STATUS, I/O ERRORS
	TRNE T2,600
	TRZ IOS,EOTBIT		;CLEAR PHYICAL EOT I/O ERROR
	JRST REST

COMERR:	PUSHJ P,SAVE	;SAVE ACS T1,T2,T3,T5,T6
	TRNE AUXFLG,TTYOUT
	RELEAS OUT,
	TRNE AUXFLG,TTYIN
	RELEAS IN,
	POPJ P,
;PRINT FILE NAME AND EXTENSION FROM (T3), 1(T3).

FN.EX:	MOVE T3,T6
	MOVE T1,(T6)	;T1=FILENAME
	HLRZ T6,1(T6)	;T6=FILE EXT
	CAIN T6,(SIXBIT /UFD/)
	SETZM 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,OUTOCT	;CONVERT TO ASCII

	MOVEI CHR,COMMA
	PUSHJ P,PUTCON

	HRRZ DOUT,(T3)	;GET PROG. NO.
	PUSHJ P,OUTOCT	;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


SAVE:	MOVE 0,[XWD 1, SAVAC]
	BLT 0,SAVAC+2
	MOVEM T5,SAVAC+3
	MOVEM T6,SAVAC+4
	POPJ P,
REST:	MOVS 0,[XWD 1, SAVAC]
	BLT 0,T3
	MOVE T5,SAVAC+3
	MOVE T6,SAVAC+4
	POPJ P,




;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,GETNUM	;LOOK FOR PROJECT-PROGRAMMER NUMBER
 	CAILE T7,-1	;GREATER THAN HALF WORD?
	JRST ERR2A	;YES, ERROR
	CAIE 0,","	;SEPARATOR?
	JRST GETT11	;OR TERMINATOR (NON-NUMERIC)
	HRLZM T7,PP
	JRST GETT10

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

GETT9:	PUSHJ P,GETNUM
	CAIN 0,">"	;TERMINATE ON RIGHT BRKA 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

GETNUM:	MOVEI T7,0	;TO PICK P-P NUMBER
GETN1:	PUSHJ P,GETBUF	;AND PROTECTION
	CAIN 0," "	;IGNORE SPACES
	JRST GETN1
	CAIL 0,"0"
	CAILE 0,"7"
	POPJ P,		;GOT A NON-NUMERIC
	MOVE	T5,0
	LSH	T7,3
 	ADDI	T7,-60(T5)	;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 ERR6	;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 #.
	SKIPA 
	JRST ERR6
	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,")"	;THERE ARE ILLEGAL 1-SWITCH CHARS.
	JRST ERR6
	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 STORE RESULT IN
	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 ERR6	;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
	IORM T5,(T6)	;FLAG OR AUXFLG
	TRNE FLAG,MTFLG
	IORM 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:	
IFN CCLSW,<
	SKIPE COMFLG	;STORED COMMANDS?
	JRST GETSC	;YES>

	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	;RESTOR OLD BUFFER LOCS
	HRROM T5,TFO	;USE PREVIOUSLY ASSIGNED I/O BUF. FOR TTY
	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 ALTMODE
	JUMPE	0,GETTA	;IGNORE NULL CHARS
	CAIL 0,140	;LOWER CASE?
	TRZ	0,40	;MAKE UPPER CASE
	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

IFN CCLSW,<GETSC:
IFN TEMP,<SKIPN TMPFLG		;IS TMPCOR UUO IN ACTION?
	JRST	GETTM1		;NO CONTINUE AS USUAL
GETTM2:	ILDB	0,TMPPNT	;PICK UP NEXT CHARACTER
	HRRZ	DOUT1,TMPPNT	;GET BYTE POINTER POISITION
	CAML	DOUT1,TMPEND	;HAS THE COMMAND FINISHED YET
	JRST	GETEND		;YES, EXIT
	JRST	GETT4		;CHECK FOR ALTMODE,NULL,LOWER CASE
GETTM1:		>
	SOSLE	CFI+2		;ANY REMAINING?
	JRST	GETSC0		;YES
	INPUT	COM,
	STATZ	COM,740000
	JRST	GETTM3
	STATZ	COM,EOFBIT	;END-OF-FILE
	JRST	GETEND		;YES
GETSC0:	ILDB	CFI+1		;GET A CHARACTER
	MOVE	DOUT1,@CFI+1	;GET PRESENT WORD
	TRNN	DOUT1,1		;IS IT A SEQUENCE NUMBER?
	JRST	GETT4		;NO - CONTINUE
	AOS	CFI+1		;YES - ADD 1 TO BYTE POINTER
	MOVNI	DOUT1,5		;I.E. IGNRORE SEQ. NO.
	ADDM	DOUT1,CFI+2	;SUBTRACT 5 FROM COUNT FOR SEQ. NO.
	JRST	GETSC		;CONTINUE 

GETTM3:	ERRPNT </READ ERROR-CCL COMMAND FILE/>
GETEND:
IFN TEMP,<SKIPE TMPFLG		;TMPCOR
	JRST	GETEN2		;YES>
	SKIPN	COMFLG		;CCL END OF CS?
	JRST	GETEN2		;NO
GETEN1:	CLOSE	COM,		;NO, DSK FILE CCL
	SETZB	0,T1		;DIRECTORY ENTRY FOR RENAME
	SETZB	T2,T3
	RENAME	COM,		;WIPE OUT cOOMAND FILE
	JFCL	17,.+1
	RELEAS	COM,0		>
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
        DISP C,TBMOD			; NOT IN 1K
        DISP D,DFLG			; NOT IN 1K
        DISP L,LFLG			; NOT IN 1K
        DISP M,0		;NOT IN OLD
        	XWD <")">*4000,0		;NOT IN OLD
        DISP N,NSMOD
        DISP O,SQMOD+NSMOD+STS+OSFLG		;NOT IN OLD
                        XWD <"P">*4000+PFLG+PCONV,0		;NOT IN OLD
        DISP R,RFLG			; NOT IN 1K
        DISP S,SQMOD+NSMOD+STS
        DISP T,SPMOD			; NOT IN 1K
                        XWD <"V">*4000+CHKFLG,LINE		;NOT IN OLD
        DISP X,XFLG			; NOT IN 1K
        DISP Z,ZFLG
                        XWD <"U">*4000+OFLG,0
                        XWD <"Y">*4000+IBFLG+RIMFLG,0		;NOT IN OLD
                        XWD <"I">*4000+IFLG,0		;NOT IN OLD
                        XWD <"H">*4000+IBFLG,0		;NOT IN OLD
                        XWD <"G">*4000+GFLG,0		;NOT IN OLD
        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 2,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
	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	;REPOCESS 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,222*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	;INGORE LINE FEED IN FORTRAN OUTPUT
	TLNN FLAG,PFLG	;/P SWITCH IN EFFECT?
	SKIPA 		;NO
	TLOA FLAG,PCONV	;CONVERT THE NEXT LIVE CHAR
	CAIN CHR,CZ
	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 LINW) 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,2
	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:	INPUT	IN,	;INPUT DATA
	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
	ERRPN2	</: FILE />
	MOVEI T6,ZRF	;LOC OF INPUT FILE NAME TO T6
	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,DSKIN+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-SPACE CHARACTER?
	JRST CPOPJ1	;YES, SO RETURN IMMEDIATELY
	SOSG TABCT	;COUNT DOWN THE TAPE STOP COUNTER
	JRST GETA5	;RESET THE COUNTER IF TAB STOP PASSED
CPOPJ1:	AOS	(P)	;SKIP RETURN
	POPJ	P,


GET7B:	CAIL T1,^D73	;LT COL 73?
	CAILE T1,^D80	;NO, LE COL 80?
	SKIPA 		;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 SPACE?
	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 SPCE 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 OF 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>>

IFE WCH,<
ERR10:	MOVEI	T4,ERR382
	SKIPA 
	MOVEI	T4,ERR381>
E10B:	ERRPNT	</?File />
	MOVEI T6,ZRF
	PUSHJ P,FN.EX
	JRST	(T4)


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

ERR382:	ERRPN2 </illegal format!/>

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

ERR9:	ERRPNT </?/>
	MOVEI T6,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>
ERR3AA:	ERRPNT </? No file named />
	MOVEI T6,FILNAM
	PUSHJ P,FN.EX	;PRINT NAME OF FILE THAT CANNOT BE FOUND
	JRST PIP2

ERR4:	SKIPN DTON
	JRST ERR4A
IFN FTDSK,<TRNE AUXFLG,DSKOUT
	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!/>>

ERR6A:	JUMPE T5,ERR6
	SKIPE ESWTCH
	JRST MAINA1
ERR6:	ERRPNT </?PIP command error!/>

ERR6B:	ERRPNT </?PIP COMMAND TOO LONG!/>

E10A:		MOVEI T4,.+2
	JRST E10B
	ERRPN2 </ line too long!/>
ERR5A:	ERRPNT </?Too many input devices!/>
ERR5:	ERRPNT </?Disk or DECtape input required!/>
ERR2:	ERRPNT </?Incorrect Project-Programmer number!>/
ERR2A:	ERRPNT </?Illegal protection!/>
IFE BLOC0,<
ERR7A:	ERRPNT <Z?DECtape I/O only!Z>>

;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
	DEVCHR		;GET INPUT DEVCHR
IFN FTDSK,<TLNN 0,DSKBIT ;INPUT DEVICE DISK?
	JRST CHECK2	;NO
	TRO AUXFLG,DSKIN;INPUT DEVICE IS DSK, SET BIT
	PUSH P,DEVICE
	POP P,ADSK
	JRST CHECK>

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

	TLNN 0,INBIT	;CAN DEVICE DO INPUT?
	JRST ERR6	;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 0,CDRBIT	;CARD READER?
	TRO AUXFLG,CDRIN

	TLNE 0,TTYBIT	;TELETYPE?
	TRO AUXFLG,TTYIN

	TRNN AUXFLG,PPTIN+DTAIN+MTAIN+CDRIN+TTYIN
	JRST ERR6

CHECK:	SKIPE SSWTCH	;_FLAG STILL ON?
	JRST ERR6	;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

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
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 DEPOST CHARACTER IN TTY OUT BUFFER

PUTCON:	SOSG TFO+2	;STORED MORE THAN BUFFER HOLDS?
	OUTPUT CON,0	;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,@0(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:
IFN FTDSK,<TRNE	AUXFLG,DSKOUT	;CLEAR DSK OR DTA DIR.
	JRST	DSKZR0>
	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
	JRST	DTCOPY+1	
	PUSHJ	P,DTCH2		;YES, GET DIRECT, SET POINTER TO DIRECT

DTCOPY:	PUSHJ	P,DTADI1		;START (T5)
IFN FTDSK,<TRNN	AUXFLG,DSKIN	;DSK INPUT. ENTER HERE FROM DTD2
	JRST	COPY1A
	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
	SKIPN 			;DESTATION FILES FROM
	MOVEI	0,"X"-40		;NON-DIR. DEVICES IN /X
	DPB	0,T1
	SOSLE	T2		;DON'T YET KNOW IF ONE
				;OF THE INPUT DEV. WILL
	JRST	XSS
	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		;NOT MORE
IFN FTDSK,<PUSHJ P,XDDSK	;GOT ONE, CHECK (XF) FROM DSK, NAMTAB
	JRST	COPY1		;IN LIST, DONT' 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 EXIT
	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 TIM>
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		;OUPUT 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 PROECTION?
	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,<	MOVEI	0,(SIXBIT /X/)	;YES,PRINT FAILURE DURING   700000
	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.
	TRNE	AUXFLG,MTAIN
	MTAPE	TAPE,0
	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
	SETZM	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	;FILNAME=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] ;404173
	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
	CAIN 0,(<CZ>B6)		;IS IT ^Z
	TRO IOS,EOFBIT		;YES,SET END OF FILE
	POPJ P,			;NO
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:	
IFN FTDSK,<TRC	AUXFLG,DSKOUT+DSKIN	;DSK I/O
	TRCN	AUXFLG,DSKOUT+DSKIN
	POPJ	P,			;YES, EXIT
	TRC	AUXFLG,DTAOUT+DTAIN	;NO
	TRCE	AUXFLG,DTAOUT+DTAIN	;DTA I/O
	JRST	OKBLK1			;NO>
	LDB	0,OKB			;DEPOSIT IN DTON
	DPB	0,OKBD
	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.)
	SKIPN	T2
	SOS	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 DSK IN 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
	SKIPA				;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:	MOVE	0,ODEV		;OUTPUT DEVICE
	TRNE	FLAG,XFLG	;/X
	JRST	DELE1		;YES
	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
IFN FTDSK,<TRNN	AUXFLG,DSKOUT	;NO, HAS TO BE /D/ OR /R
	JRST	DTD1		;ON DSK
	TRNN	FLAG,XFLG	;OR DTA
	JRST	DSKDR

DTD1:
	TRNE	FLAG,XFLG
	TRNN	AUXFLG,DSKIN	;DSK INPUT?>
	JRST	DTADR		;NO

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,ERR3AA	;FN=0 ILLEGAL
	MOVEM	0,(T1)		;STORE FILE NAME 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
	PUSHJ	P,DESCRP	;NO, GET NEXT FILENAME FROM CS
	MOVE	T2,ALLCLF
	TRNE	T2,30
	JRST	ERR5A
	AOS	T1,LOCNAM
	JRST	DTD4

;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 ERRO MSG
	OUTPUT	OUT,(T1)	;IF DTA WRITE LOCKED
	PUSHJ	P,DTCHECK	;GO GET DTA DIRECTORY

	PUSHJ	P,INFO		;WRITE "FILES DELETED/RENAMED

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


;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	DELES		;NO MORE FILES
	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
	SETZM	0		;FREE THE BLOCKS OF THIS FILE
	DPB	0,T2		;CLEAR OUT BLOCK NUMBER
	JRST	DELE2>		;LOOP ON 1102 BLOCKS
DELES:	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
	SKIPA			;NO FILE ALREADY OF DESTINATION NAME
	JRST	ERR9
	MOVE	0,DTON		;RENAME, FILENAME
	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		;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:	MOVE	0,STAR
	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	ERR6		;ONLY 1 SOURCE FILE DESCIPTOR 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.


LOOK6D:	MOVEM	T4,ALLCLF
LOOK:	MOVE	T3,ALLCLF	;DOES FILNAM, FILEX CONTAIN
	TRNE	T3,FNEX
	JRST	LOOK6		;A FILE TO THINK ABOUT? YES
	PUSHJ	P,LOOKA		;GET ONE (NOTE: DEVICE MAY ALTER)
	POPJ	P,			;NONE, END OF CS

	MOVE	T3,ALLCLF
LOOK6:	MOVE	T2,FILEX	;GET FILE EXT INTO T2
	SKIPN	T1,FILNAM	;FILENAME AND EXT=0?
	SKIPE	T2,FILEX
	SKIPA			;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

	TRNN	AUXFLG,DTAIN+DSKIN	;DONT REQUIRE FILENAME
	JRST	ERR3AA		;HERE FOR 0.EX,FN.EX OR FN.0,0.EX ILLEGAL
	JUMPE	T1,ERR3AA
LOOK7B:	TRZ	T3,FNEX		;IF HERE, ONLY ONE FILE WAS ENTAILED IN REQUEST.
	MOVEM	T3,ALLCLF
	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?
	MOVE	T4,ALLCLF
	TRZE	T4,FNEX		;SET IF A PARTIC. FILE WAS REQUESTED?
	JRST	LOOK6D		;NO
	TRC	FLAG,XFLG+DFLG	;YES
	TRCN	FLAG,XFLG+DFLG
	JRST	LOOK
	JRST	ERR3AA
;CHECK IF FILE.EXT IN DIRECTORY MATCHES FILE TO /D,/R
;NOTE WE MAY HAVE *.EXT,FIL.*, OR *.*


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

LOOK3:	TRNN	T4,MATEX	;SHOULD EXTENSIONS MATCH
	JRST	LOOK5A		;NO
	MOVE	T1,FILEX	;YES
	CAME	T1,ZRF+1
	JRST	LOOK8		;NO MATCH

LOOK5A:	TRNN	AUXFLG,DSKIN	;DSK INPUT?
	JRST	LOOK4		;NO
LOOK4:	TRO	AUXFLG,READ1	;READY FOR FIRST READ
	JRST	CPOPJ1		;MATCH OR NO CARES

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

LOOK7C:	TRNE	AUXFLG,DTAIN+DSKIN
	JRST	ERR3AA		;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		;NO, 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 DONE 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
	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 FILENAME 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:	MOVEI	T1,LBUF		;SET UP TTY FOR OUTPUT
	EXCH	T1,JOBFF	;SAVE BUFFER LOCS
INFO0:	INIT	CON,1
	SIXBIT	/TTY/
	XWD	TFO,0
	HALT	INFO0
	OUTBUF	CON,T1
	MOVEM	T1,JOBFF
	OUTPUT	CON,
	TRNN	FLAG,DFLG	;DELETE?
	JRST	INFO1		;NO, MUST BE RENAME
	ERRPN2	</FILES DELETED:/>
	JRST	INFO2
INFO1:	ERRPN2	</FILES RENAMED:/>
INFO2:	MOVEI	CHR,CR		;OUTPUT CR/LF
	PUSHJ	P,PUTCON	;ON TTY
	MOVEI	CHR,LF
	JRST	PUTCON

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

INFO3:	MOVEI	T6,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:	MOVEI	T3,1		;CLEAR FLAGS ON ENTRY
	MOVE	0,STAR		;* TO AC0
	CAME	0,FILNAM	;FILNAME=* OR 0?
	SKIPN	FILNAM
	SKIPA			;FILENAME = * OR 0
	TRO	T3,MATFN	;FILENAME MUST BE MATCHED
	SKIPN	FILEX		;EXT=0?
	TRNN	AUXFLG,MTAIN+CDRIN+PPTIN+TTYIN ;YES
	CAMN	0,FILEX		;NO, EXT = *?
	SKIPA			;YES
	TRO	T3,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	T3,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	T3,NEWDEV	;CHANGE IN SOURCE DEV.
	MOVEM	T2,DEVA		;SET DEVA=DEVICE
	MOVEM	T3,ALLCLF
	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
	MOVE	T3,ALLCLF
	RELEAS	DIR,
	TRNN	AUXFLG,MTAIN+CDRIN+PPTIN+TTYIN	;NON-DIR DEVICE?
	JRST	LOOKF

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

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

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

LOOKB:	TRNN	T3,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 DIRECTORY

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
	HRRZI	0,(SIXBIT /DSK/) ;ASSUME DSK IF NO DEVICE GIVEN
	HRLZM	0,DEVICE
	TRO	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
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,<
	SETZM	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 UP PICK UP FILE NAME
	SETZM 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,OUTOCT

	MOVEI CHR,COMMA		;COMMA
	PUSHJ P,PUT

	HRRZ DOUT,123(T5)	;PROG NO.
	PUSHJ P,OUTOCT
	JRST PDIR4B
	>
;*********************************************************************
PDIR4A:	PUSHJ	P,PDIR2		;OUTPUT 6-BIT DATA AND INCR DIRECTRORY 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
	JRST	.+3		;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

	SETZM	DOUT		;CALCULATE NBR OF BLOCK 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
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
IFN WCH,<
	AOJA	T5,PDIR4	;PROCESS NEXT ENTRY>
IFE WCH,<
PDIR6:	HRRZ	T1,IBF		;PROCESS NEXT ENTRY
	SUBM	T5,1
	CAIL	T1,26		;FILE "NUMBER" OK?
	JRST	MAIN1		;NO, END OF ENTRIES
	AOJA	T5,PDIR4	;END OF LOOP, GET NEXT FILENAME>

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
	SKIPE DOUT		;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

OUTDEC:	MOVEI T2,PUT		;PUT CHAR IN OUT BUF
	JRST OUTDC1

DATO2:	MOVEI T4,5
	MOVE T6,MNPT
	ADDM T1,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
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, SUBRACT 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
FILTYP:	TDNE FLAG,[XWD IFLG+IBFLG,BMOD]
	POPJ P,			;BIN MODE DON'T CARE IF DMP, ETC
FILL1:	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
	TRNN FLAG,XFLG		;DO NORMAL PROCESSING ON ALL
	JRST FIL2		;BUT DMP ETC FILES IF NOT /X
	TLNN AUXFLG,CDRFLG
	TDNE FLAG,[XWD PFLG+IFLG+IBFLG,LINE+BMOD+TBMOD+NSMOD+SQMOD+SPMOD]
	POPJ P,			;NO SIGNIFICANT SWITCHES
FILL:	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 FILL
	TLON AUXFLG,FRSTIN	;NOT /X TEST FURTHER
	JRST FIL4		;IS THIS FIRST SOURCE, YES
	TLOE AUXFLG,RSDCFL	;NOT FIRST, WAS PERVIOS FILE RSCD?
	JRST	FIL5		;YES, NO CHANGE UNLESS DEVICE HAS CHANGED
	OUTPUT OUT,		;NO CHANGE TO 36-BIT
	MOVE 0,OBF+2		;CURRENTLY 7-BUT 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 FILL
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 FILL
FIL5:	MOVE T1,ALLCLF
	HRLZI 0,004400		;NEW DEVICE, SET 36-BIT INPUT
	TRNE T1,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:	RELEAS 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 REQUESSTS
	TRNE T1,MTUFLG
	JRST UNLOAD

	TRNE T1,MTWFLG
	JRST REWIND

	TRNE T1,MTFFLG
	JRST MARKF

	TRNE T1,MTTFLG
	JRST SLEOT

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

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

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

MTCONT:	RELEAS TAPE,
	TRNN T1,MTUFLG		;UNLOAD?
	SKIPE 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,0
	JRST MTCONT



;MARK END OF FILE

MARKF:	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,200	;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
	MOVE 0,ALLCLF
	TRNN 0,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 T2,DEVICE	;TENTATIVELY SET I/DEV
	CAIE T6,INIMTA	;INPUT DEVICE
	MOVE T2,ODEV	;NO, SET O/DEV
	MOVEM T2,TM1
	ERRPNT </?TOO MANY REQUESTS FOR />
	PUSHJ P,P6BIT
	      TM1
	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
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 1 SWITCH
STAR:	SIXBIT /*/		;LOOK FOR *.* FILNAM.EXT
TWL:	OCT 12
DPR:	OCT 55B8
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
DATED:	POINT 12,DTON+2,35	;CREATION DATE /X
TIME:	POINT 11,ZRF+2,23	;CREATE TIME /X
TIMED:	POINT 11,DTON+2,23	;DEPOSIT CREATE TIME>
	LIT

;PROGRAM STORAGE AREA

IFN REENT,<LOC	140>
IFN TEMP,<
TMPFIL:	BLOCK	2 >
IFE BLOC0,<
BL0CNT:	BLOCK	1		;COUNT>
IFN CCLSW,<
CFILE:	BLOCK	4	;NAME OF STORED CCL COMMAND FILE
COMFLG:	BLOCK	1	;-1 IF STORED COMMANDS,0 IF TTY>
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
IFN CCLSW,<
CFI:	BLOCK	3	;STORED COMMAND INPUT 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
ALLCLF:	BLOCK	1	; 230
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 OURPUT 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
CALFLG:	BLOCK	1	;254
;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 *****
FILNAM:	BLOCK	1	;FILE NAME FROM COMMAND SCANER
FILEX:	BLOCK	1	;EXTENSION
PR:	BLOCK	1	;PROTECTION
PP:	BLOCK	1	;P-P NUMBER TYPED BY USER
;*****  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. ALLOES 205 CHARS.
COMCNT:	BLOCK	1	;COMBUF CHARS COUNT
COMPTS:	BLOCK	1	;POINTER FOR STORING/EXTRACTING CS
SYSFLG:	BLOCK	1	; 350

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>
NSWTCH:	BLOCK	1	; 354
SSWTCH:	BLOCK	1	; 355
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 FULL
AB:	BLOCK	1	;MTA VALUE SWITCHES
			;THIS IS THE END OF THE INI. ZEROED BLOCK. 
   	PURE
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

	IMPURE
PDL:	BLOCK	20	;PUSHDOWN LIST

LBUF:	BLOCK	34	;LINE BUFER. ALLOW FOR FORTRAN DATA
LBUFE==.-1

DBUF:	BLOCK	204	;DIRECTORY BUFFER
OMOD:	BLOCK	1	;OUTPUT DEVICE MODE, STATUS
ODEV:	BLOCK	2	;OUTPUT DEVICE NAME
			;BUFFER HEADERS(S) LOC

ININI1:	BLOCK	1	;INPUT DEVICE
DEVICE:	BLOCK	2

DEVERR:	BLOCK	1
DERR2:	BLOCK	2

INMTA1:	BLOCK	1
MTANAM:	BLOCK	2

	PURE
SUBTTL        RIM LOADER
IFE RIMSW,<
RIMTB:	ERRPNT <Z? /Y switch option not available this assembly!Z>
>
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
        
        IMPURE
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

	DEPHASE
>

IFE FTDSK,<     
        IMPURE
TM1:	BLOCK	1
        VAR
LOWTOP:
        PURE
        END     PIP1>
SUBTTL	DISK ROUTINES
;* * * ALL THE FOLLOWING ARE DISK ROUTINES * * *

;DISK DELETE AND RENAME ROUTINES

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
	MOVEI	0,DTON+2	;NO NAME SET SO USE LOOKUP NAME
	HRLI	0,NAMTAB+2	;AND EXT SO FILE NOT DELETED
	BLT	0,DTON+3
	LDB	0,PRNM
	TLNN	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.

DSKZR0:	PUSHJ	P,DSKSK1
	SETZM	ZCNT
	INBUF	OUT,1		;FOR LOOKUPS ON OUT
DSKZ1:	SOSLE	UFDIN+2
	JRST	.+3
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	0,(SIXBIT /Z/)
	JRST	DSKZ5
DSKDR6:	MOVSI	0,(SIXBIT /D/)
	TRNN	FLAG,DFLG
	MOVSI	0,(SIXBIT /R/)
DSKZ5:	MOVEM	0,TM2
	ERRPNT	<X?Failure(s) during /X>
	PUSHJ	P,P6BIT
		TM2
	ERRPN2	</ request!/>
;PREPARE TO LOOKUP FILES IN PARTICULAR DISK DIRECTORY

DSKSK1:	SKIPA	T1,DTON+3
DSKDIR:	MOVE	T1,PP		;GET [P,P] INTO T1
	SKIPN	T1		;IS IT ZERO?
	GETPPN	T1,		;YES, GET USER'S [P,P]
	MOVEM	T1,UFD
	MOVSI	0,(SIXBIT /UFD/)
	MOVEM	0,UFD+1
	MOVEM	T1,FNPPN
	HLRZ	0,SYSFLG
	SKIPN	0
	MOVEM	T1,FNPPNS
	MOVE	0,[XWD 1,1]
	MOVEM	0,UFD+3
	PUSHJ	P,DSKDST
	LOOKUP	DIR,UFD
	JRST	DERR5B
	POPJ	P,
;ROUTINE TO LIST DISK DIRECTORY. /L OR /F SWITCH

DSKLST:	PUSHJ	P,ININIT	;ASSIGN "IN" FOR RETRIEVAL INFO
	SETZM	BLKSUM		;CLEAR TOTAL BLOCKS FOR ALL FILES
	SETZB	T2,LIN		;SET UP APPROPRIATE CONTROLLS
	HLRZ	T1,ODEV		;FOR THIS LISTING DEVICE
	CAIN	T1,(SIXBIT /TTY/);IF ODEV IS TTY
	AOS	T2		;SET LISTTY=1 (TTY)
	MOVEM	T2,LISTTY
	PUSHJ	P,DSKDIR
	PUSHJ	P,HEADER	;PUT OUT HEADER LINES
LSTU1:	SOSLE	UFDIN+2
	JRST	.+3
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,PP		;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,FILEX
	CAIE	DOUT,(SIXBIT /UFD/)	;IS FILE UFD
	JRST	LSTU3		;GO PRINT NAME HELD IN 0.
	HLRZ	DOUT,FILNAM	;HERE FOR UFD ONLY
	MOVEI	T2,PUT
	PUSHJ	P,OUTOCT	;PRINT #,#. PROJ. NO.
	MOVEI	CHR,COMMA	;","
	PUSHJ	P,PUT		;...
	HRRZ	DOUT,FILNAM	;PROG. NO.
	PUSHJ	P,OUTOCT
	JRST	LSTU3A
LSTU3:	MOVEI	T4,6
	MOVE	0,FILNAM
	PUSHJ	P,SIXOUT	;OUTPUT FILENAME
	JUMPE	T4,LSTU3A
	PUSHJ	P,SPACES
LSTU3A:	MOVEI	T4,4		;SET LOOP FOR OUTPT EXT
	MOVE	0,FILEX
	JUMPE	0,LSTU4
	MOVEI	CHR,PERIOD
	SKIPN	0,LISTTY
	MOVEI	CHR,TAB
	PUSHJ	P,PUT
	SOJ	T4,
	PUSHJ	P,SIXOUT	;OUTPUT EXTENSION
	JUMPE	T4,.+2
LSTU4:	PUSHJ	P,SPACES
	TRNN	AUXFLG,FFLG	;SHORTEST LISTING?
	JRST	LSTU4B
	PUSHJ	P,LINOUT	;YES
	JRST	LSTU1
LSTU4B:	LOOKUP	IN,FILNAM
	JRST	LSTU5
	PUSHJ	P,TABOUT
	PUSHJ	P,BLKS		;DETERMINE NO. BLK IN FILE
				;AND TOTAL FOR UFD
	SKIPE	LISTTY		;OUTPUT DEVICE A TTY?
	JRST	LSTU7		;YES, SKIP LONG DIRECTORY
LSTU4A:	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,PROT
	PUSHJ	P,PROTO
	LDB	0,OWNER
	PUSHJ	P,PROTO
	LDB	0,MODE		;PRINT MODE
	PUSHJ	P,PROTO
	PUSHJ	P,TABOUT
	LDB	0,PROJ
	PUSHJ	P,OCTLST
	JRST	LSTU8
LSTU5:	PUSHJ	P,TABOUT	;THE FILE WAS PROTECTED
	HRRZ	T7,FILEX	;GET PARICULAR ERROR TYPE
	TRZ	T7,ETAB-ETABND	;IS IT LEGAL ERROR
	MOVE	T1,ETAB(T7)	;NO,PICK UP CATCH ALL MESSAGE
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 (!)
IFE REENT,<
	PUSHJ	P,CCASE>	;DEPOSIT CHARACTER
	PUSHJ	P,PUT
	JRST	LSTU6


LSTU7:	LDB	0,CDATE
	PUSHJ	P,DATOUT	;PRINT CREATION DATE ONLY FOR TTY
LSTU8:	CLOSE	IN,0
	PUSHJ	P,LINOUT
	JRST	LSTU1



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

SPACES:	MOVEI	CHR,40
	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)
	ILDB	CHR,T2
	JUMPE	CHR,SIXO1
	ADDI	CHR,40		;MAKE ASCII
	PUSHJ	P,PUT
	SOJ	T4,0
	TLNN	T2,770000
SIXO1:	POPJ	P,
	JRST	SIXOUT+1
;DETERMINE NUMBER OF BLOCKS PER FILE AND TOTAL NUMBER OF
;BLOCKS USED BY USERS PROJECT,PROGRAMMER NUMBER

BLKS:	SETZM	BLKTMP
	HLRE	0,PP		;GET WORD COUNT OF FILE
	JUMPGE	0,BLKADD	;IF POS = NO. OF BLOCKS
	MOVNS	0,0		;MAKE POSITIVE
	JUMPLE	0,BLKOUT
	TRZE	0,177		;TAKE CARE OF PARIAL BLOCKS
	ADDI	0,200
	IDIVI	0,200		;CALCULATE BLOCK COUNT
BLKADD:	ADDM	0,BLKSUM	;CALCULATE TOTAL FOR ALL FILES
	MOVEM	0,BLKTMP
BLKOUT:	MOVE	DOUT,BLKTMP
	PUSHJ	P,OUTDEC	;OUTPUT NUMBER OF BLOCKS IN DECIMAL
	PUSHJ	P,TABOUT
	POPJ	P,

;END OF FILE ON UFD OUTPUT TOTAL BLOCKS XXX

BLKLST:	SKIPN	BLKSUM		;ANY INFORMATION TO OUTPUT
	JRST	MAIN1		;NO - FINISHED
	PUSHJ	P,CRLF
	LSTLIN	TOTAL		;OUTPUT CR,LF "TOTAL BLOCKS"
DIRFIN:	MOVE	DOUT,BLKSUM
	SETZM	BLKSUM
	PUSHJ	P,OUTDEC	;PRINT TOTALS
	JRST	MAIN1

TOTAL:	ASCIZ	/Total Blocks    /

IFE REENT,<
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:	INPUT	DIR,
	GETSTS	DIR,IOS
	TRNN	IOS,760000	;NO ERRORS
	JRST	CPOPJ1
	TRZN	IOS,20000
	JRST	UIN2		;ERROR PRINT
	SETSTS	DIR,(IOS)
	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,LINOUT
	PUSHJ	P,HEDR4
HEDR1:	LSTLIN	HEDL1
	HLRZ	0,FNPPN
	PUSHJ	P,OCTLST	;PROJ, PROG
	MOVEI	CHR,COMMA
	PUSHJ	P,PUT
	HRRZ	0,FNPPN
	PUSHJ	P,OCTLST
	PUSHJ	P,TABOUT
	PUSHJ	P,NOWOUT	;PRINT CURRENT TIME, DATE
	CALLI	0,CDATE		;DATE REQ.
	PUSHJ	P,DATOUT
	PUSHJ	P,LINOUT
	SKIPE	LISTTY
	JRST	HEDR2		;JUMP IF LISTING TO CONSOLE
	PUSHJ	P,LINOUT
	LSTLIN	HEDLIN
HEDR2:	JRST	LINOUT

HEDR3:	SKIPE	LISTTY
	POPJ	P,
	PUSHJ	P,HEDR4
	LSTLIN	HEDL2 
	JRST	HEDR1
HEDLIN:	ASCIZ   /       File              Access            Creation                 Protection
 Name   Ext     Blks      Date          Time      Date         Owner   Project  Other          Mode
/
HEDL1:	 ASCIZ   /Directory /
HEDL2:	 ASCIZ   /Continuation of /

ETAB:	POINT 7,E1+1
	POINT 7,E2+1
	POINT 7,E3+1
	POINT 7,E4+1
	POINT 7,E5+1
	POINT 7,E6+1
	POINT 7,E7+1
	POINT 7,E8+1
ETABND:

UIN2:	PUSHJ	P,COMERR
	JSP	T5,INICN2
	ERRPN2	</?Disk directory read />
	MOVEI	T6,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

LINOUT:	SOS	LIN
	JRST	CRLF
TABOUT:	MOVEI	CHR,TAB
	JRST	PUT

;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
	MOVE	DOUT,1
	PUSHJ	P,OUTDEC
	JRST	TABOUT
;SKIP TO HEAD OF FORM OR NEXT HALF PAGE, RESET COUNT

HEDR4:	SKIPE	LISTTY		;EXIT IF TTY
	POPJ	P,
	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

OCTLST:	MOVE	T1,[POINT 3,0]
	ILDB	CHR,1
	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:	JUMPE	0,TABOUT
	MOVEI	CHR,40
	PUSHJ	P,PUT
	MOVEI	CHR,120
	TRNE	0,4
	PUSHJ	P,PUT
	MOVEI	CHR,122
	TRNE	0,2
	PUSHJ	P,PUT
	MOVEI	CHR,127
	TRNE	0,1
	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.

DERR6:	MOVEI	T6,DTON		;LOCATION OF FILENAME (OUTPUT)
	SKIPA	
DERR5:	MOVEI	T6,ZRF		;LOCATION OF FILENAME (INPUT)
DERR5A:	HRRZ	T7,1(T6)	;ERROR TYPE
	TRZ	T7,TABLE-TABLND
DERR4:	ERRPNT	</? />
	PUSHJ	P,FN.EX		;PRINT FILE NAME .EXT
	JRST	TABLE(14)	;AND PRINT MESSAGE
TABLE:	JRST	E1
	JRST	E2
	JRST	E3
	JRST	E4
	JRST	E5
	JRST	E6
	JRST	E7
	JRST	E8
TABLND:
DERR5B:	MOVEI	T6,UFD
	JRST DERR5A
E1:	ERRPN2 </(0) file was not found!/>
E2:	ERRPN2 </(1) no such project-programmer number!/>
E3:	ERRPN2 </(2) protection failure!/>
E4:	ERRPN2 </(3) file was being modified!/>
E5:	ERRPN2 </(4) rename file name already exists!/>
E6:	ERRPN2 </(5) rename error!/>
E7:	ERRPN2 </(6)!/>
E8:	ERRPN2 </(7)!/>

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 3,FILNAM+2,2	;PROTECTION
MODE:	POINT 3,FILNAM+2,8	;RECORDING MODE
OWNER:	POINT 3,FILNAM+2,5
PROJ:	POINT 4,FILNAM+2,12
	IMPURE
TM2:	BLOCK	1
UFD:	BLOCK	4		;[P,P] OR *FD*
				;UFD OR SYS
TM1:	BLOCK	1
ADSK1:	BLOCK	1		;OPEN DIRECTORY, MODE
ADSK:	BLOCK	2		;FILENAME, EXT
LIN:	BLOCK	1		;COUNT FOR DISK DIR LIST
LISTTY:	BLOCK	1		;LISTING TO TTY
UFDIN:	BLOCK	3		;HEADER FOR READING DISK DIRECTORY
BLKSUM:	BLOCK	1		;TOTAL NBR BLOCKS PER PROJ. PROG NBR
BLKTMP:	BLOCK	1		;HOLDS SUM
IFN TEMP,<
TMPEND:	BLOCK	1
TMPFLG:	BLOCK	1
TMPPNT:	BLOCK	1
>
LOWTOP:	
	PURE
	LIT
PIPEND:	END PIP1