Google
 

Trailing-Edge - PDP-10 Archives - cobol12c - libary.mac
There are 12 other files named libary.mac in the archive. Click here to see a list.
; UPD ID= 3392 on 2/11/81 at 9:54 AM by NIXON                           
TITLE	LIBARY VERSION 12C
SUBTTL	COBOL LIBRARY MAINTENANCE PROGRAM		AL BLACKINGTON/CAM/JEF

	SEARCH	COPYRT
	SALL

COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1985
;ALL RIGHTS RESERVED.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

EDIT==31
VERSION==1203


TWOSEG		;TWO-SEGMENT PROGRAM
	.COPYRIGHT		;Put COPYRIGHT statement in .REL file.

SEARCH	INTERM,UUOSYM
IFN	TOPS20,<	SEARCH	MONSYM, MACSYM>
IFE	TOPS20,<	SEARCH	MACTEN>

	LOC	137
	XWD	VERSION,EDIT

	EXTERN	.HELPR
	SALL
	RELOC	400000
;EDIT HISTORY
;
;AUTOPATCH HISTORY FILE
;
;.BEGINR
;.COMPONENT LIBARY
;.VERSION 12B
;.AUTOPATCH 4
;.NOEDIT
;.ENDA
;.AUTOPATCH 5
;
;.EDIT	31	Allow empty source modules in .LIB files
;		JEH,07-DEC-82,SPR:10-33256
;		A:SRC LIBARY
;
;.ENDA
;.AUTOPATCH 6
;.NOEDIT
;.ENDA
;.AUTOPATCH 7
;
;.ENDA
;.AUTOPATCH 8
;.ENDA
;.AUTOPATCH 9
;.ENDA
;.AUTOPATCH 10
;.ENDA
;.AUTOPATCH 11
;.ENDV
;.ENDR

;** VERSION 12A  RELEASED **
;1/2/79	DELETE EDITOR AND RENUMBERING CODE

;EDIT 30	PREVENT LOOPING "?INCORRECT COMMAND" ERROR
;EDIT 27	ADD SFD SUPPORT AND IMPROVE ERROR MESSAGES
;EDIT 26	FIX BUG IN /D CAUSED BY EDIT 24
;EDIT 25	PUT TAB AFTER LINE NUMBER ON LISTING FILE
;EDIT 24	PUT PAGE NUMBER ON LISTING OF LIBRARY
;EDIT 23	MAKE LIBARY RECOGNISE LOWER CASE COMMANDS
;EDIT 22	FIX LOOKUP DONE WHEN "END" COMMAND ENCOUNTERED
;EDIT **	ADD SWITCH /S - LIBRARY IS IN CARD IMAGE FORMAT
;EDIT 21	NEW SWITCH /D - DIRECTORY LIST ONLY THE PROGRAM NAME
;EDIT 20	OUTPUT LAST LIST BUFFER BEFORE GOING BACK FOR NEW COMMAND
;EDIT 17	FIX COMMAND SCANNER AFTER /L AND CLOSE BEFORE RENAME
;EDIT 16	CLEAR PROG COUNTER SO RESTART WORKS PROPERLY
;EDIT 15	MAKE LEADING SPACE BE IGNORED IN TEXT
;EDIT 14	FIX BAD ERROR MSG IF INPUT IS "*"
;EDIT 13	FIX JOBDAT SYMBOLS
;EDIT 12	FIX LINE NUMBER ROUTINE TO NOT GET 'ADDR CHECK'
;EDIT 11	FIX PROBLEM STEMMING FROM USING EXTRACT,DELETE
;		WITHOUT AN END BETWEEN THEM.
;
;		EXTRACT XXXXXX,FOO.EXT
;		DELETE YYYYYY
;		END
;		***********************
;		WHICH KILLS THE OUTPUT DIRECTORY AND
;		RENDERS THE LIBARY USELESS.
;		MDS  MAY 22/74.
;
;EDIT 10	FIX "I/O TO UNASSIGNED CHANNEL" WHEN INSERTING   ILG  25-JAN-74
;ACCUMULATORS

SW=0			;SWITCH REGISTER
TA=1			;TEMPORARY
TB=2			;TEMPORARY
TC=3			;TEMPORARY
TD=4			;TEMPORARY
TE=5			;TEMPORARY
TF=6			;TEMPORARY
TG=7			;TEMPORARY
TH=10			;TEMPORARY

DN=11			;DEVICE NAME FROM "GETDEV"
FN=12			;FILE-NAME FROM "GETDEV"
EX=13			;EXTENSION FROM "GETDEV"
PJ=14			;PROJ-PROG NUMBER FROM "GETDEV"

CP==TH			;POINTER TO 'COMSAV' AREA
PN==DN			;POINTER TO FINE TABLE (/L ONLY)
FT==FN			;RELATIVE ADDRESS OF FINE TABLE (/L ONLY)

WD=14			;I/O WORD
LN=15			;LINE NUMBER
CH=16			;TTY CHARACTER
PP=17			;PUSH-DOWN POINTER

;I/O CHANNELS

TTY==1			;TELETYPE
TOD==2			;TEMPORARY OUTPUT DIRECTORY
TOF==3			;TEMPORARY OUTPUT FILE
TID==4			;TEMPORARY INPUT DIRECTORY
OIF==5			;ORIGINAL INPUT FILE
FOF==6			;FINAL OUTPUT FILE
LST==7			;LISTING FILE
OFF==10			;'OFF-LINE' FILE

;MISCELLANEOUS

RUFPTR:	IOWD	200,RUFTAB+1
LINPAG==^D58		;[24] LINES PER PRINTED PAGE (EXCLUDING HEADING)

SEQFLG==40		;PROGRAM IS SEQUENCED

;SWITCH REGISTER FLAGS

ENDP==1B18		;END OF INPUT PROGRAM SEEN
ENDF==1B19		;END OF OUTPUT PROGRAM SEEN
FSRC==1B20		;INPUT FILE HAS BEEN MOVED
REGET==1B21		;GET PREVIOUS CHARACTER FROM TTY
INDIR==1B22		;INPUT FILE IS A DIRECTORY DEVICE
NOINP==1B23		;THERE IS NO INPUT FILE
OUTDIR==1B25		;OUTPUT DEVICE HAS A DIRECTORY
LISTIT==1B26		;THERE IS A LISTING FILE
DOLIST==1B27		;LIST THIS FILE AS IT IS WRITTEN
NOTTY==1B28		;COMMAND FILE IS NOT TTY
LSWICH==1B29		;WE ARE DOING LISTING OF ENTIRE FILE ONLY
ENDCOM==1B30		;NO MORE COMMANDS FROM COMMAND FILE
HAVS04==1B31		;WE ARE READING 'JJJS04' AS INPUT
LSTTY==1B32		;LISTING IS ON CONSOLE
CHAR1==1B34		;[15] THIS IS THE FIRST CHARACTER OF TEXT
DSWICH==1B35		;/ DIRECTORY HEADER SO LIST ONLY THE PROGRAM NAME

	DEFINE ERRORA (X),<
	PUSHJ	PP,TYPEQA
	OUTSTR	[ASCIZ "'X'
"]
	>

	DEFINE ERRORB (X),<
	PUSHJ	PP,TYPEQB
	OUTSTR	[ASCIZ "'X'
"]
	>

	DEFINE ERRORC (X),<
	PUSHJ	PP,TYPEQA
	OUTSTR	[ASCIZ "'X'"]
	>

;SPECIAL CHARACTERS

$HT==11
$LF==12
$VT==13
$FF==14
$CR==15
$DLE==20
$DC4==24
$CZ==32
$SP==40
		$COPYRIGHT	;Put standard copyright in .EXE file
START:	JSP	TA,INITTY	;INITIALIZE TTY

START1:	HLRZ	TA,.JBSA	;[13]SAVE ENOUGH
	ADDI	TA,406		; ROOM FOR TWO
	MOVEM	TA,SAVJFF	;  DISK BUFFERS FOR COMMAND FILE
	HRRM	TA,.JBFF	;[13]

	MOVE	PP,PPOINT	;SET UP PUSH-DOWN POINTER
	MOVE	TA,[XWD IMPVAL,LOWIMP]	;SET UP IMPURE AREA
	BLT	TA,HIIMP

	SETZM	LOCLR		;CLEAR SOME IMPURE AREA
	MOVE	TA,[XWD LOCLR,LOCLR+1]
	BLT	TA,HICLR

IFE TOPS20,<
	SETOM	MYPATH		;[27] MY JOB,,GET PATH FUNCTION
	MOVE	TA,[11,,MYPATH]	;[27] 
	PATH.	TA,		;[27] GET DEFAULT PATH
	  SETZM	MYPPN		;[27] FAILED
>
IFN TOPS20,<
	GETPPN	TA,		;[27] GET LOGGED-IN PPN
	  JFCL			;[27] JUST INCASE JACCT ON
	MOVEM	TA,MYPPN	;[27] STORE IT
>
	PUSHJ	PP,DATIME	;SET UP DATE AND TIME FOR HEADER
	PUSHJ	PP,GETDEV

	TRNE	SW,LSWICH	;IS THIS "/L" FUNCTION?
	JRST	LSTFIL		;YES

	PJOB	TA,		;GET JOB NUMBER
	PUSHJ	PP,CONVBD
	HLLM	TC,TOFNAM
	HLLM	TC,TODNAM
	HLLM	TC,TIDNAM
	SETZB	TA,TOEXTN
	OPEN	TOF,TOFDAT
	  JRST	NODSK
	OPEN	TOD,TODDAT
	  JRST	NODSK
	TRNE	SW,NOINP	;ANY INPUT FILE?
	JRST	START7		;NO
;SKIP OVER ROUGH TABLE

	OPEN	TID,TIDDAT
	  JRST	NODSK

	MOVE	TA,RUFPTR
START2:	PUSHJ	PP,GETOIF
	MOVEM	WD,0(TA)
	AOBJN	TA,START2

;COPY INPUT DIRECTORY TO DISK

	SETZM	TIDNAM+3
	SETZM	TIDNAM+2
	MOVEI	TA,TIDNAM	;[27] IN CASE OF ERROR
	ENTER	TID,TIDNAM
	  JRST	NOEDSK
	MOVE	TA,.JBFF	;[13]
	MOVEM	TA,TIDBUF
	OUTBUF	TID,2

START3:	PUSHJ	PP,GETOIF
	PUSHJ	PP,PUTTID
	AOJE	WD,START4
	PUSHJ	PP,GETOIF
	PUSHJ	PP,PUTTID
	JRST	START3

START4:	CLOSE	TID,

START5:	SKIPN	TA,TIDBUF
	MOVE	TA,.JBFF	;[13]
	MOVEM	TA,TIDBUF
	MOVEM	TA,.JBFF	;[13]
	INBUF	TID,1

	SETZM	TIDNAM+3
	MOVEI	TA,TIDNAM	;[27] IN CASE OF ERROR
	LOOKUP	TID,TIDNAM
	  JRST	NOLDSK
	PUSHJ	PP,COPYL3

;SET UP OUTPUT SCRATCH FILES


START7:	SETZM	TODNAM+3
	SETZM	TODNAM+2
	MOVEI	TA,TODNAM	;[27] IN CASE OF ERROR
	ENTER	TOD,TODNAM
	  JRST	NOEDSK
	MOVE	TA,.JBFF	;[13]
	MOVEM	TA,TODBUF
	OUTBUF	TOD,2

	SETZM	TOFNAM+3
	SETZM	TOFNAM+2
	MOVEI	TA,TOFNAM	;[27] IN CASE OF ERROR
	ENTER	TOF,TOFNAM
	  JRST	NOEDSK
	MOVE	TA,.JBFF	;[13]
	MOVEM	TA,TOFBUF
	OUTBUF	TOF,2

	SETZM	PRGCTR		;[16] CLEAR PROGRAM COUNTER FOR RESTART
	SETOM	RUFTAB
	MOVE	TA,[XWD RUFTAB,RUFTAB+1]
	BLT	TA,RUFTAB+177

	SETZM	RUFCTR

	MOVEI	TA,RUFTAB
	MOVEM	TA,RUFLOC

	MOVEI	TA,200
	MOVEM	TA,OFFSET
	MOVEM	TA,FINCTR

	SETZM	TOFCTR
	SETZM	OUTNAM
;GET ANOTHER MAJOR COMMAND FROM TTY

NEWCOM:	MOVE	PP,PPOINT
	SETZM	SEQ
	PUSHJ	PP,GETCOM

NEWCM1:	ANDCMI	SW,DOLIST	;TURN OFF "LIST THIS PROG" FLAG

	PUSHJ	PP,TSTCOM	;SEE IF THIS IS A VALID COMMAND
	JUMPN	TA,(TA)		;IF IT IS--GO TO APPROPRIATE ROUTINE

	ERRORA	<Improper command>
	PUSHJ	PP,SKPTTY	;[30] CLEAR REST OF BAD COMMAND
	JRST	NEWCOM

;FIND NEXT MAJOR COMMAND IN CCL FILE AFTER ERROR

SKPCOM:	TRNN	SW,NOTTY	;CCL COMMANDS?
	JRST	NEWCOM		;NO

SKPCM1:	MOVE	PP,PPOINT
	PUSHJ	PP,GETCOM
	ANDCMI	SW,DOLIST
	PUSHJ	PP,TSTCOM
	JUMPN	TA,(TA)		;GO EXECUTE VALID COMMAND
SKPCM2:	PUSHJ	PP,GETTY	;SKIP TO END OF INVALID LINE
	CAIL	CH,$LF
	CAILE	CH,$FF
	JRST	SKPCM2
	JRST	SKPCM1		;IGNORE INVALID COMMAND
;INSERT A NEW PROGRAM

INSERT:	PUSHJ	PP,SEARCH	;GET TO INSERTION POINT
	JRST	SKPCOM		;OOPS, PASSED IT!
	JRST	INSRT0		;GOT TO THE RIGHT PLACE

	ERRORA	<That program already exists>
	JRST	SKPCOM

INSRT0:	SKIPN	OFFDEV		;ANY 'OFF-LINE' FILE?
	JRST	INSRE0		;NO, COMPLAIN
	PUSHJ	PP,SETOFF	;SET UP 'OFF-LINE' FILE
	JRST	SKPCOM		;TROUBLE--FORGET THE WHOLE THING

INSRT1:	MOVE	TA,SEQ		;GET SEQ FLAG
	MOVEM	TA,OUTSEQ
	PUSHJ	PP,PUTNNM	;PUT NAME IN OUTPUT DIRECTORY

	SETOM	OUTLIN

;COPY PROGRAM FROM 'OFF-LINE' FILE

	PUSHJ	PP,COPOFF
	MOVNI	WD,1
	PUSHJ	PP,LSTFIN	;[20] PUT OUT LAST LISTING BUFFER
	PUSHJ	PP,PUTTOF
	JRST	NEWCOM

INSRE0:	ERRORA	<Need input file for insertion>
	JRST	SKPCOM
;DELETE A PROGRAM

DELETE:	PUSHJ	PP,SEARCH	;FIND THE PROGRAM
	  JRST	SKPCOM
	  JRST	NOPROG		;IT DOESN'T EXIST
	SKIPE	OFFDEV		;ANY 'OFF-LINE' FILE?
	JRST	DELET1		;YES--ERROR
	PUSHJ	PP,PASSP	;SKIP OVER THE PROGRAM
	JRST	NEWCOM

DELET1:	ERRORA	<File name not allowed with this command>
	JRST	SKPCOM

;REPLACE A PROGRAM

REPLAC:	PUSHJ	PP,SEARCH	;FIND THE PROGRAM
	  JRST	SKPCOM
	  JRST	NOPROG		;IT DOESN'T EXIST
	SKIPN	OFFDEV		;'OFF-LINE' FILE REQUIRED
	JRST	REPLE0		; NOT GIVEN.. COMPLAIN
	PUSHJ	PP,SETOFF	;SET UP ANY 'OFF-LINE' FILE
	JRST	SKPCOM		;ERROR--QUIT
	PUSHJ	PP,PASSP	;SKIP OVER THE PROGRAM
	JRST	INSRT1		;COPY 'OFF-LINE' FILE INSTEAD

REPLE0:	ERRORA	<Input file required for replacing>
	JRST	SKPCOM
;EXTRACT A PROGRAM

XTRACT:	PUSHJ	PP,SEARCH	;FIND THE PROGRAM
	  JRST	SKPCOM		;IT HAS BEEN PASSED
	  JRST	NOPROG		;IT DOESN'T EXIST
	SKIPN	OFFDEV		;ANY 'OFF-LINE' FILE?
	JRST	XTRAC8		;NO--ERROR
	SKIPN	TA,OFFBUF	;YES--SET IT UP
	HRRZ	TA,.JBFF	;[13]
	MOVEM	TA,OFFBUF
	HRRM	TA,.JBFF	;[13]

	MOVEI	TA,.IOASC	;ASCII MODE
	MOVE	TB,OFFDEV
	MOVSI	TC,OFFBH

	OPEN	OFF,TA
	  JRST	NOOFFD

	OUTBUF	OFF,2

	MOVE	TE,[XWD OFFNAM,TA]
	BLT	TE,TD
	ENTER	OFF,TA
	  JRST	NOEOFF

	MOVE	TA,INSEQ	;GET SEQ FLAG OF INPUT PROG
	MOVEM	TA,OUTSEQ
	PUSHJ	PP,PUTNNM	;PUT NAME IN OUTPUT DIRECTORY
	SETOM	OUTLIN

	SKIPA	WD,INLIN

XTRAC3:	PUSHJ	PP,GETOIF	;GET NEXT WORD FROM INPUT
	PUSHJ	PP,PUTTOF

	TRNN	WD,1		;IF NOT A LINE NUMBER
	JRST	XTRAC5		;  IT GOES TO EXTRACTION FILE

	AOJE	WD,XTRAC4	;IF END OF PROG, WE ARE ALMOST DONE
	JRST	XTRAC3		;  AND LOOP

XTRAC4:	IORI	SW,ENDP		;SET 'END OF PROGRAM'
	JRST	XTRAC9		;FINISH UP
;EXTRACT A PROGRAM (CONT'D)

XTRAC5:	MOVE	TA,[POINT 7,WD]	;WRITE
XTRAC6:	ILDB	CH,TA		;  WORD
	JUMPE	CH,XTRA6B	;  ONTO
	CAIL	CH,$LF		;  EXTRACTION
	CAILE	CH,$FF		;  FILE
	TRNA
	JRST	XTRAC7		;  *
XTRA6A:	PUSHJ	PP,PUTOFF	;  *
XTRA6B:	TLNE	TA,760000	;  *
	JRST	XTRAC6		;  *

	JRST	XTRAC3		;BACK FOR ANOTHER WORD

XTRAC7:	PUSH	PP,CH
	MOVEI	CH,$CR
	PUSHJ	PP,PUTOFF
	POP	PP,CH
	JRST	XTRA6A

XTRAC8:	ERRORA	<Need output file for extraction>
	JRST	SKPCOM

XTRAC9:	CLOSE	OFF,		;CLOSE OUT
	STATO	OFF,IO.ERR	;IF NO ERROR,
	  JRST	XTRA9A		;  SKIP THE ERROR TYPEOUT

	ERRORA	<Output error when extraction file closed>
XTRA9A:	RELEASE	OFF,
	PUSHJ	PP,COPYL3
	PUSHJ	PP,LSTFIN	;[20] OUTPUT LAST LISTING BUFFER
	ANDCMI	SW,ENDP		;[11] CLEAR END OF PROGRAM FLAG
				;[11] BEFORE GOING BACK TO TTY FOR NEXT COMMAND
	JRST	NEWCOM
;RESTART MAINTENANCE.
;TEMPORARY OUTPUTS BECOME INPUTS.

RESTRT:	LDB	CH,TTYIB+1
	CAIL	CH,$LF
	CAILE	CH,$FF
	JRST	REST10

	ANDCMI	SW,REGET

	PUSHJ	PP,CLOSOT

	TRNN	SW,NOINP
	JRST	REST1
	OPEN	TID,TIDDAT
	  JRST	REST9
	MOVE	TA,TIDNAM
	MOVSI	TB,'TMP'
	SETZB	TC,TD
	LOOKUP	TID,TA
	  JRST	REST7

REST1:	CLOSE	TID,
	SETZB	TA,TB
	SETZB	TC,TD
	RENAME	TID,TA
	  JRST	REST9

REST2:	MOVE	TA,TIDNAM
	MOVSI	TB,'TMP'
	SETZB	TC,TD
	RENAME	TOD,TA
	  JRST	REST9

	TRNN	SW,NOINP
	JRST	REST3
	MOVEI	TA,.IOBIN
	MOVSI	TB,'DSK'
	MOVEI	TC,OIFIB
	OPEN	OIF,TA
	  JRST	REST9
	SKIPN	TA,OIFBUF
	MOVE	TA,.JBFF	;[13]
	MOVEM	TA,OIFBUF
	MOVEM	TA,.JBFF	;[13]
	INBUF	OIF,2
;RESTART MAINTENANCE (CONT'D)

REST3:	CLOSE	OIF,
	MOVE	TA,TOFNAM	;LOOK FOR FILE 'JJJS04.TMP'
	HRRI	TA,'S04'
	MOVSI	TB,'TMP'
	SETZB	TC,TD
	LOOKUP	OIF,TA
	  JRST	REST8		;IT DOESN'T EXIST (OR POSSIBLY TROUBLE)

	CLOSE	OIF,		;OK--NOW DELETE IT
	SETZB	TA,TB
	SETZB	TC,TD
	RENAME	OIF,TA
	  JRST	REST9		;TROUBLE

REST4:	MOVE	TA,TOFNAM	;RENAME 'TOF' TO BE 'JJJS04.TMP'
	HRRI	TA,'S04'
	MOVSI	TB,'TMP'
	SETZB	TC,TD
	RENAME	TOF,TA
	  JRST	REST9		;TROUBLE

	SETZB	TC,TD		;OK--NOW OPEN THAT FILE FOR INPUT
	LOOKUP	OIF,TA
	  JRST	REST9

	ANDCMI	SW,ENDF!NOINP!ENDP
	IORI	SW,HAVS04	;REMEMBER THE RESTART
	JRST	START5

REST7:	TRNN	TB,-1		;[27] FILE NOT FOUND ERROR?
	JRST	REST2		;[27] YES
	JRST	REST9

REST8:	TRNN	TB,-1		;[27] FILE NOT FOUND ERROR?
	JRST	REST4		;[27] YES


REST9:	PUSHJ	PP,SAVEA	;[27] SAVE ERROR CODE
	OUTSTR	[ASCIZ "
?Trouble renaming files "]
	PUSHJ	PP,LREERR	;[27] COMMON ERROR ROUTINE
	EXIT

REST10:	PUSHJ	PP,BADCOM
	JRST	NEWCOM
;"END" COMMAND HAS BEEN TYPED.

ALLDUN:	PUSHJ	PP,CLOSOT

	MOVE	TA,TODBUF
	MOVEM	TA,.JBFF	;[13]
	INBUF	TOD,2
	MOVE	TA,TOFBUF
	MOVEM	TA,.JBFF	;[13]
	INBUF	TOF,2

	PUSHJ	PP,SETBAK	;SET UP OUTPUT

	MOVE	TA,RUFPTR

ALDUN2:	MOVE	WD,0(TA)
	PUSHJ	PP,PUTFOF
	AOBJN	TA,ALDUN2

	SETZM	TODNAM+2
	SETZM	TODNAM+3	;[27] CLEAR PPN SET BY ENTER
	MOVEI	TA,TODNAM	;[27] IN CASE OF ERROR
	LOOKUP	TOD,TODNAM
	  JRST	NOLDSK

ALDUN3:	PUSHJ	PP,GETTOD
	PUSHJ	PP,PUTFOF
	AOJE	WD,ALDUN4

	PUSHJ	PP,GETTOD
	ADD	WD,OFFSET
	PUSHJ	PP,PUTFOF

	JRST	ALDUN3

ALDUN4:	SETZM	TOFNAM+3
	MOVEI	TA,TOFNAM	;[27] IN CASE OF ERROR
	LOOKUP	TOF,TOFNAM
	  JRST	NOLDSK

ALDUN5:	PUSHJ	PP,GETTOF
	  JRST	ALDUN6
	PUSHJ	PP,PUTFOF
	JRST	ALDUN5
;CLOSE OUT ALL FILES, AND DELETE ALL SCRATCH FILES

ALDUN6:	MOVEI	TA,0		;FILE-NAME FOR 'DELETE'

	CLOSE	TOD,
	RENAME	TOD,TA
	  JFCL
	RELEASE	TOD,

	CLOSE	TOF,
	RENAME	TOF,TA
	  JFCL
	RELEASE	TOF,

	TRNN	SW,NOINP	;ANY INPUT FILE?
	JRST	ALDN6A		;YES
	TRNN	SW,HAVS04	;NO--READING SCRATCH?
	JRST	ALDUN7		;NO
ALDN6A:	CLOSE	TID,
	RENAME	TID,TA
	  JFCL
	RELEASE	TID,

	TRZN	SW,HAVS04	;WERE WE READING SCRATCH?
	JRST	ALDUN7		;NO
	CLOSE	OIF,		;YES--
	RENAME	OIF,TA		;DELETE IT
	  JFCL

ALDUN7:	RELEASE	OIF,

	SKIPN	FOFDAT+1	;ANY FOF FILE?
	JRST	ALDUN8		;NO
	CLOSE	FOF,
	STATZ	FOF,IO.ERR+IO.EOF
	OUTSTR	[ASCIZ "?Error while closing output file
"]
	RELEASE	FOF,

ALDUN8:	RELEASE	LST,

ALDUN9:	TRNE	SW,ENDCOM	;END OF NON-TTY COMMAND FILE?
	JRST	START		;YES--START AT RESET

	PUSHJ	PP,GETTY	;SKIP UP TO THE BEGINNING
	CAIL	CH,$LF		; OF THE NEXT LINE.
	CAILE	CH,$FF
	JRST	ALDUN9
	JRST	START1		;AND THEN GO RESTART.
;LIST THE ENTIRE LIBRARY FILE

LSTFIL:	IORI	SW,REGET	;[17] REGET THE <CR> TO INDICATE END OF CMD
	ENTER	LST,LSTNAM	;ENTER LISTING FILE
	  JRST	CNTLST		;CANNOT--ERROR

	MOVEI	FT,2

LSTF3:	PUSHJ	PP,GETFT

	MOVE	PN,[XWD -^D64,FINTAB]

LSTF4:	MOVE	TA,(PN)
	AOJE	TA,ALDUN7

	SUBI	TA,1
	MOVEM	TA,OUTNAM
	MOVE	TA,1(PN)
	MOVEM	TA,OUTNAM+1
	SETZM	PAGNO			;[24] START ON PAGE 1
	PUSHJ	PP,LSTHDG
	AOS	LINECT			;[24] ACCOUNT FOR SOS AT LSTF6
	TRNE	SW,DSWICH		;IF /DIRECTORY HEADER SWITCH
	JRST	LSTF10			;DONT LIST THE FILE

	MOVE	TA,1(PN)
	AND	TA,[XWD 37,-1]
	LSHC	TA,-7
	USETI	OIF,1(TA)
	IN	OIF,
	  AOSA	OIFIB+2
	JRST	LSTERA

	MOVEI	TA,0
	LSHC	TA,7
	ADDM	TA,OIFIB+1
	MOVNS	TA
	ADDM	TA,OIFIB+2
;LIST THE LIBRARY (CONT'D)

LSTF6:	PUSHJ	PP,GETOIF
	TRNN	WD,1
	JRST	TRBL1

	CAMN	WD,[<ASCII /     />+1]	;SOS PAGE MARK?
	JRST	LSTF11		;YES
	MOVE	TA,WD
	AOJE	TA,LSTF10

	SOSG	LINECT		;[24] ROOM LEFT ON PAGE?
	PUSHJ	PP,LSTHDG	;[24] NO, START AGAIN

	LSH	WD,-1
	PUSHJ	PP,LINOUT

LSTF7:	PUSHJ	PP,GETOIF
	TRNE	WD,1
	JRST	TRBL2

	MOVE	TA,[POINT 7,WD]
LSTF8:	ILDB	CH,TA
	CAIL	CH,$LF		;IS CHARACTER A LINE-FEED?
	CAILE	CH,$FF		;OR VT, OR FF?
	TRNA			;NO
	JRST	LSTF9		;YES

	PUSHJ	PP,PUTL2
	TLNE	TA,760000	;IS WORD NOW EMPTY?
	JRST	LSTF8		;NO
	JRST	LSTF7		;YES--GET ANOTHER

LSTF9:	MOVE	TA,CH		;SAVE END-LINE CHARACTER
	MOVEI	CH,$CR
	PUSHJ	PP,PUTL2
	MOVEI	CH,$LF
	CAME	TA,CH		;IS EOL A LF?
	PUSHJ	PP,PUTL2	;NO, PUT OUT A LF FIRST
	MOVE	CH,TA		;PUT OUT
	PUSHJ	PP,PUTL2	;  END-LINE CHARACTER
	JRST	LSTF6


LSTF10:	ADDI	PN,1
	AOBJN	PN,LSTF4
	JRST	LSTF3

LSTF11:	PUSHJ	PP,GETOIF	;GET WORD AFTER PAGE MARK
	MOVEI	CH,$FF		;FAKE UP FORM FEED
	PUSHJ	PP,PUTL2	;OUTPUT IT
	JRST	LSTF6		;GET NEXT LINE
;PRINT OUT LINE NUMBER

LINOUT:	MOVE	TA,WD
	MOVEI	TC,0
	MOVEI	TD,6

LINOT1:	IDIVI	TA,^D10
	ADDI	TB,"0"
	LSHC	TB,-6
	SOJG	TD,LINOT1

LINOT2:	MOVEI	TB,0
	LSHC	TB,6
	MOVEI	CH,(TB)
	PUSHJ	PP,PUTL2
	JUMPN	TC,LINOT2

	MOVEI	CH,$HT		;[25] PUT OUT TAB
	JRST	PUTL2		;[25]  AFTER LINE NUMBER
;GET ONE BLOCK OF FINE-TABLE

GETFT:	USETI	OIF,(FT)
	IN	OIF,
	  TRNA
	JRST	DIRERA

	MOVS	TA,OIFIB+1
	HRRI	TA,FINTAB-1
	BLT	TA,FINTAB+177
	AOJA	FT,CPOPJ


;PUT A MESSAGE ONTO LISTING FILE

PUTMES:	ILDB	CH,TE
	JUMPE	CH,CPOPJ
	PUSHJ	PP,PUTL2
	JRST	PUTMES

;CONVERT JOB NUMBER IN "TA" TO DECIMAL

CONVBD:	MOVEI	TD,3

CONVB1:	IDIVI	TA,^D10
	ADDI	TB,"0"-40
	LSHC	TB,-6
	SOJG	TD,CONVB1

	POPJ	PP,
;GET A COMMAND FROM TTY

GETCOM:	TRNE	SW,ENDCOM	;COMMAND FILE EMPTY?
	JRST	GTCOM8		;YES

	CAIN	CH,"@"
	JRST	GTCM10

	MOVE	CP,[POINT 7,COMSAV]
	TRNN	SW,NOTTY
	OUTSTR	[ASCIZ "*"]
	MOVE	TA,[POINT 6,COMWRD]
	SETZM	COMWRD
	SETZM	COMWRD+1

GTCOM1:	PUSHJ	PP,GETTY
	TRNE	SW,ENDCOM
	JRST	GTCOM8

	CAIN	CH,"@"
	JRST	GTCM10

	CAIL	CH,$LF
	CAILE	CH,$FF
	TRNA
	JRST	GTCOM2

	CAIGE	CH,140
	CAIGE	CH,40
	JRST	GTCOM7

	CAIN	CH,$SP
	JRST	GTCOM2
;	CAIE	CH,"*"	;[SEB] FIX MULTIPLE "IMPROPER COMMAND" MSGS
	CAIN	CH,"-"
	JRST	GTCOM3

	SUBI	CH,40
	IDPB	CH,TA
	CAME	TA,[POINT 6,COMWRD+1,35]
	JRST	GTCOM1
	JRST	GTCOM9

GTCOM2:	CAMN	TA,[POINT 6,COMWRD]
	JRST	GTCOM1

GTCOM3:	IORI	SW,REGET
	POPJ	PP,

GTCOM7:	CAIN	CH,$HT
	JRST	GTCOM2

	CAIE	CH,$LF
	JRST	GTCOM9
	MOVE	TA,COMWRD
	CAMN	TA,[SIXBIT "END"]
	JRST	GTCOM3
GTCOM8:	MOVSI	TA,'END'
	MOVEM	TA,COMWRD
	POPJ	PP,

GTCOM9:	PUSHJ	PP,BADCOM
	JRST	GETCOM



;'@' SEEN IN COMMAND

GTCM10:	CAME	TA,[POINT 6,COMWRD]
	JRST	GTCM11
	SETZB	DN,FN
	SETZB	EX,PJ
	PUSHJ	PP,GTDV8Z	;[27] SCAN FOR 'DEV:FILE.EXT[P,P]'
	  JFCL			;IGNORE ERROR (MESSAGE WAS TYPED)
	JRST	GETCOM		;GO BACK FOR ANOTHER COMMAND

GTCM11:	PUSHJ	PP,BADCOM
	JRST	GETCOM
;SEE IF THE COMMAND IS ONE OF THE MAJOR ONES.
;IF SO, RETURN WITH TA CONTAINING THE ADDRESS OF THE
;   APPROPRIATE ROUTINE

TSTCOM:	MOVSI	CH,LSTSIZ
	MOVE	TA,COMWRD
	SETO	TC,		;FIND MASK FOR TRAILING NULLS
	LSH	TC,-6
	TDNE	TA,TC
	JRST	.-2

TSTCM1:	MOVE	TB,LIST1(CH)
	ANDCM	TB,TC
	CAME	TA,TB
	AOBJN	CH,TSTCM1
	JUMPGE	CH,TSTCM2
	SKIPA	TA,LIST2(CH)

TSTCM2:	MOVEI	TA,0
	POPJ	PP,

DEFINE	COMMANDS<
XX	DELETE,DELETE
XX	END,ALLDUN
XX	EXTRACT,XTRACT
XX	INSERT,INSERT
XX	REPLACE,REPLAC
XX	RESTART,RESTRT
>

DEFINE	XX(A,B)<	<SIXBIT	/A/>>

LIST1:	COMMANDS

DEFINE	XX(A,B)<	EXP	B>

LIST2:	COMMANDS

LSTSIZ==LIST2-.
;COPY A LINE FROM INPUT FILE TO OUTPUT FILE

COPYL:	MOVEI	WD,^D10*2
COPYL0:	SKIPA	WD,INLIN
	MOVEM	WD,OUTLIN	;THAT'S NEW OUTPUT LINE
	JUMPL	WD,COPYL2	;[31] MODULE IS EMPTY
COPYL1:	PUSHJ	PP,PUTTOF	;WRITE IT

	PUSHJ	PP,GETOIF	;GET INPUT WORD
	TRNN	WD,1B35		;IS IT A LINE NUMBER?
	JRST	COPYL1		;NO - LOOP

COPYL2:	MOVEM	WD,INLIN	;YES -- THAT'S NEW INPUT LINE
	AOJN	WD,CPOPJ	;WAS IT MINUS 1?
	IORI	SW,ENDP		;YES -- SET "END OF PROGRAM"

COPYL3:	PUSHJ	PP,GETTID	;GET PROGRAM NAME
	AOJE	WD,COPYL5	;ANYTHING THERE?
	SUBI	WD,1		;YES
	MOVEM	WD,INNAM
	PUSHJ	PP,GETTID
	SETZM	INSEQ		;ASSUME NOT SEQUENCED
	TLNE	WD,SEQFLG	;IS IT
	SETOM	INSEQ		;YES
	AND	WD,[XWD 777700,0]
	MOVEM	WD,INNAM+1

	PUSHJ	PP,GETOIF	;GET NEXT LINE NUMBER
	MOVEM	WD,INLIN	;SAVE LINE NUMBER
	POPJ	PP,

COPYL5:	IORI	SW,ENDF		;NO MORE PROGRAMS--SET "END-FILE"
	POPJ	PP,

;PASS OVER ONE LINE OF INPUT

PASSL:	PUSHJ	PP,GETOIF	;COPY WORDS UNTIL
	TRNN	WD,1B35		;	1-BIT SEEN
	JRST	PASSL

	JRST	COPYL2
;COPY A PROGRAM FROM INPUT TO OUTPUT

COPYP:	TRZE	SW,ENDP		;END OF PROGRAM SEEN?
	JRST	COPYP1		;YES

	PUSHJ	PP,COPYL0	;NO--COPY ONE LINE
	JRST	COPYP		;LOOP

COPYP1:	MOVNI	WD,1		;WRITE OUT LAST LINE NUMBER
	JRST	PUTTOF


;PASS OVER A PROGRAM

PASSP:	PUSHJ	PP,PASSL
	TRZN	SW,ENDP
	JRST	PASSP

	POPJ	PP,
;SEARCH FOR THE PROGRAM SPECIFIED BY "NEWNAM"
;IF AT END OF INPUT FILE, PUT OUT ERROR MESSAGE AND
;	RETURN TO CALL+1.
;IF THE PROGRAM HAS BEEN PASSED, PUT OUT ERROR MESSAGE AND
;	RETURN TO CALL+1.
;IF THE PROGRAM DOESN'T EXIST, RETURN TO CALL+2.
;RETURN TO CALL+3 IF THE PROGRAM IS FOUND.

SEARCH:	ANDCMI	SW,FSRC		;TURN OFF "WE HAVE MOVED INPUT"
	PUSHJ	PP,GETNAM	;GET PROGRAM NAME
	  POPJ	PP,		;ERROR-QUIT

SERCH1:	TRNE	SW,ENDF		;END OF INPUT?
	JRST	SERCH4		;YES -- ERROR
	MOVEI	TB,INNAM
	PUSHJ	PP,COMPAR
	  JRST	SERCH4		;NEW NAME LESS THAN NEXT INPUT
	  JRST	SERCH2		;NEW NAME GREATER THAN NEXT INPUT
CPOPJ2:	AOS	(PP)		;NEW NAME EQUAL TO NEXT INPUT
CPOPJ1:	AOS	(PP)
CPOPJ:	POPJ	PP,

SERCH2:	PUSHJ	PP,PUTINM	;PUT NAME IN OUTPUT DIRECTORY
	PUSHJ	PP,COPYP	;COPY THIS PROGRAM
	IORI	SW,FSRC		;SET "WE HAVE MOVED INPUT"
	ANDCMI	SW,ENDP		;INSURE "END-OF-PROGRAM" IS RESET
	JRST	SERCH1		;LOOP

SERCH4:	TRNE	SW,FSRC		;YES -- WAS INPUT DONE?
	JRST	CPOPJ1		;YES -- PROGRAM DOESN'T EXIST

	MOVEI	TB,OUTNAM	;NO--IS NEW NAME GREATER THAN LAST WRITTEN?
	PUSHJ	PP,COMPAR
	  JRST	SERCH5		;LESS--ERROR
	  JRST	CPOPJ1		;GREATER--OK

SERCH5:	ERRORA	<Program, if it exists, has been passed>
	POPJ	PP,
;SCAN COMMAND TO SET UP INPUT AND OUTPUT FILES

GETDEV:	TRNE	SW,ENDCOM	;AT END OF COMMAND FILE?
	JRST	START		;YES--GO BACK TO TTY

	MOVE	CP,[POINT 7,COMSAV]

	ANDI	SW,NOTTY	;CLEAR ALL SWITCHES EXCEPT "COMMANDS NOT ON TTY"
	MOVE	TA,SAVJFF	;RESET JOBFF
	MOVEM	TA,.JBFF	;[13]

	TRNN	SW,NOTTY	;TYPE "*" IF COMMAND FILE NOT TTY
	OUTSTR	[ASCIZ "
*"]
	PUSHJ	PP,GETTY	;IS THERE A
	CAIL	CH,12		;  LINE-FEED WAITING?
	CAILE	CH,14		;OR VT, OR FF?
	TROA	SW,REGET	;NO--SET UP TO REGET CHARACTER
	JRST	GETDEV		;YES--FORGET IT

GTDEV0:
IFE TOPS20,<
	MOVEI	PJ,FOFPTH+.PTPPN	;[27] SFD PATH
>
	PUSHJ	PP,GTDEV6	;SCAN ONE FILE DESCRIPTOR
	CAIN	CH,"/"
	PUSHJ	PP,GTDEV7
	CAIN	CH,"@"
	JRST	GTDV0A

	SKIPN	DN
	MOVSI	DN,'DSK'

	MOVE	TA,DN		;GET
	DEVCHR	TA,		;  CHARACTERISTICS
	JUMPE	TA,NOTDEV	;IF ZERO--NOT A DEVICE
	MOVEM	TA,ODEVCH	;SAVE CHARACTERISTICS

	MOVEM	DN,FOFDAT+1
	MOVEM	FN,FOFNAM
	MOVEM	EX,FOFNAM+1
	MOVEM	PJ,FOFNAM+3
	JRST	GTDEV1

GTDV0A:	PUSHJ	PP,GTDEV8
	  JRST	START1		;ERROR
	JRST	GTDEV0
;SET UP INPUT AND OUTPUT FILES (CONT'D).

;NOW DO LISTING FILE

GTDEV1:	CAIE	CH,","		;IS THERE A LISTING FILE?
	JRST	GTDV1B		;NO

GTDV1A:
IFE TOPS20,<
	MOVEI	PJ,LSTPTH+.PTPPN	;[27] LISTING SFD
>
	PUSHJ	PP,GTDEV6	;YES--SCAN IT
	CAIN	CH,"/"
	PUSHJ	PP,GTDEV7
	CAIN	CH,"@"
	JRST	GTDV1C

	SKIPN	DN
	MOVSI	DN,'DSK'
	MOVE	TA,DN
	DEVCHR	TA,
	JUMPE	TA,NOTDEV
	MOVEM	DN,LSTDAT+1

	SKIPN	FN
	MOVE	FN,['LIBARY']
	MOVEM	FN,LSTNAM

	SKIPN	EX
	MOVSI	EX,'LST'
	MOVEM	EX,LSTNAM+1
	MOVEM	PJ,LSTNAM+3

	OPEN	LST,LSTDAT
	  JRST	NOTAV

	OUTBUF	LST,2

	ENTER	LST,LSTNAM
	  JRST	CNTLST

	IORI	SW,LISTIT
	MOVE	TA,LSTDAT+1
	DEVCHR	TA,
	TXNE	TA,DV.TTU
	IORI	SW,LSTTY

GTDV1B:	CAIN	CH,"="
	JRST	GTDEV2
	PUSHJ	PP,BADCOM
	JRST	GOBACK

GTDV1C:	PUSHJ	PP,GTDEV8
	  JRST	START1		;ERROR
	JRST	GTDV1A
;SET UP INPUT AND OUTPUT FILES  (CONT'D).

;NOW DO INPUT FILE

GTDEV2:
IFE TOPS20,<
	MOVEI	PJ,OIFPTH+.PTPPN	;[27] SFD PATH
>
	PUSHJ	PP,GTDEV6
GTDV2C:	CAIN	CH,"/"
	PUSHJ	PP,GTDEV7
	CAIN	CH,"@"
	JRST	GTDV4A

	CAIL	CH,$LF
	CAILE	CH,$FF
	JRST	[CAIE	CH,$SP		;SKIP TRAILING BLANKS.
		JRST	IMPCOM
		PUSHJ	PP,GETTY
		JRST	GTDV2C]

	JUMPN	DN,GTDEV3
	JUMPN	FN,GTDV2A
	JUMPN	EX,GTDV2A
	JUMPN	PJ,GTDV2A

	IORI	SW,ENDF!NOINP
	SETZM	INDEV
	TRNE	SW,LSWICH
	JRST	IMPCOM
	JRST	GTDV5B

GTDV2A:	MOVSI	DN,'DSK'

GTDEV3:	MOVE	TA,DN
	DEVCHR	TA,
	JUMPE	TA,NOTDEV
	TXNN	TA,DV.M14	;BINARY DEVICE?
	JRST	NOTBIN		;NO--ERROR

	TXNN	TA,DV.DIR
	JRST	GTDEV4
	IORI	SW,INDIR
	JUMPE	FN,NONAME

GTDEV4:	TRNE	SW,OUTDIR
	SKIPE	FOFNAM
	JRST	GTDEV5

	JUMPE	FN,NONAME
	MOVEM	FN,FOFNAM
	JRST	GTDEV5

GTDV4A:	PUSHJ	PP,GTDEV8
	JRST	START1
	JRST	GTDEV2
;SET UP INPUT AND OUTPUT FILES (CONT'D)
;DOING INPUT FILE (CONT'D)

GTDEV5:	MOVEM	DN,INDEV
	MOVEM	DN,OIFDAT+1
	MOVEM	FN,OIFNAM
	MOVEM	FN,INFIL

	SKIPN	EX
	MOVSI	EX,'LIB'
	HLLZM	EX,OIFNAM+1
	HLLZM	EX,INEXT
	MOVEM	PJ,OIFNAM+3
	MOVEM	PJ,INPP

	OPEN	OIF,OIFDAT
	  JRST	NOTAV

	SETZM	OIFNAM+2
	MOVE	TE,[XWD OIFNAM,TA]
	BLT	TE,TD
	MOVE	TE,.JBFF	;[13]
	MOVEM	TE,OIFBUF
	ADDI	TE,406

	MOVEI	TF,1
	TRNN	SW,LSWICH
	MOVEI	TF,2
	INBUF	OIF,(TF)

	MOVEM	TE,.JBFF	;[13]

	LOOKUP	OIF,TA
	  JRST	NOFIND
;SET UP I/O FILES  (CONT'D)

;INITIALIZE OUTPUT DEVICE

GTDV5B:	MOVE	TA,ODEVCH
	TXNE	TA,DV.DIR
	IORI	SW,OUTDIR

	SKIPN	TB,FOFNAM
	MOVE	TB,OIFNAM
	JUMPN	TB,.+3
	TRNE	SW,OUTDIR
	JRST	NONAME
	MOVEM	TB,FOFNAM

	TRNE	SW,LSWICH	;ARE WE DOING "/L"?
	JRST	GTDV5C		;YES

	TXNN	TA,DV.M14	;BINARY DEVICE?
	JRST	NOTBIN		;NO--ERROR

	SKIPN	EX,FOFNAM+1	;ANY EXTENSION?
	MOVSI	EX,'LIB'	;NO--USE LIB
	MOVEM	EX,FOFNAM+1

	MOVE	DN,FOFDAT+1
	OPEN	FOF,FOFDAT
	  JRST	NOTAV
	OUTBUF	FOF,2
	POPJ	PP,

GTDV5C:	TRNE	SW,LISTIT	;ARE THERE TWO OUTPUT FILES?
	JRST	TUMANY		;YES
	SKIPN	EX,FOFNAM+1
	MOVSI	EX,'LST'
	MOVEM	EX,FOFNAM+1
	MOVE	TA,[XWD FOFNAM,LSTNAM]
	BLT	TA,LSTNAM+3
	MOVE	DN,FOFDAT+1
	MOVEM	DN,LSTDAT+1
	SETZM	FOFDAT+1
	OPEN	LST,LSTDAT
	  JRST	NOTAV
	OUTBUF	LST,2

	DEVCHR	DN,
	TXNE	DN,DV.TTU
	IORI	SW,LSTTY
	POPJ	PP,
;SCAN 'DEV:FILE.EXT[P,P]

GTDEV6:	MOVEM	CP,SAVECP	;SAVE POINTER TO COMMAND SAVER
IFE TOPS20,<
	MOVEM	PJ,PTHPTR	;[27] STORE POINTER TO SFD BLOCK
>
	SETZB	DN,FN
	SETZB	EX,PJ

	PUSHJ	PP,SKIPBL	;SKIP OVER LEADING BLANKS.
	PUSHJ	PP,GETSIX
	CAIE	CH,":"
	JRST	GTDV6B
	MOVE	DN,TA
	PUSHJ	PP,GETSIX

GTDV6B:	MOVE	FN,TA
	CAIE	CH,"."
	JRST	GTDV6C
	PUSHJ	PP,GETSIX
	HLLZ	EX,TA

GTDV6C:	CAIE	CH,"["
	POPJ	PP,

	PUSHJ	PP,GETOCT
	CAIN	CH,"-"		;[27] CHECK FOR [-]
	JRST	[JUMPN	TA,BADPP	;[27] BUT ONLY ALLOW "-"
IFN TOPS20,<	MOVE	PJ,MYPPN	;[27] GET DEFAULT>
IFE TOPS20,<	MOVEI	PJ,MYPATH	;[27] GET DEFAULT>
		JRST	GTDV6D]		;[27]
	HRLZ	PJ,TA
	CAIE	CH,","
	JRST	BADPP
	SKIPN	TA		;[27] TEST FOR [,PROG]
	HLL	PJ,MYPPN	;[27] AND USE DEFAULT
	PUSHJ	PP,GETOCT
	HRR	PJ,TA
	SKIPN	TA		;[27] TEST FOR [PROJ,]
	HRR	PJ,MYPPN	;[27] AND USE DEFAULT
IFE TOPS20,<
	CAIE	CH,","		;[27] CHECK FOR SFDS
	JRST	GTDV6D		;[27] NOT
	MOVEM	PJ,@PTHPTR	;[27] STORE PPN IN .PTPPN
	MOVE	PJ,PTHPTR	;[27] POINT TO FIRST SFD-1
	HRLI	PJ,-<.PTMAX-.PTPPN-1>	;[27] FORM AOBJN PTR
GTDV6E:	PUSHJ	PP,GETSIX	;[27] GET SFD
	MOVEM	TA,1(PJ)	;[27] STORE SFD
	CAIE	CH,","		;[27] MORE?
	JRST	GTDV6F		;[27] NO
	AOBJN	PJ,GTDV6E	;[27] LOOP
	JRST	BADPP		;[27] UNLESS TOO MANY

GTDV6F:	SETZM	2(PJ)		;[27] END ON ZERO
	MOVE	PJ,PTHPTR	;[27] POINT TO PATH BLOCK
	SUBI	PJ,.PTPPN	;[27] BACKUP TO START OF PATH
>
GTDV6D:	CAIE	CH,"]"		;[27]
	JRST	BADPP
	JRST	GETTY

SKIPBL:	PUSHJ	PP,GETTY	;GO GET A CHAR.
	CAIN	CH,$SP		;IF IT'S A BLANK,
	JRST	SKIPBL		; IGNORE IT.
	IORI	SW,REGET	;REMEMBER TO REGET IT.
	POPJ	PP,		;RETURN.
;"/" SEEN -- CHECK FOR 'L' SWITCH

GTDEV7:	PUSHJ	PP,GETTY
	CAIE	CH,"H"
	CAIN	CH,"h"
	JRST	HELP
	CAIE	CH,"L"
	CAIN	CH,"l"
	IORI	SW,LSWICH
	CAIE	CH,"D"		;/DIRECTORY HEADER ?
	CAIN	CH,"d"
	IORI	SW,LSWICH!DSWICH
	TRNE	SW,LSWICH!DSWICH
	JRST	GETTY

	PUSHJ	PP,TYPEQA
	OUTCHR	CH
	OUTSTR	[ASCIZ	/ is not a legal switch/]
	JRST	GOBACK

;HELP SWITCH

HELP:	MOVE	1,['LIBARY']
	PUSHJ	PP,.HELPR
	JRST	GOBACK

;IMPROPER PROJ-PROG NUMBER

BADPP:	ERRORA	<Improper project-programmer number>
	JRST	GOBACK
;TERMINATOR IS "@", SET UP NEW COMMAND FILE

GTDEV8:	JUMPN	DN,GTDV8A
	JUMPN	FN,GTDV8A
	JUMPN	EX,GTDV8A
	JUMPN	PJ,GTDV8A
GTDV8Z:	PUSHJ	PP,GTDEV6	;[27] ENTER HERE WITH ALL ACCS PRE-SET TO ZERO
	JRST	GTDV8B

GTDV8A:	PUSHJ	PP,GETTY
GTDV8B:	CAIL	CH,$LF
	CAILE	CH,$FF
	JRST	IMPCOM

	RELEASE	TTY,		;THROW AWAY OLD COMMAND DEVICE
	SKIPN	DN
	MOVSI	DN,'DSK'
	MOVEI	TA,0
	MOVE	TB,DN
	MOVEI	TC,TTYIB
	OPEN	TTY,TA
	  JRST	NOTAV

	MOVE	TA,FN
	MOVE	TB,EX
	MOVEI	TC,0
	MOVE	TD,PJ
	JUMPN	TB,GTDV8E
	MOVSI	TB,'CCL'
	LOOKUP	TTY,TA
	  SKIPA	TB,EX
	JRST	GTDV8F
	MOVE	TD,PJ

GTDV8E:	LOOKUP	TTY,TA
	  JRST	NOCOM
GTDV8F:	IORI	SW,NOTTY

	HLRZ	TA,.JBSA	;[13]
	EXCH	TA,.JBFF	;[13]
	INBUF	TTY,2
	MOVEM	TA,.JBFF	;[13]

	ANDCMI	SW,ENDCOM
	MOVE	CP,SAVECP	;RESET POINTER TO COMMAND SAVER
	JRST	CPOPJ1		;SKIP RETURN

;ERRORS DETECTED WHILE SCANNING FILE COMMAND

CNTFOF:	ERRORA	<Cannot enter output file >
	MOVEI	TA,FOFNAM	;[27] POINT TO ERROR CODE
	JRST	GOERR		;[27] COMMON ERROR ROUTINE

CNTLST:	ERRORA	<Cannot enter listing file >
	MOVEI	TA,LSTNAM	;[27] POINT TO ERROR CODE
GOERR:	PUSHJ	PP,LREERR	;[27] COMMON ERROR ROUTINE
GOBACK:	PUSHJ	PP,SKPTTY
	JRST	START


NOTDEV:	ERRORA	<Improper device>
	JRST	GOBACK
NOTBIN:	ERRORA	<Input and output devices must be binary>
	JRST	GOBACK
NONAME:	ERRORA	<Directory devices require file names>
	JRST	GOBACK

NOFIND:	PUSHJ	PP,SAVEA	;[27] PUT ERROR CODE IN SAFE PLACE
	ERRORC	<Input file LOOKUP error >
	MOVEI	TA,ERRNAM	;[27] POINT TO LOOKUP BLOCK
	JRST	GOERR		;[27]

NOTAV:	MOVE	TA,[POINT 6,DN]
	MOVE	TB,[POINT 7,COMWRD]

NOTAV1:	ILDB	TC,TA
	JUMPE	TC,NOTAV2
	ADDI	TC,40
	IDPB	TC,TB
	TLNE	TA,770000
	JRST	NOTAV1

NOTAV2:	MOVEI	TC,0
	IDPB	TC,TB

	PUSHJ	PP,TYPEQB
	OUTSTR	[ASCIZ /"/]
	OUTSTR	COMWRD
	OUTSTR	[ASCIZ /" not available
/]
	JRST	GOBACK
NOCOM:	PUSHJ	PP,SAVEA	;[27] SAVE ERROR CODE
	ERRORA	<Cannot find command file >
	MOVEI	TA,ERRNAM	;[27] POINT TO ERROR CODE
	JRST	GOERR		;[27] COMMON ERROR ROUTINE

TUMANY:	ERRORA	<Only one output file allowed with /L>
	JRST	GOBACK

IMPCOM:	ERRORA	<Improper command>
	JRST	GOBACK
;INITIALIZE TTY.
;ENTER WITH 'JSP TA,INITTY'

INITTY:	MOVEI	SW,0		;CLEAR SWITCHES
	CALLI	0		;RESET DEVICES
	INIT	TTY,.IOASL	;ASCII-LINE MODE
	SIXBIT	'TTY'
	XWD	0,TTYIB
	JRST	CANTTY		;NO TTY????

	INBUF	TTY,2
	JRST	(TA)

CANTTY:	OUTSTR	[ASCIZ "?Cannot init TTY:
"]
	EXIT
;TYPE OUT '<C.R.>?'
;IF COMMAND FILE IS NOT ON TTY, TYPE OUT LATEST COMMAND.

TYPEQA:	OUTSTR	[ASCIZ "
?"]
	TRNN	SW,NOTTY
	POPJ	PP,

	JRST	TYPEQ4


;TYPE OUT '<C.R.>?'
;IF INPUT IS NOT FROM TTY, TYPE OUT LATEST LIBRARY NAME FOLLOWED BY
;	PREVIOUS COMMAND.

TYPEQB:	OUTSTR	[ASCIZ "
?"]
	TRNN	SW,NOTTY
	POPJ	PP,

	MOVE	TA,[POINT 6,LASTPG]
TYPEQ2:	ILDB	TB,TA
	JUMPE	TB,TYPEQ3
	ADDI	TB,40
	CAIN	TB,":"
	MOVEI	TB,"-"
	OUTCHR	TB
	JRST	TYPEQ2

TYPEQ3:	OUTSTR	[ASCIZ " -- "]
TYPEQ4:	MOVEI	TB,0
	IDPB	TB,CP
	OUTSTR	COMSAV
	OUTSTR	[ASCIZ "
"]
	MOVE	CP,[POINT 7,COMSAV]
	POPJ	PP,
;GET INPUT AND OUTPUT DEVICES (CONT'D).

;READ NEXT SIXBIT NAME FROM COMMAND STRING INTO TA.

GETSIX:	MOVEI	TA,0
	MOVE	TB,[POINT 6,TA]

GETSX1:	PUSHJ	PP,GETTY
	CAIG	CH,"Z"
	CAIGE	CH,"A"
	JRST	GETSX3

GETSX2:	SUBI	CH,40
	TLNE	TB,770000
	IDPB	CH,TB
	JRST	GETSX1

GETSX3:	CAIG	CH,"9"
	CAIGE	CH,"0"
	POPJ	PP,
	JRST	GETSX2

;GET NEXT OCTAL NUMBER FROM COMMAND STRING INTO TA

GETOCT:	MOVEI	TA,0

GETOC1:	PUSHJ	PP,GETTY
	CAIG	CH,"7"
	CAIGE	CH,"0"
	POPJ	PP,

	LSH	TA,3
	IORI	TA,-"0"(CH)
	CAIG	TA,-1
	JRST	GETOC1
	POPJ	PP,
;GET NAME OF PROGRAM FROM TTY

GETNAM:	SETZM	OFFDEV
	SETZM	NEWNAM
	SETZM	NEWNAM+1
	MOVE	TA,[POINT 6,NEWNAM]

GTNAM0:	PUSHJ	PP,GETTY	;PASS OVER INTERVENING SPACES
	CAIE	CH,$SP
	CAIN	CH,$HT
	JRST	GTNAM0

	TRNA
GTNAM1:	PUSHJ	PP,GETTY
	CAIG	CH,"Z"
	CAIGE	CH,"A"
	JRST	GTNAM3

GTNAM2:	CAIN	CH,"-"
	MOVEI	CH,":"
	SUBI	CH,40
	CAMN	TA,[POINT 6,NEWNAM+1,11]
	JRST	GTNM2A		;TOO BIG
	IDPB	CH,TA
	JRST	GTNAM1

GTNM2A:	OUTSTR	[ASCIZ	/%Library module name too long - truncated to 8 characters - continuing
/]
	TLZ	TA,007700	;SO WE DON'T STORE ANYTHING
	JRST	GTNAM1		;GET RID OF THE REST OF THE NAME

GTNAM3:	CAIG	CH,"9"
	CAIGE	CH,"0"
	CAIN	CH,"-"
	JRST	GTNAM2
GTNM3A:	CAIE	CH,$SP
	JRST	.+3
GTNM3E:	PUSHJ	PP,GETTY
	JRST	GTNM3A
	CAIN	CH,"/"
	JRST	GTNAM7

GTNM3B:	CAIL	CH,$LF
	CAILE	CH,$FF
	TRNA
	JRST	GTNAM5

	CAIE	CH,","
	JRST	GTNM3C
	SKIPE	OFFDEV
	JRST	GTNM3D
	PUSHJ	PP,GTNM10
	JRST	GTNM3A

GTNM3C:	ERRORA	<Improper character in name>
	JRST	SKPTTY
GTNM3D:	ERRORA	<Only one file allowed>
	PUSHJ	PP,SKPTTY
	JRST	GTNAM9
;GET NAME OF PROGRAM FROM COMMAND FILE (CONT'D)

GTNAM5:	SKIPE	NEWNAM
	JRST	GTNAM9
	ERRORA	<No name specified>
	POPJ	PP,

;SWITCH SEEN

GTNAM7:	PUSHJ	PP,GETTY
	CAIN	CH,"S"		;CARD IMAGE?
	JRST	[SETOM	SEQ		;YES
		JRST	GTNM3E]		;EAT UP ANY SPACES

	OUTSTR	[ASCIZ /
?/]
	OUTCHR	CH
	OUTSTR	[ASCIZ	/ is not a legal switch
/]
	JRST	SKPTTY

GTNAM9:	MOVE	CH,[XWD NEWNAM,LASTPG]
	BLT	CH,LASTPG+1
	JRST	CPOPJ1


;COMMA SEEN -- SCAN FILE NAME

GTNM10:
IFE TOPS20,<
	MOVEI	PJ,OFFPTH+.PTPPN	;[27] SFD PATH
>
	PUSHJ	PP,GTDEV6
	SKIPN	DN
	MOVSI	DN,'DSK'
	MOVEM	DN,OFFDEV
	MOVEM	FN,OFFNAM
	HLLZM	EX,OFFNAM+1
	MOVEM	PJ,OFFNAM+3
	POPJ	PP,
;COMPARE "NEWNAM" AGAINST TWO WORDS WHOSE ADDRESS IS IN TB.
;EXIT TI CALL+1 IF NEWNAM<(TB)
;EXIT TO CALL+2 IF NEWNAM>(TB)
;EXIT TO CALL+3 IF NEWNAM=(TB)

COMPAR:	SKIPL	TC,NEWNAM
	JRST	COMP3
	SKIPL	(TB)
	JRST	CPOPJ1

COMP1:	CAMN	TC,(TB)
	JRST	COMP2
	CAMLE	TC,(TB)
	AOS	(PP)
	POPJ	PP,

COMP2:	HLRZ	TC,NEWNAM+1
	HLRZ	TD,1(TB)
	LSH	TC,-6
	LSH	TD,-6
	CAMN	TC,TD
	AOSA	(PP)
	CAMLE	TC,TD
	AOS	(PP)
	POPJ	PP,

COMP3:	SKIPL	(TB)
	JRST	COMP1
	POPJ	PP,
;COPY A LINE FROM TTY TO OUTPUT BUFFER

PUTLIN:	MOVEI	WD,^D10*2
	SKIPA	WD,COMLIN
	MOVEM	WD,OUTLIN
	TRO	SW,CHAR1	;[15] SET "THIS IS FIRST CHAR"

PUTLI1:	PUSHJ	PP,PUTTOF
	MOVEI	WD,0
	MOVE	TB,[POINT 7,WD]

PUTLI2:	PUSHJ	PP,GETTY

	TRZE	SW,CHAR1	;[15] IS THIS THE 1ST CHAR?
	CAIE	CH,$SP		;[15] IGNORE IF LEADING SPACE
	IDPB	CH,TB

	CAIL	CH,$LF
	CAILE	CH,$FF
	TRNA
	JRST	PUTTOF

	TLNE	TB,760000
	JRST	PUTLI2
	JRST	PUTLI1
;PUT INPUT NAME INTO OUTPUT DIRECTORY

PUTINM:	MOVE	TA,INNAM
	MOVEM	TA,OUTNAM
	MOVE	TA,INNAM+1
	MOVEM	TA,OUTNAM+1
	MOVE	TA,INSEQ
	MOVEM	TA,OUTSEQ
	JRST	PUTNAM


;PUT NEW NAME INTO OUTPUT DIRECTORY

PUTNNM:	MOVE	TA,NEWNAM
	MOVEM	TA,OUTNAM
	MOVE	TA,NEWNAM+1
	MOVEM	TA,OUTNAM+1

	TRNN	SW,LISTIT	;ANY LISTING FILE?
	JRST	PUTNAM		;NO

	IORI	SW,DOLIST	;YES--SET "LIST THIS PROGRAM" FLAG
	SETZM	PAGNO		;[24] PAGE 1
	PUSHJ	PP,LSTHDG	;PUT OUT HEADING LINE
;PUT OUTPUT NAME INTO DIRECTORY.
;IF THIS IS THE FIRST WORD OF A DIRECTORY BLOCK, PUT ENTRY INTO ROUGH TABLE.

PUTNAM:	MOVE	TC,TOFCTR	;IS FILE TOO LARGE?
	TLNE	TC,377700
	JRST	PUTNM6		;YES

	HLLZ	TB,OUTNAM+1	;NO
	TLZ	TB,77
	IOR	TB,TC
	SKIPE	OUTSEQ		;SEQUENCED OUTPUT?
	TLO	TB,SEQFLG	;YES, SET SEQ BIT

	MOVE	TA,PRGCTR	;ARE WE ABOUT TO WRITE FIRST WORD OF A BLOCK?
	TRNE	TA,77
	JRST	PUTNM2		;NO

	MOVE	TA,RUFCTR	;YES--IS ROUGH TABLE FULL?
	CAILE	TA,176
	JRST	PUTNM5		;YES

	MOVE	TC,OUTNAM
	MOVEM	TC,RUFTAB(TA)

	HLLZ	TC,OUTNAM+1
	TLZ	TC,77
	IOR	TC,FINCTR
	MOVEM	TC,RUFTAB+1(TA)

	MOVEI	TC,200
	ADDM	TC,FINCTR

	MOVEI	WD,2
	ADDM	WD,RUFCTR

PUTNM2:	AOS	PRGCTR
	MOVEI	WD,2
	ADDM	WD,OFFSET
	MOVE	WD,OUTNAM
	PUSHJ	PP,PUTTOD
	MOVE	WD,TB
	JRST	PUTTOD

;ROUGH TABLE IS FULL

PUTNM5:	ERRORA	<Too many programs>
	JRST	KILLIM

;FILE TOO LARGE

PUTNM6:	ERRORA	<File too large>
	JRST	KILLIM
;GET A CHARACTER FROM COMMAND FILE.
;PRINTER-CONTROL CHARACTERS (EXCEPT FORM-FEED) ARE CONVERTED
;	TO LINE-FEEDS.
;CARRIAGE-RETURNS AND NULLS ARE IGNORED.

GETTY:	TRNE	SW,ENDCOM	;COMMAND FILE EMPTY?
	JRST	GETY2A		;YES

	TRZE	SW,REGET	;REGET LAST CHARACTER?
	JRST	GETTY4		;YES

	SOSG	TTYIB+2		;NO--GET NEXT ONE
	JRST	GETTY5
GETTY0:	ILDB	CH,TTYIB+1

GETTY1:	CAIN	CH,$HT		;CONVERT TABS TO BLANKS.
	MOVEI	CH,$SP
	CAIN	CH,$CR
	JRST	GETTY
	CAIL	CH,"a"		;[23] IS THIS CHARACTER
	CAILE	CH,"z"		;[23] A LOWER CASE CHARACTER?
	TRNA			;[23] NO   GO ON
	SUBI	CH,40		;[23] YES  CONVERT TO UPPER CASE

	CAIN	CH,$CZ
	JRST	GETY5A
	JUMPE	CH,GETTY

	CAIE	CH,$VT
	CAIN	CH,$FF
	JRST	GETY2A
	CAIG	CH,$DC4
	CAIGE	CH,$DLE
	JRST	GETTY7

GETTY2:	TRNN	SW,NOTTY
	OUTSTR	[ASCIZ "
"]
GETY2A:	MOVEI	CH,$LF
	DPB	CH,TTYIB+1
	POPJ	PP,

GETTY4:	LDB	CH,TTYIB+1
	JRST	GETTY1
;GET CHARACTER FROM COMMAND FILE  (CONT'D).

;GET ANOTHER BUFFER FULL

GETTY5:	IN	TTY,
	  JRST	GETTY0

	GETSTS	TTY,CH		;END-OF-FILE?
	TRNN	CH,IO.EOF
	JRST	GETTY6		;NO
GETY5A:	IORI	SW,ENDCOM	;YES
	JRST	GETY2A


GETTY6:	OUTSTR	[ASCIZ "
?Read error on command file
"]
	JRST	START

;PUT CHARACTER INTO COMMAND STREAM SAVER

GETTY7:	CAME	CP,[POINT 7,COMSAV+8,27]
	IDPB	CH,CP
	POPJ	PP,
;DISPLAY "IMPROPER COMMAND" AND SKIP TO END OF LINE

BADCOM:	ERRORB	<Improper command>

;SKIP THE REST OF THE TTY INPUT LINE

SKPTTY:	IORI	SW,REGET
SKPTT1:	PUSHJ	PP,GETTY
	CAIL	CH,$LF
	CAILE	CH,$FF
	JRST	SKPTT1
	POPJ	PP,
;WRITE CONTENTS OF "WD" ONTO LISTING FILE

PUTLST:	TRNN	WD,1		;SEQUENCE NUMBER?
	JRST	PUTL6		;NO

	SKIPGE	TE,WD		;YES-- GET LINE NUMBER (BITS 0-34)
	POPJ	PP,		;LINE NUMBER WAS NEGATIVE--FORGET IT

	LSH	TE,-1
	MOVE	TG,[XWD -6,DECIML]

PUTL1:	IDIV	TE,(TG)
	MOVEI	CH,"0"(TE)
	PUSHJ	PP,PUTL2
	MOVE	TE,TE+1
	AOBJN	TG,PUTL1

	MOVEI	CH,$HT

;PUT A SINGLE CHARACTER OUT ONTO LISTING FILE

PUTL2:	SOSG	LSTBH+2
	JRST	PUTL4
PUTL3:	IDPB	CH,LSTBH+1
	POPJ	PP,

PUTL4:	OUT	LST,
	  JRST	PUTL3
	JRST	LSTERA

PUTL6:	SKIPA	TE,[POINT 7,WD]
PUTL7:	PUSHJ	PP,PUTL2
PUTL8:	TLNN	TE,760000
	POPJ	PP,

	ILDB	CH,TE
	JUMPE	CH,PUTL8
	CAIL	CH,$LF
	CAILE	CH,$FF
	JRST	PUTL7

	MOVEI	CH,$CR
	PUSHJ	PP,PUTL2
	LDB	CH,TE

PUTL9:	MOVEI	TE,LINPAG
	CAIN	CH,$FF
	MOVEM	TE,LINECT

	JRST	PUTL2
;WRITE OUT HEADING LINE ONTO LISTING FILE

LSTHDG:	TRNE	SW,LSTTY	;IS LISTING ON CONSOLE?
	JRST	LSTHD6		;YES

	TRNE	SW,DSWICH	;DIRECTORY HEADER ONLY?
	JRST	LSTHD1		;THEN NO PAGE OR LINE CHARACTERS
	MOVE	CH,LINECT
	CAIN	CH,LINPAG
	JRST	LSTHD1

	MOVEI	CH,$CR
	PUSHJ	PP,PUTL2
	MOVEI	CH,$FF
	PUSHJ	PP,PUTL2

LSTHD1:	MOVE	TE,[POINT 6,OUTNAM]

LSTHD2:	ILDB	CH,TE
	JUMPE	CH,LSTHD5
	ADDI	CH,40
	CAIN	CH,":"
	MOVEI	CH,"-"
	PUSHJ	PP,PUTL2
	MOVEI	CH,$SP
	TRNN	SW,DSWICH	;DONT GET FANCY
	PUSHJ	PP,PUTL2
	JRST	LSTHD2

LSTHD3:	MOVE	TE,OUTNAM+1
	TLNN	TE,SEQFLG	;TEST FOR SEQUENCED
	JRST	LSTH3A		;NO
	MOVE	TE,[POINT 7,[ASCIZ \/S\]]
	PUSHJ	PP,PUTMES
LSTH3A:	MOVE	TE,[POINT 7,HEADER]	;[26]
	PUSHJ	PP,PUTMES	;[26]
	AOS	TE,PAGNO	;[24] GET PAGE NUMBER
	PUSHJ	PP,PUTDEC	;[24] OUTPUT IT
	MOVE	TE,[POINT 7,[ASCIZ "

"]]				;[24]
LSTHD4:	PUSHJ	PP,PUTMES	;[26] [24] OUTPUT CRLF-CRLF

	MOVEI	CH,LINPAG-1
	MOVEM	CH,LINECT
	POPJ	PP,

LSTHD5:	TRNN	SW,DSWICH	;/DIRECTORY HEADER ONLY?
	JRST	LSTHD3		;NOP
	MOVE	TE,OUTNAM+1
	TLNE	TE,SEQFLG	;SEQUENCED?
	SKIPA	TE,[POINT 7,[ASCIZ \ /S
\]]
	MOVE	TE,[POINT 7,[ASCIZ /
/]]
;[26]	ILDB	CH,TE		;GET FIRST CHAR
	JRST	LSTHD4		;OUTPUT END OF LINE

LSTHD6:	MOVE	TE,[POINT 7,[ASCIZ "

*** PROGRAM "]]
	TRNN	SW,DSWICH	;/DIRECTORY HEADER MEANS NAME ONLY
	PUSHJ	PP,PUTMES

	MOVE	TE,[POINT 6,OUTNAM]

LSTHD7:	ILDB	CH,TE
	ADDI	CH,40
	CAIN	CH,":"
	MOVEI	CH,"-"
	PUSHJ	PP,PUTL2
	CAME	TE,[POINT 6,OUTNAM+1,11]
	JRST	LSTHD7

	MOVE	TE,OUTNAM+1
	TLNN	TE,SEQFLG	;SEQUENCED?
	JRST	LSTHD8		;NO
	MOVE	TE,[POINT 7,[ASCIZ \ /S\]]
	PUSHJ	PP,PUTMES
LSTHD8:
	MOVE	TE,[POINT 7,[ASCIZ "

"]]
	TRNE	SW,DSWICH	;ONLY ONE CRLF IF /DIRECTORY
	MOVE	TE,[POINT 7,[ASCIZ "
"]]
	PUSHJ	PP,PUTMES

	HRLOI	CH,377777
	MOVEM	CH,LINECT

	POPJ	PP,

LSTFIN:	TRNE	SW,DOLIST	;[20] IS THERE A LIST FILE?
	OUT	LST,		;[20] YES OUTPUT LAST BUFFER
	  POPJ	PP,		;[20] GO BACK
	JRST	LSTERA		;[20] LISTING ERROR
;PUT DATE AND TIME INTO HEADING LINE

DATIME:	DATE	TE,		;GET DATE
	IDIVI	TE,^D31*^D12	;TE=YEAR
	IDIVI	TF,^D31		;TF=MONTH,TG=DAY
	ADDI	TG,1
	PUSHJ	PP,DATIM9
	TRNN	TG,3600
	TRZ	TG,4000
	DPB	TG,[POINT 14,HDATE,34]
	MOVE	TG,MOTABL(TF)
	DPB	TG,[POINT 21,HDATE+1,27]

	MOVEI	TG,^D64(TE)
	CAIL	TG,^D100	;CK FOR YR 2000+
	SUBI	TG,^D100	;IF SO, CHANGE TO 00+
	PUSHJ	PP,DATIM9
	DPB	TG,[POINT 14,HDATE+2,13]
	MSTIME	TF,		;GET TIME IN MILLISECONDS
	IDIVI	TF,^D1000*^D60	;CONVERT TO MINUTES
	IDIVI	TF,^D60
	PUSHJ	PP,DATIM9
	DPB	TG,[POINT 14,HTIME,34]
	MOVE	TG,TF
	PUSHJ	PP,DATIM9
	DPB	TG,[POINT 14,HTIME,13]
	POPJ	PP,

DATIM9:	IDIVI	TG,^D10
	LSH	TG,7
	ADDI	TG,"00"(TH)
	POPJ	PP,

;[24] OUTPUT DECIMAL NUMBER IN TE

PUTDEC:	IDIVI	TE,^D10		;[24] DIVIDE BY RADIX
	HRLM	TF,(PP)		;[24] SAVE DIGIT
	SKIPE	TE		;[24] ANYTHING LEFT?
	PUSHJ	PP,PUTDEC	;[24] YES, LOOP BACK
	HLRZ	CH,(PP)		;[24] GET DIGIT
	ADDI	CH,"0"		;[24] CONVERT TO ASCII
	JRST	PUTL2		;[24] OUTPUT IT

;[27] OUTPUT OCTAL NUMBER IN TE

PUTOCT:	IDIVI	TE,8		;[27] DIVIDE BY RADIX
	HRLM	TF,(PP)		;[27] SAVE DIGIT
	SKIPE	TE		;[27] ANYTHING LEFT?
	PUSHJ	PP,PUTOCT	;[27] YES, LOOP BACK
	HLRZ	CH,(PP)		;[27] GET DIGIT
	ADDI	CH,"0"		;[27] CONVERT TO ASCII
	OUTCHR	CH		;[27] OUTPUT IT
	POPJ	PP,		;[27] GET NEXT OR RETURN
;OUTPUT ROUTINES

;PUT A WORD ONTO TEMPORARY OUTPUT FILE

PUTTOD:	SOSG	TODOB+2
	JRST	PTOD2
PTOD1:	IDPB	WD,TODOB+1
	POPJ	PP,

PTOD2:	OUT	TOD,
	  JRST	PTOD1
	JRST	SCROE

;PUT A WORD ONTO TEMPORARY INPUT DIRECTORY

PUTTID:	SOSG	TIDOB+2
	JRST	PTID2
PTID1:	IDPB	WD,TIDOB+1
	POPJ	PP,

PTID2:	OUT	TID,
	  JRST	PTID1
	JRST	SCROE

;PUT A WORD ONTO FINAL OUTPUT FILE

PUTFOF:	SOSG	FOFOB+2
	JRST	PFOF2
PFOF1:	IDPB	WD,FOFOB+1
	POPJ	PP,

PFOF2:	OUT	FOF,
	  JRST	PFOF1
	JRST	SCROE

;PUT A WORD ONTO TEMPORARY OUTPUT FILE

PUTTOF:	AOS	TOFCTR

	SOSG	TOFOB+2
	JRST	PTOF2
PTOF1:	IDPB	WD,TOFOB+1
	TRNE	SW,DOLIST
	PUSHJ	PP,PUTLST
	POPJ	PP,

PTOF2:	OUT	TOF,
	  JRST	PTOF1
	JRST	SCROE

;INPUT ROUTINES

;GET A WORD FROM TEMPORARY OUTPUT DIRECTORY

GETTOD:	SOSG	TODIB+2
	JRST	GTOD2
GTOD1:	ILDB	WD,TODIB+1
	POPJ	PP,

GTOD2:	IN	TOD,
	  JRST	GTOD1
	JRST	SCRIE

;GET A WORD FROM TEMPORARY INPUT DIRECTORY

GETTID:	TRNE	SW,ENDF		;ANY MORE INPUT FILE?
	JRST	GOIF3		;NO

	SOSG	TIDIB+2
	JRST	GTID2
GTID1:	ILDB	WD,TIDIB+1
	POPJ	PP,

GTID2:	IN	TID,
	  JRST	GTID1
	JRST	SCRIE

;GET A WORD FROM TEMPORARY OUTPUT FILE

GETTOF:	SOSG	TOFIB+2
	JRST	GTOF2
GTOF1:	ILDB	WD,TOFIB+1
	JRST	CPOPJ1

GTOF2:	IN	TOF,
	  JRST	GTOF1
	GETSTS	TOF,WD
	TRNE	WD,IO.ERR
	JRST	SCRIE
	POPJ	PP,
;INPUT ROUTINES  (CONT'D).

;GET A WORD FROM OLD INPUT FILE

GETOIF:	TRNE	SW,ENDF		;ANY MORE INPUT FILE?
	JRST	GOIF3		;NO

	SOSG	OIFIB+2
	JRST	GOIF2
GOIF1:	ILDB	WD,OIFIB+1
	POPJ	PP,

GOIF2:	IN	OIF,
	  JRST	GOIF1
	JRST	INPERA


GOIF3:	MOVNI	WD,1
	POPJ	PP,
;SET UP ANY 'OFF-LINE' FILE FOR INPUT

SETOFF:	SKIPN	OFFDEV
	JRST	CPOPJ1

	SKIPN	TA,OFFBUF
	HRRZ	TA,.JBFF	;[13]
	HRRM	TA,.JBFF	;[13]
	MOVEM	TA,OFFBUF
	MOVEI	TA,0
	MOVE	TB,OFFDEV
	MOVEI	TC,OFFBH
	OPEN	OFF,TA
	  JRST	NOOFFD

	INBUF	OFF,2

	MOVE	TE,[XWD OFFNAM,TA]
	BLT	TE,TD
	LOOKUP	OFF,TA
	  JRST	NOOFFL
	JRST	CPOPJ1

NOOFFD:	OUTSTR	[ASCIZ /?Device does not exist
/]
	POPJ	PP,

NOOFFL:	PUSHJ	PP,SAVEA	;[27] SAVE ERROR CODE
	OUTSTR	[ASCIZ /?Cannot find file /]
	MOVEI	TA,ERRNAM	;[27] POINT TO ERROR CODE
	PUSHJ	PP,LREERR	;[27] COMMON ERROR ROUTINE
CRLF:	OUTSTR	[ASCIZ	/
/]				;[27] CR-LF
	POPJ	PP,		;[27]
;COPY PROGRAM FROM 'OFF-LINE' FILE

COPOFF:	MOVEI	TA,1		;SET LINE # TO ZERO
	MOVEM	TA,OUTLIN

	PUSHJ	PP,GETOFF	;GET A CHARACTER
	JUMPE	CH,CPOPJ	;IF END-OF-FILE -- QUIT

COPF01:	MOVE	TA,@OFFBH+1	;ANY SEQ #?
	TRNN	TA,1
	JRST	COPF06		;NO
	CAME	TA,[<ASCII /     />+1]	;SOS PAGE MARK?
	JRST	COPF03		;NO
	MOVE	WD,TA		;YES
	PUSH	PP,SW		;SAVE SWITCHES
	TRZ	SW,DOLIST	;TURN OFF LISTING OF SOS PAGE MARK
	PUSHJ	PP,PUTTOF	;OUTPUT IT AS IS
	AOS	OFFBH+1		;BYPASS IT
	MOVNI	TB,5
	ADDM	TB,OFFBH+2	;NOTE, WE WILL READ SECOND BYTE OF WORD, BUT IT IS OK
	PUSHJ	PP,GETOFF	;GET NEXT WORD
	MOVE	WD,@OFFBH+1	;GET CR-FF
	PUSHJ	PP,PUTTOF	;OUTPUT IT AS IS
	POP	PP,SW		;GET SWITCHES BACK
	TRNN	SW,DOLIST	;NEED LISTING?
	JRST	COPOFF		;NO, JUST READ NEXT LINE
	MOVEI	CH,$FF		;YES, FAKE UP FORM FEED
	PUSHJ	PP,PUTL9	;OUTPUT IT AND RESET LINE COUNTERS
	JRST	COPOFF		;READ NEXT LINE

COPF03:	MOVEI	WD,0
	MOVEI	TB,5
COPF04:	IMULI	WD,^D10
	ADDI	WD,-"0"(CH)
	PUSHJ	PP,GETOFF
	SOJG	TB,COPF04
	LSH	WD,1
	IORI	WD,1

COPF05:	PUSHJ	PP,GETOFF	;GET FIRST DATA CHARACTER
	MOVEI	TA,1		;CLEAR "SEQ" FLAG
	ANDCMI	TA,@OFFBH+1	;  IN THAT WORD
	CAMLE	WD,OUTLIN
	JRST	COPF07

COPF06:	MOVEI	WD,^D10*2
	ADD	WD,OUTLIN

COPF07:	MOVEM	WD,OUTLIN
;COPY 'OFF-LINE' FILE (CONT'D)

COPF08:	PUSH	PP,CH
	PUSHJ	PP,PUTTOF	;PUT OUT ONE WORD
	POP	PP,CH
	MOVE	TB,[POINT 7,WD]	;RESET
	MOVEI	WD,0		;  WORD
COPF09:	JUMPE	CH,COPF10	;[EDIT#10]
	IDPB	CH,TB		;[EDIT#10]
	CAIG	CH,$FF		;END OF LINE?
	CAIGE	CH,$LF		;I.E. LF, VT, OR FF
	TRNA			;NO
	JRST	COPF11		;YES

	PUSHJ	PP,GETOFF	;NO--GET ANOTHER
	MOVE	TA,@OFFBH+1	;SEQ #?
	TRNE	TA,1
	JRST	COPF10		;YES

	TLNE	TB,760000	;NO--IS OUTPUT WORD FULL?
	JRST	COPF09		;NO
	JRST	COPF08		;YES

COPF10:	MOVEI	TA,$LF		;STASH END-OF-LINE
	IDPB	TA,TB
	JRST	COPF12

COPF13:	DPB	CH,TB		;REPLACE LF BY VT OR FF
COPF11:	PUSHJ	PP,GETOFF	;GET CHARACTER AFTER LINE-FEED
	CAIE	CH,$VT		;CHECK FOR VT
	CAIN	CH,$FF		;AND FORM-FEED
	JRST	COPF13		;AS THESE ARE SPECIAL
COPF12:	PUSH	PP,CH
	PUSHJ	PP,PUTTOF	;PUT OUT FINAL WORD FOR LINE
	POP	PP,CH
	JUMPE	CH,CPOPJ	;[24] FINISH UP IF EMPTY
	TRNE	SW,DOLIST	;[24] SKIP IF NO LISTING FILE
	SOSLE	LINECT		;[24] ROOM LEFT ON PAGE?
	JRST	COPF01		;[24] LOOP UNTIL END-FILE
	PUSH	PP,CH		;[24] SAVE IT AGAIN
	PUSHJ	PP,LSTHDG	;[24] START AGAIN
	POP	PP,CH		;[24] GET CHAR BACK
	JRST	COPF01		;[24] LOOP UNTIL END-FILE
;GET CHARACTER FROM 'OFF-LINE' FILE

GETOFF:	SOSG	OFFBH+2
	JRST	GETOF3
GETOF1:	ILDB	CH,OFFBH+1
	CAILE	CH,32		;POSSIBLY AN INTERESTING CONTROL CHARACTER?

	POPJ	PP,		;NO, JUST RETURN WHAT WE FOUND

	JUMPE	CH,GETOFF	;IGNORE NULLS
	CAIN	CH,$CR		;AND CARRIAGE-RETURNS
	JRST	GETOFF

	CAIN	CH,$CZ		;^Z
	JRST	GETOF4		;YES, SEE IF FROM TERMINAL

	CAIG	CH,$DC4		;JUST RETURN THE NON-INTERESTING CONTROL CHARS.
	CAIGE	CH,$LF
	POPJ	PP,

	CAIL	CH,$DLE		;CONVERT 20-24 INTO LF
GETOF2:	MOVEI	CH,$LF
	POPJ	PP,		;RETURN LF, VT, FF

GETOF3:	IN	OFF,
	  JRST	GETOF1
	STATZ	OFF,IO.ERR
	OUTSTR	[ASCIZ "
?Read error on insertion file
"]
	MOVEI	CH,0
	RELEASE	OFF,
	POPJ	PP,

GETOF4:	MOVEI	CH,OFF		;SEE IF DEVICE IS TERMINAL
	DEVCHR	CH,
	TXNE	CH,DV.TTY	;TEST DV.TTY BIT
	JRST	GETOFF		;IT IS, THROW AWAY ^Z
	MOVEI	CH,32		;ITS NOT
	POPJ	PP,		;ASSUME USER KNOWS WHAT HE'S DOING
;PUT LINE NUMBER INTO 'OFF-LINE' FILE

OFFNUM:	MOVE	TA,OFFBH+1	;MAKE
	TLNN	TA,760000	;  SURE
	JRST	OFFNM1		;  WE
	MOVEI	CH,0		;  ARE
	PUSHJ	PP,PUTOFF	;  AT
	JRST	OFFNUM		;  WORD BOUNDARY

OFFNM1:	SOS	TA,WD		;GET LINE NUMBER BACK
	LSH	TA,-1		;SHIFT OFF BIT 35
	MOVSI	TC,1B18		;GET READY TO SHIFT IN A NUMBER

OFFNM2:	IDIVI	TA,^D10		;GET LOW-OERDER DIGIT INTO TB
	ADDI	TB,"0"		;CONVERT TO ASCII
	LSHC	TB,-7		;SHIFT IT INTO TC
	TRNN	TC,1		;IF WE DON'T HAVE FIVE DIGITS,
	JRST	OFFNM2		;  LOOP

	MOVE	TA,[POINT 7,TC]
OFFNM3:	ILDB	CH,TA		;GET HIGH-ORDER DIGIT
	PUSHJ	PP,PUTOFF	;WRITE IT OUT
	TLNE	TA,760000	;LOOP UNTIL
	JRST	OFFNM3		;  FIVE DIGITS OUT

	MOVEI	TA,1		;SET
	IORM	TA,@OFFBH+1	;[12]  BIT 35

	MOVEI	CH,$HT		;PUT OUT TAB AND
	JRST	PUTOFF		;  RETURN

;PUT A CHARACTER INTO 'OFF-LINE' FILE

PUTOFF:	SOSG	OFFBH+2		;IF BUFFER IS FULL,
	JRST	PUTOF2		;  WRITE IT OUT
PUTOF1:	IDPB	CH,OFFBH+1	;STASH CHARACTER
	POPJ	PP,		;EXIT

PUTOF2:	OUT	OFF,		;WRITE OUT A BUFFER FULL
	  JRST	PUTOF1		;NO ERRORS--ALL IS WELL

	ERRORA	<Output error on extraction file>
	JRST	KILLIM		;TOUGH
;CLOSE OUT TEMPORARY OUTPUT FILES AFTER COPYING REST OF INPUT

CLOSOT:	TRNE	SW,ENDF		;END OF INPUT SEEN?

	JRST	CLSOT1

	ANDCMI	SW,ENDP
	PUSHJ	PP,PUTINM

	PUSHJ	PP,COPYP
	JRST	CLOSOT

CLSOT1:	MOVNI	WD,1
	PUSHJ	PP,PUTTOD

	AOS	OFFSET

	CLOSE	TOD,		;CLOSE OUTPUT DIRECTORY
	CLOSE	TOF,		;CLOSE OUTPUT PROGRAMS

	CLOSE	OIF,		; [17] CLOSE ORIGNAL FILE
	POPJ	PP,
;CREATE "BAK" FILE IF NECESSARY.
;SET UP OUTPUT FILE.

SETBAK:	TRNN	SW,NOINP	;ANY INPUT DEVICE?
	TRNN	SW,INDIR	;YES--DIRECTORY DEVICE?
	JRST	SETBK4		;NO

	MOVE	TA,OIFNAM	;SAME NAME FOR
	CAME	TA,FOFNAM	; INPUT AND OUTPUT?
	JRST	SETBK4		;NO

	HLLZ	TA,OIFNAM+1	;YES--SAME EXTENSION?
	HLLZ	TB,FOFNAM+1
	CAME	TA,TB
	JRST	SETBK4		;NO

	MOVE	TA,OIFNAM+3
	CAME	TA,FOFNAM+3
	JRST	SETBK4

;INPUT FILE SHOULD BE CHANGED TO HAVE EXTENSION "BAK"

	MOVE	TA,OIFNAM	;ANY BACKUP FILE ALREADY?
	MOVSI	TB,'BAK'
	MOVEI	TC,0
	MOVE	TD,OIFNAM+3
	LOOKUP	TOD,TA
	  JRST	SETBK5		;NO

	CLOSE	TOD,		;YES--DELETE IT
	SETZB	TA,TB
	SETZB	TC,TD
	RENAME	TOD,TA
	  JRST	SETBK6		;COULDN'T DELETE

SETBK2:	MOVE	TA,OIFNAM	;RENAME INPUT FILE
	HLLZ	TB,OIFNAM+1
	MOVEI	TC,0
	MOVE	TD,OIFNAM+3
	LOOKUP	TOD,TA
	  JRST	SETBK9		;CAN'T FIND IT NOW

	CLOSE	TOD,
	HRLI	TB,'BAK'
	MOVE	TD,OIFNAM+3
	RENAME	TOD,TA
	  JRST	SETBK9

;NOW SET UP OUTPUT FILE

SETBK4:	ENTER	FOF,FOFNAM
	  JRST	CNTFOF

	POPJ	PP,
;RENAME INPUT FILE TO "BAK" (CONT'D)

SETBK5:	TRNN	TB,-1		;[27] COULDN'T FIND "BAK"--IS IT THERE?
	JRST	SETBK2		;[27] IF JUMP--IT REALLY WASN'T THERE

SETBK6:	PUSHJ	PP,SAVEA	;[27] SAVE ERROR CODE
	OUTSTR	[ASCIZ /
?Cannot delete "BAK" file /]

SETBK7:	PUSHJ	PP,LREERR	;[27] COMMON ERROR ROUTINE
	OUTSTR	[ASCIZ "
writing "]

	MOVE	TA,[POINT 6,TIDNAM]
SETBK8:	ILDB	TB,TA
	ADDI	TB,40
	OUTCHR	TB
	CAME	TA,[POINT 6,TIDNAM,17]
	JRST	SETBK8

	OUTSTR	[ASCIZ "LIB.LIB as output file
"]

	MOVE	TA,TIDNAM
	HRRI	TA,'LIB'
	MOVEM	TA,FOFNAM
	HRLZM	TA,FOFNAM+1
	JRST	SETBK4

SETBK9:	PUSHJ	PP,SAVEA	;[27] SAVE ERROR CODE
	OUTSTR	[ASCIZ /
?Cannot rename input to "BAK" /]
	JRST	SETBK7
;ERROR ROUTINES

DIRERA:	OUTSTR	[ASCIZ "?Error reading table
"]
	JRST	KILL2

TRBL1:	OUTSTR	[ASCIZ "?First word not line number
"]
	JRST	KILL2

TRBL2:	OUTSTR	[ASCIZ "?Imbedded line number
"]
	JRST	KILL2

NODSK:	OUTSTR	[ASCIZ /
?DSK: is not a device/]
	JRST	KILLIM

NOEDSK:	OUTSTR	[ASCIZ /
?Can't enter a scratch file on DSK: /]
	MOVEI	TA,TIDNAM	;[27] POINT TO ERROR CODE
	PUSHJ	PP,LREERR	;[27] COMMON ERROR ROUTINE
	JRST	KILLIM

NOEOFF:	PUSHJ	PP,SAVEA	;[27] SAVE ERROR CODE
	ERRORA	<Cannot enter extraction file >
	MOVEI	TA,ERRNAM	;[27] POINT TO ERROR CODE
	PUSHJ	PP,LREERR	;[27] COMMON ERROR ROUTINE
	JRST	KILLIM

NOLDSK:	OUTSTR	[ASCIZ /
?Can't find a scratch file on DSK: /]
	PUSHJ	PP,LREERR	;[27] COMMON ERROR ROUTINE
	JRST	KILLIM

NOPROG:	ERRORA	<That program not found>
	JRST	NEWCOM

SCROE:	OUTSTR	[ASCIZ "
?Output error on scratch file"]
	JRST	KILLIM

SCRIE:	OUTSTR	[ASCIZ "
?Read error on scratch file"]
	JRST	KILLIM

LSTERA:	OUTSTR	[ASCIZ "
?Output error on listing file
"]
	JRST	KILLIM

INPERA:	OUTSTR	[ASCIZ "
?Error reading input file"]

KILLIM:	CALLI	0		;THROW AWAY ALL OUTPUT FILES
KILL2:	EXIT			;GIVE UP
;[27] CALLED WITH ADDRESS OF LOOKUP/ENTER BLOCK IN TA

LREERR:	HRRZ	TB,1(TA)	;[27] GET ERROR CODE ONLY
	CAIL	TB,LRELEN	;[27] MAKE SURE ITS LEGAL
	PUSHJ	PP,DEFERR	;[27] NO, USE DEFAULT
	OUTSTR	@LRETAB(TB)	;[27]
	SKIPN	TC,(TA)		;[27] NON-ZERO FILE NAME?
	POPJ	PP,		;[27] NO, GIVE UP
	PUSHJ	PP,PUTSIX	;[27] PRINT FILE-NAME
	OUTSTR	[ASCIZ	/./]	;[27]
	HLLZ	TC,1(TA)	;[27] GET EXTENSION
	PUSHJ	PP,PUTSIX	;[27]
	SKIPN	TE,3(TA)	;[27] GET PPN
	POPJ	PP,		;[27] FINISHED
	OUTSTR	[ASCIZ	/[/]	;[27] START PPN
IFE TOPS20,<
	TLNN	TE,-1		;[27] SFD?
	JRST	LRESFD		;[27] YES
>
	HLRZ	TE,TE		;[27] PROJ#
	PUSHJ	PP,PUTOCT	;[27]
	OUTSTR	[ASCIZ	/,/]	;[27]
	HRRZ	TE,3(TA)	;[27] PROG#
	PUSHJ	PP,PUTOCT	;[27]
LREEND:	OUTSTR	[ASCIZ	/]/]	;[27]
	POPJ	PP,		;[27]

IFE TOPS20,<
LRESFD:	MOVEI	TA,.PTPPN(TE)	;[27] POINT TO PPN
	HLRZ	TE,(TA)		;[27] PROJ#
	PUSHJ	PP,PUTOCT	;[27]
	OUTSTR	[ASCIZ	/,/]	;[27]
	HRRZ	TE,(TA)		;[27] PROG#
	PUSHJ	PP,PUTOCT	;[27]
LRESF1:	SKIPN	TC,1(TA)	;[27] GET NEXT SFD
	JRST	LREEND		;[27] FINISHED
	OUTSTR	[ASCIZ	/,/]	;[27]
	PUSHJ	PP,PUTSIX	;[27]
	AOJA	TA,LRESF1	;[27] LOOP
>

;[27] OUTPUT SIXBIT WORD IN TC, USING TB

PUTSIX:	SETZ	TB,		;[27] CLEAR JUNK
	LSHC	TB,6		;[27] GET CHAR.
	ADDI	TB,$SP		;[27] MAKE ASCII
	OUTCHR	TB		;[27]
	JUMPN	TC,PUTSIX	;[27] LOOP IF ANY LEFT
	POPJ	PP,		;[27]
LRETAB:	[ASCIZ	\(0) file was not found \]
	[ASCIZ	\(1) no directory for project-programmer number \]
	[ASCIZ	\(2) protection failure \]
	[ASCIZ	\(3) file was being modified \]
	[ASCIZ	\(4) rename file name already exists \]
	[ASCIZ	\(5) illegal sequence of UUOs \]
	[ASCIZ	\(6) bad UFD or bad RIB \]
	[ASCIZ	\(7) not a SAV file \]
	[ASCIZ	\(10) not enough core \]
	[ASCIZ	\(11) device not available \]
	[ASCIZ	\(12) no such device \]
	[ASCIZ	\(13) not two reloc reg. capability \]
	[ASCIZ	\(14) no room or quota exceeded \]
	[ASCIZ	\(15) write lock error \]
	[ASCIZ	\(16) not enough monitor table space \]
	[ASCIZ	\(17) partial allocation only \]
	[ASCIZ	\(20) block not free on allocation \]
	[ASCIZ	\(21) can't supersede (enter) an existing directory \]
	[ASCIZ	\(22) can't delete (rename) a non-empty directory \]
	[ASCIZ	\(23) SFD not found \]
	[ASCIZ	\(24) search list empty \]
	[ASCIZ	\(25) SFD nested too deeply \]
	[ASCIZ	\(26) no-create on for specified SFD path \]
	[ASCIZ	\(27) segment not on swap space \]
	[ASCIZ	\(30) can't update file \]
	[ASCIZ	\(31) low segment overlaps high segment \]

LRELEN==.-LRETAB
	[ASCIZ	\) unknown error \]

DEFERR:	OUTSTR	[ASCIZ	\(\]		;[27]
	HRRZ	TE,1(TA)		;[27] GET ERROR NUMBER
	PUSHJ	PP,PUTOCT		;[27] OUTPUT IT IN OCTAL
	MOVEI	TB,LRELEN		;[27] USE DEFAULT MESSAGE
	POPJ	PP,			;[27] RETURN TO PRINT IT

;[27] STORE LOOKUP/ENTER BLOCK IN CURRENTLY IN AC TA-TD IN ERRNAM

SAVEA:	MOVEM	TA,ERRNAM	;[27] SAVE LOOKUP BLOCK
	MOVEM	TB,ERRNAM+1	;[27] SAVE EXT AND ERROR CODE
	MOVEM	TC,ERRNAM+2	;[27]
	MOVEM	TD,ERRNAM+3	;[27]
	MOVEI	TA,ERRNAM	;[27] POINT TO IT
	POPJ	PP,		;[27]
PPLEN==^D20		;LENGTH OF PUSHDOWN STACK
PPOINT:	IOWD	PPLEN,PPTABL
TTYC1:	POINT	6,COMWRD,5

DECIML:	DEC 100000
	DEC 10000
	DEC 1000
	DEC 100
	DEC 10
	DEC 1

;TABLE OF MONTHS

MOTABL:	"JAN"
	"FEB"
	"MAR"
	"APR"
	"MAY"
	"JUN"
	"JUL"
	"AUG"
	"SEP"
	"OCT"
	"NOV"
	"DEC"
;THESE ARE THE VALUES THAT ARE JAMMED INTO IMPURE AREA BETWEEN
;  LOWIMP AND HIIMP

IMPVAL:	ASCII	"		COBOL LIBRARY"
	ASCIZ	"		 XX-XXX-XX   XX:XX	PAGE	"	;[24]
	OCT	.IOBIN		;TOF DATA
	SIXBIT	"DSK"
	XWD	TOFOB,TOFIB
	SIXBIT	"   S01"
	SIXBIT	"TMP"
	OCT	0
	OCT	0

	OCT	.IOBIN		;TOD DATA
	SIXBIT	"DSK"
	XWD	TODOB,TODIB
	SIXBIT	"   S02"
	SIXBIT	"TMP"
	OCT	0
	OCT	0

	OCT	.IOBIN		;TID DATA
	SIXBIT	"DSK"
	XWD	TIDOB,TIDIB
	SIXBIT	"   S03"
	SIXBIT	"TMP"
	OCT	0
	OCT	0

	OCT	.IOBIN		;FOF DATA
	OCT	0
	XWD	FOFOB,0
	OCT	0
	OCT	0
	OCT	0
	OCT	0

	OCT	.IOBIN		;OIF DATA
	OCT	0
	XWD	0,OIFIB
	OCT	0
	OCT	0
	OCT	0
	OCT	0

	OCT	.IOASC		;OFF DATA
	OCT	0
	OCT	0
	OCT	0
	OCT	0

	OCT	.IOASC		;LST DATA
	OCT	0
	XWD	LSTBH,0

ENDPUR==.		;END OF PURE SEGMENT--LITERALS WILL START HERE
;IMPURE AREA

	RELOC	0

LOWIMP==.

HEADER:	BLOCK	3
HDATE:	BLOCK	3
HTIME:	BLOCK	3	;[24] EXTRA ROOM FOR PAGE

TOFDAT:	BLOCK	3
TOFNAM:	BLOCK	4

TODDAT:	BLOCK	3
TODNAM:	BLOCK	4

TIDDAT:	BLOCK	3
TIDNAM:	BLOCK	4

FOFDAT:	BLOCK	3
FOFNAM:	BLOCK	4

OIFDAT:	BLOCK	3
OIFNAM:	BLOCK	4

OFFDEV:	BLOCK	1
OFFNAM:	BLOCK	4

LSTDAT:	BLOCK	3
LSTNAM:	BLOCK	4

HIIMP==LSTNAM-1

ODEVCH:	BLOCK	1	;CHARACTERISTICS OF FIRST OUTPUT DEVICE
TTYIB:	BLOCK	3
LSTBH:	BLOCK	3
TOFOB:	BLOCK	3
TOFIB:	BLOCK	3
TODOB:	BLOCK	3
TODIB:	BLOCK	3
TIDOB:	BLOCK	3
TIDIB:	BLOCK	3
FOFOB:	BLOCK	3
OIFIB:	BLOCK	3
OFFBH:	BLOCK	3
LOCLR==.

TOFBUF:	BLOCK	1
TODBUF:	BLOCK	1
TIDBUF:	BLOCK	1
OIFBUF:	BLOCK	1
OFFBUF:	BLOCK	1

LASTPG:	BLOCK	2	;LATEST LIBRARY NAME TYPED

IFE TOPS20,<
TOFPTH:	BLOCK	.PTMAX	;[27]
TODPTH:	BLOCK	.PTMAX	;[27]
TIDPTH:	BLOCK	.PTMAX	;[27]
FOFPTH:	BLOCK	.PTMAX	;[27]
OIFPTH:	BLOCK	.PTMAX	;[27]
OFFPTH:	BLOCK	.PTMAX	;[27]
LSTPTH:	BLOCK	.PTMAX	;[27]
>

ERRNAM:	BLOCK	4		;[27] WHERE TO STORE LOOKUP/ENTER BLOCK ON ERRORS

HICLR==.-1
SAVJFF:	BLOCK	1	;SAVE JOBFF AFTER SETTING UP TTY
INDEV:	BLOCK	1	;INPUT DEVICE
INFIL:	BLOCK	1	;INPUT FILE-NAME
INEXT:	BLOCK	1	;INPUT FILE-EXTENSION
INPP:	BLOCK	1	;INPUT PROJ-PROG NUMBER
TOEXTN:	BLOCK	1	;CURRENT TEMPORARY EXTENSION, IN BINARY

PPTABL:	BLOCK	PPLEN	;PUSH-DOWN LIST
COMLIN:	BLOCK	1	;LINE NUMBER TYPED WITH "I", "R" OR "D"
COMWRD:	BLOCK	2
NEWNAM:	BLOCK	2
RUFCTR:	BLOCK	1
RUFLOC:	BLOCK	1
RUFTAB:	BLOCK	200	;ROUGH TABLE

INNAM:	BLOCK	2	;CURRENT INPUT PROGRAM
OUTNAM:	BLOCK	2	;CURRENT OUTPUT PROGRAM
INLIN:	BLOCK	1	;CURRENT INPUT LINE NUMBER
OUTLIN:	BLOCK	1	;CURRENT OUTPUT LINE NUMBER

OFFSET:	BLOCK	1	;AMOUNT NEEDED TO OFFSET CHAINS
TOFCTR:	BLOCK	1	;COUNT OF WORDS WRITTEN INTO TEMP OUTPUT FILE
PRGCTR:	BLOCK	1	;NUMBER OF PROGRAMS IN THE FILE
FINCTR:	BLOCK	1
LINECT:	BLOCK	1	;LINES LEFT ON PRINTER PAGE
PAGNO:	BLOCK	1	;[24] CURRENT PAGE NUMBER
COMSAV:	BLOCK	^D9	;SAVE COMMAND STREAM
SAVECP:	BLOCK	1	;SAVE 'CP' DURING '@' COMMAND
SEQ:	BLOCK	1	;-1 IF LIBRARY IS CARD IMAGE (SEQUENCED) /S
INSEQ:	BLOCK	1	;SEQ FLAG FOR COPIED PROGRAMS
OUTSEQ:	BLOCK	1	;...
	BLOCK	1	;USED WHEN BLT'ING TO FINTAB
FINTAB:	BLOCK	200	;HOLDS FINE TABLE WHEN DOING /L
IFE TOPS20,<
PTHPTR:	BLOCK	1	;[27] POINTER TO WHICH SFD BLOCK TO USE
MYPATH:	BLOCK	.PTPPN	;[27] FIRST PART OF DEFAULT PATH
>
MYPPN:	BLOCK	1	;[27] LOGGED IN PPN
IFE TOPS20,<
MYSFD:	BLOCK	.PTMAX-.PTPPN	;[27] REST OF DEFAULT PATH
>
EXTERNAL .JBFF,.JBSA		;[13]

	RELOC ENDPUR


	END	START