TITLE	BAKWDS V.1	;FROM PIP V.033A(123)
SUBTTL	VJC/PMH/AK-DAG/DMN	18-OCT-72

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

REPEAT 0,<
VPIP==33		;VERSION NUMBER
VUPDATE==1		;DEC UPDATE LEVEL
VEDIT==123		;EDIT NUMBER
VCUSTOM==0		;NON-DEC UPDATE LEVEL
>
VPIP==0			;BAKWDS VERSION
VUPDATE==0		;BAKWDS VERSION
VEDIT==1		;BAKWDS VERSION
VCUSTOM==0		;BAKWDS VERSION

	LOC 124
	PIP1		;SET REENTER ADDRESS
	RELOC
	LOC 137
	<VCUSTOM>B2+<VPIP>B11+<VUPDATE>B17+VEDIT
	RELOC

;RIMSW==0 /Y SWITCH OPTION UNAVAILABLE.
;RIMSW==1 /Y SWITCH OPTION AVAILABLE.

;CCLSW==0 PIP WILL NOT PROCESS CCL COMMANDS.
;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
;FTDSK==1 DSK SYSTEM

;FORSW==1	FOROTS/FORSE BINARY DATA FILE CONVERSION ON /K
;NOTE THIS "FEATURE" WILL VANISH FOREVER ON 1-1-74

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

IFNDEF FTDSK,	<FTDSK==1>
IFE FTDSK,	<CCLSW==0>
IFNDEF CCLSW,	<CCLSW==1>
IFE CCLSW,	<TEMP==0>
IFNDEF TEMP,	<TEMP==1>
IFNDEF REENT,	<REENT==1>
IFNDEF RIMSW,	<RIMSW==0>
IFNDEF FORSW,	<FORSW==1>



IFN REENT,<	TWOSEGMENTS
	RELOC	400000>

	MLON
	SALL

EXTERN .JBFF,.JBSA,.JBREL

;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
PFLG==4		;FORTRAN PROGRAM OUTPUT FORMAT CONVERSION
PCONV==10	;COLUMN 1 CONVERSION IN PROGRESS
KFLG==20	;FOROTS/FORSE CONVERSION REQUIRED
CHKFLG==40	;PARENTHESES CHECK MODE
IFLG==100	;SELECT IMAGE MODE
GFLG==200	;KEEP GOING IF THERE ARE I/O ERRORS
IBFLG==400	;SELECT IMAGE BINARY MODE
JFLG==1000	;NON-STANDARD MODE
WFLG==2000	;/W CONVERT TABS TO SPACES
		;*** FLAGS TOO BIG FOR SWITCHES ***
TBSN==4000	;TAB ALREADY SEEN DURING /W
NEWFIL==10000	;NEW FILE JUST INITIATED
;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
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
MTIFLG==10000	;MTA INDUSTRIAL COMPATIBLE
MTSFLG==20000	;MTA DEC STANDARD

;AUXFLG ASSIGNMENTS (RIGHT HALF)

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

FNEX==1		;==1 WHEN FN.EX==*.*, *.EXT, FN.* (WHEN MORE
		;THAN ONE FN.EX IS IMPLIED).
MATEX==2	;FILE EXTENSIONS MUST MATCH
MATFN==4	;FILE NAMES MUST MATCH
NEWDEV==10	;A NEW INPUT DEVICE WAS GIVEN
NEWPP==20	;A NEW #P-P WAS GIVEN
ASTFLG==40	;FLAG SET WHEN FILE NAMED IN CS FOUND
		;BY LOOK ROUTINE EVEN IF FN OR EXT =*
DEV==100	;DEVICE NAME INDICATOR
DVSWTH==200	;OUTPUT DEVICE SEEN
NSWTCH==400	;INDICATES NULL NAME
SSWTCH==1000	;LEFT ARROW SEEN (TEMPORARY SWITCH)
LISTTY==2000	;LIST TO TTY
TMPI==4000	;INPUT DEVICE TMPCOR SEEN
TMPO==10000	;OUTPUT DEVICE TMPCOR
RXFLG==20000	;(RX) SEEN
RTRNFL==40000	;RETURN (POPJ ) FROM ERROR PRINTER (PTEXT)
ARWSW==100000	;LEFT ARROW SEEN IN THIS LINE
SQNSN==200000	;A SEQUENCE NUMBER HAS BEEN SEEN FOR THIS LINE
COMAFL==400000	;A COMMA SEEN ON INPUT  SIDE OF SPECIFICATIONS

ALLCLF==FNEX!MATEX!MATFN!NEWDEV!NEWPP
;MORE FLAGS IN LEFT HALF
MFLG==1		;A WILD CHAR MASK HAS BEEN SET UP FOR ??????.???
LDVFLG==2	;WE HAVE A DEVICE TO OUTPUT (DIR COMMAND)
LPPFLG==4	;WE HAVE A PPN TO OUTPUT (DIR)
OSPLFL==10	;OUTPUT DEVICE IS SPOOLED

;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
DD==6		;DUMP MODE CHANNEL FOR DTA DIR (TAPE ID ONLY)

;ACCUMULATOR ASSIGNMENTS

T1=1		;GENERAL PURPOSE
T2=2		;G.P.
T3=3		;G.P.
CHR=4		;INPUT CHARACTER
FL=5		;MORE FLAGS
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
P=17		;PUSHDOWN POINTER

CALFLG==FL	;OLD NAME - TOO LONG TO TYPE

;MISCELLANEOUS PARAMETERS

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

;MACRO DEFINITIONS

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

DEFINE	LSTLIN (Z),<
MOVEI	T1,Z
PUSHJ	P,LISTIT>

DEFINE	ERRPNT	(X),<
JSP	T1,PTEXT
XLIST
ASCIZ	X
LIST>
DEFINE	ERRPN2	(X),<
JSP	T1,PTEXT2
XLIST
ASCIZ	X
LIST>

;MACRO TO THROW AWAY CURRENT LINE BEFORE PRINTING ERROR MESSAGE
DEFINE ERRPNX (X)<
JSP	T1,PRETXT
XLIST
ASCIZ	X
LIST>

DEFINE	SWSEG <
IFN REENT,	<RELOC>>


;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	WAIT	[MTAPE   0]
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	GOBSTR	[CALLI	66]
OPDEF	DEVPPN	[CALLI	55]
OPDEF	PATH.	[CALLI	110]

;EXTENDED LOOKUP PARAMETERS

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

PTHLEN==6		;NUMBER OF SFD'S ALLOWED (1 MORE THAN 5.04)
PIP1:	IFN CCLSW,<
	TDZA	FLAG,FLAG	;NORMAL ENTRY TO ACCEPT COMMANDS FROM TTY
	SETO	FLAG,		;CCL ENTRY TO READ COMMANDS FROM DISK FILE>
	MOVE	0,[LOW,,LOW+1]	;XWD FOR BLT TO 
	SETZM	LOW		;CLEAR DATA AREA
	BLT	0,LOWTOP-1	;TO ZERO
	MOVEI	P,PDL-1		;SETUP PDL INCASE OF ERRORS
	MOVSI	'TTY'		;TEST TTY TO SEE IF  NOT A REAL TTY
	DEVCHR
	TLNE	TTYBIT		;WELL IS IT
	SKIP	2		;YES
	OUTSTR	[ASCIZ /?Logical TTY must be physical TTY/]
	EXIT	1,		;NO, DO MONRET
IFN FTDSK,<
	GETPPN			;SEE WHO WE ARE
	  JFCL			;INCASE JACCT ON?
	MOVEM	MYPPN		;STORE
	MOVE	[PTHLEN+3,,JOBPTH]
	SETOM	JOBPTH		;FIND JOB'S DEFAULT PATH
	PATH.			;GET PATH
	  SETZM	JOBPTH		;FAILED NOT SFD'S
	MOVE	[XWD 17,11]	;STATES WORD
	GETTAB			;GET IT
	  SETZ			;ERROR RETURN
	TLNN	(7B9)		;TEST FOR LEVEL D
	TDZA			;NOT LEVEL D
	HRROI	-2		;THIS IS LEVEL D
	MOVEM	LEVEL		;SAVE 
	MOVSI	'SYS'
	DEVPPN			;FIND PP OF DEVICE SYS
	  JRST	[MOVE	PP11	;ASSUME 1,,1 IF NOT LEVEL D
		SKIPE	LEVEL	;DEVPPN FAILED, BUT MIGHT BE SMALL MONITOR
		ADDI	3	;IT WAS, USE LEVEL D AREA
		JRST	.+1]
	MOVEM	SYSPP		;SAVE AS SYS PP>
IFE REENT,<
IFE FTDSK,<HLRZ	T1,.JBSA	;NO DSK SO USE JOBFF>
IFN FTDSK,<MOVEI T1,DSKDR0	;ASSUME NO DISK FOR TEST, LOC OF DSK RTNS
	MOVSI	0,'DSK'
	DEVCHR			;DEVCHR REQUEST: IS THERE A DSK 
	JUMPE	0,P1		;0 IF NO DISK: USE DSKDR
	MOVE	T1,.JBFF	;DISK: PREPARE TO SAVE C(JOBFF)
	HRRZ	T2,.JBREL	;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	CERR7		;CORE UNAVAILABLE>
	>
IFN REENT,<
	HLRZ	T1,.JBSA	;GET JOBFF>
P1:	HRRZM	T1,SVJBFF	;SAVE JOBFF SO BUFFERS CAN BE CREATED
	RESET			;RESET. MOVES JOBSA (LH) TO C (JOBFF)
IFE CCLSW,<JRST	PIP>
IFN CCLSW,<JUMPE FLAG,PIP	;ENTER PIP IF NO COMMAND FILE
	MOVEI	PIP1		;GET STARTING ADDRESS
	HRRM	.JBSA		;RESET IT SO ^C START WILL WORK

;THIS IS MODIFICATION FOR USING TMPCOR WITH CCL
IFN TEMP,<MOVE	T1,[XWD 1,TMPFIL];SET BLOCK POINTER FOR TMPCOR UUO
				;1=READ ONLY, LOC OF FILENAME
	MOVSI	T2,'PIP'
	MOVEM	T2,TMPFIL
	MOVSI	T2,-200
	HRR	T2,SVJBFF	;CALCULATE TMPFIL ADDRESS FOR BUFFER
	HRRZ	T5,.JBREL	;GET TOP OF CORE
	CAIGE	T5,200(T2)	;WILL BUFFER FIT IN AVAILABLE CORE?
	JRST	[ADDI	T5,200	;NO, TRY FOR ONE MORE K
		CORE	T5,
		JRST	OMODER	;FAILED, GIVE UP
		JRST	.+1]	;WILL BE OK NOW
	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
	MOVNI	0,(T1)		;GET NUMBER OF WORDS
	HRLM	0,TMPFIL+1	;IN CASE COMMAND FAILS
	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,'PIP'
	MOVEM	T3,CFILE	;INSERT JOB NBR IN CCL INIT
	MOVSI	T3,'DSK'
	MOVEM	T3,CCLINI+1	;DEFAULT DEVICE
	MOVSI	T3,'TMP'
	SETZM	CFILE+3
P12:	MOVEM	T3,CFILE+1
	SETZM	CCLINI		;CLEAR MODE
	MOVEI	T3,CFI		;COMMAND FILE BUFFER HEADER
	MOVEM	T3,CCLINI+2
	OPEN	COM,CCLINI	;INIT DEVICE FOR CCL OR @
	  JRST	CER1		;CAN'T INIT
	LOOKUP	COM,CFILE	;LOOKUP COMMAND FILE
	  JRST	[SKIPE	CFILE+1	;IF NUL FILE NOT FOUND
		JRST	CER2	;NO, REAL FILE NOT FOUND
		MOVSI	T3,'CCL'
		MOVEM	T3,CFILE+1
		JRST	.-1]	;TRY AGAIN WITH CCL
	INBUF	COM,1		;1 BUFFER ONLY
	MOVE	0,.JBFF		;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!/>

CER2:	SETOM	COMEOF		;FORCE EXIT AFTER MESSAGE
	ERRPNT	</?Command file />
	MOVEI	T3,CFILE	;ADDRESS OF FILE NAME
	PUSHJ	P,FN.EX		;PUT IT IN MESSAGE
	ERRPN2	</ not found!/>

PIP2:	SKIPE	TAPEID	;NEED TO SET TAPE ID?
	PUSHJ	P,WRTID	;YES
	SKIPE	COMFLG	;LAST COMMAND CCL?
	SKIPN	COMEOF	;ANY MORE CCL COMMAND?
	JRST	PIP2A	;YES,GET NEXT PIP COMMAND
	CLOSE	CON,	;FORCE OUTPUT OF ERROR MESSAGE
	EXIT	1,	;NO,CAN EXIT
	SETZM	COMFLG	;CLEAR FLAG NOW
	JRST	PIP2A	;JUST INCASE MONITOR RETURNS>

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

PIP:
			;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,"*"	;TYPE ASTERISK******
	IDPB 0,TFO+1	;READY TO ACCEPT
	OUTPUT CON,	;COMMAND FROM TTY
PIP2B:	SETZM TOTBRK	;CLEAR PAREN COUNTER
	MOVEI 0,TABSP	;SPACES PER TAB
	MOVEM 0,TABCT	;INITIALIZE TAB COUNT
	MOVE 0,ZRO	;ASCII /00000/
	MOVEM 0,SQNUM	;INITIALIZE SEQUENCE NUMBERS
	RELEAS CON,	;RELEASE TTY FOR USE AS IN-OUT DEVICE

MAINA1:	SETZB FLAG,FZERO   ;INITIALIZE FOR FIRST/NEXT COMMAND STRING
	SETZB AUXFLG,DEVICE
IFN FTDSK,<HRRZI 0,'SYS'	;SYSTEM DIRECT DEV, DSK/DTA
	HRLZM 0,ADSK		;PUT IN SYSTEM DEVICE>
	MOVE	0,[XWD FZERO,FZERO+1]
	BLT	0,LZERO		;CLEAR STORAGE AREA
	SETZ	CALFLG,		;CLEAR OTHER FLAGS
IFN CCLSW,<SKIPE COMFLG	;CCL COMMAND?
	JRST	COMPRO	;YES, GET FROM CORE OR DSK>
	MOVE	T3,.JBFF	;FREE CORE POINTER
	HRLI	T3,(POINT 7)	;FORM BYTE POINTER
	MOVEM	T3,COMPTR	; FOR STORING CS IN CORE

;ACCUMULATE CS CHARS IN CORE

COMSTO:	PUSHJ	P,GETTA		;GET CS CHAR
	AOS	COMCNT		;COUNT CHARS
	MOVEI	T4,1(T3)	;GET BYTE POINTER ADDRESS PLUS SOME
	CAMGE	T4,.JBREL	;SEE IF IT WILL BE IN BOUNDS
	JRST	.+3		;YES, ALL IS WELL
	CORE	T4,		;GET WHAT WE NEED
	  JRST	OMODER		;FAILED, UNLIKELY TO HAPPEN
	CAIN	0,CZ		;CHECK FOR ^Z
COMASK:	PUSHJ	P,GETEN2	;SET  ^Z IN 0
	IDPB	0,T3		;STORE IN COMBUF
	SKIPE	COMEOF		;END-OF-FILE SET?
	AOJA	T3,COMSTD	;YES, PROCESS CS IN COMBUF
	CAIG	0,CR		;NOT EOF
	CAIGE	0,LF		;LF,VT,FF,CR?
	CAIN	0,ALTMODE	;NO, $?
	JRST	COMASK		;YES
	JRST	COMSTO		;NO, KEEP STORING

COMSTD:	HRRM	T3,.JBFF	;RESET JOBFF TO RETAIN STORED COMMAND
	HRRM	T3,DTJBFF	;ALSO JOBFF AFTER 2 TTY BUFFERS (PLUS COMMAND)
				; AND FALL INTO COMPRO

;********************************************************************
;BEGIN SCAN OF DESTINATION PORTION OF COMMAND STRING
COMPRO:
IFN FTDSK,<
	MOVSI	0,'DSK'		;MAKE DEFAULT DEVICE
	MOVEM	0,DEVICE		;TENTATIVELY DSK>

COMPRP:	RELEASE	CON,		;RELEASE TTY
	PUSHJ P,NAME	;GO SCAN DESTINATION PORTION OF COMMAND STRING
	SKIPE XNAME	;NO SCAN OVERSHOOT ALLOWED
	JRST ERR6A
	SKIPL	ESWTCH	;11/25/69  END OF CS ?
	JRST	MAINC	;NO
IFN CCLSW,<SKIPE COMFLG		;STILL IN CCL
	JRST	PIP2		;YES>
	TLNE	AUXFLG,QFLG	;PERHAPS JUST /Q?
	JRST	MAINQ		;YES IT WAS
	TRNN	CALFLG,NSWTCH	;NON-NULL DESTINATION
	TRNE	CALFLG,SSWTCH	;_ NOT SEEN?
	SKIPE	FILNAM		;OR ANYTHING IN FILENAME
	JRST	ERR6A		;YES, ERROR
	JRST	PIP2		;NO, ALL OK

MAINQ:	MOVSI	0,'DSK'	;SEE IF DEFAULT DEVICE
	CAMN	0,DEVICE
	TLCA	0,200722;TURN DSK INTO TTY BY WAVE OF WAND
MAINC:	MOVE 0,DEVICE	;GET OUTPUT DEVICE NAME
	MOVEM 0,ODEV	;SAVE DEVICE NAME FOR LATER USAGE
	PUSHJ P,DEVTST	;SAVE DEVICE TYPE, SET XXXOUT.E.G. DTAOUT
	PUSHJ P,ABCHK	;CHECK MTA BACKSPACE/ADV VALUES
	PUSHJ P,PROTK	;CHECK PROTECTION
	MOVE 0,AB	;MTA VALUE SWITCHES
	MOVEM 0,ABOUT	;GET MTA CONTROL NUMBERS FO R OUT
	MOVE 0,AUX
	MOVEM 0,AUXOUT
	MOVE 0,[FILNAM,,DTON]
	BLT 0,DTON+3	;SAVE DESTINATION FILE NAME
IFN FTDSK,<TRNN AUXFLG,DSKOUT	;DISK OUTPUT?>
	SETZM DTON+3    ;ZERO 4TH WD OF DIRECTORY ENTRY
IFN FTDSK,<SKIPN	PTHADD	;FULL PATH SPECIFIED?
	JRST	M3		;NO
	MOVE	0,[PTHADD,,PTHOUT]
	HRRZM	0,DTON+3	;SET PATH ADDRESS
	BLT	0,PTHOUT+PTHLEN+3
>
M3:	TRZ	CALFLG,SSWTCH	;TERMINATE DESTINATION FILE SCAN
IFE FTDSK,<SETZM DEVICE	;DONT CARRY OVER INPUT DEVICE>
IFN FTDSK,<SETZM PPP	;CLEAR OUTPUT PPN
	SETZM	PP	;JUST IN CASE
	SETZM	PTHADD	;AND FULL PATH JUNK
	SETZM	DEFPTH	;AND ITS DEFAULT
	MOVSI 0,'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).
	TLZN AUXFLG,QFLG	;/Q?
	JRST M2		;NO
	HRRZI 0,'SYS'	;YES MAKE INPUT DEVICE SYS
	HRLZM 0,DEVICE
	HRLZM DEVA		;SAVE COPY OF INPUT DEVICE
	MOVE	0,['PIPHLP']	;NAME.EXT FOR HELP TEXT
	HLLZM	0,FILNAM
	HRLZM	0,FILEX
	TRO	AUXFLG,SYSFLG	;DEVICE IS SYS
IFN FTDSK,<MOVE	0,SYSPP	;GET SYS PP
	MOVEM	0,PP	;AND SET IT>
	SOS ESWTCH	;NO MORE COMMAND STRING
	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
	TRNN	FLAG,XFLG	;/X ?
	JRST	M2A		;NO
	TRNE	FLAG,RFLG	;(RX)?
	JRST	M5		;YES, (RX)
	MOVE	0,DTON		;GET FILE NAME
	JUMPN	0,M5		;BELIEVE ANYTHING BUT ZERO
	HLRZ	0,DTON+1	;SAME FOR EXT
	JUMPN	0,M5
M2A:	IFN RIMSW,<
	TLNN FLAG,RIMFLG	;RIM OUTPUT?
	JRST M1		;NO
	TRNE AUXFLG,PPTOUT	;RIM IS ONLY DTA TO PTP
	TRNN AUXFLG,DTAIN!DSKIN!MTAIN
	JRST ERR5B>

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

M4:	TRNN FLAG,BMOD	;BINARY MODE?
	JRST .+3	;NO
	TRZ T4,17	;CLEAR ALL MODES
	TRO T4,14	;BIN. MODE

	TLNN FLAG,IFLG	;IMAGE BINARY MODE?
	JRST .+3	;NO
	TRZ T4,17	;CLEAR ALL MODES
	TRO T4,10	;IM. MODE

	TLNN FLAG,IBFLG	;IMAGE BINARY MODE?
	JRST .+3	;NO
	TRZ T4,17	;CLEAR ALL MODES
	TRO T4,13	;YES
	TRNE FLAG,XFLG	;COPY MODE?
	POPJ P,		;YES, DON'T ALTER DATA MODE

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

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

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




;SAME FOR INPUT DEVICE.

INLOOK:	SKIPE	T3,FILNAM	;IF NO FILENAME
	TRNN	FLAG,XFLG	;OR NOT /X
	JRST	INLUK1		;CONTINUE
	SKIPE	DTON		;IF OUTPUT NAME SET UP
	JRST	INLUK1		;CONTINUE
	HLRZ	T1,FILEX	;GET EXT
	MOVEM	T3,DTON		;SET OUT NAME
	HRLZM	T1,DTON+1	;AND EXTENSION
INLUK1:	MOVE T3,AB	;ADV OR BKSPACE
	MOVE T1,AUX	;AUX FOR INPUT DEV
	MOVEI T6,INIMTA	;SET TO INIT
	JRST MT1	;MTA FOR INPUT
;ROUTINE TO INITIALIZE OUTPUT DEVICE

OMODE:	IFN TEMP,<
	TRNE	CALFLG,TMPO	;TMPCOR OUTPUT DEVICE?
	JRST	OMOD2		;YES, NO OUTBUFS>
	MOVE T1,[XWD OBF,IBF]
	MOVEM T1,ODEV+1
	MOVE T1,DTJBFF	;JOBFF AFTER 2 TTY BUFS
	MOVEM T1,.JBFF	;SET UP

	MOVEI	0,MTIFLG!MTSFLG	;TEST FOR  (MI) OR (MS) NOW
	AND	0,OMOD
	ANDCAM	0,OMOD		;AND CLEAR FROM MODE WORD
	OPEN OUT,OMOD	;INITIALIZE OUTPUT DEVICE
	  JRST ERR1	;UNAVAILABLE ERROR
	JUMPE	0,OMOD3		;JUMP IF NOT (MI) OR (MS)
	MOVEI	T4,100		;ARG FOR MTAPE UUO
	TRNE	0,MTIFLG	;DID WE GUESS CORRECTLY?
	IORI	T4,101		;NO
	MTAPE	OUT,(T4)	;SET MODE
OMOD3:	OUTBUF OUT,1	;TRY ONE OUTBUFFER FOR SIZE
	EXCH T1,.JBFF	;JOBFF_DTJBFF+BUFSZ
			;NOTE JOBFF RESET TO DTJBFF
	SUB T1,DTJBFF	;T1=BUFSZ
	HRRZ 0,.JBREL	;HIGHEST CORE AVAILABLE
	SUB 0,DTJBFF	;0=TOTAL CORE AVAILABLE
	ASH 0,-1	;COMPUTE HOW MANY OUTPUT BUFFERS
	IDIVM 0,T1	;FIT IN HALF THE AVAILABLE SPACE
	MOVEI	T4,OMODE	;SET RETURN FROM CORCHK
	PUSHJ	P,CORCHK	;LOOP BACK OR ERROR IF NOT ENOUGH CORE
	OUTBUF OUT,(T1)	;SET UP OUTPUT BUFFERS
	MOVE 0,OBF+1
	MOVEM 0,SVOBF	;SAVE ORIGINAL MODE SETTING
OMOD2:	MOVE 0,.JBFF
	HRRZM 0,SVJBF1	;PREPARE TO RECLAIM INBUFFER SPACE
	POPJ P,

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

;ROUTINE TO CHECK FOR ENOUGH CORE FOR I/O BUFFERS
;ENTER	T1: COMPUTED NUMBER OF BUFFERS WE WANT
;	T4: WHERE TO GO IF WE EXPAND CORE
CORCHK:	CAIL	T1,2		;ROOM NOW FOR  AT LEAST 2 BUFFERS?
	POPJ	P,		;YES, RETURN OK
	JUMPLE	T1,MORCOR	;HAVE TO GET MORE ROOM IF NONE
	HRRZ	0,.JBREL	;WANTED 1, SEE IF WE CAN GET 2
	ADDI	0,1000		;TRY 1/2K MORE
	CORE	0,
	  POPJ	P,		;NO, LIVE WITH 1 BUFFER
	POP	P,0		;YES, POP OFF PUSHJ CALL
	JRST	(T4)		;AND RECOMPUTE

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

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


MAINA2:	TRNE   FLAG,RFLG+DFLG	;RENAME OR DELETE FILE MODE?
	JRST   DTDELE		;YES./D,/X,OR(DX)
IFN RIMSW,<
	TLNE   FLAG,RIMFLG	;RIM?
	JRST   RIMTB		;YES./Y
	>
	TRNE   FLAG,XFLG	;TRANSFER EVERYTHING MODE?
	JRST   PRECOP		;YES./X
;LOOP TO COPY ALL FILES BEGINS HERE FROM MAIN2
MAINA3:	TRNN   AUXFLG,FFLG	;LIST DSK DIR SHORT?
	TRNE   FLAG,LFLG	;LIST DIRECTORY?
	JRST   DTPDIR		;YES./F OR /L
IFN TEMP,<
	TRNE	CALFLG,TMPI	;TEMCOR:
	JRST	TMPIN		;YES THIS IS SPECIAL>
	PUSHJ  P,ININIT		;INITIALIZE INPUT FILE
	TRNN	CALFLG,FNEX	;SINGLE FILE SPECIFICATION?
	JRST	[MOVE	0,[FILNAM,,ZRF]	;YES, DON'T READ DIRECTORY
		BLT	0,ZRF+3	;SET UP FILE NAME,EXT, AND PPN
		SETZM	GENERI	;JUST IN CASE
		JRST	MAINA4+2]
	TRNE   AUXFLG,DTAIN	;DEC TAPE INPUT?
	PUSHJ  P,DTADIR		;INIT DTA DIR

IFN FTDSK,<TRNN   AUXFLG,DSKIN	;NO, DISK INPUT?
	JRST	MAINA4		;NO
	PUSHJ	P,INITFS	;INIT SEARCH LIST IF LEVEL D
	  JRST	MAINA4-1	;NOT GENERIC "DSK"
MAINAD:	PUSHJ	P,NXTFSU	;GET NEXT F/S
	  JRST	MAINA6		;END OF F/S LIST
	TROA	CALFLG,FNEX	;KEEP THE FLAG FLYING
	PUSHJ	P,DSKDIR	;INIT DSK UFD CHANNEL
	  JFCL>
MAINA4:	PUSHJ  P,LOOK		;GET A FILE TO COPY
	  JRST   MAINA5		;NO MORE
IFN FTDSK,<PUSHJ P,SETPTH	;SEE IF FULL PATH
	  MOVEM	0,ZRF+3		;NON-SKIP RETURN, USE IT>
	LOOKUP IN,ZRF
	  JRST   ERR3		;LOOKUP FAILURE
IFN TEMP,<TRNE	CALFLG,TMPO
	JRST	TMPOUT		;OUTPUT TO TMPCOR>
	TLO   FLAG,NEWFIL
	PUSHJ P,FILTYP
	TRNE  AUXFLG,ONEOUT
	JRST  PSCANA		;OUT HAS BEEN INITIALIZED
	PUSHJ P,OKBLKS
IFN FTDSK,<SKIPE LEVEL		;IF LEVEL D
	TLNN	AUXFLG,NSPROT	;AND NON-STANDARD PROTECTION
	JRST	.+3		;NOT BOTH TRUE
	LDB	0,PRPTL		;GET PROTECTION CODE
	DPB	0,PRPTD		;INTO ENTER BLOCK>
	GETSTS	OUT,T1		;SAVE CURRENT MODE
	LDB	T2,[POINT 4,ZRF+2,12]	;GET INPUT MODE
	SETSTS	OUT,(T2)	;SET OUTPUT SAME
	PUSHJ	P,CHKDTON	;MAKE SURE WE HAVE A VALID NAME
	ENTER	OUT,DTON	;CREATE OUTPUT FILE
	  JRST	ERR4		;DIR. FULL OR 0 FILE NAME
	SETSTS	OUT,(T1)	;RESET OUTPUT MODE
	JRST	PSCANA

MAINA5:
IFN FTDSK,<TRNE	AUXFLG,DSKIN	;DSK INPUT
	JRST	MAINAD		;YES, GET NEXT F/S>
MAINA7: TRZ  AUXFLG,REDFLG
	JRST  MAIN1

MAINA6:	TRNN	AUXFLG,REDFLG	;WAS FILE FOUND?
	PUSHJ	P,ERR3A		;NO
	JRST	MAINA7		;YES, BUT NO MORE F/S

;HERE TO CHECK NAME.EXT IN DTON
;AT THIS POINT THERE MUST BE NO ? FROM MASK LEFT
;NOTE ? INTRODUCED BY # ARE OK
CHKDTON:HLLZS	DTON+1		;CLEAR IN CASE ERROR
	MOVE	0,OQMASK	;GET OUTPUT MASK
	JUMPE	0,CPOPJ		;NO WILD CARDS
	AND	0,DTON		;JUST LEAVE MASKED CHARS.
	XOR	0,OQMASK	;THEY SHOULD HAVE CHANGED
	JUMPE	0,CPOPJ1	;SKIP RETURN IS FAILURE
	MOVE	0,OQMASK+1	;SAME FOR EXT
	JUMPE	0,CPOPJ
	AND	0,DTON+1
	XOR	0,OQMASK+1
	JUMPE	0,CPOPJ1
	POPJ	P,		;GOOD RETURN
PSCANB:	TRNE AUXFLG,MTAIN!CDRIN!TTYIN!PPTIN	;ON NON-DIR DEVICE?
	TRZ	CALFLG,ALLCLF	;END OF THE ONE OR MANY FILES SPECIFIED
	TRON AUXFLG,ONEOUT	;HAS OUT JUST BEEN INIT?
	OUTPUT OUT,	;YES, AND FIRST FILE IS EOF ONLY, INIT OUT IN
			;CASE NO MORE SOURCE FILES
	JRST PSCAN5	;EMPTY FILE, CLOSE INPUT, RETURN FOR MORE

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

PSCAN:	TRO AUXFLG,ONEOUT	;INDICATE ONE OUTPUT FILE INITED
	TDNN FLAG,[XWD IFLG+IBFLG,BMOD]	;BIN. OR NO CHAR. PROCESSING
	TLNE AUXFLG,SBIN
	JRST PSCAN3	;YES
	MOVE 0,OPTRA	;PRESCAN A LINE, INITIALIZE LINE BUFFER PTR
	MOVEM 0,OPTR
	SETZM CDRCNT
	PUSHJ P,CLRBUF	;CLEAR LINE BUFFER
	TRO FLAG,STS	;START A FRESH LINE
PSCAN2:	PUSHJ P,GET	;GET CHARACTER
	JRST PSCAN1	;END OF FILE RETURN
	CAIN CHR,DEL	;VJC 4/16/69
	JRST PSCAN2	;GET NEXT CHAR
	HRRZ	T1,OPTR	;GET DEPOSIT ADDRESS
	CAIL	T1,LBUFE
	PUSHJ	P,PSCLNG	;LINE TOO LONG
	IDPB CHR,OPTR	;DEPOSIT CHAR. IN LINE BUFFER
	CAIG CHR,24
	CAIGE	CHR,20	;LINE PRINTERR CONTROL CHAR
	SKIP	1	;NO
	JRST PSCAN4	;YES, TREAT AS END OF LINE
	CAIG CHR,14
	CAIGE CHR,12	;END OF LINE CHARACTER?
	SKIP	1	;NO
	JRST	PSCAN4	;YES
	CAIGE	CHR," "	;TEST FOR CONTROL CHARS.
	CAIN	CHR,CR	;BUT ALLOW CR
	JRST	PSCAN2	;NONE, SO CONTINUE
	CAIE	CHR,TAB	;TAB IS O.K. THOUGH
	TRNN	AUXFLG,LPTOUT!TTYOUT
	JRST	PSCAN2	;IF LPT OR TTY CONVERT CHARACTER
	PUSH	P,CHR	;IT WAS, SO SAVE IT
	MOVEI	CHR,"^"	;STANDARD UP ARROW
	DPB	CHR,OPTR;WIPE OUT BAD CHAR
	POP	P,CHR	;GET IT BACK
	TRC	CHR,100	;MAKE IT VISIBLE
	IDPB	CHR,OPTR
	JRST	PSCAN2	;AND CONTINUE

PSCAN4:	TRNN	FLAG,TBMOD!SPMOD;REMOVED TRAILING SPACES?
	JRST	PSCAN7		;NO
	MOVE	T2,LBUF		;GET FIRST 5 CHARS.
	CAME	T2,[BYTE (7) 15,12,40,40,40]
	JRST	PSCAN7		;NOT A BLANK LINE
	MOVE	T2,[BYTE (7) 40,15,12,40,40]
	MOVEM	T2,LBUF		;GUARENTEE ONE SPACE
	IBP	OPTR		;DON'T FORGET TO ACCOUNT FOR IT
PSCAN7:	PUSHJ	P,OUTLBF	;YES, SO DUMP THE LINE BUFFER
	JRST	PSCAN		;SCAN THE NEXT LINE

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

;HERE IF LINE IS TOO LONG FOR LINE BUFFER

PSCLNG:	TRNE	FLAG,LINE	;FATAL IF /A LINE BLOCKING
	JRST	ERR10		;SINCE WE DON'T KNOW HOW TO
	PUSHJ	P,OUTLBF	;DUMP THE LINE
	MOVE	0,OPTRA		;FIX UP LINE BUFFER AGAIN
	MOVEM	0,OPTR
	JRST	CLRBUF		;CLEAR LINE BUFFER AND RETURN

	;HERE FOR BINARY TRANSFER

PSCAN3:
IFN FORSW,<TLNE	FLAG,KFLG	;/K ?
	JRST	KCONV0		;YES>
	SETZB	T3,T4		;SAVES TIME LATER
	TLNN	FLAG,PFLG	;FORTRAN BINARY DATA (BP) ?
	JRST	PSCAN8		;NO
	ILDB	T3,IBF+1	;GET DATA COUNT
	TRZE	T3,-1		;INCASE ONLY ONE BLOCK
	SETO	T4,		;IT WAS, SO FLAG THAT FACT
	SOS	IBF+2		;COUNT ONE LESS
PSCAN8:	SKIPG	IBF+2		;BUFER ENPTY?
	JRST	[PUSHJ	P,INP		;YES, INPUT A BUFFER
		TRNE	IOS,EOFBIT	;END OF FILE?
		JRST	PSCAN9		;YES, RETURN
		TLNN	FLAG,PFLG	;FORTRAN BINARY?
		JRST	.+1		;NO
		ILDB	CHR,IBF+1	;GET FIRST DATA WORD
		TRZE	CHR,-1		;INCASE LAST BLOCK
		HRLI	T4,-1		;FLAG IT WAS
		ADD	T3,CHR		;ADD TO WORD COUNT
		SOS	IBF+2		;DECREMENT WORD COUNT
		JRST	.+1]		;BUFFER FULL NOW
	SKIPG	OBF+2		;ANY ROOM IN OUTPUT BUFFER?
	JRST	[PUSHJ	P,OUTP		;OUTPUT FULL BUFFER
		TLNN	FLAG,PFLG	;FORTRAN BINARY?
		JRST	.+1		;NO
		SOS	CHR,OBF+2	;GET WORD COUNT-1
		HRLZS	CHR		;PUT COUNT IN LEFT HALF
		SUB	T3,CHR		;ACCOUNT FOR LAST BLOCK OUTPUT
		IDPB	CHR,OBF+1	;STORE AS FIRST WORD
		ADDI	T3,1		;INCREMENT BLOCK COUNT
		HRR	T4,OBF+1	;SAVE INITIAL ADDRESS
		JRST	.+1]		;CONTINUE
	MOVE	T1,IBF+2	;NUMBER OF WORDS TO GO
	CAMLE	T1,OBF+2	;WILL THEY FIT?
	MOVE	T1,OBF+2	;NO, SO FILL BUFFER ONLY
	HRLZ	T2,IBF+1	;BLT FROM INPUT
	HRR	T2,OBF+1	;TO OUTPUT
	AOBJP	T2,.+1		;BUT START ON DATA WORDS
	ADDM	T1,IBF+1	;ADJUST BYTE POINTER
	ADDM	T1,OBF+1
	MOVNS	T1		;NEGATE WORDS TO GO
	ADDM	T1,IBF+2	;ADJUST WORD COUNT
	ADDM	T1,OBF+2
	BLT	T2,@OBF+1	;MOVE WORDS
	JUMPGE	T4,PSCAN8	;NOT FORTRAN BINARY, OR NOT LAST BLOCK
	SKIPE	IBF+2		;FINISHED WITH THIS BUFFER?
	JRST	PSCAN8		;NO, WILL FIX WORD COUNT NEXT TIME
	ADDM	T3,(T4)		;SET FINAL WORD COUNT
	SETZB	T3,T4		;JUST IN CASE
	SETZM	OBF+2		;FORCE OUTPUT
	JRST	PSCAN8		;GET MORE
;HERE FOR FOROTS TO FORSE DATA FILE CONVERSION
IFN FORSW,<
KCONV0:	SKIPGE	OBF		;BUFFER SETUP?
KCONVA:	PUSHJ	P,OUTP		;NO, DO DUMMY OUTPUT
	SETZB	T3,T4
	SOSLE	IBF+2		;BUFFER EMPTY
	JRST	.+4		;NO
	PUSHJ	P,INP		;YES
	TRNE	IOS,EOFBIT	;TEST FOR E-O-F
	JRST	PSCAN9		;ALL DONE IF SO
	ILDB	T2,IBF+1	;GET CONTROL WORD
	TLNE	T2,DEL*4000	;BITS 0-6 MUST BE ZERO
	JRST	KERR		;ERROR
	LDB	T1,[POINT 2,T2,8]	;GET CONTROL WORD TYPE
	SOJN	T1,KERR		;ERROR IF NOT TYPE 1
	MOVEI	T2,-1(T2)	;IGNORE TRAILING CONTROL WORD FOR NOW
KCONVB:	ADD	T3,[1,,0]	;BUMP BUFFER COUNT
	MOVE	T4,OBF+1	;STORE ORIGINAL BYTE PTR
	IBP	OBF+1		;ADVANCE PAST  CONTROL WORD
	SOS	OBF+2		;ACCOUNT FOR IT
KCONVC:	CAMLE	T2,OBF+2	;WILL ALL DATA FIT IN THIS BLOCK (USUALLY)
	JRST	KCONV2		;NO
	ADD	T3,T2		;ADD THIS DATA TO TOTAL
	MOVSM	T3,1(T4)	;STORE CONTROL WORD
	MOVN	T3,T2		;GET COPY OF -COUNT
	HRLZ	T1,IBF+1	;FROM
	HRR	T1,OBF+1	;TO
	ADDM	T2,IBF+1	;ACCOUNT FOR INPUT WORDS
	ADDB	T2,OBF+1	;END
	ADD	T1,[1,,1]
	BLT	T1,(T2)
	ADDM	T3,IBF+2
	ADDM	T3,OBF+2	;FIXUP WORD COUNT
KCONVD:	SOSLE	IBF+2		;BUFFER EMPTY
	JRST	.+4		;NO
	PUSHJ	P,INP		;YES
	TRNE	IOS,EOFBIT	;TEST FOR E-O-F
	JRST	KERR		;MUST SEE CONTROL WORD
	ILDB	T2,IBF+1	;GET NEXT CONTROL WORD
	LDB	T1,[POINT 2,T2,8]	;GET CONTROL TYPE
	SOJLE	T1,KERR		;ERROR IF CODE 0 OR 1
	SOJG	T1,KCONVA	;CODE 3, GET NEXT LOGICAL RECORD
KCONV1:	HRRZI	T2,-1(T2)	;GET DATA WORD COUNT
	JUMPE	T2,KCONVD	;GET NEXT CONTROL WORD IF NO DATA
	MOVS	T3,1(T4)	;RECOVER PARTIAL CONTROL WORD
	JRST	KCONVC		;AND CONTINUE

KCONV2:	ADD	T3,OBF+2	;ONLY THIS MANY ALLOWED
	HRLZM	T3,1(T4)	;WORDS PER PHYSICAL BLOCK
	HLLZS	T3		;START BACK ON ZERO
	PUSHJ	P,OUTP		;OUTPUT THIS BLOCK
	JRST	KCONVB		;AND CONTINUE WITH NEW OUTPUT BUFFER

KERR:	ERRPNT	</?Incorrect FOROTS data file!/>
>
;COME HERE AFTER /L,/D,/R ON DISK OR THROUGH COPYING

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

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

MAINB:	CLOSE OUT,	;CLOSE THE OUTPUT FILE
	PUSHJ P,OUTP1	;CHECK THE FINAL ERROR BITS
IFN FTDSK,<TLNE AUXFLG,NSPROT	;NON-ST. PROT?
	TRNN AUXFLG,DSKOUT	;DISK OUT/
	JRST MAINB1	;NO
	LDB 0,PRPTL
	SKIPE	LEVEL		;IF LEVEL D
	JUMPN	0,MAINB1	;ALREADY SET UNLESS 0
	DPB 0,PRPTD
	PUSHJ	P,SETPTH	;SEE IF FULL PATH
	  MOVEM	0,DTON+3	;NON-SKIP RETURN, USE IT
	RENAME OUT,DTON	;SET UP RENAME REQUEST
	  JRST DERR6	;DISK ERROR
MAINB1:>
	RELEAS OUT,	;RELEASE THE OUTPUT DEVICE
	JRST PIP2	;PROCESS THE NEXT COMMAND

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

ININIT:	IFN TEMP,<
	TRNE	CALFLG,TMPI	;IF DEV IS TMPCOR:
	POPJ	P,		;RETURN>
	MOVE T1,SVJBF1	;SVJBF1=END OF OUTPUT BUFFERS
	MOVEM T1,.JBFF	;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,.JBFF	;HOW MANY INBUFFERS WILL FIT?
	SUB T1,SVJBF1
	HRRZ 0,.JBREL
	SUB 0,.JBFF	;JOBREL-SVJBF1=TOTAL SPACE LEFT
	IDIVM 0,T1
	MOVEI	T4,ININIT	;RETURN FROM CORCHK IS ININIT
	PUSHJ	P,CORCHK	;LOOP BACK OR ERROR IF NOT ENOUGH CORE
	INBUF IN,(T1)	;SET UP AS MANY BUFFS AS FIT
	MOVE 0,IBF+1	;SAVE ORIGINAL MODE
	MOVEM 0,SVIBF
	POPJ P,
;THIS ROUTINE GETS AN INPUT UNIT DESCRIPTOR AND, FOR
;ADVANCE FILE AND BSPF ON MTA, ENSURES THE VALUE 1 IF NO
;NUMBER WAS GIVEN.

DESCRP:	SETZM AUX	;WILL GET ANY MTA REQ. GOING TO AUXFLG.
	TRZE	AUXFLG,SYSFLG	;IS THIS DEVICE SYS.?
	TRO	AUXFLG,SYSLST	;YES,SET SYS AS LAST DEVICE
	SETZM AB	;MTA VALUE SWITCHES
	SETZM PR	;PROTECTION
IFN FTDSK,<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
	PUSHJ P,CHECK1	;CHECK UNIT, AND FOR _

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

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

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

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

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

DEVTST:	DEVCHR		;GET DEVICE CHARACTERISTICS
IFN FTDSK,<TLNN 0,DSKBIT	;IS OUTPUT DEV DSK?
	JRST DEVTSU	;NO
	TRO AUXFLG,DSKOUT	;YES, SET BIT
	PUSH	P,DEVICE	;SAVE DEVICE NAME
	POP	P,ADSK		;PUT NAME IN DSK INIT
	POPJ P,
DEVTSU:>
	JUMPE	0,DEVER2	;NON-EXISTENT DEVICE
	TLNN 0,OUTBIT	;CAN DEV DO OUTPUT?
	JRST ERR6A	;NO
	TLNE 0,DTABIT	;DECTAPE?
	TRO AUXFLG,DTAOUT	;YES
	TLNE 0,PTPBIT	;PAPER TAPE PUNCH?
	TRO AUXFLG,PPTOUT
	TLNE 0,LPTBIT	;LINE PRINTER?
	TRO AUXFLG,LPTOUT
	TLNE 0,TTYBIT	;TELETYPE?
	TRO AUXFLG,TTYOUT
	TLNE 0,MTABIT	;MAGTAPE?
	TRO AUXFLG,MTAOUT
	MOVE	0,ODEV		;GET OUTPUT DEVICE AGAIN
	DEVTYP	0,		;NEED TO FIND OUT ABOUT SPOOLING
	  SETZ	0,		;NEED 5.03 TO SPOOL
	TLNE	0,.TYSPL	;IS DEVICE SPOOLED
	TLOA	CALFLG,OSPLFL	;YES
	TLZ	CALFLG,OSPLFL	;NO
	POPJ P,

;ROUTINE TO CHECK IF DEVICE SYS AND SET [P,P], IF NONE GIVEN

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

DEVER1:	IFN TEMP,<
	TROA	CALFLG,TMPI>
DEVER2:	IFN TEMP,<
	TRO	CALFLG,TMPO>
IFN TEMP,<HLRZ	T1,DEVICE
	CAIN	T1,'TMP'
	POPJ	P,		;ALLOW DEVICE TMPCOR:
	TRZ	CALFLG,TMPI!TMPO	;JUST IN CASE>
	MOVE	T1,DEVICE
DEVER:	MOVEM	T1,DEVERR
	ERRPNT	</?Device />
	PUSHJ	P,P6BIT
		DEVERR
	ERRPN2	</ does not exist!/>
;ROUTINE TO INIT PDL POINTER AND TTY

INICN1:	MOVEI	P,PDL-1		;INITIALIZE PUSHDOWN POINTER
	SETZM	DTJBFF		;ALWAYS REINITIALIZE IF * OUTPUT
INICN2: MOVE	0,SVJBFF	;IS INITIALIZED AT PIP1
	MOVEM	0,.JBFF		;SET JOBFF TO BEGINNING OF BUFFER AREA
	PUSHJ	P,INICON	;INITIALIZE THE TTY
	INBUF	CON,1		;ONE INBUFFER
	OUTBUF	CON,1		;ONE OUTBUFFER
	MOVE	0,DTJBFF	;SEE IF THIS IS FIRST TIME HERE
	JUMPN	0,[MOVEM 0,.JBFF	;NO, SO SAVE POSSIBLE STORED COMMAND
		JRST	INICN3]
	MOVE	0,.JBFF
	HRRZM	0,DTJBFF	;JOBFF AFTER 2 TTY BUFFERS SET
INICN3:	OUTPUT	 CON,		;INITIALIZE BUFFER POINTERS
	JRST	(T5)

;ROUTINE TO CLEAR LINE BUFFER

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

;COMMAND SCANNER ROUTINE

NAME:	TRNN	CALFLG,SSWTCH	;RETURN NULL IF _ OR END-OF-LINE SEEN
	SKIPGE	ESWTCH
	JRST	NM13		;
	TRZ	CALFLG,NSWTCH
	SKIPE	T1,XNAME	;IF COMMAND SCAN OVERSHOOT PICKED UP
				;DEVICE NAME, USE IT NOW
	JRST	NM7
	TRZ	CALFLG,DEV
;LOOK FOR FILE NAME, EXT
NM1:	SETZM	FILEX
	SETZM	QMASK+1		;CLEAR WILD CHAR. MASK
	TLZ	CALFLG,MFLG	;AND FLAG
	TRZ	CALFLG,COMAFL	;CLEAR COMMA FLAG
NM2:	SETZM	FILNAM
	SETZM	QMASK
	SKIPA	T1,NM15
IDFIN:	POP	P,T1		;RESTORE OLD POINTER
;LOOP TO PICK OFF FILENAME, EXT
NM3:	PUSHJ	P,GETCOM	;GO GET 7 BIT ASCII CHAR. FROM COMMAND STRING
NM3A:	CAIN	0,"*"		;TO ALLOW FN.EX = *.*
	JRST	NMSTAR		;GO SET MASK
	CAIL	0,"A"		;ALPHABETIC CHARACTER?
	CAILE	0,"Z"
	JRST	NM4A		;NO
NM4:	SUBI	0,40		;CONVERT TO SIXBIT
	TLNE	T1,770000	;6 CHARS. YET?
	IDPB	0,T1		;NO
	JRST	NM3		;GET NEXT CHAR.

NM4A:	CAIL	0,"0"		;NUMERIC?
	CAILE	0,"9"
	JRST	NM5		;NO
	JRST	NM4

NMBIN:	TLC	T1,500		;MAKE BYTE SIZE 3
NMBIN1:	PUSHJ	P,GETBUF	;GET A CHARACTER
	CAIL	0,"0"		;MUST BE OIT
	CAILE	0,"7"
	JRST	NMBIN2		;NOT NUMERIC
	SUBI	0,"0"		;MAKE BINARY
	TLNE	T1,770000	;STILL ROOM?
	IDPB	0,T1		;YES
	JRST	NMBIN1		;GET NEXT 
NMBIN2:	TLNE	T1,010000	;ODD NUMBER OF 3 BIT BYTES?
	IBP	T1		;YES, MAKE EVEN
	TLC	T1,500		;BACK TO SIXBIT BYTES
	JRST	NM3A		;PROCESS THIS CHAR.
;CHARACTER NOT *,0-9,A-Z
NM5:	CAIG	0,CR		;CARRIAGE RETURN
	CAIGE	0,LF		;LINE FEED
	CAIN	0,ALTMOD	;ALTMODE
	JRST	NM5A		;YES
	CAIN	0,CZ		;END-OF-FILE(CCL)?
NM5A:	JRST	NM5C		;YES, OR EOF
	CAIN	0,COMMA		;COMMA
	JRST	NM6		;YES
	CAIN	0,PERIOD	;PERIOD
	JRST	NM10		;YES
	CAIN	0,COLON		;COLON
	JRST	NM9		;YES
	CAIN	0,";"		;IS THE REST A COMMENT?
	JRST	NM16		;YES
IFN CCLSW,<CAIN 0,"@"		;INDIRECT COMMAND
	JRST	INDRCT		;YES
	CAIN	0,"!"		;RUN COMMAND?
	JRST	RUNIT		;YES>
	CAIN	0,"?"		;WILD CHAR.?
	JRST	WLDCH		;YES, SET UP MASK
	CAIN	0,"^"		;TAPE ID ?
	JRST	ID		;YES
	CAIN	0,"#"		;SPECIAL OCTAL FILE NAME ?
	JRST	NMBIN		;YES
	CAIE	0,LA		;LEFT ARROW
	CAIN	0,"="		;OR EQUALS
	SKIP	1		;YES
	JRST	NM5B		;NO
	TRNE	CALFLG,DEV	;HAS A DEVICE BEEN SEEN?
	TRO	CALFLG,DVSWTH	;YES-NEEDED FOR /Z/,/D
	TROA	CALFLG,SSWTCH!ARWSW	;SET LEFT ARROW SWITCHES
NM5C:	SOS	ESWTCH		;END OF LINE OR FILE
	JRST	NM6A		;BUT NOT COMMA

NM6:	TRNN	CALFLG,ARWSW	;COMMA'S ILLEGAL BEFORE "_"
	JRST	ERR6A		;GIVE MESSAGE
	TRO	CALFLG,COMAFL	;MARK COMMA SEEN, MORE TO COME
NM6A:
IFN FTDSK,<SKIPE PP		;IF PPN ALREADY SET UP
	SKIP	2		;GO ON
	SKIPE	T1,PPP		;GET DEFAULT PPN
	MOVEM	T1,PP		;AS PPN>
	SKIPN	T1,FILEX	;COMMA ROUTINE - FIGURE OUT WHAT WE HAVE
	JRST	NM17		;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
	MOVE	T1,QMASK+1	;GET FILE NAME MASK
	EXCH	T1,QMASK	;INTO RIGHT PLACE
	HLR	T1,T1		;PUT MASK IN BOTH HALVES
	MOVEM	T1,QMASK+1	;SINCE NEEDED IN EITHER HALF
	MOVE	T1,[QMASK,,OQMASK]	;PUT MASK ON OUTPUT SIDE
	TRNE	CALFLG,SSWTCH	;SEEN LEFT ARROW YET?
	BLT	T1,OQMASK+1	;SINCE IT MAY DIFFER FROM INPUT MASK
	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
	SETZM	FILNAM		;FILE NAME OUT OF DATE BY NOW
IFN FTDSK,<SETZM PPP		;CLEAR PERM PPN
	SETZM	DEFPTH		;AND DEFAULT PATH>
	TRO	CALFLG,DEV
	JRST	NM1		;LOOK FOR A FILE NAME AND EXTENSION

NM9:	TRNN	CALFLG,DEV	;COLON ROUTINE - IS DEVICE NAME IN YET?
	JRST	NM12		;NO
	SKIPN	T1,FILNAM	;SCAN OVERSHOOT - NULL OVERSHOOT?
	MOVEI	T1,1		;YES - FLAG NULL OVERSHOOT WITH A 1
	MOVEM	T1,XNAME	;XNAME = OVERSHOOT NAME
	JRST	NM14

ID:	PUSH	P,T1		;SAVE BYTE POINTER
	MOVE	T1,[POINT 6,TAPEID]
ID1:	PUSHJ	P,GETBUF	;ALLOW ALL 6 BIT  CHARS.
	CAIN	0,"^"		;END OF TAPE ID?
	JRST	IDFIN		;YES
	SUBI	0,40		;MAKE SIXBIT
	JUMPL	0,ERR6		;MUST BE SIXBIT
	TLNN	T1,770000	;TOO MANY CHAR.?
	JRST	ERR6		;YES, GIVE ERROR
	IDPB	0,T1		;STORE CHAR.
	JRST	ID1		;GET MORE

NM10:	SKIPE	FILEX		;FILENAME SEEN ALREADY?
	JRST	ERR6		;YES, GIVE COMMAND ERROR
	MOVE	0,FILNAM	;PERIOD ROUTINE - SAVE FILE NAME
	MOVEM	0,FILEX		;TEMPORARILY IN FILEX
	MOVE	0,QMASK		;GET WILD CHAR. MASK
	MOVEM	0,QMASK+1	;SAVE IT ALSO
	JRST	NM2		;LOOK FOR EXTENSION

NM11:	SKIPN	FILNAM		;WAS A FILE NAME SPECIFIED?
	TRNE	CALFLG,DEV	;WAS ANYTHING SPECIFIED?
	POPJ	P,		;YES
NM12:	SKIPE	T1,FILNAM	;NULL NAME SPECIFIED?
	JRST	NM8		;NO - SO REMEMBER AND LOOK FOR FILE NAME

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

NM15:	POINT	6,FILNAM
NM5B:	CAIE	0,TAB		;IGNORE TAB
	CAIN	0,SPACE		;SPACES IGNORED
	JRST	NM3		;IGNORE NOT LEGAL SIXBIT
	PUSH	P,0		;SAVE CHARACTER
	ERRPNX	</?Illegal character />
	POP	P,0		;RECOVER CHAR.
	CAIL	0,SPACE		;INVISIBLE CHAR.?
	JRST	.+4		;NO
	MOVEI	CHR,"^"		;USUAL UP ARROW MARKER
	PUSHJ	P,PUTCON	;OUTPUT TO TTY
	TRC	0,100		;MAKE CHAR. VISIBLE
	MOVE	CHR,0		;NOW FOR THE CHAR.
	PUSHJ	P,PUTCON
	ERRPN2	</ in command!/>

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

IFE FTDSK,<SYN	NM11,NM17>
IFN FTDSK,<
NM17:	MOVE	T1,[QMASK,,OQMASK]	;PUT MASK ON OUTPUT SIDE
	TRNE	CALFLG,SSWTCH	;SEEN LEFT ARROW YET?
	BLT	T1,OQMASK+1	;SINCE IT MAY DIFFER FROM INPUT MASK
	MOVS	T1,FILNAM	;GET EXT
	CAIN	T1,(SIXBIT 'UFD')	;CHECK FOR .UFD
	SKIPN	PP		;AND [PPN]
	JRST	NM11		;NO, NOT A UFD LOOKUP
	MOVSM	T1,FILEX	;EXT IN CORRECT PLACE
	MOVE	T1,PP		;GET PPN
	MOVEM	T1,FILNAM	;INTO FILNAM
	MOVE	T1,PP11		;MFD IS ON [1,,1]
	MOVEM	T1,PP		;FOR DSK LOOKUP
	POPJ	P,>

IFN CCLSW,<
INDRCT:	MOVE	T3,DEVICE	;GET DEVICE
	MOVEM	T3,CCLINI+1	;SET IT UP FOR OPEN
	SKIPN	T3,PP		;SOMEONE ELSES AREA
	SETZ	T3,		;NO, USE OWN
	MOVEM	T3,CFILE+3	;STORE PPN
	MOVE	T3,FILEX	;GET FILE NAME OR EXTENSION
	MOVEM	T3,CFILE	;ASSUME FILE NAME
	MOVE	T3,FILNAM	;GET FILE NAME
	SKIPN	CFILE		;HAVE WE A FILE NAME
	EXCH	T3,CFILE	;PUT IN RIGHT PLACE
	JRST	P12		;STORE EXT 

RUNIT:	TRNE	CALFLG,DEV	;USE SYS IF NO DEVICE SEEN
	SKIPN	T3,DEVICE	;GET DEVICE IF SPECIFIED
	MOVSI	T3,'SYS'
	MOVEM	T3,RUNDEV
	MOVE	T3,FILNAM	;GET FILE NAME
	MOVEM	T3,RUNFIL	;SAVE IT
	PUSHJ	P,GETEND	;DELETE COMMAND FILE
	SKIPN	T3,PP		;SOMEONE ELSES AREA?
	SETZ	T3,		;NO, SO USE OWN
	MOVEM	T3,RUNPP
	MOVEI	16,RUNDEV	;XWD 0,RUNDEV
	SKIPE	COMFLG		;CCL IN PROGRESS?
	HRLI	16,1		;YES START AT C(JOBSA)+1
	RUN	16,
	HALT			;SHOULD NOT RETURN
>

;HERE IF A "?" SEEN IN FILE NAME OR EXTENSION
WLDCH:	TLO	CALFLG,MFLG	;SET FLAG
	TLNN	T1,770000	;6 CHAR. YET?
	JRST	NM3		;YES, NO MORE
	IDPB	0,T1		;DEPOSIT IN NAME
	HRRI	T1,QMASK	;MASK BYTE POINTER
	DPB	0,T1		;PUT IN MASK ALSO
	HRRI	T1,FILNAM	;BACK AS IT WAS
	JRST	NM3		;RETURN FOR MORE

;HERE IF "*" SEEN IN FILE NAME OR EXTENSION
NMSTAR:	SKIPE	(T1)		;NAME BETTER BE ZERO
	JRST	ERR6A		;YOU LOSE
	SETOM	QMASK		;MASK ALL CHARACTERS
	SETOM	(T1)		;AND NAME OF ??????
	TLZ	T1,770000	;MAKE SURE NOTHING ELSE GETS HERE
	TLO	FL,MFLG		;SET FLAG
	JRST	NM3		;BACK FOR MORE
;ROUTINE TO OUTPUT ONE LINE FROM LBUF

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

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

LISTIT:	TLOA	T1,(POINT 7)	;FORM BYTE POINTER
	PUSHJ	P,PUT		;OUTPUT CHAR
	ILDB	CHR,T1		;GET CHAR.
	JUMPN	CHR,.-2		;BACK FOR MORE
	POPJ	P,		;DONE

;ROUTINE TO DUMP OUT BUFFER WHEN FULL

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

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

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

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

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

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

	MOVEI T1,TXTD1
	TRNE IOS,WRTLOK
	JRST PTEXT2

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

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

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

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

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

TXTD1:	ASCIZ /binary data incomplete/
	JRST IOERRG

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

TXTA:	ASCIZ /device error/
	JRST IOERRG

TXTB:	ASCIZ /checksum or parity error/
	JRST IOERRG

TXTC:	ASCIZ /physical eot/
	JRST IOERRG

TXTC1:	ASCIZ /block or block number too large/
	;FALLS THROUGH TO IOERRN

IOERRN:	PUSHJ	P,TCRLF	;OUTPUT A CR-LF ON TTY
	RELEAS TAPE,	;NO RECOVERY ERRORS EXIT HERE
	RELEAS DIR,
	RELEAS OUT,
	RELEAS IN,
	SETZM	TAPEID	;CLEAR REQUEST TO WRITE TAPE ID
	JRST PIP2	;GET NEXT COMMAND

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

;TEST IF /G FLAG(IGNORE ERRORS) SET

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

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

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

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

FN.EX:	MOVE T1,(T3)	;T1=FILENAME
	HLRZ T6,1(T3)	;T6=FILE EXT
	MOVEM T1,DERR2	;STORE FILE NAME
	JUMPE T6,DERR2A	;FILE EXT=0?
	JUMPL T1,DERR2B	;MUST BE SIXBIT, SIGN BIT ON
	CAIE T6,'UFD'
	JRST DERR2B	;NO

	SETZB T1,DERR2	;CLEAR FILE NAME IF 'UFD'
	HLRZ DOUT,(T3)	;YES, GET PROJ. NO.
	MOVEI T2,PUTCON	;PRINT PROJ-PROG. NO.
	MOVEI	CHR,"["	;BETWEEN SQUARE BRACKETS
	PUSHJ	P,PUTCON
	PUSHJ P,OUTOCT	;CONVERT TO ASCII

	MOVEI CHR,COMMA
	PUSHJ P,PUTCON

	HRRZ DOUT,(T3)	;GET PROG. NO.
	PUSHJ P,OUTOCT	;CONVERT TO ASCII
	MOVEI	CHR,"]"
	PUSHJ	P,PUTCON

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




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

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

GETT10:	PUSHJ P,GETNUM	;LOOK FOR PROJECT-PROGRAMMER NUMBER
IFN FTDSK,<SETZM PTHADD	;CLEAR FULL PATH IN CASE ONLY PPN>
	CAILE T7,-1	;GREATER THAN HALF WORD?
	JRST ERR2	;YES, ERROR
	JUMPN	T7,.+4		;NUMBER SPECIFIED?
	CAIN	0,"-"		;CHECK FOR SPECIAL [-]
	JRST	[SETZM	PP	;MEANS [0,0]
		PUSHJ	P,GETBUF	;MAKE SURE ENDS RIGHT
		CAIE	0,"]"
		JRST	ERR2		;NO, GIVE ERROR
		JRST	GETT11]		;OK, USE 0
	HLRZ	T7,MYPPN	;NO, GET IT
	HRLZM T7,PP
	CAIE 0,","	;SEPARATOR?
	JRST GETT11	;OR TERMINATOR (NON-NUMERIC)
	PUSHJ	P,GETNUM	;GET RIGHT HALF
	CAILE	T7,-1		;GREATER THAN HALF WORD
	JRST	ERR2A		;YES, ERROR
	SKIPN	T7		;OTHER THAN 0
	HRRZ	T7,MYPPN	;NO, GET USER'S
	HRRM	T7,PP		;STORE RIGHT HALF
IFN FTDSK,<CAIE	0,","		;SFD'S
	JRST	GETT11		;NO
	PUSHJ	P,GETPTH	;GET FULL PATH>

GETT11:	CAIG	0,CR		;ALLOW END OF LINE
	CAIGE	0,LF		;TO TERMINATE PPN
	JRST	.+3		;NOT CR/LF
	AOS	COMCNT		;ALLOW FOR EXTRA CHAR READ
	JRST	.+3		;AND SKIP TEST
	CAIE	0,"]"		;FORCE CORRECT TERMINATOR
	JRST	ERR2
IFN FTDSK,<SKIPE FILNAM	;IF NO FILE SEEN YET
	JRST	GETCOM	;NOT DEFAULT PPN
	MOVE	T7,PTHADD	;GET FULL PATH FLAG
	MOVEM	T7,DEFPTH	;SET AS NEW DEFAULT FULL PATH
	MOVE	T7,PP	;GET TEMP PP
	MOVEM	T7,PPP	;MAKE PERM>
	JRST	GETCOM	;CONTINUE SCAN

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

GETNUM:	MOVEI T7,0	;TO PICK UP P-P NUMBER
GETN1:	PUSHJ P,GETBUF	;AND PROTECTION
	CAIN 0," "	;IGNORE SPACES
	JRST GETN1
	CAIL 0,"0"
	CAILE 0,"7"
	POPJ P,		;GOT A NON-NUMERIC
	MOVE T5,0
	LSH T7,3
	ADDI T7,-60(T5)	;PROCESS TO BINARY
	JRST GETN1
GETT3:	PUSHJ P,GETT5	;PROCESS SWITCH CHARACTER
	CAIN 0,")"	;CLOSING PAREN?
	JRST GETCOM	;YES
	CAIN 0,"M"	;MTA FLAG?
	TRO FLAG, MTFLG	;SET MTA, LOOK FOR MULTI CHAR. SWITCH
	CAIE 0,"#"	;MTA#
	JRST GETT3	;NO
	TRNN FLAG,MTFLG	;ONLY LOOK AFTER # IF MTFLG IS ON.
	JRST ERR6A	;I.E. IF MT SWITCH IS IN PROGRESS.
	PUSHJ P,GETNUD	;GET A NUMBER
	SKIPN	T7	;SKIP IF NOT EXPLICIT ZERO
	SETO	T7,	;MAKE IT DIFFERENT FROM DEFAULT ZERO
	CAIE 0,"D"	;TERMINATED BY D?
	CAIN 0,"A"	;TERMINATED BY A?
	JRST GETT3A	;YES, MARK AB UPPER
	CAIE 0,"P"	;ONLY A,D,P AND B CAN BE
	CAIN 0,"B"	;PRECEDED BY #.
	SKIP	1
	JRST ERR6A
	HRRM T7,AB	;NO. FILES/RECS TO ADVANCE
			;GOES IN AB (RH)
GETT3B:	PUSHJ P,GETT5A
	JRST GETT3

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

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

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

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

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

;SET TO LOOK AT NON-MTA LETTERS FIRST

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

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

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

	MOVE T5,(T2)	;YES, SET FLAG OR AUXFLG OR MTAREQ
	TLZ	T5,DEL*4000	;CLEAR ASCII CHAR SINCE IT'S NOT A FLAG
	ORM T5,(T6)	;FLAG OR AUXFLG
	TRNE FLAG,MTFLG
	ORM T5,AUX	;MTA REQUESTS SAVED IN AUX
IFE RIMSW,<
	TLNE FLAG,RIMFLG
	JRST RIMTB	;NO RIM IF RIMSW=0
	>		;PRINT ERROR MESSAGE
	POPJ P,		;EXIT ON MATCHING CHAR

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

GETTA:
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	;RESTORE OLD BUFFER LOCS
	HRROM T5,TFO	;USE PREVIOUSLY ASSIGNED I/O BUF. FOR TTY
	INPUT CON,	;GET THE NEXT LINE
	MOVE T5,TFI+2	;SAVE CHAR COUNT
	RELEAS CON,	;LET GO OF TTY FOR USE AS IN-OUT DEVICE
	MOVEM T5,TFI+2	;RESTORE CHAR COUNT LOST DURING RELEASE
GETT2:	ILDB 0,TFI+1	;FETCH CHAR
GETT4:	CAIE 0,ALT175	;OLD ALTMODE?
	CAIN 0,ALT176
	MOVEI 0,ALTMOD	;YES,MAKE NEW ALTMOD
	JUMPE	0,GETTA	;IGNORE NULL CHARS
	CAIL 0,140	;LOWER CASE?
	TRZ	0,40	;YES MAKE UPPER CASE?
	CAIE	0,XON	;IGNORE XON,XOFF ONLY FOR
	CAIN	0,XOFF	;TTY SERVICE TO SIGNAL TTY
	JRST	GETTA	;PTR READ IN MODE
	POPJ P,

;ROUTINE TO GET ONE TTY CHAR FROM COMBUF INTO AC0

GETBUF:	IFN CCLSW,<
	SKIPE COMFLG	;CCL COMMAND?
	JRST GETSC	;YES, GET CHARS FROM DSK, CORE>
	SOSGE COMCNT	;ANY CHARS LEFT?
	JRST ERR6B	;NO, COMMAND ERROR
	ILDB 0,COMPTR	;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
	IN	COM,
	JRST	GETSC0		;NO ERRORS
	STATZ	COM,EOFBIT	;END-OF-FILE
	JRST	GETEND		;YES
	ERRPNT	</Read error-CCL command file!/>
GETSC0:	ILDB	0,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. IGNORE SEQ. NO.
	ADDM	DOUT1,CFI+2	;SUBTRACT 5 FROM COUNT FOR SEQ. NO.
	JRST	GETSC		;CONTINUE

GETEND:
IFN TEMP,<SKIPE TMPFLG		;TMPCOR
	JRST	GETEN3		;YES>
	SKIPN	COMFLG		;CCL END OF CS?
	JRST	GETEN2		;NO
GETEN1:	CLOSE	COM,		;NO, DSK FILE CCL
	SETZ	0,		;DIRECTORY ENTRY FOR RENAME
	HLRZ	1,CFILE+1	;GET EXT
	CAIN	1,'TMP'		;IF EXT IS TMP
	RENAME	COM,0		;WIPE OUT COMMAND FILE
	  JFCL
	RELEASE	COM,0		>
GETEN2:	SETOM	COMEOF		;INDICATE END OF FILE
	MOVEI	0,CZ		;NEEDED TO TERM CCL CS SCAN
	POPJ	P,
IFN TEMP,<
GETEN3:	MOVE	1,[XWD 2,TMPFIL]
	TMPCOR	1,		;READ AND DELETE
	  JFCL			;NOT FOUND
	JRST	GETEN2		;CONTINUE>
;TABLE OF RECOGNIZED COMMAND LETTERS AND CORRESPONDING FLAG BITS
DEFINE DISP (A,B,C)
<	XWD <<"A">*4000>!C,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 I,MTIFLG
	DISP S,MTSFLG
	DISP #,0
	OCT 000000000000
;1ST BYTE 0=END OF DISPTB
;------------------------
;COMMAND STRING LETTERS AND FLAG BITS. TABLE 2 (AUXFLG)
DISPTA:	DISP Q,,QFLG
	DISP E,,CDRFLG
	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
	DISP D,DFLG
	DISP G,,GFLG
	DISP H,,IBFLG
	DISP I,,IFLG
	DISP J,,JFLG
IFN FORSW,<DISP K,BMOD,KFLG>
	DISP L,LFLG
	DISP M,0
	DISP ),0
	DISP N,NSMOD
	DISP O,SQMOD+NSMOD+STS+OSFLG
	DISP P,,PFLG!PCONV
	DISP R,RFLG
	DISP S,SQMOD+NSMOD+STS
	DISP T,SPMOD
	DISP U,,OFLG
	DISP V,LINE,CHKFLG
	DISP W,,WFLG
	DISP X,XFLG
	DISP Y,,IBFLG!RIMFLG
	DISP Z,ZFLG
	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	CHR,IBF+1	;GET FIRST CHAR OF THIS LINE
	CAIG	CHR,15		;PREPARE TO OUTPUT A CR,LF
	CAIGE	CHR,12		;IS FIRST CHAR OF LINE AN END OF LINE CHAR?
	JRST	[TRNE	CALFLG,SQNSN	;REPLACING OLD SQ. NUM.?
		TRZA	FLAG,ESQ	;YES, SO DON'T REPEAT CHAR.
		MOVEI	CHR,TAB		;NO, SO OUTPUT A TAB
		JRST	.+2]		;SKIP RETURN
	MOVEI	CHR,15		;END OF LINE, NO TAB
	TRZ FLAG,SUS	;TURN OFF SUS SUPPLY
	JRST	GETA5
GET5:	AOS IBF+1	;HERE IF A SEQ NUM FOUND IN INBUFFER
	TRO	CALFLG,SQNSN	;SIGNAL SQ. NUM. SEEN
	MOVNI T1,5	;IGNORE SEQ NUM, AND DECREMENT CHAR COUNT
	ADDB T1,IBF+2
	TRNE FLAG,NSMOD	;REMOVE SEQ NUMS MODE?
	JRST GET2A	;YES, SO GET NEXT CHAR
	MOVEM T2,SQNUM	;SEQ NUM FROM BUFFER BECOMES NEW SEQ NUM
	PUSHJ P,OUTLBF	;DUMP THE LINE BUFFER (IF REQUIRED)
	TRON FLAG,STS+SNI	;TURN ON START OF LINE
			;AND NO-INCREMENT SEQ NUM FLAG
	PUSHJ P,CLRBUF	;CLEAR LBUF IF IN THE MIDDLE OF A LINE
	JRST	GET1	;GET CHAR. AFTER SEQ. NUMBER

GET2A:	TRNN	FLAG,SQMOD	;IF RESEQUENCING COPY FIRST CHAR.
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
REPEAT 0,<	;REMOVED UNTIL CORRECT FIX FOUND
;EDIT #107	SPR 7795
	TRNE	FLAG,SQMOD	;SEQUENCED?
	TRNN	FLAG,NSMOD	;AND REMOVING?
	JRST	GET2		;NO, SO PROCESS INBUFFER
	IBP	IBF+1		;IGNORE TAB
	SOS	IBF+2
>;END OF REPEAT 0
	JRST	GET2

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

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

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

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

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

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

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

	TRNN IOS,BIGBLK	;BLOCK NO. TOO LARGE?
	JRST QUEST2	;NO
	TRNN AUXFLG,DTAIN+DTAOUT	;YES
	MOVEI	CHR,"%"	;WARNING SYMBOL
	JRST PUTCON	;DEPOSIT "?" FATAL EVEN IF /G ON

QUEST2:	TRNE IOS,WRTLOK	;WRITE LOCKED?
	TRNN AUXFLG,DTAIN+DTAOUT+MTAIN+MTAOUT+DSKOUT
	MOVEI	CHR,"%"	;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
	CAIN CHR,SPACE	;SPACE?
	JRST GETA2	;YES
	CAIN CHR,CR	;CAR. RET.?
	JRST GETA3	;YES
	TLNE AUXFLG,CDRFLG
	JRST GET7B	;CARD READER INPUT
GET7C:	TRZ FLAG,SPOK	;CHAR NOT A SPACE STOP COUNTING CONSEC. SPACES
	CAIN CHR,TAB	;TAB?
	JRST GETA5	;KEEP TRACK OF TAB STOPS
	CAIGE	CHR,DEL
	CAIGE CHR,SPACE	;NON-SPACING CHARACTER?
	JRST CPOPJ1	;YES, SO RETURN IMMEDIATELY
	SOSG TABCT	;COUNT DOWN THE TAB STOP COUNTER
	JRST GETA5	;RESET THE COUNTER IF TAB STOP IS PASSED
CPOPJ1:	AOSA	(P)	;SKIP RETURN
CPOPJZ:	SETZ	IOS,	;CLEAR IOS JUST IN CASE
CPOPJ:	POPJ	P,


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

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

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

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

ERR382:	ERRPN2	</illegal format!/>

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

ERR9:	MOVEI T3,DTON
IFN FTDSK,<MOVEI T7,4		;REALLY ERROR TYPE 4
	SKIPE	DTON		;UNLESS FILE NAME IS ZERO
	JRST	DERR4		;NOT, SO USE DSK ERROR ROUTINES>
	ERRPNT	</?/>
	PUSHJ P,FN.EX
IFE FTDSK,<SKIPN DTON		;SKIP IF NON-ZERO FILE NAME>
	JRST	ERR4B
IFE FTDSK<ERRPNT </(4) rename file name already exists!/>>
ERR1:	SKIPA T2,ODEV	;OUTPUT UNAVAILABLE
ERR1A:	MOVE T2,DEVICE	;INPUT UNAVAILABLE
ERR1B:	ERRPNT	</?Device />
	PUSHJ	P,P6BIT
		T2
	ERRPN2	</ not available!/>
ERR3:
IFN FTDSK,<TRNE AUXFLG,DSKIN
	JRST DERR5	;ERR ON DSK>
	PUSHJ P,ERR3A
	JRST IOERRN	;EXIT
ERR3A:	SKIPN	FILNAM		;IF FILE NAME IS ZERO
	JRST	ERR4B		;GIVE ILLEGAL FILE NAME MESSAGE
	TRNE	FLAG,DFLG	;DELETING?
	JRST	ERR3AD		;YES, GIVE NON-FATAL MESSAGE
	ERRPNT	</? />		;NO, FATAL
ERR3AB:	ERRPN2	</No file named />
	SKIPN	T3,QMASK	;USING WILD CHAR. ?
	JRST	ERR3AX		;NO
	ANDCAM	T3,FILNAM	;CLEAR GARBAGE CHARS.
	AND	T3,['??????']	;CREATE MASK OF ??S
	IORB	T3,FILNAM	;FILL IN FILE NAME
	CAME	T3,['??????']	;BUT IF ALL CHARS ARE WILD
	JRST	ERR3AX		;NOT
	MOVSI	T3,'*  '	;USE *
	MOVEM	T3,FILNAM
ERR3AX:	SKIPN	T3,QMASK+1	;SAME FOR EXT
	JRST	ERR3AY
	ANDCAM	T3,FILNAM+1
	AND	T3,['??????']
	IORB	T3,FILNAM+1
	CAME	T3,['??????']	;BUT IF ALL CHARS ARE WILD
	JRST	ERR3AY		;NOT
	MOVSI	T3,'*  '	;USE *
	MOVEM	T3,FILNAM+1
ERR3AY:	MOVEI	T3,FILNAM
	PUSHJ	P,FN.EX	;PRINT NAME OF FILE THAT CANNOT BE FOUND
	PUSHJ	P,INFO2		;OUTPUT MESS. WITH CR-LF
	TRNN	AUXFLG,TTYIN!TTYOUT	;WAS TTY IN USE?
	POPJ	P,		;NO
	TRNE	AUXFLG,TTYIN	;INPUT DEVICE?
	JRST	ININIT		;YES ,RE-INIT
	JRST	OMODE		;MUST BE OUTPUT

ERR3AD:	ERRPNT	</% />		;NON-FATAL
	JRST	ERR3AB		;AND COMMON MESSAGE

ERR4:	SKIPN DTON
	JRST ERR4A
	HRRZ	T7,DTON+1	;MIGHT BE ILL FILE NAME
	TRNE	AUXFLG,DSKOUT	;ON DSK
	JUMPE	T7,ERR4A	;FULL OF ? WILD CARDS
IFN FTDSK,<TRNE AUXFLG,DSKOUT	;ERR ON DSK
	JRST DERR6>
	ERRPNT	</?/>
	PUSHJ	P,P6BIT
		ODEV		;OUTPUT DEVICE
	ERRPN2	</: />
	MOVEI	T3,DTON
	PUSHJ	P,FN.EX		;GIVE NAME.EXT
	ERRPN2	</enter failure!/>
ERR4A:
ERR4B:	ERRPNT	</?(0) Illegal file name!/>

ERR6:	SETZM	TAPEID		;CLEAR ID TO PREVENT LOOP
ERR6A:	ERRPNX	</?PIP command error!/>

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

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

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

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

CHECK1:	TRZ AUXFLG,DTAIN+DSKIN+CDRIN+PPTIN+TTYIN+MTAIN
	MOVE 0,DEVICE	;INPUT DEVICE NAME TO AC 0
	JUMPE 0,CHECK	;IGNORE IF NO INPUT DEVICE
IFN FTDSK,<PUSHJ P,PSYSP	;CHECK IF DEVICE IS SYS:>
	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	;GET DEVICE
	POP	P,ADSK		;AND SAVE IT FORDIRECTORY READ
	JRST	CHECK>

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

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

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

	TLNE 0,DTABIT	;DECTAPE?
	TRO AUXFLG,DTAIN

	TLNE 0,MTABIT	;MAGTAPE?
	TRO AUXFLG, MTAIN

	TLNE CDRBIT	;CARD READER?
	TRO AUXFLG,CDRIN

	TLNE 0,TTYBIT	;TELETYPE?
	TRO AUXFLG,TTYIN

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

PRETXT:	IFN CCLSW,<
	SKIPN	COMFLG	;IN CCL MODE
	JRST	PTEXT	;NO, SO DON'T BOTHER
PRTXT1:	PUSHJ	P,GETBUF	;GET A CHAR.
	CAIG	0,FF	;TEST FOR LF, VT, FF
	CAIGE	0,LF
	JRST	PRTXT1	;NOT A LINE TERMINATOR>
PTEXT:	TRNE	AUXFLG,TTYOUT	;OUTPUT DEVICE TTY?
	OUTPUT	OUT,		;YES, OUTPUT LAST LINE
	JSP T5,INICN2	;INITIALIZE THE TTY
	PUSHJ	P,TCRLF	;OUTPUT A CR-LF
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	PTEXT3		;YES, END OF MESSAGE
	IDPB 0,TFO+1	;DEPOSIT CHAR IN OUTBUFFER
	JRST PTEXT1	;GET NEXT CHAR

PTEXT3:	TRZN	CALFLG,RTRNFL	;FATAL
	JRST	IOERRN		;YES, END OF MESSAGE, APPEND CAR.RET., LF
	PUSHJ	P,TCRLF		;END WITH CR-LF
	TRNE	AUXFLG,TTYOUT	;NEED TO RE-INIT TTY FOR OUTPUT?
	PUSHJ	P,OMODE		;YES
	TRNE	AUXFLG,TTYIN	;OR TTY INPUT?
	PUSHJ	P,ININIT	;YES
	POPJ	P,

;ROUTINE TO DEPOSIT CHARACTER IN TTY OUT BUFFER

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

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

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

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

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

;ROUTINE TO WRITE ID IN DTA

	SYN	QMASK,DDIOW	;SAVE SPACE
WRTID:	MOVEI	0,117		;NON-STANDARD DUMP MODE
	MOVEM	0,OMOD		;IN OPEN DATA
	SETZM	OMOD+2		;NO BUFFERS
	OPEN	DD,OMOD		;INIT DEVICE
	  JRST	ERR1		;NOT AVAILABLE
	USETI	DD,144		;SET ON DIRECTORY
	HRRZ	T1,.JBFF	;GET CURRENT TOP OF FREE CORE
	ADDI	T1,200		;DIRECTORY BUFFER
	CAMLE	T1,.JBREL	;WILL IT FIT
	JSP	T4,MORCOR	;NO, GET SOME
	SUBI	T1,201		;IOWD ADDRESS
	HRLI	T1,-200		;NUMBER OF WORDS
	MOVEM	T1,DDIOW	;STORE I/O WORD
	SETZM	DDIOW+1		;TERMINATE LIST
	INPUT	DD,DDIOW	;DO INPUT
	MOVE	0,TAPEID	;GET ID
	MOVEM	0,200(T1)	;PUT IT IN DIRECTORY
	USETO	DD,144		;SET TO WRITE IT OUT
	OUTPUT	DD,DDIOW	;OUT IT GOES
	RELEAS	DD,0		;CLEAR DIRECTORY IN CORE BIT
	SETZM	TAPEID		;SO WE DON'T COME BACK TOO OFTEN
	POPJ	P,
;ROUTINE TO SET UP TO COPY EVERYTHING

PRECOP:IFN TEMP,<
	TRNE	CALFLG,TMPI	;INPUT DEV. IS TMPCOR?
	JRST	TMPIN		;YES>
	TRO	CALFLG,FNEX	;/X IMPLIES MANY FILES
	PUSHJ	P,ININIT	;INIT INPUT FILE
	TRNN	AUXFLG,DTAIN	;DECTAPE INPUT
	SKIP	2		;NO
	PUSHJ	P,DTCH2		;YES, GET DIRECT, SET POINTERS TO DIRECT

DTCOPY:	PUSHJ	P,DTADI1	;START (T5)
IFN FTDSK,<TRNE	AUXFLG,DSKIN	;DSK INPUT. ENTER HERE FROM DTD2
	PUSHJ	P,DSKDIR	;YES, PREPARE TO LOOKUP FILES
	  JFCL>
COPY1A:	MOVEI	T2,6		;FILL 0 CHARS. IN DEST-FILE
	MOVE	T1,[POINT 6,DTON]	;NAME WITH X'S. THIS IS
	TRNN	FL,RXFLG	;TWO NAMES GIVEN?
	JRST	.+3		;NO
	MOVE	0,[FILNAM,,DTON]	;GET INPUT FILE NAME
	BLT	0,DTON+1	;AS OUTPUT
	MOVE	0,QMASK		;GET INPUT MASK
	ANDCAM	0,DTON		;AND CLEAR WILD CHARACTERS
	HLLZ	0,QMASK+1	;SAME FOR EXT
	ANDCAM	0,DTON+1
XSS:	ILDB	0,T1		;THEN THE BASE FOR GENERATED
	JUMPN	0,.+2		;DESTINATION FILES FROM
	MOVEI	0,"X"-40	;NON-DIR. DEVICES IN /X
	DPB	0,T1
	SOJG	T2,XSS		;DON'T YET KNOW IF ONE
				;OF THE INPUT DEV. WILL BE NON-DIR
	MOVE	0,[DTON,,DTONSV]
	BLT	0,DTONSV+1

COPY1:	PUSHJ   P,SR2		;SET INIT. COPYING MODE
	PUSHJ	P,LOOK		;GET A FILE TO COPY
	  JRST	CAL6		;NO MORE
IFN FTDSK<PUSHJ	P,XDDSK		;GOT ONE, CHECK (XD) FROM DSK, NAMTAB
	JRST	COPY1		;IN LIST, DON'T COPY>
	TRNN	AUXFLG,MTAIN+PPTIN+CDRIN+TTYIN	;OK, COPY FILE
	JRST	COPY6A		;MUST BE DIRECTORY DEVICE
	PUSHJ	P,MTPTCR	;SET UP A DEST. FN.
	JRST	COPY6
COPY6A:
IFN FTDSK,<PUSHJ P,SETPTH	;SEE IF FULL PATH
	  MOVEM	0,ZRF+3		;YES, USE IT>
	LOOKUP	IN,ZRF		;LOOKUP INPUT FILE NAME
	  JRST	CAL5		;INPUT FILE FILE PROTECTED
COPY6:	PUSHJ	P,FILTYP	;CHECK FOR DMP,SAV,REL,CHN
	TRNN	AUXFLG,DSKIN!DTAIN	;ALLOW NULL FILE ON DIRECTORY DEVICES
	PUSHJ	P,COPY3		;INPUT FIRST BLOCK AND CHECK FOR EOF
COPY6B:	MOVE	0,ZRF		;INPUT FILE NAME
	MOVEM	0,DTON		;IS OUTPUT FILE NAME
	HLLZ	0,ZRF+1		;LIKEWISE EXT
	HLLZM	0,DTON+1

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

	SETZM	DTON+2		;CLEAR DATE. OUTPUT FILE, DSK/DTA
	LDB	0,DATE		;GET DSK/DTA DATE CREATED
	TDNN	FLAG,[XWD PFLG+WFLG,LINE+TBMOD+NSMOD+SQMOD+SPMOD]
	TLNE	AUXFLG,CDRFLG
	JRST	COPY6C
	DPB	0,DATED		;DEPOSIT IF NO EDITS
IFN FTDSK,<LDB	0,TIME
	TRC	AUXFLG,DSKIN+DSKOUT
	TRCN	AUXFLG,DSKIN+DSKOUT
	DPB	0,TIMED		;DSK TO DSK TIME>
COPY6C:	PUSHJ   P,OKBLKS	;SETUP 1K BLOCKS
IFN FTDSK,<SKIPE LEVEL		;IF LEVEL D
	TLNN	AUXFLG,NSPROT	;AND NON-STANDARD PROTECTION
	JRST	.+3		;NOT BOTH TRUE
	LDB	0,PRPTL		;GET PROTECTION CODE
	DPB	0,PRPTD		;INTO ENTER BLOCK>
	GETSTS	OUT,T1		;GET OUTPUT STATUS
	LDB	T2,[POINT 4,ZRF+2,12]	;GET INPUT MODE
	SETSTS	OUT,(T2)	;SET OUTPUT TO IT
	PUSHJ	P,CHKDTON	;MAKE SURE NO WILD CARDS LEFT
	ENTER	OUT,DTON	;GOT DATA, CREATE NEW FILE
	  JRST	ERR4		;DIRECTORY FULL
	SETSTS	OUT,(T1)	;BACK TO ORIGINAL STATUS
	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+WFLG+IFLG+IBFLG,LINE+BMOD+TBMOD+NSMOD+SQMOD+SPMOD]	
	JRST	PSCAN		;YES, DO IT
	TRNE	AUXFLG,LPTOUT!TTYOUT
	TLNE	CALFLG,OSPLFL	;IS IT HARD COPY BUT NOT SPOOLED
	JRST	COPY5		;NO
	JRST	PSCAN		;YES, MAKE SURE CONTROL CHARS. ARE HANDLED
COPY5:	SOSGE	IBF+2		;INPUT BUFFER EMPTY?
	JRST	COPY4		;YES
	ILDB	CHR,IBF+1	;GET NEXT WORD AND
	PUSHJ	P,PUT		;OUTPUT IT
	JRST	COPY5
COPY4:	PUSHJ	P,COPY3		;GET NEXT FULL SOURCE BLOCK
	PUSHJ   P,OUTP		;OUTPUT PREV. BLOCK-DONT ALTER DATA
	AOS	OBF+2		;MAKE PUT HAPPY BECAUSE OF
	JRST	COPY5		;OUTPUT HERE.
COPY2A:	CLOSE	IN,
	CLOSE	OUT,
IFN FTDSK,<TLNE	AUXFLG,NSPROT	;NON-STANDARD PROTECTION?
	TRNN    AUXFLG,DSKOUT	;RENAME ALL OUTPUT FILES IF
	JRST    COPY2B		;NON-STANDARD PROTECTION
	LDB	0,PRPTL		;GET NEW PROTECTION
	SKIPE	LEVEL		;IF LEVEL D
	JUMPN	0,COPY2B	;AND NOT ZERO, DONE ALREADY
	DPB	0,PRPTD
	PUSHJ	P,SETPTH	;SEE IF FULL PATH
	  MOVEM	0,DTON+3	;NON-SKIP RETURN, USE IT
	RENAME  OUT,DTON	;RENAME OUTPUT FILE
	  JRST	DERR6>
COPY2B:	PUSHJ	P,OUTP1
	JRST	COPY1		;GO GET NEXT FILE

IFE FTDSK,<SYN	COPY1,CAL5>
IFN FTDSK,<
CAL5:	PUSHJ	P,DERR5R	;PRINT DSK ERROR TYPE
	JRST	COPY1		;COUNT READ FAILURES>

;NO MORE FILES TO COPY

CAL6:	TLZ     AUXFLG,NSPROT
	JRST	MAIN1	

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

COPY3:	PUSHJ   P,INP		;READ NEXT BLOCK
	TRZE    AUXFLG,READ1
	PUSHJ   P,TTYZ		;END OF FILE FROM TTY?
	TRNN    IOS,EOFBIT	;END OF FILE? IOS HAS STATUS BITS
	JRST    COPY3B		;NO.
	POP	P,0		;CLEAR ITEM FROM STACK
	HRRZS	0		;ADDRESS ONLY
	TRNN	AUXFLG,DSKIN!DTAIN	;ALLOW NULL FILE FOR THESE ONLY
	CAIE	0,COPY6B	;DID WE COME FROM COPY6B-1?
	JRST	COPY2A		;NO, CLOSE OUT FILES
	TRZ	CALFLG,ALLCLF	;YES, END OF INFO ON NON-DIR DEVICE
	JRST	COPY1

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

MTPTCR:	TRNE	FL,RXFLG	;OUTPUT NAME SEEN?
	HLLOS	OQMASK		;YES, ONLY USE FIRST 3 CHARS.
	AOS T1,NO.
	CAILE T1,^D999
	JRST MPC2
	PUSHJ P,MTPTC1
	MOVE	0,[DTONSV,,ZRF]	;FILNAM=DTON IS ONLY WAY TO IDENTIFY
	BLT	0,ZRF+1		;INPUT FILE
	POPJ P,

MPC2:	ERRPNT <Z?Terminate /X, max. of 999 files processed!Z>

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

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

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

;ROUTINE TO SEE IF ^Z FIRST CHAR ON TTY

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

OKBLKS:	TRNN	CALFLG,RXFLG	;(RX)?
	JRST	OKBLK0		;NO
	MOVE	0,MATCH		;GET FILE NAME
	HLRZ	T1,MATCH+1	;AND EXT.
	MOVEM	0,DTON		;REPLACE NAME
	HRLM	T1,DTON+1
	SKIPN	T1,OQMASK	;WILD CARD OUTPUT
	JRST	.+4		;NO
	ANDCAM	T1,DTON		;CLEAR OUT MASK CHARS
	AND	T1,ZRF		;GET SUBSTITUTE ONES
	ORM	T1,DTON		;PUT THEM IN
	HLLZ	T1,OQMASK+1	;TRY EXT
	JUMPE	T1,.+4		;NO
	ANDCAM	T1,DTON+1	;SAME AS ABOVE
	AND	T1,ZRF+1
	ORM	T1,DTON+1
OKBLK0:	MOVE	0,DTON		;GET OUTPUT FILE NAME
REPEAT 0,<
	HLRZ	T1,DTON+1	;AND EXT
	CAIE	T1,'SAV'	;SAV FILE?
	CAIN	T1,'SVE'	;OR SVE (SPMON) FILE?
	TRNN	AUXFLG,DTAOUT	;AND OUTPUT TO DTA?
	SKIP	1		;NO
	UGETF	OUT,0		;SET TO FIRST FREE BLOCK
>	;END OF REPEAT 0
IFN FTDSK,<TRC	AUXFLG,DSKIN+DSKOUT	;DSK I/O
	TRCN	AUXFLG,DSKIN+DSKOUT
	POPJ	P,			;YES, EXIT
	TRC	AUXFLG,DTAIN+DTAOUT	;NO
	TRCE	AUXFLG,DTAIN+DTAOUT	;DTA I/O
	JRST	OKBLK1			;NO>
	LDB	0,OKB			;DTA I/O - 1K BLKS
	DPB	0,OKBD			;DEPOSIT IN DTON
	POPJ	P,

IFN FTDSK,<
OKBLK1:	TRC	AUXFLG,DTAIN+DSKOUT	;DTA-TO-DSK
	TRCN	AUXFLG,DTAIN+DSKOUT
	POPJ	P,			;YES
	TRC	AUXFLG,DSKIN+DTAOUT	;NO,DSK-TO-DTA?
	TRCE	AUXFLG,DSKIN+DTAOUT	;NO
	POPJ	P,
	HLRZ	0,ZRF+1			;YES DSK-TO-DTA
	CAIE	0,'SAV'		;GET LOOKED UP EXT,(INPUT).
	CAIN	0,'SVE'
	SKIP	1
	POPJ	P,
	HLRO	T1,ZRF+3		;EXTENSION=SAV
	MOVNS	T1			;WORD COUNT
	IDIVI	T1,2000			;DIVIDE BY 1K CORE(OCTAL LOCS.)
	JUMPN	T2,.+2
	SOJ	T1,			;N-1
	DPB	T1,OKBD
	POPJ    P,>

IFN FTDSK,<
;ARE WE DOING (XD) FROM DSK? IF NOT, EXIT.
;SEE IF CURRENT FILE SELECTED IN ZRF IS IN THE
;LIST OF FILES NOT TO BE COPIED. (POPJ IF IT IS)

XDDSK:	TRC	FLAG,XFLG+DFLG		;COMPLEMENT
	TRCN	FLAG,XFLG+DFLG		;RESET AND TEST
	TRNN	AUXFLG,DSKIN		;/X AND /D WERE SET
	JRST	CPOPJ1			;NOT DSKIN SO COPY FILE
	HRROI	T1,-12			;SET TO LOOP NAMTAB
XDDSK2:	MOVE	T2,ZRF			;GET FILE NAME
	SKIPN	T3,NAMTAB+12(T1)	;END OF TABLE ENTRIES?
	JRST	CPOPJ1			;YES, EXIT
	IOR	T2,QMASK		;MASK OUT WILD CHARS
	CAME	T2,T3			;FN IS * 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
	IOR	T2,QMASK+1		;MASK OUT WILD CHARS
	CAMN	T2,T3			;EXT IS * OR MATCH?
	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:	IFN TEMP,<
	TRNE	CALFLG,TMPO	;TMPCOR
	JRST	TMPDEL		;YES>
	TRNE	FLAG,XFLG	;/X
	JRST    DELE1		;YES
	TRNN	FLAG,DFLG	;/D NEED EXPLICIT DEVICE
	SKIP	2
	TRNN	CALFLG,DVSWTH	;-1 IF DEVICE SEEN
	JRST	ERR8		;NO, ERROR
	MOVE	0,ODEV		;OUTPUT DEVICE
	MOVEM	0,DEVICE	;NO,SET DEVICE FOR INPUT
	MOVEM   0,DEVA
DELE1:	PUSHJ	P,CHECK1	;RESET INPUT DEVICE DESCRP
	MOVE   0,[DTON,,NAMTAB]	;FOR /R GET NEW NAME
	 			;SET TO BLT OUTPUT DIRECT ENTRY
	BLT     0,NAMTAB+3	;TO NAMTAB

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

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

	PUSHJ	P,INFO		;WRITE "FILES DELETED/RENAME

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


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


DELE3:	PUSHJ	P,LOOK		;GET FILE TO DELETE OR RENAME FROM CS
	  JRST	DELE5		;NO MORE FILES
	TRNN	FLAG,XFLG	;/X?
	PUSHJ	P,INFO3		;PRINT FILENAME-EXT
	MOVE	T1,DIRST	;GOT A MATCH - PROCESS IT
	TRNE	FLAG,RFLG	;AND IT IS AT (T5) IN (DTA) DIR
	JRST	DTRNAM		;RENAME
	SETZM   (T1)		;DELETE FILENAME IN CORE DIRECT
	SETZM   26(T1)		;DELETE EXT
	TRNE	FLAG,XFLG	;(DX)?
	JRST	DELE3		;YES, DON'T ACTUALLY DELETE FILE FROM TAPE
	LOOKUP	OUT,ZRF		;DO LOOKUP
	  JRST	DELE3		;SHOULD NEVER FAIL
	SETZM	DTON		;SET NAME TO ZERO
DELE4:	RENAME	OUT,DTON	;GET RID OF IT
	  JRST	ERR9		;SHOULD NEVER HAPPEN EITHER
	JRST	DELE3		;GET NEXT FILE NAME

DELE5:	MOVE	T1,IBF		;LOC OF INPUT BUFFER
	TRNE	FLAG,XFLG	;DX SWITCH?
	JRST	DTD6		;YES, NOW MUST COPY REMAINING FILES
	RELEAS	CON,		;OUTPUT DELETE OR RENAME INFO TO TTY
	JRST	MAINB
;ROUTINE TO RENAME FILE ON DECTAPE

DTRNAM:	PUSHJ   P,RENAME	;SET UP FILE NAME
	SETZM   DTON+3		;
	SKIPE	DTON		;JUST INCASE 0 FILE NAME
	LOOKUP  OUT,ZRF		;LOOK UP FILENAME-EXT ON OUTPUT DEV
	  JRST	DELE3		;SHOULD NEVER FAIL
	JRST	DELE4		;RENAME TO NEW NAME

;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:	SETOB	0,FILNAM	;FORCE COPY-ALL
	HLLZM	0,FILEX		;BY MAKING FILE-EXT=*.*
	SETOM	QMASK		;AND MASKS
	HLLZM	0,QMASK+1
	SETOM	OQMASK		;SAME FOR OUTPUT SIDE
	HLLZM	0,OQMASK+1
	TLO	FL,MFLG		;SET FLAG ALSO
	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.*
;ALSO MUST HANDLE WILD CARD MASK

RENAME:	SKIPL	ESWTCH		;SKIP IF CR,LF SEEN IN C.S.
	JRST	ERR6A		;ONLY 1 SOURCE FILE DESCRIPTOR ALLOWED
	SKIPN	T2,NAMTAB	;AN OUTPUT NAME SPECIFIED?
	JRST	RENAM0		;NO, USE INPUT
	MOVEM	T2,DTON		;STORE IT
	MOVE	0,OQMASK	;WILD CHARS.
	JUMPE	0,.+4		;NO
	ANDCAM	0,DTON		;YES, CLEAR FROM OUTPUT NAME
	AND	0,ZRF		;PICKUP FROM INPUT NAME
	ORM	0,DTON		;PUT IN OUTPUT
	HLLZ	0,NAMTAB+1	;USER SUPPLIED EXT
	MOVEM	0,DTON+1
	HLLZ	0,OQMASK+1	;SAME FOR EXT
	JUMPE	0,.+4		;NO CHARS.
	ANDCAM	0,DTON+1
	AND	0,ZRF+1
	ORM	0,DTON+1
	SETZM	DTON+2		;LET MONITOR SUPPLY
	POPJ	P,

RENAM0:	MOVE	0,[XWD ZRF,DTON];NO NAME SET SO USE LOOKUP NAME
	BLT	0,DTON+2	;AND EXT SO FILE NOT DELETED
	POPJ	P,


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

LOOK:	TRNE	CALFLG,NSWTCH	;NULL NAME?
	SKIPN	TAPEID		;AND TAPE ID SEEN?
	JRST	LOOK0		;NO
	SETZM	GENERI		;YES, SAVES TIME
	TRO	AUXFLG,REDFLG	;FAKE SO COMMAND WILL BE ERROR FREE
	TRO	CALFLG,ASTFLG	;SAME AGAIN
	POPJ	P,		;RETURN TO WRITE ID

LOOK0:	TRNE	CALFLG,FNEX	;DOES FILNAM, FILEX CONTAIN
	JRST	LOOK6		;A FILE TO THINK ABOUT? YES
LOOK01:	PUSHJ	P,LOOKA		;GET ONE (NOTE: DEVICE MAY ALTER)
	  POPJ	P,		;NONE, END OF CS
		 		;RETURN SKIP FROM LOOKA
LOOK6:	MOVE    T2,FILEX	;GET FILE EXT INTO T2
	SKIPN   T1,FILNAM	;FILNAME AND EXT=0?
	JUMPE	T2,LOOK7C	;FN.EX=0, ONE FILE COPY
	TLNE	CALFLG,MFLG	;WILD CHAR. MASKING?
	JRST	LOOK1		;YES, ALLOW FOR MANY FILES

	TRNE	AUXFLG,DTAIN+DSKIN	;DONT REQUIRE FILENAME
	JUMPE	T1,LOOK6C	;HERE FOR 0.EX,FN.EX OR FN.0,0.EX ILLEGAL
LOOK7B:	TRZ     CALFLG,FNEX	;IF HERE, ONLY ONE FILE WAS ENTAILED IN REQUEST.
	TRNN	AUXFLG,DTAIN+DSKIN
	JRST	LOOK4		;GOT A FILE TO HANDLE
	TRNE	FLAG,DFLG!RFLG	;/R OR /D ?
	JRST	LOOK8		;YES, MUST SCAN DIRECTORY IN THAT CASE
	MOVE	T1,[FILNAM,,ZRF]	;SET UP NAME AND EXT
	BLT	T1,ZRF+1	;IN LOOKUP BLOCK
	MOVE	T1,PP		;AND PROJ-PROG #
	MOVEM	T1,ZRF+3	;ALSO
	JRST	CPOPJ1		;OK RETURN

LOOK8:	PUSHJ	P,PICUP		;GET A FILE (ANY) FROM DIRECTORY
	  JRST	LOOK2		;WE GOT A FILE, DOES IT MATCH?
LOOK6C:
LOOK6D:
IFN FTDSK,<SKIPE GENERI		;SEARCHING F/S ?
	POPJ	P,		;YES, WAIT TIL END OF F/S SEARCH LIST>
	TRZ	FL,FNEX		;CLEAR  FLAG (FOR LOOK0:)
	TRZN	FL,ASTFLG	;DID WE FIND AT LEAST ONE
	PUSHJ	P,ERR3A		;NO, PRINT MSG.
	JRST	LOOK		;YES, GET NEXT FILE FROM CS


;CHECK IF FILE.EXT IN DIRECTORY MATCHES FILE TO /D,/R
;NOTE WE MAY HAVE *.EXT,FIL.*, OR *.*


MLOOK2:	XOR	T1,FILNAM	;XOR TOGETHER
	ANDCM	T1,QMASK	;MASK
	JUMPN	T1,LOOK8	;NO MATCH
	MOVE	T1,ZRF		;GET GOOD FILENAME
	MOVEM	T1,FILNAM	;WHERE IT BELONGS
	JRST	LOOK3

MLOOK3:	XOR	T1,FILEX
	ANDCM	T1,QMASK+1
	JUMPN	T1,LOOK8
	MOVE	T1,ZRF+1
	MOVEM	T1,FILEX
	JRST	LOOK5

LOOK2:	TRNN	CALFLG,MATFN	;SHOULD FILENAMES MATCH
	JRST	LOOK3		;NO
	MOVE	T1,ZRF		;YES
	TLNE	CALFLG,MFLG	;MASKING NEEDED?
	JRST	MLOOK2		;YES
	CAME	T1,FILNAM
	JRST	LOOK8		;NO MATCH

LOOK3:	TRNN	CALFLG,MATEX	;SHOULD EXTENSIONS MATCH
	JRST    LOOK5		;NO
	MOVE	T1,ZRF+1	;YES
	TLNE	CALFLG,MFLG	;MASKING?
	JRST	MLOOK3		;YES
	CAME	T1,FILEX
	JRST	LOOK8		;NO MATCH
LOOK5:
LOOK4:	TRO	AUXFLG,READ1	;READY FOR FIRST READ
	TRO	CALFLG,ASTFLG	;FOUND A FILE *.EXT, F.*,*.*
	JRST	CPOPJ1		;MATCH OR NO CARES

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

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

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

PICUP2:	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
	BLT	T3,DBUF+176	;MOVE FROM INBUF TO DBUF
	MOVEI	T5,DBUF+123-1	;LOC OF FIRST FILE NAME
	MOVEM	T5,DIRST	;T5 POINTS TO FILNAME JUST HANDLED
	MOVEM   T5,DIRST1	;TO RESTORE DIRST
	POPJ	P,		;(IE NONE BUT NEXT WILL BE FIRST)

SUBTTL	ROUTINE TO OUTPUT FILENAMES THAT WERE DELETED OR RENAMED
;PRINT "FILES DELETED:" OR "FILES RENAMED:"


INFO:	MOVE	T1,TFO		;SETUP TTY FOR OUTPUT
	MOVE	T2,TFI		;SAVE BUFFER LOCS
	PUSHJ P,INICON		;INIT TTY
	HRROM	T2,TFI		;SET BUFFER LOCS
	HRROM	T1,TFO
	OUTPUT CON,
	TRNN	FLAG,DFLG	;DELETE?
	JRST	INFO1		;NO, MUST BE RENAME
IFN CCLSW,<SKIPE COMFLG
	SKIPG	RENSN
	SKIP	1
	POPJ	P,
	HRRZM	T1,RENSN	;SET POSITIVE>
	ERRPN2	</Files deleted:/>
IFN FTDSK,<SETZM BLKSUM		;SET TOTAL TO ZERO>
	JRST	INFO2
INFO1:	IFN CCLSW,<
	SKIPE	COMFLG		;IF NOT CCL
	SKIPL	RENSN		;OR FIRST TIME
	SKIP	1
	POPJ	P,		;ONLY PRINT ONCE IF CCL
	SETOM	RENSN		;DON'T PRINT IT TWICE>
	ERRPN2	</Files renamed:/>	;RENAME (/R)
TCRLF:
INFO2:	MOVEI	CHR,CR		;OUTPUT CR/LF
	PUSHJ	P,PUTCON	;ON TTY
	MOVEI	CHR,LF
	PUSHJ	P,PUTCON
	OUTPUT CON,
	POPJ	P,

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

INFO3:	MOVEI	T3,ZRF		;LOCATION OF FILENAME
	PUSHJ	P,FN.EX
IFN FTDSK,<TRNE	FLAG,DFLG	;SKIP IF /D
	TRNN	AUXFLG,DSKIN	;AND INPUT DEVICE IS DSK>
	JRST	INFO2		;NO
IFN FTDSK,<HLRE	DOUT,ZRF+3	;GET BLOCK SIZE
	PUSHJ	P,BLKSD		;STORE BLOCK SIZE
	JRST	INFO2		;AND CR-LF>
SUBTTL	/X OR /D. FIND OUT DETAILS OF FILE NAME AND
;EXTENSION (0 FN.EX=*.*) AND ANY CHANGE IN
;SOURCE DEV. SET BITS IN CALFLG.

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

LOOKA:	SKIPE	T4,ESWTCH		;MORE C.S.?
	POPJ	P,			;NO
	PUSHJ	P,DESCRP		;YES, GET NEXT FN.EX FROM CS
	PUSHJ	P,INLOOK		;CHECK FOR MTA REQUESTS, MODE
	PUSHJ   P,M4			;CHECK FOR /I,/B,/H
	HRRZM    T4,ININI1		;SET MODE
	RELEAS  DIR,
	TRNN	FLAG,DFLG		;FOR DELETE, ONE SOURCE FILE
	JRST	LOOKB			;...

	TRNE	CALFLG,NEWDEV		;ONLY IS PERMITTED
	JRST	ERR5A

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

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

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

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

DEFINE P6 (A,B)<
	MOVEI	T2,A		;;NUMBER OF CHARACTERS
	MOVE	0,[POINT 6,B]	;;BYTE POINTER TO SIXBIT STRING
	PUSHJ	P,PDIR2		;;OUTPUT THE STRING
>

DTPDIR:	TROE	AUXFLG,ONEOUT	;ONLY DO ENTRY ONCE
	JRST	DTPDN		;SO MULTIPLE LISTINGS DON'T LOSE
	ENTER   OUT,DTON	;OUTPUT DEV ENTRY
	  JRST    ERR4		;DIRECTORY FULL
DTPDN:	IFN FTDSK,<
	TRNE    AUXFLG,FFLG	;/F? SHORT FORM?
	SKIPE   DEVICE		;INPUT DEVICE SPECIFIED?
	JRST    PDIR1A		;YES
	HRRZI   0,'DSK'		;ASSUME DSK IF NO DEVICE GIVEN
	HRLZM   0,DEVICE
	TROA   AUXFLG,DSKIN	;SET DSK INPUT
PDIR1A:	TRNE    AUXFLG,DSKIN	;DSK INPUT?
	JRST    DSKLST		;YES, GO AND TRY TO LIST DSK>
IFN TEMP,<
	TRNE	CALFLG,TMPI	;LIST TMPCOR DIRECTORY?
	JRST	TMPLST		;YES>
	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
	MOVE	T1,IBF		;START OF BUFFER
	MOVE	DOUT,200(T1)	;GET POSSIBLE TAPE ID
	JUMPE	DOUT,NOTPID	;NOT IF ZERO
	CAMN	DOUT,[-1]	;OR -1
	JRST	NOTPID		;JUST GARBAGE
	P6	9,[SIXBIT /TAPE ID: /]
	P6	6,DOUT
	PUSHJ	P,CRLF		;NEW LINE
NOTPID:	SETZ   DOUT,		;CLEAR NO. FREE BLOCKS
	MOVEI   T4,1102		;OCTAL NO. OF BLOCKS ON DECTAPE
	MOVSI   T1,(POINT 5,0)	;5 BIT BYTES
	HRRZ    T5,IBF		;CURRENT INPUT BUFFER
	ADDI    T1,1(T5)	;POINTER TO 1ST DATA WORD IN DIRECT

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

				;THIS BLOCK FULL
	AOJA    DOUT,PDIR8	;COUNT NO. WITH ZERO IN
PDIR1:	P6	6,['FREE: ']
	PUSHJ   P,OUTDC3	;PRINT RESULT
	P6	6,<[' BLKS,']>
	PUSHJ   P,DTCH1		;FIX T5, TO POINT AT BEGIN OF DIR
	MOVE	T4,T5		;ANOTHER COPY
	MOVEI	T2,26		;NUMBER OF POSSIBLE FILES
	MOVEI	DOUT,26
	SKIPE	123(T4)		;SKIP IF NO FILE THERE
	SUBI	DOUT,1		;ONE LESS FREE
	ADDI	T4,1		;SET FOR NEXT FILE
	SOJG	T2,.-3		;LOOP FOR ALL FILES
	PUSHJ	P,OUTDC3	;OUTPUT NUMBER FREE
	P6	6,[' FILES']
	PUSHJ   P,CRLF		;CARRIAGE RET, LINEFEED
SUBTTL	LOOP TO EXAMINE FILE NAMES DTA DIRECTORY
PDIR4:
	SKIPN   123(T5)		;NULL (=0) FILE NAME?
	JRST    PDIR6		;YES SO LOOK FOR ANOTHER
	MOVEI   T2,6		;TRANSMIT UP TO 6 CHARACTERS
	MOVSI   0,440600+T5	;SET UP SOURCE BYTE POINTER
	HRRI    0,123		;SET TO PICK UP FILE NAME
	SETZ   T4,
;FOLLOWING CODE TO OUTPUT PROJ, PROG FILENAME
	HLRZ	CHR,151(T5)	;GET EXT
	CAIE	CHR,'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 DIRECTORY PTR
PDIR4B:	HLLZ    CHR,151(T5)	;PICK UP EXTENSION
	MOVSI   0,440600+T5	;SET BYTE POINTER
	HRRI    0,151		;PICK UP EXTENSION
	MOVEI   T2,4		;PRINT UP TO 4 CHRS. (PERIOD+3*EXT)
	JUMPN	CHR,.+3		;EXTENSION NULL?
	PUSHJ	P,PDIR2A+1	;YES
	SKIP	2		;NO
	MOVEI   CHR,PERIOD-40	;NO, SO PRINT A PERIOD
PDIR3:	PUSHJ	P,PDIR2A	;OUTPT 6 BIT OR INCR T5
	MOVEI	CHR,SPACE	;OUTPUT 2 SPACES
	PUSHJ	P,PUT
	PUSHJ	P,PUT
	TRNE AUXFLG,FFLG	;SHORT FORM DIRECT ?
	JRST PDIR3A		;YES VJC 4/16/69

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

PDIR2:	ILDB    CHR,0		;ROUTINE TO OUTPUT 6-BIT DATA
	TRNN    0,-1		;PRINT SPACES WHEN PRINTING THE FREE BLOCKS
PDIR2A:	JUMPE   CHR,PDIR21	;TERMINATE ON SPACE
	ADDI    CHR,40		;CONVERT TO 7 BIT
	PUSHJ   P,PUT		;OUTPUT CHARACTER
	ADDI    T4,1
	SOJG    T2,PDIR2	;COUNT DOWN MAX-CHARS COUNTER
PDIR21:	POPJ    P,		;CONTINUE
;OUTPUT THE DATE FOUND IN AC 0.

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

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

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

OUTDC3:	MOVEI	CHR," "		;GET A SPACE READY
	CAIGE	DOUT,^D100	;LESS THAN 3 CHAR.
	PUSHJ	P,PUT		;YES, COMPENSATE WITH A SPACE
OUTDEC:	MOVEI T2,PUT		;PUT CHAR IN OUT BUF
	JRST OUTDC1

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

DTCHECK:PUSHJ P,ININIT	;INITIALIZE INPUT DEVICE
DTCH2:
	USETI IN,144	;GET DTA DIR
	PUSHJ P,INP	;INPUT DIRECTORY
	CLOSE	IN,	;FINISHED WITH CHAN FOR NOW
DTCH1:	HRRZ T5,IBF	;LOC. OF CURRENT BUF, 2ND WORD
	MOVEI 0,123(T5)	;83 WORDS,7, FIVE-BIT BYTES
	ADDI T5,1	;COMPUTE ADD. OF DIR. START
	MOVEM 0,DIRST	;FIRST FILE NAME LOC
	MOVEM 0,DIRST1	;TO RESTORE DIRST
	POPJ P,

;ROUTINE TO CHECK BRACKET COUNT/MATCHING

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

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

FILTYP:	TDNE	FLAG,[XWD IFLG+IBFLG,BMOD]
	POPJ	P,		;BIN MODE DON'T CARE IF DMP, ETC
	TLZ	AUXFLG,SBIN	;CLEAR BINARY FLAG
	TDNN	FLAG,[XWD PFLG!WFLG,LINE!TBMOD!NSMOD!SQMOD!SPMOD]
	TLNE	AUXFLG,CDRFLG	;/E FROM DSK IS NOT BINARY
	JRST	FIL2		;SO TURN OFF SBIN
	TRNN	FLAG,XFLG	;NO CONCATENATION ALLOWED
	TRNN	CALFLG,COMAFL	;CONCATENATION, SO TAKE IT SLOWLY
	TRNN	AUXFLG,DSKIN!DTAIN!MTAIN	;BINARY INPUT POSSIBLE?
	JRST	FIL11		;NO
	TRNE	AUXFLG,DSKOUT!DTAOUT!MTAOUT	;BINARY OUTPUT?
	JRST	FIL3		;YES, USE BINARY MODE
FIL11:	HLLZS	ZRF+1		;CLEAR RIGHT HALF
	MOVE	T1,[-TYTLEN,,TYPTAB]
FIL11A:	HLLZ	0,(T1)		;GET AN EXT
	CAMN	0,ZRF+1		;MATCH?
	JRST	FIL3		;YES, USE BINARY
	HRLZ	0,(T1)		;TRY OTHER
	CAMN	0,ZRF+1
	JRST	FIL3
	AOBJN	T1,FIL11A	;NO, KEEP TRYING
	HLLZS	DTON+1		;CLEAR RIGHT HALF INCASE NOT ZERO
	MOVE	T1,[-TYTLEN,,TYPTAB]
FIL11B:	HLLZ	0,(T1)		;GET AN EXT
	CAMN	0,DTON+1	;MATCH?
	JRST	FIL3		;YES, USE BINARY
	HRLZ	0,(T1)		;TRY OTHER
	CAMN	0,DTON+1
	JRST	FIL3
	AOBJN	T1,FIL11B	;NO, KEEP TRYING
	TRNN	FLAG,XFLG	;DO NORMAL PROCESSING ON ALL
	JRST	FIL2		;BUT DMP ETC FILES IF NOT /X
	POPJ	P,		;NO SIGNIFICANT SWITCHES

TYPTAB:	'SHR',,'HGH'
	'SAV',,'LOW'
	'XPN',,'SVE'
	'REL',,'CHN'
	'DMP',,'BIN'
	'RIM',,'RTB'
	'RMT',,'BAC'
	'BUG',,'CAL'
	'DAE',,'DCR'
	'MSB',,'OVR'
	'QUC',,'QUE'
	'QUF',,'SFD'
	'SYS',,'UFD'
TYTLEN==.-TYPTAB

FIL4:	TLO AUXFLG,RSDCFL	;SET REL,SAV,DMP,CHN FLAG
FIL1:	HRLZI 0,004400		;FORCE 36-BIT.
	HLLM 0,IBF+1		;INPUT BYTE POINTER
	HLLM 0,OBF+1		;OUTPUT BYTE POINTER
	GETSTS	IN,T1		;GET CURRENT MODE
	TRZ	T1,17		;CLEAR
	IORI	T1,14		;SET TO BINARY
	SETSTS	IN,(T1)
	GETSTS	OUT,T1		;SAME FOR OUTPUT
	TRZ	T1,17
	IORI	T1,14
	SETSTS	OUT,(T1)
	POPJ P,			;CHANGE TO FORCED BINARY

FIL3:	TLO AUXFLG,SBIN		;INPUT EXT = DMP,SAV,CHN,REL
	TRNE FLAG,XFLG
	JRST FIL1
	TLON AUXFLG,FRSTIN	;NOT /X TEST FURTHER
	JRST FIL4		;IS THIS FIRST SOURCE, YES
	TLOE AUXFLG,RSDCFL	;NOT FIRST, WAS PREVIOS FILE RSCD?
	JRST	FIL1		;ENSURE BINARY AT ALL TIMES
	OUTPUT OUT,		;NO CHANGE TO 36-BIT
	MOVE 0,OBF+2		;CURRENTLY 7-BIT I/O, MUST CHANGE TO 36-BIT
				;OUTPUT CURRENT BUFFER
	IDIVI 0,5		;DIVIDE OBF+2 BY 5 (CHAR. COUNT)
	MOVEM 0,OBF+2
	JRST FIL1

FIL2:	TLOE AUXFLG,FRSTIN	;NOT A RSCD FILE
	TLZN AUXFLG,RSDCFL	;NO, WAS PREV. FILE RSCD?
	POPJ P,			;NO, NO CHANGE
	OUTPUT OUT,		;YES, CHANGE 36-BIT TO 7-BIT
	MOVEI 0,5
	IMULM 0,OBF+2
	MOVE 0,SVIBF		;RESTORE 7-BIT
	HLLM 0,IBF+1
	MOVE 0,SVOBF
	HLLM 0,OBF+1
	GETSTS	IN,T1		;GET CURRENT MODE
	TRZ	T1,17		;CLEAR
	IORI	T1,1		;SET TO ASCII LINE
	SETSTS	IN,(T1)
	GETSTS	OUT,T1		;SAME FOR OUTPUT
	TRZ	T1,17
	IORI	T1,1
	SETSTS	OUT,(T1)
	POPJ P,
SUBTTL ROUTINES TO HANDLE DEVICE TMPCOR:
IFN TEMP,<

;ZERO TMPCOR DIRECTORY
TMPZRO:	MOVE	T1,[XWD 5,TMPNAM]
	PUSHJ	P,TMPXCT
	  JRST	TMPNAV		;ONLY GETS HERE IF NO TMPCOR
	JRST	PIP2		;GET NEXT COMMAND

;LIST TMPCOR DIRECTORY
TMPLST:	SETZ	T1,		;0 TO GET FREE SPACE
	TMPCOR	T1,		;GET IT
	  JRST	TMPNAV		;NO TMPCOR IN THIS MONITOR
	MOVE	DOUT,T1		;GET WORD COUNT
	MOVEI	T2,PUT
	PUSHJ	P,OUTDC1	;OUTPUT IT
	LSTLIN	TMPHDR		;AND MESSAGE
	MOVE	T1,[XWD 4,TMPNAM]
	PUSHJ	P,TMPXCT
	  JRST	MAIN1		;SHOULD NEVER HAPPEN
	JUMPLE T1,MAIN1		;DIRECTORY EMPTY
	MOVNS	T1		;GET - WORD COUNT
	HRL	T5,T1		;MAKE AOBJN WORD
TMPLS2:	HLLZ	0,(T5)		;GET NAME
	PUSHJ	P,SIXOUT	;OUTPUT IT
	PUSHJ	P,TABOUT	;AND A TAB
	HRRZ	DOUT,(T5)		;GET WORD COUNT
	MOVEI	T2,PUT
	PUSHJ	P,OUTDC1	;OUTPUT IN OCTAL
	PUSHJ	P,CRLF		;NEW LINE
	AOBJN	T5,TMPLS2
	JRST	MAIN1		;END OF DIRECTORY

;INPUT ONE FILE FROM TMPCOR
TMPIN:	SKIPL	ESWTCH		;MORE COMMAND
	JRST	TMPERR		;YES
	MOVE	T1,[XWD 1,TMPNAM]
	PUSHJ	P,TMPXCQ
	JRST	[PUSHJ	P,ERR3A	;ERROR
		PUSHJ	P,GETEND;DELETE CCL FILE
		JRST	PIP2]
	TROE	AUXFLG,ONEOUT	;ONLY DO ENTRY ONCE
	JRST	TMPIN1		;DONE ALREADY
	ENTER	OUT,DTON	;ENTER FILE IN CASE DIRECTORY DEV.
	  JRST	ERR4		;FAILURE
TMPIN1:	HRLI	T5,440700	;MAKE A BYTE POINTER
	IMULI	T1,5		;WORD COUNT
	ADDI	T1,1		;BONUS FOR SOSGE
	SOJLE	T1,MAIN1	;JUMP WHEN DONE
	ILDB	CHR,T5		;GET CHARACTER
	PUSHJ	P,PUT		;OUTPUT IT
	JRST	.-3		;LOOP 'TIL DONE

;DELETE ONE FILE FROM TMPCOR
TMPDEL:	TRNE	FLAG,RFLG!XFLG
	JRST	TMPERR
	MOVE	T1,[XWD 2,TMPNAM]
	PUSHJ	P,TMPXCQ
	JRST	[PUSHJ	P,ERR3A
		PUSHJ	P,GETEND
		JRST	PIP2]
	ERRPNT	</File deleted:	/>
	PUSHJ	P,P6BIT		;OUTPUT FILE NAME
		FILNAM
	PUSHJ	P,TCRLF		;OUTPUT CR-LF
	JRST	PIP2

;OUTPUT ONE FILE TO TMPCOR
TMPOUT:	MOVE	T1,DTON		;OUTPUT FILE NAME
	MOVEM	T1,TMPNAM	;FOR TMPCOR
	SETZ	T1,		;GET FREE WORD 
	PUSHJ	P,TMPXCT	;DO IT
	  JRST	TMPNAV		;NO TEMPCOR
	MOVEM	T5,TMPNAM+1	;SAVE START
	HLL	T5,IBF+1	;FORM BYTE POINTER
	HRRZ	T2,.JBFF	;TOP OF BUFFER
INPTMP:	PUSHJ	P,INP		;GET A BUFFER FULL
	PUSHJ	P,TTYZ		;CHECK TTY FOR EOF
	TRNE	IOS,EOFBIT	;CHECK FOR EOF ON ALL DEVICES
	JRST	TMPEOF		;YES IT WAS
TMPILP:	SOSGE	IBF+2		;ANYTHING IN BUFFER?
	JRST	INPTMP		;NO, GET MORE
	ILDB	T1,IBF+1	;GET A CHARACTER
	CAIGE	T2,(T5)		;TOO MANY CHARS.?
	JRST	TMPFUL		;YES, ERROR
	IDPB	T1,T5		;DEPOSIT CHAR
	JRST 	TMPILP		;LOOP

TMPEOF:	HRRZ	T5		;CLEAR OUT BYTE POSITION
	SUB	T5,TMPNAM+1	;TOTAL NO OF WORDS
	MOVNS	T5		;NEGATE IT
	HRLM	T5,TMPNAM+1	;MAKE IOWD
	MOVE	T1,[3,,TMPNAM]	;SET TO WRITE
	TMPCOR	T1,		;DO IT 
	  JRST	TMPFUL		;FAILED, NOT ENOUGH ROOM
	JRST	PIP2		;ONLY ONE BUFFER ALLOWED
;SET UP AND XCT TMPCOR UUO
TMPXCQ:	MOVE	T2,FILNAM	;GET FILE NAME
	SKIPE	QMASK		;CANN'T HANDLE WILD CHARS. YET
	JRST	TMPERR		;YES
	MOVEM	T2,TMPNAM	;PUT IN LOOKUP BLOCK
TMPXCT:	MOVSI	T2,-200		;ALLOW 200 WORDS
	HRR	T2,.JBFF	;WHERE TO PUT CHARS.
	HRRZ	T5,.JBREL	;GET TOP OF CORE
	CAIGE	T5,200(T2)	;WILL BUFFER FIT IN
	JRST	[ADDI	T5,200	;ASK FOR ENUF CORE
		CORE	T5,	;TRY TO GET IT
		JRST	OMODER	;FAILED
		JRST	.+1]	;OK NOW
	MOVEM	T2,TMPNAM+1	;STORE IN LOOKUP BLOCK
	SOS	TMPNAM+1	;MAKE AN IOWD
	TMPCOR	T1,		;THIS IS IT
	  POPJ	P,		;ERROR RETURN
	MOVE	T5,T1		;NUMBER OF WORDS
	ADD	T5,.JBFF	;FIX UP JOBFF JUST IN CASE
	EXCH	T5,.JBFF	;PUT START OF BUFFER IN T5
	JRST	CPOPJ1		;AND SKIP RETURN

TMPERR:	ERRPNT	</?Command not yet supported for TMPCOR!/>

TMPFUL:	ERRPNT	</?Not enough room in TMPCOR:!/>

TMPHDR:	ASCIZ	/ TMPCOR words free
/
TMPNAV:	ERRPNT	</?TMPCOR not available!/>
>


SUBTTL BLOCK 0 CODE

;THIS CODE COPIES BLOCK 0,1,2 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
	AOS T1,BL0CNT
	CAIGE T1,3
	JRST BL4
BL3:	RELEASE OUT,		;IF ANY, PDL IS RESET
	JRST PIP2

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
	CAIN	T6,INOMTA	;OUTPUT DEVICE?
	TRNE	CALFLG,DVSWTH	;YES, AN EXPLICIT DEVICE?
	JRST	.+2		;INPUT DEVICE, OR EXPLICIT OUTPUT ONE
	JRST	ERR8		;NOT OUTPUT DEVICE SEEN
	PUSHJ P,(T6)		;THERE IS A  REQUEST
				;GO TO INIMTA/INOMTA

;PERFORM POSITIONING REQUESTS
	TRNE T1,MTUFLG
	JRST UNLOAD

	TRNE T1,MTWFLG
	JRST REWIND

	TRNE T1,MTFFLG
	JRST MARKEF

	TRNE T1,MTTFLG
	JRST SLEOT

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

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

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

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

;ROUTINE TO CHECK AND SET DENSITY FOR NEW DEVICE

MTC1:	MOVE T4,T1		;GET AUX/AUXOUT
	ANDI T4,MT2FLG+MT5FLG+MT8FLG
	ANDI T4,-1(T4)		;REMOVE RIGHT MOST 1
	JUMPN T4,MTR1		;MORE THAN 1 REQ, ERROR
	TRC	T1,MTIFLG!MTSFLG
	TRCN	T1,MTIFLG!MTSFLG
	JRST	MTR1		;CAN NOT BOTH BE ON

	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

	TRNE	T1,MTIFLG	;INDUSTRIAL COMPATIBLE?
	TRO	T4,MTIFLG
	TRNE	T1,MTSFLG	;DEC STANDARD?
	TRO	T4,MTSFLG

	POPJ P,

;REWIND AND UNLOAD

UNLOAD:	MTAPE TAPE,11
	JRST MTCONT

;REWIND ONLY

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




;MARK END OF FILE

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




;SKIP TO LOGICAL END OF TAPE.

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

BSPF:	HRRE T3,T3	;T3=NO. OF FILES/RECORDS TO BACK
	MOVEI T5,7	;BSPR
	TRNN T1,MTPFLG	;BSPR?
	MOVEI T5,17	;BSPF
BSPF2:	WAIT TAPE,	;WAIT
	STATO TAPE,LDP	;AT LOAD POINT?
	  JRST BSPF3	;NOT LDP
	ERRPNT </?Load point before end of backspace request!/>

BSPF3:	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:	HLRE T3,T3	;T3=NO. FILES (OR REC) TO ADVANCE
	MOVEI T5,6	;ADVR
	TRNN T1,MTDFLG	;ADVR ?
	MOVEI T5,16	;ADVF
	MTAPE TAPE,(T5)	;ADVANCE FILE/RECORD
	SOJG T3,.-1	;MORE FILES/RECORDS TO ADV?
			;NO, END OF LOOP
	SKIPGE	T3	;WAS ITEXPLICIT ZERO
	MTAPE	TAPE,7	;YES , POSITION BEFORE EOF MARK
	WAIT TAPE,	;WAIT...
	GETSTS TAPE,IOS
	TRZE IOS,EOFBIT
	SETSTS TAPE,(IOS)	;END OF FILE
	JRST MTCONT
;ROUTINE TO INITIALIZE MAGTAPE FOR INPUT OR OUTPUT

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

INMTA:	OPEN TAPE,INMTA1
	  JRST ERR1B
	POPJ P,

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

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

;CONSTANTS

OKBD:	POINT 6,DTON+2,23	;FOR NO. 1K BLOCKS
OKB:	POINT 6,ZRF+2,23
DATE:	POINT 12,ZRF+2,35
DATED:	POINT 12,DTON+2,35	;CREATION DATE /X
ZRO:	ASCII /00000/
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
TWL:	OCT 12
IFN FTDSK,<
PP11:	XWD 1,1
PRPTL:	POINT 9,PROTS,8		;PROTECTION FOR RENAME
PRPTD:	POINT 9,DTON+2,8
PRNM:	POINT 9,ZRF+2,8		;PROT FOR /R
TIME:	POINT 11,ZRF+2,23	;CREATE TIME /X
TIMED:	POINT 11,DTON+2,23	;DEPOSIT CREATE TIME
ADATE:	POINT 12,FILNAM+1,35	;ACCESS DATE
CTIME:	POINT 11,FILNAM+2,23	;CREATION TIME
CDATE:	POINT 12,FILNAM+2,35	;CREATION DATE
PROT:	POINT 9,FILNAM+2,8	;PROTECTION
MODE:	POINT 4,FILNAM+2,12	;RECORDING MODE
>
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

;PROGRAM STORAGE AREA
	SWSEG
LOW:
IFN TEMP,<
TMPPNT:	BLOCK 	1
TMPFLG:	BLOCK	1
TMPEND:	BLOCK	1
TMPFIL:	BLOCK	2
TMPNAM:	BLOCK	2 >
BL0CNT:	BLOCK	1	;COUNT
IFN CCLSW,<
CFI:	BLOCK   3	;STORED COMMAND INPUT HEADER 
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
SAVAC:	BLOCK   5	;SAVE SOME ACS
NAMTAB:	BLOCK   24	;FOR (XD) ON DSK OR RENAME
IFN FTDSK,<
SYSPP:	BLOCK	1	;PP OF DEVICE SYS
LOCNAM:	BLOCK	1	;POINTER FOR NAMTAB>
DIRST:	BLOCK	1	;LOC. OF LAST DIR. FILE NAME REFERENCED
DIRST1:	BLOCK	1	;SAVE INITIAL DIRST
SQNUM:	BLOCK	1	;CURRENT SEQUENCE NUMBER
DTJBFF:	BLOCK	1	;VALUE OF JOBFF AFTER CONSOLE I/O BUFFERS
SVJBFF:	BLOCK	1	;INITIAL VALUE OF JOBFF
SVJBF1:	BLOCK	1	;VALUE OF JOBFF AFTER OUTBUF UUO
OPTR:	BLOCK	1	;CURRENT POINTER FOR LINE PRESCAN
DTONSV:	BLOCK   2	;OUTPUT DIRECTORY ENTRY COPY
SVPTR1:	BLOCK	1	;POINTER TO LAST PRINTING CHARACTER
SVPTR2:	BLOCK	1	;POINTER TO LAST GENERATED TAB
TLBRKT:	BLOCK	1	;TOTAL PARENS ON THIS LINE
TOTBRK:	BLOCK	1	;TOTAL CUMULATIVE PARENS
TABCT:	BLOCK	1	;SPACES TO NEXT TAB STOP
SPCT:	BLOCK	1	;CONSECUTIVE SPACES COUNTER
ABOUT:	BLOCK	1	;AB FOR OUTPUT UNIT
AUXOUT:	BLOCK	1	;AUX FOR OUTPUT UNIT
PROTS:	BLOCK	1	;SAVE PROTECTION
CDRCNT:	BLOCK	1	;COUNT CARD COLS.
PTRPT:	BLOCK	1	;STORE SEQ. NO. POINTER

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

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

COMEOF:	BLOCK	1	;EOF INDICATOR
COMCNT:	BLOCK	1	;COMBUF CHARS COUNT
COMPTR:	BLOCK	1	;POINTER FOR STORING/EXTRACTING CS


AUX:	BLOCK	1	;COPT AUXFLG (MTA)
IFN FTDSK,<
PPP:	BLOCK	1	;PERMANENT PPN
FNPPN:	BLOCK	1	;RESERVE #P-P
FNPPNS:	BLOCK	1	;COPY FNPPN FOR LATEST NON-SYS #P-P
LSTPPN:	BLOCK	1	;PPN FOR LIST COMMAND>
ESWTCH:	BLOCK	1	;-1 INDICATES END OF LINE
XNAME:	BLOCK	1	;-1 INDICATES SCAN OVERSHOOT WITH A NULL NAME
			;0  INDICATES NO SCAN OVERSHOOT
			;CONTAINS OVERSHOOT NAME IF NOT NULL
AB:	BLOCK	1	;MTA VALUE SWITCHES

PTHADD:	BLOCK	1	;FIRST ADDRESS OF FULL PATH
PTHSCN:	BLOCK	1		;SCAN SWITCH
PTHPPN:	BLOCK	1		;PATH PPN
PTHSFD:	BLOCK	PTHLEN+1	;SFD LIST + 0

DEFPTH:	BLOCK	PTHLEN+4	;DEFAULT PATH
PTHOUT:	BLOCK	PTHLEN+4	;OUTPUT PATH
MATCH:	BLOCK	2	;NAME AND EXT FOR /L OR (RX)
TAPEID:	BLOCK	1	;TAPE ID  IN SIXBIT
QMASK:	BLOCK	2	;MASK FOR MATCHING FILE NAME AND EXT
OQMASK:	BLOCK	2	;SAME BUT FOR OUTPUT 
STRARG:	BLOCK	3	;ARGUMENTS FOR GOBSTR UUO
GENERI=STRARG+2		;FILE STRUCTURE NAMES IF GENERIC DSK
	BLOCK	2	;BUG IN 5.03 RETURNS 5 WORDS FROM GOBSTR
LZERO==.-1		;THIS IS THE END OF THE INIT. ZEROED BLOCK.
PDL:   BLOCK 20		;PUSHDOWN LIST

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

DBUF:  BLOCK 204	;DIRECTORY BUFFER

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

ININI1:	BLOCK 1		;INPUT DEVICE
DEVICE:	BLOCK 2

IFN CCLSW,<
RENSN:	BLOCK	1	;-1 IF RENAME MESSAGE SEEN
RUNDEV:	BLOCK	1	;RUN UUO DEVICE
RUNFIL:	BLOCK	3	;FILE NAME
RUNPP:	BLOCK	2
CCLINI:	BLOCK	3	;CCL INPUT DEVICE OPEN BLOCK>

DEVERR:	BLOCK 1
DERR2:	BLOCK 2

INMTA1:	BLOCK 1
MTANAM:	BLOCK 2

IFN FTDSK,<
MYPPN:	BLOCK	1		;LOGGED IN PPN
ADSK1:	BLOCK	1		;OPEN DIRECTORY, MODE
ADSK:	BLOCK	2		;FILENAME, EXT
LIN:	BLOCK 1			;COUNT FOR DSK DIR LIST
PGCNT:	BLOCK	1		;COUNT OF PAGES FOR DSK DIR
UFDIN:	BLOCK 3			;HEADER FOR READING DISK DIRECTORY
UFD:	BLOCK 4			;[P,P] OR *FD*
				;UFD OR SYS
BLKSUM:	BLOCK 1			;TOTAL NBR BLOCKS PER PROJ. PROG NBR
LEVEL:	BLOCK	1		;-2 IF LEVEL D DISK SERVICE
JOBPTH:	BLOCK	PTHLEN+4	;DEFAULT JOB PATH
JOBPPN=JOBPTH+2			;DEFAULT JOB PPN
JOBSFD=JOBPTH+3			;DEFAULT JOB SFD LIST
>
IFN RIMSW,<
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.
>

	VAR			;JUST IN CASE
LOWTOP:				;LAST DATA LOCATION PLUS ONE
	SWSEG
SUBTTL	RIM LOADER
IFE RIMSW,<
RIMTB:	ERRPNT	<Z? /Y switch option not available this assembly!Z>
XLIST>
IFN RIMSW,<
LODAL==16			;LENGTH OF RIM LOADER
HLTBIT==200			;CHANGES JRST TO HALT
BLKSZ==17			;NORMAL BLOCK LENGTH IN RIM10B
.JBDA==140			;START OF USER AREA

RIMTB:	TRNN	AUXFLG,DTAIN!DSKIN!MTAIN
	JRST	ERR5B
	PUSHJ	P,ININIT
	OUTPUT	OUT,
	PUSHJ	P,FNSET		;SEE WHAT WE HAVE FOR FILNAM.EXT
	TRNN	CALFLG,FNEX	;SINGLE FILE SPECIFICATION?
	JRST	[MOVE	0,[FILNAM,,ZRF]	;YES, DON'T READ DIRECTORY
		BLT	0,ZRF+3	;SET UP FILE NAME,EXT, AND PPN
		SETZM	GENERI	;JUST IN CASE
		JRST	RIMTB0+2]
	TRNE	AUXFLG,DTAIN
	PUSHJ	P,DTADIR
IFN FTDSK,<
	TRNE	AUXFLG,DSKIN
	PUSHJ	P,DSKDIR>
RIMTB0:	PUSHJ	P,LOOK		;GET FILE TO CONVERT
	  JRST	MAIN1		;NONE LEFT
IFN FTDSK,<PUSHJ P,SETPTH	;SEE IF FULL PATH
	  MOVEM	0,ZRF+3		;NON-SKIP RETURN, USE IT>
	LOOKUP	IN,ZRF
	  JRST	ERR3
	MOVEI	0,254000
	HRLM	0,XFERWD	;ASSUME JRST
	HLRZ	0,ZRF+1
	CAIN	0,'RTB'
	JRST	RIMTB1
	CAIE	0,'SAV'
	CAIN	0,'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,'SAV'
	JRST	RIMTB4		;"SAV" FILE
	MOVEI	T2,^D126(CHR)	;FIND VALUE OF .JBSA
	MOVEI	T3,.JBDA-1
	CAMGE	T2,T3		;(JOBDA) IS FIRST LOC. OF USER PROF,
	JRST	ERR8A		;NO, ERROR
	MOVE	T1,IBF+1
	MOVEI	T3,.JBSA
	PUSHJ	P,RMS1
	HRRM	CHR,XFERWD	;SAVE TRANSFER WORD
	MOVEI	T3,.JBFF
	MOVE	T1,IBF+1
	PUSHJ	P,RMS1
	HRRZM	CHR,LENGTH	;SAVE (JOBFF)
	HLRZ	0,ZRF+1
	CAIN	0,'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,.JBDA	;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,RIMTB8
	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,'SAV'		;NO XFER WD FOR "SAV" FILES
	JRST	RIMA
	PUSHJ	P,PUT
	SETZ	CHR,
	PUSHJ	P,PUT		;TRAILING ZERO
	OUTPUT	OUT,
RIMA:	CLOSE	IN,
	TRNN	FLAG,XFLG
	JRST	MAIN1		;END OF SINGLE FILE
	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:!	HALT	ST
	AOBJN	ADR,RD
ADR:!	JRST	ST1
CKSM:!	BLOCK	0

DEPHASE>
LIST

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

;DISK DELETE AND RENAME ROUTINES

	SYN AB,STRCNT		;SOMEWHERE TO COUNT NO. OF F/S SEEN
	SYN MTAREQ,SAVSTR	;FIRST F/S NAME SEEN
DSKDR0:	MOVE	T1,DTON+3	;GET OUTPUT PPN
	SKIPE	PP		;ALREADY SET?
	JRST	.+4		;YES
	MOVEM	T1,PP		;OUTPUT=INPUT FOR /D,/R
	SKIPE	PTHSFD		;INPUT SFD SPECIFIED?
	SETOM	PTHADD		;YES, USE IT
	PUSHJ   P,ININIT	;GET DSK AS INPUT DEVICE
	PUSHJ   P,DSKDIR	;GET USER'S FILE DIRECTORY
	  JFCL
	PUSHJ	P,INFO		;PRINT FILES DELETED:/RENAMED:
DSKDR5:	PUSHJ   P,LOOK		;PREPARE FOR LOOKUP/ENTER
				;OF FILE TO /D OR /R
	  JRST    DSKDR1	;ALL THROUGH WITH UFD
	TRNN	FLAG,DFLG	;ONLY MAKE NON-AMBIGUITY CHECK FOR /D
	JRST	DSKDR		;/R WILL ALWAYS FAIL
	TRC	CALFLG,MATEX!MATFN
	TRCE	CALFLG,MATEX!MATFN
	JRST	DSKDR+1		;YES MUST NOT BE AMBIGUOUS
	TLNN	CALFLG,MFLG	;TEST FOR ???
DSKDR:	PUSHJ	P,INITFS	;INITIALIZE THE F/S SEARCH LIST
	  JRST	DSKDR6		;LEVEL C, OR NOT GENERIC "DSK"
	SETOM	STRCNT		;START WITH -1
	PUSH	P,DEVICE	;SAVE DSK DEVICE
DSKDR3:	PUSHJ	P,NXTFS		;GET NEXT F/S
	  JRST	RENFIN		;NO MORE
	PUSH	P,ZRF+3		;SAVE PPN
	PUSHJ	P,SETPTH	;SEE IF FULL PATH
	  MOVEM	0,ZRF+3		;NON-SKIP RETURN, USE IT
	LOOKUP	IN,ZRF		;TRY THIS F/S
	  JRST	DSKDRE		;LOOKUP FAILED, FILE NOT ON THIS F/S
				; OR FILE ERROR (BAD RIB ETC)
	MOVE	0,STRCNT	;GET COUNT
	AOS	STRCNT		;INCRENENT COUNT
	JUMPL	0,[MOVE 0,GENERI
		MOVEM 0,SAVSTR	;SAVE FIRST F/S
		JRST	DSKDRF]	;AND CONTINUE
	JUMPG	0,DSKDRA	;NOT FIRST TIME
	ERRPN2	</?Ambiguous />	;GIVE MESSAGE
	PUSHJ	P,P6BIT		;PRINT
		SAVSTR		;FIRST F/S
	PUSHJ	P,TYPSTR	;AND :
DSKDRA:	PUSHJ	P,P6BIT		;PRINT THIS F/S
		GENERI
	PUSHJ	P,TYPSTR	;FOLLOWED BY COLON SPACE
	JRST	DSKDRF		;RESTORE PPN AND CONTINUE

DSKDRE:	HRRZ	T7,ZRF+1	;GET ERROR CODE
	JUMPE	T7,DSKDRF	;FILE NOT FOUND IS OK
	PUSHJ	P,DERR5R	;GIVE CORRECT ERROR CODE
DSKDRF:	POP	P,ZRF+3		;PUT PPN BACK
	JRST	DSKDR3		;TRY NEXT F/S

TYPSTR:	MOVEI	CHR,":"		;FOLLOW WITH COLON
	PUSHJ	P,PUTCON
	MOVEI	CHR," "		;AND A SPACE
	JRST	PUTCON		;POPJ RETURN

DSKR6I:	PUSHJ	P,ININIT	;INIT CORRECT DEVICE
DSKDR6:	PUSHJ	P,SETPTH	;SEE IF FULL PATH
	  MOVEM	0,ZRF+3		;NON-SKIP RETURN, USE IT
	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

RENFIN:	POP	P,DEVICE	;GET DSK DEVICE BACK
	MOVE	0,STRCNT	;GET COUNT
	JUMPL	0,DERR5		;NOT EVEN ONE FOUND
	JUMPE	0,DSKR6I	;UNIQUE, DO RENAME/DELETE
	SETZM	ZRF+3		;CLEAR PPN IN LOOKUP BLOCK
	JRST	DSKDR9		;SINCE TOO MANY F/S

DSKDR4:	PUSHJ   P,RENAME
	MOVE	0,ZRF+2		;GET DATE,MODE,PROT ETC.
	MOVEM	0,DTON+2	;SAVE AS BEFORE
	LDB	0,[POINT 9,NAMTAB+2,8]
	TLNE    AUXFLG,NSPROT	;USE THE CURRENT PROTECTION
	DPB     0,PRPTD		;UNLESS NEW PROT. SPECIFIED
	MOVE	0,NAMTAB+3	;GET PROJ-PROG
	MOVEM	0,DTON+3
	JUMPN	0,DSKDR7	;PPN ALREADY SETUP
	PUSHJ	P,SETPTH	;NO, SO USE INPUT
	  MOVEM	0,DTON+3	;FULL PATH WAS SET SO USE IT
DSKDR7:	RENAME  IN,DTON
	  JRST	[PUSHJ	P,DERR7		;OUTPUT ERROR CODE
		JRST	DSKDR5]		;AND CONTINUE
DSKDR9:	PUSHJ	P,INFO3		;PRINT FILENAME DELETED/RENAMED
	JRST    DSKDR5

DSKDR1:	TLZ     AUXFLG,NSPROT	;NON-ST. PROT FIXED
	SOS     ESWTCH		;ENSURE ESWTCH NEGATIVE
	SKIPE	DOUT,BLKSUM	;GET TOTAL FREED BLOCKS
	TRNN	FLAG,DFLG	;BUT ONLY IF /D
	JRST	DSKDR2		;BOTH NOT TRUE
	MOVEI	T2,PUTCON	;ON TTY
	SKPINC			;CLEAR ^O
	  JFCL
	PUSHJ	P,OUTDC1	;OUTPUT IN DECIMAL
	ERRPN2	</ Blocks freed/>
	PUSHJ	P,TCRLF		;FINISH WITH CR-LF
	SETZM	BLKSUM		;CLEAR RUNNING TOTAL
DSKDR2:	RELEAS	CON,
	JRST    MAIN1
;ZERO DSK DIRECTORY OF ALL POSSIBLE FILES.  IF ANY ARE PROTECTED, GIVE
;A MESSAGE AND DO NOT PROCESS ANY OTHER SWITCHES.

DSKZRO:	SKIPE	T1,ODEV		;GET REAL DSK
	MOVEM	T1,ADSK		;SO AS TO INIT CORRECT F/S
	PUSHJ   P,DIRSK1
	  JFCL
	INBUF   OUT,1		;FOR LOOKUPS ON OUT
DSKZ1:	SOSLE   UFDIN+2
	SKIP	2
DSKZ3:	PUSHJ   P,UIN
	  POPJ	P,
	ILDB    0,UFDIN+1
	JUMPE   0,DSKZ3
	MOVEM   0,ZRF
	MOVEM	0,DTON	;INCASE OF FAILURE
	SOS     UFDIN+2
	ILDB    0,UFDIN+1
	HLLZM   0,ZRF+1		;EXTENSION
	MOVE    0,FNPPN
	MOVEM   0,ZRF+3
	PUSHJ	P,SETPTH	;SEE IF FULL PATH
	  MOVEM	0,ZRF+3		;NON-SKIP RETURN, USE IT
	LOOKUP  OUT,ZRF
	  JRST	[PUSHJ P,DERR5R	;ERROR
		JRST	DSKZ1]	;IGNORE RENAME TO ZERO
	CLOSE   OUT,
	SETZM   ZRF
	MOVE    0,FNPPN
	MOVEM   0,ZRF+3
	PUSHJ	P,SETPTH	;SEE IF FULL PATH
	  MOVEM	0,ZRF+3		;NON-SKIP RETURN, USE IT
	RENAME  OUT,ZRF
	  PUSHJ	P,DERR7Z
	JRST    DSKZ1		;REPEAT
;ROUTINES TO HANDLE LEVEL D FILE STRUCTURES

;TO INITIALIZE THE SEARCH LIST
INITFS:	SKIPN	LEVEL		;ONLY IF LEVEL D
	POPJ	P,		;LEVEL C - NON-SKIP RETURN
	SETZM	GENERI		;CLEAR INCASE OF ERROR RETURN
	TRNE	AUXFLG,SYSFLG	;SYS DEVICE
	JRST	INISYS		;YES
	MOVEI	0,ADSK		;ADDRESS OF DEVICE
	DSKCHR	0,		;SEE IF DSK
	  POPJ	P,		;NOT LEVEL D DSK
	TLNE	0,(7B17)	;GENERIC DEVICE DSK
	POPJ	P,		;NO
INIFS1:	SETOM	STRARG		;CURRENT JOB NUMBER
	SETOM	STRARG+1	;CURRENT PPN
INIFS2:	SETOM	GENERI		;YES, MARK START OF SEARCH LIST
	JRST	CPOPJ1		;GIVE SKIP RETURN

;TO INITIALIZE SYSTEM SEARCH LIST
INISYS:	MOVE	0,SYSPP		;GET SYS PPN
	CAME	0,[1,,4]	;IS IT THE REAL SYS
	JRST	INIFS1		;NO, SET UP FOR CURRENT JOB
	SETZM	STRARG		;SYS IS JOB 0
	MOVEM	0,STRARG+1	;PPN INTO ARG BLOCK
	JRST	INIFS2		;YES

;TO FIND NEXT F/S IN SEARCH LIST
NXTFS:	MOVEI	0,STRARG	;GET ADDRESS
	SKIPE	GENERI		;FINISHED IF IT IS ZERO
	GOBSTR	0,		;GET FILE STRUCTURE
	  TDZA	0,0		;ERROR
	MOVE	0,GENERI	;GET DEVICE
	CAMN	0,[-1]		;MIGHT BE MISSING FENCE, CHECK FOR END
	JRST	NOFNCE		;IT WAS
	JUMPE	0,ENDFS		;FINISHED
	MOVEM	0,DEVICE	;FOR RETRIEVAL INFO
	PUSHJ	P,ININIT	;INIT
	JRST	CPOPJ1		;GIVE SKIP RETURN

;TO INIT NEXT UFD
NXTFSU:	PUSHJ	P,NXTFS		;GET NEXT F/S
	  POPJ	P,		;SIMPLE NON-SKIP RETURN
	MOVE	0,DEVICE	;OTHERWISE GET IT
	MOVEM	0,ADSK		;FOR DIR INIT
	PUSHJ	P,DSKDIR	;INIT NEW UFD
	  JRST	NXTFSU		;FAILED, TRY NEXT F/S (NO UFD)
	JRST	CPOPJ1		;SKIP RETURN

NOFNCE:	AOS	GENERI		;SIGNAL END OF F/S
ENDFS:	MOVSI	0,'DSK'		;GENERIC "DSK"
	TRNE	AUXFLG,SYSFLG	;IS IT SYS?
	MOVSI	0,'SYS'		;YES
	MOVEM	0,ADSK		;RESTORE INCASE
	MOVEM	0,DEVICE	;INPUT TO PROCESS
	POPJ	P,		;RETURN

;ROUTINES TO HANDLE SFD'S
GETPTH:	SETOM	PTHADD		;SIGNAL FULL PATH TO BE USED
	MOVE	T7,[PTHSCN,,PTHPPN]
	SETZM	PTHSCN		;ZERO START OF FULL PATH
	BLT	T7,PTHSFD+PTHLEN	;AND REST OF IT
	MOVE	T7,PP		;GET PPN
	MOVEM	T7,PTHPPN	;STORE PPN
	MOVEI	T7,PTHSFD	;ADDRESS OF SFD LIST
GTPTH1:	HRLI	T7,(POINT 6,,)	;ILDP LOOP
	PUSHJ	P,GETBUF	;GET A CHARACTER
	CAIL	0,"A"		;ALPHABETIC
	CAILE	0,"Z"
	JRST	.+2		;NO
	JRST	GTPTH2		;YES , FOUND ONE
	CAIL	0,"0"		;NUMERIC
	CAILE	0,"9"
	JRST	GTPTH3		;NO
GTPTH2:	SUBI	0,40		;MAKE SIXBIT
	TLNE	T7,770000	;SIX CHAR. YET?
	IDPB	0,T7		;NO DEPOSIT
	JRST	GTPTH1+1	;LOOP

GTPTH3:	CAIE	0,","		;MORE SFD'S
	JRST	GTPTH4		;NO
	MOVEI	T7,1(T7)	;ADVANCE BYTE POINTER
	CAIGE	T7,PTHSFD+PTHLEN-1	;TOO MANY SFD'S
	JRST	GTPTH1		;NO, GET NEXT SFD
	ERRPNX	</?SFD list too long!/>

GTPTH4:	SKIPE	FILNAM		;FILE NAME SEEN YET?
	POPJ	P,		;YES, SO NOT DEFAULT
	MOVE	T7,[PTHADD,,DEFPTH]
	BLT	T7,DEFPTH+PTHLEN+3
	POPJ	P,


;PUT PATH ADDRESS IN AC0
;SKIP IF ZER0, NON-SKIP IF FULL PATH IN USE
SETPTH:	MOVEI	0,PTHADD	;TRY FULL PATH
	SKIPN	JOBPTH		;SKIP IF SFD'S
	JRST	CPOPJ1		;SKIP RETURN NON-SFD MONITOR
	SKIPE	PTHADD		;IN USE
	POPJ	P,		;YES
	MOVE	0,@(P)		;IF A PPN HAS BEEN SET , DON'T USE DEFAULT
	SKIPN	@0		;LOOK AT @RETURN ADDRESS
	SKIPN	DEFPTH		;IS DEFAULT PATH IN USE
	AOSA	(P)		;NO, SKIP RETURN
	MOVEI	0,DEFPTH	;YES, USE DEFAULT PATH
	POPJ	P,		;RETURN
;PREPARE TO LOOKUP FILES IN PARTICULAR DISK DIRECTORY
;NON-SKIP RETURN IF LOOKUP FAILED BECAUSE OF NO UFD ON F/S
;SKIP RETURN IF OK

DIRSK1:	SKIPA   T1,DTON+3
DSKDIR:	MOVE    T1,PP		;GET [P,P] INTO T1
	TRNE	AUXFLG,SYSFLG	;DEVICE SYS
	MOVE	T1,SYSPP	;GET SYS  [PP]
	MOVEM	T1,FNPPN
	MOVE	0,[XWD FILNAM,UFD]
	BLT	0,UFD+3		;SAVE LOOKUP BLOCK
	MOVSI	0,'UFD'
	MOVEM	0,FILEX		;USER HAS SPECIFIED [P,P]
	TRNN    CALFLG,SYSFLG	;CURRENT DEVICE SYS?
	MOVEM   T1,FNPPNS	;SAVE LATEST NON-SYS #P-P
	JUMPN   T1,.+3		;IS IT ZERO?
	SKIPN	T1,JOBPPN	;GET DEFAULT JOB PPN
	MOVE	T1,MYPPN	;LOGGED IN PPN AS LAST RESORT
	MOVEM   T1,FILNAM	;[P,P] TO UFD
	MOVEM	T1,LSTPPN	;SAVE ACTUAL UFD LOOKED UP
	MOVE    0,PP11		;MAKE [P,P]=[1,1]
	MOVEM   0,PP
	MOVEM	0,PPN		;SAVE FOR EXTENDED LOOKUP
	PUSHJ   P,DSKDST	;INIT TO READ DIRECTORY
	MOVEI	T1,RIBSTS	;NO. OF WORDS FOR EXTENDED LOOKUP
	MOVEM	T1,RIBFIR
	SKIPE	PTHADD		;SFD SPECIFIED?
	JRST	SFDDIR		;YES, LOOKUP PATH
	SKIPN	FNPPN		;REAL PPN SEEN?
	SKIPN	JOBSFD		;OR A DEFAULT PATH WITH SFDS
	CAIA			;IGNORE JOB PATH
	JRST	JOBDIR		;YES
	MOVE	T1,LEVEL	;LEVEL D = -2
	LOOKUP  DIR,FILNAM(T1)	;GET USERS FILE DIRECTORY
	  JRST    DERR5A	;ONE OF MANY LOOKUP ERRORS
DIRSK3:	AOS	(P)		;SET FOR SKIP RETURN
	JUMPE	T1,DIRSK2	;IF LEVEL C
	HRRZ	T1,RIBFIR+RIBSTS
	ANDI	T1,777		;GET ERROR BITS
	JUMPN	T1,DIRSK2	;JUMP IF ERRORS IN UFD
	MOVEI	T1,RBSIZ	;SET LOOKUP
	MOVEM	T1,RIBFIR	;FOR SHORT EXTENDED
DIRSK2:	MOVS	T1,[XWD FILNAM,UFD]
	BLT	T1,PP		;RESTORE LOOKUP BLOCK
	POPJ    P,		;LOOKUP OK

;HERE TO DO LOOKUP ON SPECIFIED PATH

JOBDIR:	SKIPA	T1,[EXP JOBPTH]
SFDDIR:	MOVEI	T1,PTHADD	;ADDRESS OF FULL PATH
	MOVEM	T1,PPN		;THIS IS THE DIRECTORY REQUIRED
	MOVSI	0,'SFD'		;CHANGE EXTENSION
	MOVEM	0,FILEX		;TO EXPECTED
	ADDI	T1,PTHLEN+3	;LOOP FOR ALL SFD'S
	MOVE	0,(T1)		;GET SFD
	SKIPN	0		;END WHEN NON-ZERO
	SOJA	T1,.-2		;NOT YET
	SETZM	(T1)		;BACKUP PATH ONE SFD
	MOVEM	0,FILNAM	;THIS IS WHAT WE ARE LOOKING UP
	LOOKUP	DIR,RIBFIR	;GIVE IT A TRY
	  JRST	DERR5A		;FAILED
	MOVEM	0,(T1)		;RESTORE FULL PATH IN ALL IT GLORY
	JRST	DIRSK3		;AND RETURN TO COMMON CODE
;ROUTINE TO LIST DISK DIRECTORY. /L OR /F SWITCH

	SYN	AB,FILCNT	;COUNT OF NUMBER OF FILES FOUND
	SYN	MTAREQ,FILERR	;ERROR BIT IN FILE
DSKLST:	PUSHJ	P,ININIT	;ASSIGN "IN" FOR RETRIEVAL INFO
	SETZM	BLKSUM		;CLEAR TOTAL BLOCKS FOR ALL FILES
	SETZM	FILCNT		;START AT ZERO
	SETZM	LIN		;SET UP APPROPRIATE CONTROLS
	MOVS	T1,ODEV		;FOR THIS LISTING DEVICE
	CAIN	T1,'TTY'	;IF ODEV IS TTY
	TRO	CALFLG,LISTTY	;SET LISTTY=1 (TTY)
	SKIPN	FILNAM		;IF NO FILNAM GIVEN
	TRZ	CALFLG,MATFN!MATEX	;LIST ALL OF DIRECTORY
	MOVE	T1,FILNAM
	MOVEM	T1,MATCH
	HLRZ	T1,FILEX
	MOVEM	T1,MATCH+1
	PUSHJ	P,DSKDIR
	  JFCL
	PUSHJ	P,CRLF		;GIVE A BLANK LINE
	TRNN	AUXFLG,FFLG	;SHORT LISTING
	PUSHJ	P,HEADER	;PUT OUT HEADER LINES
	TLO	CALFLG,LPPFLG	;OUTPUT PPN LATER
	PUSHJ	P,INITFS	;INIT F/S SEARCH LIST
	  JRST	LSTU0A		;NOT GENERIC "DSK"
LSTU0:	PUSHJ	P,NXTFSU	;GET NEXT F/S IN LIST
	  JRST	DIRFIN		;NO MORE
LSTU0A:	TLO	CALFLG,LDVFLG	;SIGNAL NEW DEVICE TO OUTPUT
	MOVE	T1,PP		;GET PROJ-PROG
	MOVEM	T1,PPN		;SAVE FOR EXTENDED LOOKUP
LSTU1:	SOSLE   UFDIN+2
	SKIP	2
LSTU2:	PUSHJ   P,UIN		;GO READ DIRECTORY
	  JRST    BLKLST	;(EOF) - OUTPUT BLOCKS USED
	ILDB	0,UFDIN+1
	JUMPE   0,LSTU2
	MOVEM	0,FILNAM	;PREPARE TO GET RETRIEVAL INFO
	MOVE	T1,FNPPN	;EACH LOOKUP DESTROYS P-P NO.
	MOVEM	T1,FILNAM+3	;RESTORE P-P NO.
	SKIPG	LIN
	PUSHJ	P,HEDR3		;YES, PUT OUT HEADER LINES
	SOS	UFDIN+2
	ILDB	DOUT,UFDIN+1	;PICK UP EXTENSION
	HLRZS	DOUT		;CLEAR RIGHT HALF
	HRLZM	DOUT,FILNAM+1	;KEEP FOR LOOKUP
	TLNE	CALFLG,MFLG	;NEED TO MASK?
	JRST	MLSTU		;YES
	TRNN	CALFLG,MATEX	;MATCH EXTENSIONS?
	SKIP	2		;NO,TRY MATFN
	CAME	DOUT,MATCH+1	;MATCH?
	JRST	LSTU1		;NO,GET NEXT FILE
	TRNN	CALFLG,MATFN	;MATCH FILENAME?
	JRST	LSTU2A		;NO
	CAME	0,MATCH		;FILNAM MATCH?
	JRST	LSTU1		;NO
LSTU2A:	CAIE	DOUT,'UFD'	;IS FILE MFD
	JRST	LSTU3		;GO PRINT NAME HELD IN 0.
	HLRZ	DOUT,FILNAM	;HERE FOR MFD 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:	MOVE	0,FILNAM
	PUSHJ	P,SIXOUT	;OUPUT FILENAME
LSTU3A:	MOVEI	T4,5		;SET LOOP FOR OUTPT EXT
	MOVE	0,FILEX
	JUMPE	0,LSTU4
	PUSHJ	P,TABOUT
	PUSHJ	P,SIXOUT	;OUTPUT EXTENSION
LSTU4:	AOS	FILCNT		;COUNT ONE MORE FILE SEEN
	TRNN    AUXFLG,FFLG	;SHORTEST LISTING?
	SKIP	2
	PUSHJ	P,CLRF		;YES
	JRST	LSTU1
	SKIPN	FILEX
	PUSHJ	P,TABOUT	;ACCOUNT FOR LACK OF EXTENSION
	PUSHJ	P,SPACES
	MOVE	T4,LEVEL	;-2 IF LEVEL D,0 IF LEVEL C
	LOOKUP	IN,FILNAM(T4)	;GET RETRIEVAL INFO.
	  JRST	LSTU5		;NOT AVAILABLE
	JUMPE	T4,LSTU4A	;LEVEL C OR NO UFD ERRORS
	HRRZ	DOUT,RIBFIR+RIBSTS	;FILE ERROR STATUS
	ANDI	DOUT,777		;ONLY ERROR BITS
	MOVEM	DOUT,FILERR	;STORE ERROR BIT OR ZERO
LSTU4A:	PUSHJ   P,BLKS		;DETERMINE NO. BLK IN FILE
				;AND TOTAL FOR UFD
	LDB	0,PROT		;GET PROTECTION BITS
	PUSHJ	P,PROTO		;PRINT OCTAL NUMBERS
	TRNE	CALFLG,LISTTY	;OUTPUT DEVICE A TTY?
	JRST	LSTU7		;YES, SKIP LONG DIRECTORY
	LDB	0,ADATE		;PRINT ACCESS DATE
	PUSHJ	P,DATOUT
	PUSHJ	P,TABOUT
	LDB	0,CTIME		;PRINT CREATION TIME
	PUSHJ	P,TIMOUT
	LDB	0,CDATE
	PUSHJ	P,DATOUT	;PRINT CREATION DATE
	PUSHJ	P,SPACE2
	LDB	0,MODE		;PRINT MODE
	PUSHJ	P,OCTLS2
	JRST	LSTU8

LSTU5:	PUSHJ	P,TABOUT	;THE FILE WAS PROTECTED
	HRRZ    T7,FILEX	;GET PARTICULAR ERROR TYPE
	CAIL	T7,TABLND-TABLE	;IS IT LEGAL ERROR
	PUSHJ	P,DERRQ		;NO,PICK UP CATCH ALL MESSAGE
	MOVE    T1,TABLE(T7)	;PICK UP POINTER FOR ERROR MSG
LSTU6:	ILDB    CHR,T1		;PICK UP CHAR FROM ERROR MSG
	JUMPE   CHR,LSTU8	;PRINT ERROR MESSAGE, END SEEN
	CAIN    CHR,"!"
	JRST	LSTU8		;ALTERNATE END SEEN (!)
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,
	SKIPE	DOUT,FILERR	;ANY FILE ERRORS
	PUSHJ	P,ERROUT	;YES, LIST CODE INSIDE PARENS.
	PUSHJ	P,LSTU8A	;COMMON ROUTINE TO OUTPUT "DEV:[PPN]"
	JRST	LSTU1

LSTU8A:	TLZN	CALFLG,LDVFLG	;DEVICE TO OUTPUT?
	JRST	LSTU9		;NO
	PUSHJ	P,SPACE2
	MOVE	0,ADSK		;GET F/S NAME
	PUSHJ	P,SIXOUT	;PRINT IT
	MOVEI	CHR,":"		;FOLLOW WITH COLON
	PUSHJ	P,PUT
LSTU9:	TLZN	CALFLG,LPPFLG	;PPN TO LIST?
	JRST	LSTU9A		;NO
	PUSHJ	P,SPACE2
	MOVEI	CHR,"["		;FORM PPN
	PUSHJ	P,PUT
	HLRZ	0,LSTPPN
	PUSHJ	P,OCTLST
	MOVEI	CHR,","
	PUSHJ	P,PUT
	HRRZ	0,LSTPPN
	PUSHJ	P,OCTLST
	MOVEI	CHR,"]"
	PUSHJ	P,PUT
LSTU9A:	JRST	CLRF		;PRINT CR-LF AND RETURN

ERROUT:	PUSHJ	P,SPACE2	;SEPARATE BY SOME SPACES
	MOVEI	CHR,"("		;PUT ERROR CODE IN PARENS
	PUSHJ	P,PUT
	SKIPA	T4,[POINT 7,[ASCII /a*cm**rwf*/]]
	LSH	DOUT,-1		;SHIFT ERROR BIT TOWARDS BIT 35
	ILDB	CHR,T4		;GET AN ERROR CHARACTER
	TRNN	DOUT,1		;IS IT THIS ERROR?
	JRST	.-3		;NO
	PUSHJ	P,PUT		;YES,OUT IT GOES
	MOVEI	CHR,")"
	JRST	PUT		;RETURN

DIRFIN:	SKIPE	FILCNT		;HAVE WE SEEN ANY FILES?
	JRST	MAIN1		;YES, EXIT
	TRO	CALFLG,RTRNFL	;SET TO RETURN
	PUSH	P,DIRFIN+1	;STORE RETURN ADDRESS
	ERRPNT	</Directory has no such files!/>
MLSTU:	TRNN	CALFLG,MATFN	;MATCH FILE NAME
	JRST	MLSTU1		;NO, TRY EXT
	XOR	0,MATCH
	ANDCM	0,QMASK
	JUMPN	0,LSTU1		;MATCH FAILED
MLSTU1:	TRNN	CALFLG,MATEX	;MATCH EXT
	JRST	LSTU2A		;NO
	XOR	DOUT,MATCH+1
	ANDCM	DOUT,QMASK+1
	JUMPN	DOUT,LSTU1	;FAILED
	JRST	LSTU2A		;MATCH FOUND


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

SPACE2:	MOVEI	T4,2		;SET FOR 2 SPACES
SPACES:	MOVEI	CHR,SPACE
	PUSHJ	P,PUT
	SOJG	T4,.-1
	POPJ	P,

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

BLKS:	MOVEI	T2,PUT		;SET OUTPUT
	MOVE	DOUT,RIBFIR+RBSIZ
	SKIPE	LEVEL		;SKIP IF LEVEL C
	SKIP	3		;LEVEL D WORD COUNT
	HLRE    DOUT,PP		;GET WORD COUNT OF FILE
BLKSD:	JUMPGE	DOUT,BLKADD	;IF POS = NO. OF BLOCKS
	MOVNS   DOUT		;MAKE POSITIVE
	TRZE    DOUT,177	;TAKE CARE OF PARTIAL BLOCKS
	ADDI    DOUT,200
	IDIVI   DOUT,200	;CALCULATE BLOCK COUNT
BLKADD:	ADDM    DOUT,BLKSUM	;CALCULATE TOTAL FOR ALL FILES
	TRNE	FLAG,DFLG	;IF /D
	POPJ	P,		;JUST RETURN
	PUSHJ   P,OUTDE4	;OUTPUT NUMBER OF BLOCKS IN DECIMAL
	JRST	SPACE2		;RETURN WITH 2 SPACES

;END OF FILE ON UFD OUTPUT TOTAL BLOCKS XXX

BLKLST:	SKIPN   BLKSUM		;ANY INFORMATION TO OUTPUT
	JRST    BLKLS1		;NO - FINISHED
	SKPINC			;CLEAR ^O
	  JFCL
	LSTLIN	TOTAL		;OUTPUT CR,LF "TOTAL BLOCKS"
	MOVE    DOUT,BLKSUM
	MOVEI	T2,PUT		;SET OUTPUT
	PUSHJ   P,OUTDE4	;PRINT TOTALS
	PUSHJ	P,CRLF		;BONUS CR-LF
BLKLS1:	SKIPN	GENERI		;MORE FILE STRUCTURES?
	JRST    MAIN1		; FINISHED
	SETZM	BLKSUM		;START AFFRESH
	MOVE	T1,PPN		;RESTORE PP
	MOVEM	T1,PP
	JRST	LSTU0		;YES

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:	SETZ	IOS,		;JUST IN CASE
	IN	DIR,
	  JRST	CPOPJ1		;NO ERRORS
	STATUS	DIR,IOS
	TRZN	IOS,EOFBIT
	JRST	UIN2		;ERROR PRINT
	POPJ	P,

;INIT DIRECTORY DEVICE

DSKDST:	MOVE	T2,.JBFF	;SAVE JOBFF IN T2

	MOVEI	T1,DBUF
	MOVEM	T1,.JBFF	;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,.JBFF
	POPJ	P,
;OUTPUT THE DIRECTORY LISTING HEADER

HEDR3:	TRNN	AUXFLG,FFLG	;POP BACK IF SHORT LISTING
	TRNE	CALFLG,LISTTY
	POPJ	P,

HEADER:	PUSHJ	P,HEDR4
HEDR1:	LSTLIN	HEDL1
	DATE			;DATE REQ.
	PUSHJ	P,DATOUT
	PUSHJ	P,TABOUT
	PUSHJ	P,NOWOUT	;PRINT CURRENT TIME, DATE
	AOS	PGCNT		;INCREMENT PAGE COUNT
	LSTLIN	HEDPG
	MOVE	0,PGCNT		;GET PAGQ NUMBER
	IDIVI	0,^D10		;DECIMAL PAGES
	JUMPE	0,.+4
	MOVE	CHR,0
	ADDI	CHR,"0"
	PUSHJ	P,PUT
	MOVEI	CHR,"0"(1)
	PUSHJ	P,PUT
	SOS	LIN
	LSTLIN	HEDLIN
HEDR2:	JRST	CLRF

HEDLIN: ASCIZ /
Name Extension Len  Prot     Access      ---Creation---   Mode 
/
HEDL1:	ASCIZ	/	Directory  listing	/
HEDPG:	ASCIZ /	Page  /

UIN2:	PUSHJ	P,COMERR
	JSP     T5,INICN2
	ERRPN2	</?Disk directory read />
	MOVEI   T3,UFD	;LOCATION OF FILENAME(AND EXT)
	PUSHJ   P,FN.EX	;PRINT FILE NAME EXTENSION
	MOVE    T2,AUXFLG
	ANDI    T2,DSKIN
	PUSHJ   P,IOERR
	SETSTS  DIR,(IOS)
	JRST    CPOPJ1
;OUTPUT THE TIME FOUND IN AC 0

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

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

;OUTPUT OCTAL WORD FOUND IN AC 0

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

;OUTPUT PROTECTION BITS FOUND IN AC 0

PROTO:	MOVEI	CHR,"<"
	MOVSI	T1,(POINT 3,,26)
	PUSHJ	P,OCTL1+1
	MOVEI	CHR,">"
	PUSHJ	P,PUT
	MOVEI	T4,3		;SET FOR THREE SPACES
	JRST	SPACES		;AND EXIT

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

DERR5A:	MOVEI   T3,FILNAM	;LOCATION OF FILENAME
	HRRZ	T7,1(T3)	;GET ERROR CODE
	SKIPE	GENERI		;FATAL IF NOT GENERIC "DSK"
	CAILE	T7,1		;NO UFD IF 0 OR 1
	JRST	DERR4		;ANY OTHER ERROR
	TRNN	FLAG,LFLG	;IF /L
	TRNE	AUXFLG,FFLG	;OF /F
	CAIA			;YES, OUTPUT MESSAGE
	POPJ	P,		;NO, JUST RETURN (NON-SKIP)
	LSTLIN	NOUFD
	TLO	CALFLG,LDVFLG!LPPFLG	;PRINT "DEV:[PPN]"
	PUSHJ	P,LSTU8A
	JRST	DIRSK2		;GET NEXT FILE STRUCTURE

NOUFD:	ASCIZ	/%no UFD created for /

DERR7Z:	MOVE	T3,DTON		;RECOVER NAME
	MOVEM	T3,ZRF
	JRST	DERR5R		;PRINT AND RETURN

DERR6R:	TRO	CALFLG,RTRNFL
DERR6:	MOVEI   T3,DTON		;LOCATION OF FILENAME (OUTPUT)
	JRST	DERTYP
DERR7:	HRRZ	T3,DTON+1	;GET ERROR CODE
	CAIN	T3,4		;IF RENAME ERROR =4
	JRST	DERR6R		;USE OUTPUT NAME
	HRRM	T3,ZRF+1	;PUT IT IN EXPECTED PLACE
DERR5R:	TRO	CALFLG,RTRNFL	;SET TO RETURN FROM ERROR PRINTER
DERR5:	MOVEI   T3,ZRF		;LOCATION OF FILENAME (INPUT)
DERTYP:	HRRZ	T7,1(T3)	;ERROR TYPE
DERR4:	ERRPNT	</? />
	PUSHJ   P,FN.EX		;PRINT FILE NAME .EXT
	CAIL	T7,TABLND-TABLE	;LEGAL ERROR?
	PUSHJ	P,DERRQ		;NO USE CATCHALL MESSAGE
	MOVE	T1,TABLE(T7)	;PICK UP BYTE POINTER
	JRST	PTEXT1		;AND PRINT MESSAGE

DERRQ:	MOVEI	CHR,"("		;ENCLOSE ERROR NUMBER IN PARENS.
	PUSHJ	P,PUTCON	;OUTPUT IT
	MOVE	0,T7		;GET ERROR NUMBER
	IDIVI	0,8		;TWO OCTAL DIGITS
	JUMPE	0,.+4		;NO LEADING DIGIT
	MOVE	CHR,0
	ADDI	CHR,"0"		;ASCII 
	PUSHJ	P,PUTCON	;OUTPUT IT
	MOVEI	CHR,"0"(1)	;REMAINDER
	MOVEI	T7,TABLND-TABLE	;SETUP MESSAGE
	JRST	PUTCON		;PRINT REMAINDER AND RETURN
TABLE:	POINT	7,[ASCII /(0) file was not found!/]
	POINT	7,[ASCII /(1) no directory for project-programmer number!/]
	POINT	7,[ASCII /(2) protection failure!/]
	POINT	7,[ASCII /(3) file was being modified!/]
	POINT	7,[ASCII /(4) rename file name already exists!/]
	POINT	7,[ASCII /(5) illegal sequence of UUOs!/]
	POINT	7,[ASCII /(6) bad UFD or bad RIB!/]
	POINT	7,[ASCII /(7) not a SAV file!/]
	POINT	7,[ASCII /(10) not enough core!/]
	POINT	7,[ASCII /(11) device not available!/]
	POINT	7,[ASCII /(12) no such device!/]
	POINT	7,[ASCII /(13) not two reloc reg. capability!/]
	POINT	7,[ASCII /(14) no room or quota exceeded!/]
	POINT	7,[ASCII /(15) write lock error!/]
	POINT	7,[ASCII /(16) not enough monitor table space!/]
	POINT	7,[ASCII /(17) partial allocation only!/]
	POINT	7,[ASCII /(20) block not free on allocation!/]
	POINT	7,[ASCII /(21) can't supersede (enter) an existing directory!/]
	POINT	7,[ASCII /(22) can't delete (rename) a non-empty directory!/]
	POINT	7,[ASCII /(23) SFD not found!/]
	POINT	7,[ASCII /(24) search list empty!/]
	POINT	7,[ASCII /(25) SFD nested too deeply!/]
	POINT	7,[ASCII /(26) no-create on for specified SFD path!/]

TABLND:	POINT	7,[ASCII /) lookup,enter,or rename error!/]

	END PIP1          
WX