Google
 

Trailing-Edge - PDP-10 Archives - cobol12c - creld.mac
There are 4 other files named creld.mac in the archive. Click here to see a list.
; UPD ID= 1875 on 5/1/79 at 9:05 AM by W:<WRIGHT>
TITLE	CRELD -- PROGRAM TO CREATE/MODIFY AN LSTATS DIRECTORY FILE
SUBTTL	COBOL-74 PROJECT

	SEARCH COPYRT
	SALL

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1976, 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.


; THIS PROGRAM IS USED TO CREATE AND MAINTAIN AN LSTATS DIRECTORY FILE.
;THE DIRECTORY FILE CONTAINS OUTPUT FILESPECS AND PARAMETERS USED BY COBOL
;PROGRAMS TO WRITE THE LSTATS DATA THEY ARE COLLECTING.

;THE FILE HAS THE SAME FORMAT ON TOPS10 AND TOPS20:

;WORD		;CONTENTS
;----		---------
.LDBPC==0	;BYTE PTR TO CURRENT FILENAME
.LDNFL==1	;# FILES IN DIRECTORY,,# OF CURRENT FILE
.LDSZL==2	; SIZE LIMIT OF EACH FILE (BLOCKS OR PAGES)
.LDTML==3	;TIME LIMIT (AS DAYS,,1/3 SECS)
.LDFWR==4	;TIME OF FIRST WRITE TO CURRENT FILE
.LDAFN==5	;ASCIZ FILE SPECS

;UNIVERSALS

	    SEARCH	LBLPRM		;LIBOL PARAMETERS (INC. "TOPS20" F.T.)
	    SEARCH	METUNV		;LSTATS DEFINITIONS

;TOPS20==0	;FOR EASILY TESTING TOPS10 CODE ON TOPS20 SYSTEM


IFN TOPS20,<
	SEARCH	MONSYM,MACSYM	;MONITOR-SPECIFIC DEFINITIONS
	.REQUIRE SYS:MACREL	;AND GET MACREL
>
IFE TOPS20,<
	SEARCH	UUOSYM,MACTEN	; . .
	.TEXT	@ REL:SCAN/SEARCH/INCL:.TOUTS @ ;TELL LINK TO LOAD SCAN
>

	.COPYRIGHT		;Put standard copyright statement in REL file
	SALL
SUBTTL	DEFINITIONS

;DEFAULT OUTPUT DIRECTORIES ARE DEFINED IN METUNV.MAC.

PDLSIZ==^D100		;PUSHDOWN STACK SIZE
FILLEN==5*^D512		;FILE LENGTH IN 36-BIT BYTES
LINLEN==^D100		;MAX TTY INPUT LINE (CHARACTERS)

DSK==1			;CHANNEL FOR FILE LSTATS.DIR
IFE TOPS20,<
DSKO==2			;OUTPUT CHANNEL FOR BACKUP/DUMPER COMMAND FILE
FSP==3			;FILE-SPEC FILE
>

DEFINE	TMSG(TEXT),<
IFE TOPS20,<
OUTSTR	[ASCIZ/TEXT/]
>
IFN TOPS20,<
	HRROI	T1,[ASCIZ/TEXT/]
	PSOUT
>
>

DEFINE PRSTRG,<
BYTE(7)"C","R","E","L","D",76
>

DEFINE TCRLF,<
IFE TOPS20,<	OUTSTR	[ASCIZ/
/]
>
IFN TOPS20,<	HRROI T1,[ASCIZ/
/]
		PSOUT
>
>

;ACS

F=0		;FLAGS
T1=1		;STANDARD AC DEFS..
T2=2
T3=3
T4=4

P1=5
P2=6
P3=7
CO=10		;A COUNTER
FP=11		;RH = FILE POINTER
C=12		;TTY INPUT CHARACTERS

P=17		;PUSHDOWN PTR

;FLAGS IN "F"

F.NTY==1B0		;NUMBER WAS TYPED
F.NFL==1B1		;NO PREVIOUS LSTATS.DIR
F.WAI==1B2		;WE'VE BEEN WAITING FOR THE FILE TO STOP
			; BEING MODIFIED BY SOMEONE ELSE
F.EXH==1B3		;OLD FILE IS EXHAUSTED
F.FEF==1B4		;EOF ON FILE-SPEC FILE SEEN
F.SOL==1B5		;STUFF ON LINE

SUBTTL	STARTUP

;SETUP DATA AREAS, READ OLD DIRECTORY FILE IF ANY.

ST:	RESET			;CLEAR I/O
	TDZ	F,F		;CLEAR FLAGS
	SETZM	STBEG		;CLEAR DATA STORAGE AREA
	MOVE	T1,[STBEG,,STBEG+1]
	BLT	T1,STEND	;. .
	MOVE	P,[IOWD PDLSIZ,PDL] ;MAKE A PUSHDOWN POINTER

	PUSHJ	P,FILSET	;SETUP FILES INITIALLY AND SETUP FLAGS

	TMSG	<Type "H" for help
>
; HERE WHEN EITHER THE OLD INFO IS IN CORE, OR WE HAVE SETUP
;DEFAULTS. (FLAG F.NFL IS ON IN THE LATTER CASE).

NEWCMD:
IFE TOPS20,<
	OUTSTR	[PRSTRG]	;OUTPUT PROMPT
>
IFN TOPS20,<
	HRROI	T1,[PRSTRG]	;OUTPUT PROMPT
	MOVEM	T1,TXTIBL+.RDRTY ;SETUP CONTROL-R BUFFER
	PSOUT
>;END IFN TOPS20
	PUSHJ	P,GETLIN	;READ A LINE
	PUSHJ	P,GETC		;GET CHAR
	CAIN	C,12
	 JRST	NEWCMD
	CAIN	C,"H"
	 JRST	HELP
	CAIN	C,"E"
	 JRST	EXITT
	CAIN	C,"W"
	 JRST	WRITT
	CAIN	C,"C"
	 JRST	CHANG
	CAIN	C,"F"
	 JRST	RFILES
	CAIN	C,"L"
	 JRST	LIST
	CAIN	C,"R"		;REINIT
	 JRST	REINIT
IFE TOPS20,	CAIN C,"B"		;BACKUP
IFN TOPS20,	CAIN C,"D"		;DUMPER
	 JRST	DUMPER
	TMSG	<? Commands are:
>
	JRST	HLP1

HELP:	TMSG	<Commands are:
>
HLP1:	TMSG	<W	Write out LSTATS.DIR and exit
E	Exit without doing anything
C	Change defaults
F	Change the list of output files
L	List current information
R	Re-initialize file with all defaults
H	Type this text
>
IFN TOPS20,<
	HRROI	T1,[ASCIZ/D	Write out a DUMPER command file
	to save the files used up so far. Also deletes the
	used-up filespecs from LSTATS.DIR
/]
	PSOUT
>
IFE TOPS20,<
	OUTSTR	[ASCIZ/B	Write out a BACKUP command file
	to save the files used up so far. Also deletes the
	used-up filespecs from LSTATS.DIR
/]
>
	JRST	NEWCMD
SUBTTL	COMMANDS - WRITE, EXIT

;WRITE OUT CURRENT INFO.

WRITT:	USETO	DSK,1
	MOVE	T1,[IOWD FILLEN,FILINF]
	SETZ	T2,
	OUT	DSK,T1		;WRITE INFO
	 JRST	OUTOK
	OUTSTR	[ASCIZ/? OUT UUO FAILED
/]
	JRST	EXITT		;GO EXIT

OUTOK:	CLOSE	DSK,
	RELEAS	DSK,
	TXNE	F,F.NFL		;WAS FILE NOT FOUND WHEN WE STARTED?
	 JRST	WROTEK		;YES, SAY "WRITTEN"
	TMSG	<[LSTATS.DIR rewritten]
>				;SAY "REWRITTEN"
	 JRST	EXITT		;AND GO EXIT
WROTEK:	TMSG	<[LSTATS.DIR written]
>

EXITT:	RELEAS	DSK,		;RELEASE CHANNEL SO OTHERS CAN USE
	RESET
IFE TOPS20,<
	EXIT	1,
	JRST	ST
>
IFN TOPS20,<
	HALTF
	JRST	ST
>
SUBTTL	COMMANDS - CHANGE

;CHANGE DEFAULTS

CHANG:	TMSG	<(Type CRLF to retain old values, "0" to set no limit)

>
	TMSG	<Size limit of the output files in >
IFE TOPS20,	TMSG	<blocks (>
IFN TOPS20,	TMSG	<pages (>
	SKIPN	T2,FILINF+.LDSZL
	 JRST	[TMSG <No limit>
		JRST .+2]
	PUSHJ	P,TYPDEC
	TMSG	<): >
IFN TOPS20, SETZM	TXTIBL+.RDRTY	;CLEAR CONTROL-R BUFFER
	PUSHJ	P,GETLIN	;READ A LINE
	PUSHJ	P,RDNUM		;READ NUMBER
	 MOVE	T1,FILINF+.LDSZL ;CRLF TYPED, GET DEFAULT
	MOVEM	T1,FILINF+.LDSZL ;AND STORE IT
	TMSG	<
Time limit for writing to any one output file
		( >
	SKIPN	FILINF+.LDTML ;SEE IF ANY LIMIT NOW
	 JRST	[TMSG <No limit> ;NO
		JRST	CHNG1]
	HLRZ	T2,FILINF+.LDTML ;TIME LIMIT IN DAYS
	PUSHJ	P,TYPDEC	;TYPE NUMBER
	TMSG	<D >
	HRRZ	T2,FILINF+.LDTML ;GET SECS
	IDIVI	T2,3
	SKIPE	T2		;DON'T TYPE HH:MM:SS IF UNNECESSARY
	PUSHJ	P,HHMMSS	;TYPE HH:MM:SS
CHNG1:	TMSG	< ): >
IFN TOPS20, SETZM TXTIBL+.RDRTY ;CLEAR CONTROL-R BUFFER
	PUSHJ	P,GETLIN	;READ LINE
	PUSHJ	P,RDTIM		;READ DATE & TIME
	 MOVE	T1,FILINF+.LDTML ;GET DEFAULT IF ERROR OR CRLF TYPED
	MOVEM	T1,FILINF+.LDTML ;STORE NEW VALUE

ASKCUR:	TMSG	<Current file number (>
	HRRZ	T2,FILINF+.LDNFL
	PUSHJ	P,TYPDEC
	TMSG	<): >
IFN TOPS20, SETZM TXTIBL+.RDRTY ;CLEAR CONTROL-R BUFFER
	PUSHJ	P,GETLIN	;READ LINE
	PUSHJ	P,RDNUM		;READ DECIMAL NUMBER
	 JRST	[CAIN C,12
		JRST CHNG2	;USE OLD VALUE
		TMSG	<? Bad decimal number, try again
>
		JRST	ASKCUR]	;GO ASK AGAIN

;HE WANTS TO CHANGE THE CURRENT FILE. T1=NEW FILE NUMBER

	JUMPE	T1,[TMSG <? Must be between 1 and >
		HLRZ	T2,FILINF+.LDNFL
		PUSHJ	P,TYPDEC
		TCRLF
		JRST	ASKCUR]
	HLRZ	T2,FILINF+.LDNFL ;; GET TOTAL # OF FILES
	CAMGE	T2,T1		;BIGGER THAN MAX FILES?
	 JRST	[TMSG	<? Too large - only >
		PUSHJ	P,TYPDEC
		TMSG	< files in the directory
>
		JRST	ASKCUR]	;GO ASK AGAIN
	HRRM	T1,FILINF+.LDNFL ;STORE NEW CURRENT FILE

;FIX BYTE PTR TO CURRENT FILE.

	MOVE	P1,[POINT 7,FILINF+.LDAFN] ;BYTE PTR TO FIRST
	MOVEI	T2,1		;T2= FILE NUMBER
CURLP1:	CAMN	T2,T1		;ARE WE THERE YET?
	 JRST	CURLP2		;YES, STORE NEW BYTE PTR
	ILDB	T3,P1		;GET CHAR
	JUMPN	T3,.-1		;LOOK FOR END OF THIS ONE
	ADDI	T2,1		;NEXT FILE
	JRST	CURLP1		;SEE IF WE GOT IT YET
CURLP2:	SUBI	P1,FILINF	; GET A RELATIVE B.P.
	MOVEM	P1,FILINF+.LDBPC ;STORE NEW BYTE PTR TO CURRENT
	SETZM	FILINF+.LDFWR	;DELETE "FIRST WRITE" TIME.

CHNG2:	JRST	NEWCMD
SUBTTL	COMMANDS - F

;CHANGE LIST OF OUTPUT FILENAMES

RFILES:	TMSG	<File to read filespecs from: >
IFE TOPS20,<
	PUSHJ	P,GETLIN
	SETZM	FILDEV
	SETZM	INFIL
	SETZM	INFIL+1
	SETZM	INFIL+2
	SETZM	INFIL+3
	PUSHJ	P,RDFILS	;READ FILESPEC
	 JRST	NEWCMD		;ERROR, FORGET IT

	MOVE	T1,['CRELD']	;DEFAULT NAME
	SKIPN	INFIL
	MOVEM	T1,INFIL

RFILE1:	SKIPN	T2,FILDEV	;ANY DEVICE GIVEN?
	MOVSI	T2,'DSK'	;NO, USE DSK
	MOVEI	T1,0		;ASCII MODE
	MOVEI	T3,FSPBUF	;INPUT BUFFER HEADER
	OPEN	FSP,T1
	 JRST	[OUTSTR	[ASCIZ/? CAN'T OPEN DEVICE
/]
		JRST	NEWCMD]	;FORGET IT
	LOOKUP	FSP,INFIL	;LOOKUP THE FILE
	 JRST	[OUTSTR	[ASCIZ/? LOOKUP ERROR FOR INPUT FILE
/]
		RELEAS FSP,
		JRST	NEWCMD]	;GIVE UP

;READ FILENAMES FROM THE FILE, AND STORE THEM IN THEIR PLACE

	MOVE	P1,[POINT 7,.LDAFN] ;RESET CURRENT POINTER TO FILE #1
	MOVEM	P1,FILINF+.LDBPC
	MOVEI	P1,1		;0,,1
	MOVEM	P1,FILINF+.LDNFL  ;0 FILES SO FAR, CURRENT FILE IS #1
	MOVE	P1,[POINT 7,FILINF+.LDAFN] ;P1:=POINTER TO FILESPECS
	MOVEI	P2,0		;P2 = FILE NUMBER WE'RE AT NOW
	TXZ	F,F.FEF		;CLEAR END-OF-FILE FLAG
RFILE2:	PUSHJ	P,GETFLN	;READ A LINE FROM THE FILE
	 JRST	RFILEE		;END OF FILE
	SETZM	FILDEV		;CLEAR DEFAULTS
	SETZM	INFIL
	SETZM	INFIL+1
	SETZM	INFIL+2
	SETZM	INFIL+3
	PUSHJ	P,RDFILS	;GET FILE-SPEC
	 JRST	CHKECR		;ERROR OR CRLF, CHECK

	SKIPE	INFIL+3		;BETTER NOT HAVE SPECIFIED A PPN
	 JRST	[OUTSTR	[ASCIZ/? PPN MAY NOT BE SPECIFIED
/]
		JRST	CHKECR]
	MOVE	T1,INFIL	;BETTER HAVE A GOOD NAME
	TLNE	T1,770000
	 JRST	NAMOK
	OUTSTR	[ASCIZ/? FILENAME MUST BE GIVEN
/]
	JRST	CHKECR

; WE ARE SURE WE HAVE A REASONABLE FILE SPEC NOW

NAMOK:	SKIPN	T2,FILDEV	;ANY DEVICE GIVEN?
	 JRST	RDMOR1		;NO
	OUTSTR	[ASCIZ/? DEVICE MAY NOT BE SPECIFIED
/]
	JRST	CHKEC1

RDMOR1:	MOVE	T2,INFIL	;NAME
RDMOR2:	SETZ	T1,
	JUMPE	T2,RDMRV2	;DONE
	LSHC	T1,6
	ADDI	T1,40
	IDPB	T1,P1
	JRST	RDMOR2
RDMRV2:	MOVEI	T1,"."
	IDPB	T1,P1

	MOVE	T2,INFIL+1	;EXTENSION
RDMOR3:	SETZ	T1,
	JUMPE	T2,RDMRV3	;DONE
	LSHC	T1,6
	ADDI	T1,40
	IDPB	T1,P1
	JRST	RDMOR3
RDMRV3:	SKIPN	INFIL+3		;PPN?
	 JRST	RDMRV4		;NO
	MOVEI	T1,"["		;BRACKET TO START PPN
	IDPB	T1,P1
	HLRZ	T1,INFIL+3	;GET PROJECT #
	PUSHJ	P,OCTP1		;PUT OCTAL NUMBER
	MOVEI	T1,","
	IDPB	T1,P1
	HRRZ	T1,INFIL+3	;GET PROGRAMMER #
	PUSHJ	P,OCTP1
	MOVEI	T1,"]"
	IDPB	T1,P1
RDMRV4:	MOVEI	T1,0
	IDPB	T1,P1		;NULL TO END FILENAME
	ADDI	P2,1		;COUNT ANOTHER FILE
	HRLM	P2,FILINF+.LDNFL ;BUMP COUNTER
	CAIE	P2,^D100	;HAVE 100 YET?
	  JRST	RFILE2		;NO, KEEP INPUTTING
	JRST	NEWCMD

;WRITE OCTAL NUMBER IN T1 TO STRING WHOSE BYTE PTR IS IN "P1"
OCTP1:	IDIVI	T1,10
	PUSH	P,T2
	SKIPE	T1
	PUSHJ	P,OCTP1
	POP	P,T1
	ADDI	T1,"0"
	IDPB	T1,P1
	POPJ	P,

CHKECR:	LDB	C,[POINT 7,LINE,6] ;GET 1ST CHAR
	CAIN	C,12		;IF JUST <CR>
	 JRST	RFILE2		;THEN JUST READ MORE
CHKEC1:	OUTSTR	[ASCIZ/[ Stopping after reading /]
	HRRZ	T2,P2		;HOW MANY FILESPECS WE'VE COMPLETED
	PUSHJ	P,TYPDEC
	CAIN	P2,1
	 JRST	[OUTSTR [ASCIZ/ filespec./]
		JRST	.+2]
	OUTSTR	[ASCIZ/ filespecs./]
	OUTSTR	[ASCIZ/]
/]
RFILEE:	SETZ	T1,
	IDPB	T1,P1		;STORE LAST NULL
	JRST	NEWCMD		;GO ON TO NEW COMMAND
>;END IFE TOPS20
IFN TOPS20,<
	MOVX	T1,GJ%SHT!GJ%CFM!GJ%OLD!GJ%FNS
	MOVE	T2,[.PRIIN,,.PRIOU]
	GTJFN
	 ERJMP	[JSERR
		JRST NEWCMD]
	MOVEM	T1,CMDJFN	;STORE COMMAND FILE JFN
	MOVX	T2,7B5+OF%RD	;READ NORMALLY
	OPENF			;OPEN THE FILE
	 ERJMP	[JSERR
		JRST NEWCMD]	;RELEASE JFN AND LEAVE

	MOVE	P1,[POINT 7,.LDAFN] ;RESET CURRENT POINTER TO FILE #1
	MOVEM	P1,FILINF+.LDBPC
	MOVEI	P1,1		;0,,1
	MOVEM	P1,FILINF+.LDNFL  ;0 FILES SO FAR, CURRENT FILE IS #1
	MOVE	P1,[POINT 7,FILINF+.LDAFN] ;P1:=POINTER TO FILESPECS
	MOVEI	P2,0		;P2 = FILE NUMBER WE'RE AT NOW
	TXZ	F,F.FEF		;CLEAR END-OF-FILE FLAG
RFILE2:	PUSHJ	P,GETFLN	;READ A LINE FROM THE FILE
	 JRST	RFILEE		;END OF FILE
	MOVX	T1,GJ%SHT
	MOVE	T2,[POINT 7,LINE]
	GTJFN			;READ JFN FROM LINE
	 ERJMP	RFILE4		;ERROR READING JFN
	HRRZM	T1,TJFN		;SAVE IT

NAMOK:	MOVE	T2,T1		;JFN IN T2
	MOVE	T1,P1		; STORE IT HERE
	SETZ	T4,		;NO PREFIX
	MOVX	T3,1B8+1B11+JS%PAF ;JUST FILENAME, FILETYPE, AND .

;NOTE THAT IF HE TYPED A DEVICE NAME, WE AREN'T SMART ENOUGH TO FIGURE
; THAT OUT AND WARN HIM THAT IT WON'T BE USED.
;TO DO SO WOULD REQUIRE US TO PARSE THE TOPS20 FILESPEC OURSELVES.

	JFNS			;GET ASCII STRING FOR IT
	 ERJMP	[JSERR
		JRST	NEWCMD]
	MOVE	P1,T1		;GET UPDATED STRING POINTER
	LDB	T1,P1		;STORE NULL ON END IF THERE ISN'T ONE
	TDZE	T1,T1
	IDPB	T1,P1
	MOVE	T1,TJFN
	RLJFN			;NOW RELEASE JFN
	 JFCL			;IGNORE ERRORS
	ADDI	P2,1		;READ ANOTHER ONE
	HRLM	P2,FILINF+.LDNFL ;BUMP OFFICIAL COUNTER
	CAIE	P2,^D100	;100 YET?
	 JRST	RFILE2		;NO, KEEP INPUTTING
	JRST	NEWCMD

RFILEE:	SETZ	T2,
	IDPB	T2,P1		;STORE LAST NULL
	JRST	NEWCMD

RFILE4:	JSERR
	HRROI	T1,[ASCIZ/ - THE LINE WAS:
/]
	PSOUT
	HRROI	T1,LINE	
	PSOUT
	JRST	NEWCMD

>;END IFN TOPS20
SUBTTL	COMMANDS - REINIT

REINIT:	PUSHJ	P,REFRES	;REFRESH DATA AREA
	JRST	NEWCMD		;DONE

REFRES:	SETZM	FILINF		;CLEAR OLD INFO
	MOVE	T1,[FILINF,,FILINF+1]
	BLT	T1,FILINF+FILLEN-1
	PUSHJ	P,DEFSET	;SETUP DEFAULTS
	POPJ	P,		;AND RETURN
SUBTTL	COMMANDS - DUMPER/BACKUP

;WRITE DUMPER/BACKUP COMMAND FILE, UPDATE IN-CORE DIRECTORY

DUMPER:	HRRZ	T1,FILINF+.LDNFL ;NUMBER OF CURRENT FILE
	CAIN	T1,1
	 JRST	[TMSG	<% Nothing to do.. current file is #1
>
		JRST	NEWCMD]
DUMP1:	TMSG	<Output command file: >
IFN TOPS20,<
	MOVE T1,[POINT 7,[ASCIZ/Output command file: /]]
	MOVEM	T1,TXTIBL+.RDRTY
	PUSHJ	P,GETLIN
	MOVX	T1,GJ%SHT!GJ%FOU ;OUTPUT FILESPEC BITS
	MOVE	T2,[POINT 7,LINE] ;READ IT FROM HERE
	GTJFN
	 ERJMP	[JSERR
		JRST	DUMP1]	;ERROR, GO TRY AGAIN
	MOVEM	T1,OJFN		;SAVE OUTPUT FILE JFN
	MOVX	T2,7B5+OF%WR	;WRITE TO FILE, 7 BIT BYTES
	OPENF
	 ERJMP	[JSERR		;TYPE ERROR MESSAGE
		JRST	DMERR0]	;CAN'T OPEN FILE
>;END IFN TOPS20
IFE TOPS20,<
	PUSHJ	P,GETLIN
	PUSHJ	P,RDFILS	;READ THE FILESPEC
	SKIPN	T2,FILDEV	;GET DEVICE
	 MOVSI	T2,'DSK'	;NULL, USE DSK:
	MOVEI	T1,0		;ASCII MODE
	MOVSI	T3,OBUF		;BUFFER HEADER
	OPEN	DSKO,T1		;OPEN COMMAND FILE DEVICE
	 JRST	[OUTSTR	[ASCIZ/? OPEN FAILED FOR BACKUP COMMAND FILE
/]
		JRST	DUMP1]	;TRY AGAIN
	MOVE	T1,INFIL	;GET NAME
	TLNN	T1,770000	;BETTER BE NON-NULL IN FIRST CHAR
	 JRST	[OUTSTR	[ASCIZ/? NULL FILENAME.. TRY AGAIN
/]
		JRST	DUMP1]	;WOULD YOU BELIEVE.
	SKIPN	T2,INFIL+1	;EXTENSION
	 MOVSI	T2,'CMD'	;DEFAULT IS .CMD
	MOVE	T3,INFIL+2
	MOVE	T4,INFIL+3	;PPN
	ENTER	DSKO,T1		;ENTER FILE
	 JRST	[OUTSTR	[ASCIZ/? ENTER FAILED FOR BACKUP COMMAND FILE
/]
		RELEAS	DSKO,	;FORGET THIS
		JRST	NEWCMD]	;TRY ANOTHER COMMAND
>;END IFE TOPS20
	MOVE	P1,[POINT 7,[ASCIZ/INTERCHANGE
FILES
/]]
	PUSHJ	P,WRTSTR	;WRITE THE STRING

;NOW WRITE OUT 'SAVE' COMMANDS FOR ALL THE OLD FILENAMES
SAVOFN:	HRRZ	P2,FILINF+.LDNFL ;CURRENT FILE
	MOVEI	P3,1		;P3= NUMBER OF THE FILE WE'RE ON
	MOVE	T4,[POINT 7,.LDAFN] ;START AT 1ST
	ADDI	T4,FILINF
SAVOF1:	MOVE	P1,[POINT 7,[ASCIZ/SAVE /]]
	PUSHJ	P,WRTSTR	;WRITE "SAVE "
	MOVE	P1,T4		;GET STRING PTR
	PUSHJ	P,WRTSTR	;WRITE IT
	ILDB	T1,T4		;GET CHAR
	JUMPN	T1,.-1		;LOOK FOR THE NULL
	MOVE	P1,[POINT 7,[ASCIZ/
/]]
	PUSHJ	P,WRTSTR	;WRITE CRLF
	ADDI	P3,1		;NEXT FILE
	CAME	P3,P2		;AT CURRENT FILE YET?
	 JRST	SAVOF1		;NO, LOOP
IFE TOPS20,<
	CLOSE	DSKO,
	RELEASE	DSKO,
>
IFN TOPS20,<
	MOVE	T1,OJFN		;NOW CLOSE FILE & RELEASE JFN
	CLOSF
	 ERJMP	SYSERR
	JRST	CLOSOK

DMERR0:	HRROI	T1,[ASCIZ/? CAN'T OPEN FILE:
/]
	PSOUT
	JSERR
	MOVE	T1,OJFN
	RLJFN
	 ERJMP	.+1
	JRST	NEWCMD

CLOSOK:
>;END IFN TOPS20


;COMMAND FILE IS WRITTEN.. NOW UPDATE THE INCORE TABLE
; TO DELETE THE FINISHED FILES FROM THE DIRECTORY.

	TMSG	<[Command file written]
>
	MOVE	T1,FILINF+.LDBPC ;T1=PTR TO CURRENT
	ADDI	T1,FILINF
	MOVE	T2,[POINT 7,FILINF+.LDAFN] ;T2=PTR TO WHERE IT GOES
	ILDB	T3,T1		;GET CHAR
	JUMPE	T3,ONENUL	;END OF THIS FILESPEC
NEXFS:	IDPB	T3,T2		;STORE CHAR
	JRST	.-3		;KEEP GOIN'

ONENUL:	IDPB	T3,T2		;STORE THAT
	ILDB	T3,T1		;GET FOLLOWING CHAR
	JUMPN	T3,NEXFS	;NOT END OF LIST YET

	REPEAT 5,<IDPB T3,T2>	;STORE SOME NULLS
	SETZM	(T2)		;CLEAR OUT REST OF BUFFER
	HRL	T1,T2
	HRRI	T1,1(T2)
	BLT	T1,FILINF+FILLEN-1 ;ZAP

	MOVE	T1,[POINT 7,.LDAFN] ;CURRENT FILE IS AT THE TOP NOW
	MOVEM	T1,FILINF+.LDBPC
	HLRZ	T1,FILINF+.LDNFL ;FIX # FILES IN DIRECTORY
	HRRZ	T2,FILINF+.LDNFL
	SUBI	T2,1
	SUB	T1,T2
	HRLM	T1,FILINF+.LDNFL
	MOVEI	T1,1		;CURRENT FILE IS NOW #1
	HRRM	T1,FILINF+.LDNFL
	JRST	NEWCMD

SUBTTL	COMMANDS - LIST

;LIST CURRENT PARAMETERS

LIST:	TMSG	<Output file size limit:
	>
	SKIPN	T2,FILINF+.LDSZL
	 JRST	[TMSG	<No limit.>
		JRST	LIST0]
	PUSHJ	P,TYPDEC
IFE TOPS20, TMSG	< BLOCKS>
IFN TOPS20, TMSG	< PAGES>
LIST0:	TMSG	<

Time limit for writing to any one "CURRENT" file:
	>
	MOVE	T1,FILINF+.LDTML
	JUMPE	T1,NOTLM	;JUMP IF NONE
	HLRZ	T2,T1		;GET DAYS
	JUMPE	T2,NODYS	;LESS THAN 1 DAY
	CAIN	T2,1		;EXACTLY 1 DAY
	 JRST	[TMSG <1 Day>
		JRST	NODYS]
	PUSHJ	P,TYPDEC
	TMSG	< Days>
NODYS:	HRRZ	T1,FILINF+.LDTML ;GET 1/3'S OF SECONDS
	JUMPE	T1,NOSCS	;JUMP IF NO SECS.
	TMSG	<, >		;SEPARATE DAYS FROM TIME
	HRRZ	T1,FILINF+.LDTML ;GET AGAIN
	IDIVI	T1,3		;GET SECONDS
	IDIVI	T1,^D60*^D60	;T1=HRS
	PUSH	P,T2
	JUMPE	T1,NOHRS
	MOVE	T2,T1
	PUSHJ	P,TYPDEC
	TMSG	< Hrs. >
NOHRS:	POP	P,T1
	IDIVI	T1,^D60		;T1=MINS, T2=SECS
	JUMPE	T1,NOMNS
	PUSH	P,T2
	MOVE	T2,T1
	PUSHJ	P,TYPDEC
	TMSG	< Mins. >
	POP	P,T2
NOMNS:	JUMPE	T2,NOSCS
	PUSHJ	P,TYPDEC
	TMSG	< Secs.>
NOSCS:	TMSG	<
>
	JRST	LIST1
NOTLM:	TMSG	< No limit
>
LIST1:	TMSG	<
# Files in directory: >
	HLRZ	T2,FILINF+.LDNFL
	PUSHJ	P,TYPDEC
	TMSG	<,  the current file is number >
	HRRZ	T2,FILINF+.LDNFL
	PUSHJ	P,TYPDEC
	TMSG	<

The current file is >
	MOVE	T1,FILINF+.LDBPC
	ADDI	T1,FILINF
IFN TOPS20,	PSOUT
IFE TOPS20,	PUSHJ	P,TTYSTR	;TYPE STRING TO TTY
	SKIPN	FILINF+.LDTML	;ANY TIME LIMIT?
	 JRST	LIST2		;NO
	SKIPN	T2,FILINF+.LDFWR ;GET TIME OF FIRST WRITE TO THE FILE
	JRST	[TMSG < (No data written into it yet)>
		JRST	LIST2]
	TMSG	< First written: >
IFN TOPS20,<
	MOVEI	T1,.PRIOU
	SETZ	T3,
	ODTIM
>
IFE TOPS20,<
	MOVE	T1,T2		;GET TIME IN T1
	PUSHJ	P,.TDTTM##	; CALL SCAN ROUTINE TO TYPE IT
>
LIST2:	TMSG	<

Files in the directory: (f = finished, * = current file)

>

	MOVEI	T3,1		;T3=NUMBER OF THE FILE
	HLRZ	T4,FILINF+.LDNFL ;GET # FILES TOTAL
	HRRZ	P1,FILINF+.LDNFL ;P1= # OF CURRENT FILE
	MOVE	P3,[POINT 7,FILINF+.LDAFN]; FIRST ONE IS HERE
TYPONE:	CAMLE	T3,T4		;DONE?
	 JRST	LIST5		;YES
	MOVE	P2,[POINT 7,OUTLIN] ;MAKE AN OUTPUT LINE
	MOVEI	T2,[ASCIZ/f  /] ;ASSUME FILE IS FINISHED
	CAMLE	T3,P1		;PAST CURRENT FILE
	MOVEI	T2,[ASCIZ/   /] ;YES, GET SPACES
	CAMN	T3,P1		; .EQ. CURRENT FILE?
	MOVEI	T2,[ASCIZ/*  /]	;YES, GET *
	HRLI	T2,(POINT 7,)	;T2=BYTE PTR TO STARTER STRING
	ILDB	T1,T2		;GET CHAR
	JUMPE	T1,.+3		;JUMP WHEN NULL FOUND
	IDPB	T1,P2		;AND STORE IN OUTPUT LINE
	JRST	.-3

;COPY FILENAME
	ILDB	T1,P3		;GET NEXT FILENAME
	JUMPE	T1,.+3		;DONE AT NULL
	IDPB	T1,P2		;STORE IN OUTPUT LINE
	JRST	.-3
	MOVEI	T1,15
	IDPB	T1,P2
	MOVEI	T1,12
	IDPB	T1,P2
	MOVEI	T1,0
	IDPB	T1,P2		;<CRLF><NUL> ENDS IT

;TYPE THE LINE
IFE TOPS20,<
	OUTSTR	OUTLIN		;TYPE THE LINE
>
IFN TOPS20,<
	HRROI	T1,OUTLIN
	PSOUT			;TYPE THE LINE
>
	ADDI	T3,1		;GO ON TO NEXT FILE
	JRST	TYPONE

LIST5:	JRST	NEWCMD

SUBTTL	FILSET -- INITIAL SETUP ROUTINE

;FILSET OPENS THE FILE FOR I/O, AND SETS UP THE DATA AREA IN CORE.

FILSET:	OPEN	DSK,[17		;THIS IS ALL DONE WITH TOPS10 CODE,
	SIXBIT	/DSK/		; PA1050 DEPENDED ON FOR TOPS20
	0]
	 JRST	NODSK		;CAN'T OPEN THE DEVICE
DOLKE:	MOVE	T1,['LSTATS']
	MOVSI	T2,'DIR'
	SETZB	T3,T4		;ON [,]
	LOOKUP	DSK,T1
	 JRST	NOFIL		;ANALYZE LOOKUP ERROR
	TXNN	F,F.WAI		;DON'T TYPE MESSAGE MORE THAN ONCE
	OUTSTR	[ASCIZ/[Reading file DSK:LSTATS.DIR]
/]
	HLRE	T1,T4		;GET FILE SIZE
	JUMPG	T1,FILBIG	;.GT. 1024 BLOCKS! MUCH TOO BIG - GIVE UP
	MOVM	T2,T1		;GET MAGNITUDE
	CAIE	T2,FILLEN	; NOT EQUAL TO ASSUMED FILE LENGTH?
	 JRST	FILBG1		;YES, DON'T EVEN ALLOW THAT
	HRLM	T1,OLDSIZ	;SAVE OLD SIZE AS LEFT HALF OF IOWD
	PUSHJ	P,ENTFIL
	 JRST	NOENT		;ANALYZE ENTER ERROR
	TXZN	F,F.WAI		;HAVE WE BEEN WAITING
	JRST	ENTOK		;ALL OK
	OUTSTR	[ASCIZ/[File open for updating]
/]
	JRST	ENTOK


NODSK:	OUTSTR	[ASCIZ/? CAN'T OPEN "DSK"!
/]
	EXIT
NOFIL:	HRRZ	T2,T2		;GET LOOKUP ERROR CODE
	JUMPE	T2,FILNFD	;FILE NOT FOUND--OK
	OUTSTR	[ASCIZ/? LOOKUP ERROR /]
	PUSHJ	P,TYPOCT
	OUTSTR	[ASCIZ/ FOR FILE LSTATS.DIR
/]
	EXIT			;DIE

FILBIG:	OUTSTR	[ASCIZ/? FILE LARGER THAN 1024 BLOCKS!
(THERE MUST BE SOMETHING WRONG)
/]
	EXIT			;DIE

FILBG1:	OUTSTR	[ASCIZ/? FILE LENGTH NOT EQUAL TO 20 BLOCKS!
(THERE MUST BE SOMETHING WRONG)
/]
	EXIT			;DIE

FILNFD:	OUTSTR	[ASCIZ/[Can't find DSK:LSTATS.DIR - creating one]
/]
	TXO	F,F.NFL		;FILE DOESN'T YET EXIST
	PUSHJ	P,ENTFIL	;ENTER IT FOR UPDATING
	 JRST	NOENT		;CAN'T

	PUSHJ	P,DEFSET	;SETUP DEFAULTS
	POPJ	P,		;ALL SETUP NOW

NOENT:	HRRZ	T2,T2		;GET ENTER ERROR CODE
	CAIN	T2,3		;FILE BEING MODIFIED?
	 JRST	FILMOD		;YES, TRY AGAIN IN A SEC
	OUTSTR	[ASCIZ/? ENTER ERROR /]
	PUSHJ	P,TYPOCT
	OUTSTR	[ASCIZ/ FOR FILE LSTATS.DIR
/]
	EXIT			;DIE

;FILE IS BEING MODIFIED. (QUITE POSSIBLE -- TRY AGAIN IN A SEC).
FILMOD:	CLOSE	DSK,		;CLOSE FILE
	TXOE	F,F.WAI		;WAITING FOR IT..
	 JRST	FILMD1		;BEEN WAITING
	OUTSTR	[ASCIZ/[FILE BEING MODIFIED -- WAITING]
/]
	MOVEI	CO,^D10		;WAIT FOR 10 SECONDS, THEN COMPLAIN AGAIN
FILMD1:	SOJLE	CO,FILMD2	;WAITED TOO LONG!
	MOVEI	T1,1		;NA.. WAIT A SEC
	SLEEP	T1,
	JRST	DOLKE		;LOOKUP/ENTER AGAIN
FILMD2:	OUTSTR	[ASCIZ/? LSTATS.DIR BEING UPDATED-- TIMOUT
/]
	EXIT			;DIE -- SOMETHING WRONG PROBABLY

;FILE IS OPEN FOR I/O.  READ PREVIOUS INFO.

ENTOK:	MOVEI	T1,FILINF-1	;PLACE TO START
	HRRM	T1,OLDSIZ	;FINISH IOWD
	MOVE	T1,OLDSIZ	;GET IOWD
	SETZ	T2,		;END OF LIST
	IN	DSK,T1		;READ IT
	 JRST	INOK		;GREAT
	OUTSTR	[ASCIZ/? CAN'T READ OLD LSTATS.DIR -- IN UUO FAILED
/]
	EXIT			;GIVE UP

;CHECK CONSISTANCY, AND REPORT ANY OBVIOUS PROBLEMS
INOK:	PUSHJ	P,CSTCHK
	 JRST	INCON		;FILE IS INCONSISTANT
	POPJ	P,		;ALL SET
INCON:	OUTSTR	[ASCIZ/[STARTING FRESH]
/]
	PUSHJ	P,REFRES	;REFRESH DATA AREA
	POPJ	P,		;AND RETURN

;ROUTINE TO READ NEXT LINE FROM TTY

GETLIN:	MOVE	T1,[POINT 7,LINE]
	MOVEM	T1,LINBP

IFN TOPS20,<
	MOVEI	T1,TXTIBL	;USE TEXTI BLOCK
	MOVE	T2,[POINT 7,LINE] ;BUFFER POINTER
	MOVEM	T2,.RDDBP(T1)	;STORE IT
	MOVEI	T2,LINLEN	;SIZE
	MOVEM	T2,.RDDBC(T1)	;STORE THAT
	MOVX	T2,RD%JFN!RD%BEL ;BREAK ON END OF TTY LINE
	MOVEM	T2,.RDFLG(T1) ;STORE FLAGS
	TEXTI			;DO TEXTI
	 ERJMP	[JSERR
		POPJ P,]
	MOVE	T2,[POINT 7,LINE] ;LOOK AT LINE, TRANSFORM CR INTO LF
	ILDB	T1,T2
	JUMPE	T1,CPOPJ	;ALL DONE WHEN WE HAVE NUL
	CAIE	T1,15		;HAVE CR?
	 JRST	.-3		;NO, LOOP UNTIL WE GOT IT OR NULL
	MOVEI	T1,12
	DPB	T1,T2		;STORE LF ON TOP OF IT
	SETZ	T1,
	IDPB	T1,T2		;THEN STORE NUL
	POPJ	P,		;RETURN OK
>
	MOVEI	T2,LINLEN	;MAX SIZE OF LINE
GETL1:	PUSHJ	P,INCH		;GET NEXT CHAR
	 JRST	BRKCH		;BREAK CHAR
	SOJL	T2,BIGLIN	;COMPLAIN IF LINE TOO LONG
	IDPB	C,T1		;STORE CHAR
	JRST	GETL1		;LOOP

BIGLIN:	OUTSTR	[ASCIZ/? INPUT LINE TOO LONG - TRUNCATED
/]
	PUSHJ	P,INCH
	 JRST	BRKCH
	JRST	.-2		;EAT LINE UNTIL BREAK FOUND

BRKCH:	MOVEI	C,12		;STORE LF
	IDPB	C,T1
	POPJ	P,		;RETURN, LINE DONE

;ROUTINE TO GET NEXT CHAR
GETC:	ILDB	C,LINBP
	POPJ	P,		;RETURN

;ROUTINE TO READ A DECIMAL NUMBER.
; POPJ'S IF FIRST NON-SPACE CHARACTER IS NOT A DIGIT.

RDNUM:	SETZ	T1,		;INTO T1
RDNUM1:	PUSHJ	P,GETC		;GET 1ST NON-SPACE CHARACTER
	CAIE	C,11
	CAIN	C,40
	 JRST	RDNUM1
	CAIL	C,"0"
	CAILE	C,"9"
	  POPJ	P,		;NOT A DIGIT, POPJ
	AOS	(P)		;WILL TAKE SKIP RETURN NOW
RDNUM2:	IMULI	T1,^D10
	ADDI	T1,-"0"(C)	;ADD IN DIGIT
	PUSHJ	P,GETC
	CAIL	C,"0"
	CAILE	C,"9"
	 POPJ	P,
	JRST	RDNUM2		;MORE DIGITS, KEEP GOING

;ROUTINE TO READ AN OCTAL NUMBER.
; POPJ'S IF FIRST NON-SPACE CHARACTER IS NOT A DIGIT.

RDOCT:	SETZ	T1,		;INTO T1
RDOCT1:	PUSHJ	P,GETC		;GET 1ST NON-SPACE CHARACTER
	CAIE	C,11
	CAIN	C,40
	 JRST	RDOCT1
	CAIL	C,"0"
	CAILE	C,"7"
	  POPJ	P,		;NOT A DIGIT, POPJ
	AOS	(P)		;WILL TAKE SKIP RETURN NOW
RDOCT2:	LSH	T1,3
	ADDI	T1,-"0"(C)	;ADD IN DIGIT
	PUSHJ	P,GETC
	CAIL	C,"0"
	CAILE	C,"7"
	 POPJ	P,
	JRST	RDOCT2		;MORE DIGITS, KEEP GOING


;ROUTINE TO READ A TIME LIMIT AS [NNND] [,] [HH:MM:SS]
; PUTS INTO T1 AS THE UNIVERSAL DATE/TIME FORMAT.
;THUS "1D" = 1,,0  "5D 3:00:00" = 5,,4231,  ETC.
;RETURNS POPJ IF ERROR OR JUST "CRLF" TYPED

RDTIM:	SETZM	INTIM
	PUSHJ	P,RDNUM		;READ # DAYS OR HH
	 POPJ	P,		;NOTHING, JUST POPJ
	CAIN	C,"D"		;DAYS?
	 JRST	STRDYS		;YES
	CAIN	C,":"		;TIME?
	 JRST	STRTM		;YES
	CAIN	C,12		;CRLF?
	 JRST	[HRLZM T1,INTIM ;STORE # DAYS
		JRST DONDTM]	;AND DONE
BADFMT:	TMSG	<? FORMAT IS NNND HH:MM:SS
>
	POPJ	P,		;BAD RETURN
STRDYS:	HRLZM	T1,INTIM	;STORE # DAYS
STRDY1:	PUSHJ	P,RDNUM		;NEXT GET TIME
	 JRST	[CAIN C,12
		JRST DONDTM	;ALL DONE, OK
		CAIN C,","	;COMMA IS OK HERE
		JRST STRDY1
		JRST BADFMT]	;PROBLEMS
STRTM:	HRRZ	T2,INTIM	;GET OLD TIME
	IMULI	T2,^D60
	ADDI	T2,(T1)
	HRRM	T2,INTIM
	PUSHJ	P,RDNUM		;GET NEXT NN
	 JRST	[CAIN C,12
		JRST DONDTM	;ALL DONE, OK
		JRST	BADFMT] ;PROBLEMS
	HRRZ	T2,INTIM
	IMULI	T2,^D60
	ADDI	T2,(T1)
	HRRM	T2,INTIM
	CAIN	C,12
	 JRST	DONDTM
	PUSHJ	P,RDNUM		;GET LAST NN
	 JRST	[CAIN C,12
		JRST DONDTM
		JRST BADFMT]
	HRRZ	T2,INTIM
	IMULI	T2,^D60
	ADDI	T2,(T1)
	HRRM	T2,INTIM
DONDTM:	HRRZ	T1,INTIM	;GET SECS
	IMULI	T1,3		;GET 1/3'S OF SECONDS
	HRRM	T1,INTIM	;DONE
	MOVE	T1,INTIM
CPOPJ1:	AOS	(P)
CPOPJ:	POPJ	P,
; TOPS10 ROUTINE TO READ A FILESPEC.
; RETURNS INFO IN "INFIL", "FILDEV".
IFE TOPS20,<
RDFILS:
	PUSHJ	P,RDSIX		;READ SIXBIT WORD
	 POPJ	P,		;NOTHING THERE, RETURN
	CAIN	C,":"		;COLON?
	 JRST	SAWDEV		;YES, SAW DEVICE NAME
CHKFNM:	CAIE	C,"."		;END OF FILENAME?
	CAIN	C,"["
	 JRST	SAWFIL		;YES
	CAIN	C,12		;END OF EVERYTHING?
	 JRST	[MOVEM T1,INFIL	;YES, SAVE NAME
		JRST CPOPJ1]	;AND RETURN OK
BADFNM:	OUTSTR	[ASCIZ/? FORMAT IS DEV:FILE.EXT[P,PN]
/]
	POPJ	P,		;BAD RETURN

SAWDEV:	MOVEM	T1,FILDEV	;SAVE DEVICE NAME
	PUSHJ	P,RDSIX		;READ NEXT SIXBIT WORD
	 JRST	CPOPJ1		;END--RETURN OK
	JRST	CHKFNM		;GO CHECK FILENAME

SAWFIL:	MOVEM	T1,INFIL	;SAVE FILENAME
	CAIN	C,"."
	 JRST	GETEXT		;GO GET EXT
	CAIN	C,"["
	 JRST	GETPPN		;GO GET PPN
	JRST	CPOPJ1		;MUST BE LF, RETURN OK

GETEXT:	PUSHJ	P,RDSIX		;READ EXT
	 JRST	[SETZM INFIL+1	;NULL
		JRST	CPOPJ1]
	CAIE	C,"["		;NOW CAN HAVE PPN
	CAIN	C,12		;OR END
	 CAIA
	JRST	BADFNM		;ELSE COMPLAIN
	HLLZM	T1,INFIL+1	;ELSE STORE EXT
	CAIN	C,12
	 JRST	CPOPJ1		;END IS OK

GETPPN:	PUSHJ	P,RDOCT		;READ OCTAL NUMBER
	 JRST	[CAIN C,","
		JRST PPNCMA	;COMMA IS OK
		JRST BADFNM]	;ELSE BAD
	CAIN	C,","		;COMMA IS OK
	 JRST	PPNCMA
	JRST	BADFNM		;EVERYTHING ELSE IS BAD
PPNCMA:	HRLM	T1,INFIL+3
	PUSHJ	P,RDOCT		;READ NEXT NUMBER
	 JRST	[CAIE C,"]"
		CAIN C,12	;END IS OK
		JRST	PPNOK
		JRST	BADFNM]	;ELSE BAD
	CAIE	C,"]"
	CAIN	C,12
	 JRST	PPNOK
	JRST	BADFNM		;COMPLAIN IF SOMETHING FUNNY
PPNOK:	HRRM	T1,INFIL+3
	JRST	CPOPJ1		;RETURN OK
>;END IFE TOPS20
;ROUTINE TO READ A SIXBIT WORD INTO T1
;RETURNS .+1 IF NOTHING THERE.

RDSIX:	SETZ	T1,
	MOVE	T2,[POINT 6,T1]
	PUSHJ	P,GETC
	CAIN	C,12
	POPJ	P,		;NOTHING THERE.
NXTLTR:	CAIL	C,"0"
	CAILE	C,"9"
	 JRST	[CAIL	C,"A"
		CAILE	C,"Z"
		JRST	CPOPJ1	;NOT LETTER OR DIGIT
		JRST	.+1]	;OK
	SUBI	C,40		;MAKE SIXBIT CHAR
	TLNE	T2,760000	;UNLESS T1 FULL,
	IDPB	C,T2		;STORE CHAR
	PUSHJ	P,GETC
	JRST	NXTLTR
;ROUTINE TO INPUT A CHAR FROM THE TERMINAL.
;SKIPS IF NOT A BREAK CHARACTER

INCH:	INCHWL	C		;READ INTO C
	CAIN	C,15
	 JRST	INCH		;IGNORE CR
	CAIN	C,12
	 POPJ	P,		;BREAK CHAR
	CAIE	C,33
	CAIN	C,175
	 JRST	INCHLF		;ALTMODE--TYPE <LF> AND POPJ
	CAIE	C,7
	CAIN	C,13
	 POPJ	P,
	CAIE	C,14
	CAIN	C,32
	 POPJ	P,
	CAIL	C,"A"+40	;UPPER CASE?
	CAILE	C,"Z"+40
	 CAIA
	 SUBI	C,40		;YES, MAKE LOWER CASE
	AOS	(P)
	POPJ	P,		;RETURN

INCHLF:	OUTSTR	[ASCIZ/
/]
	POPJ	P,
;TOPS10 SUBROUTINES

;ROUTINE TO ENTER THE FILE FOR UPDATING
ENTFIL:	MOVE	T1,['LSTATS']	;ALSO USED BY TOPS20
	MOVSI	T2,'DIR'	; SINCE IT IS EASIER
	SETZB	T3,T4
	ENTER	DSK,T1		;PREPARE TO UPDATE FILE
	 POPJ	P,		;ENTER ERROR
	AOS	(P)
	POPJ	P,

IFE TOPS20,<

;TYPE NUMBER IN T2 IN OCTAL
TYPOCT:	IDIVI	T2,10
	PUSH	P,T3
	SKIPE	T2
	PUSHJ	P,TYPOCT
	POP	P,T2
	ADDI	T2,"0"
	OUTCHR	T2
	POPJ	P,

TYPDEC:	IDIVI	T2,^D10
	PUSH	P,T3
	SKIPE	T2
	PUSHJ	P,TYPDEC
	POP	P,T2
	ADDI	T2,"0"
	OUTCHR	T2
	POPJ	P,

;TYPE A STRING TO TTY
;BP IN T1
TTYSTR:	ILDB	T2,T1
	JUMPE	T2,CPOPJ	;DONE IF NULL SEEN
	OUTCHR	T2		;TYPE CHAR
	JRST	TTYSTR		;LOOP FOR ALL

;TYPE A TIME IN UNIVERSAL DAY/TIME FORMAT
;IN T2, OUTPUT AS DD-MMM-YY  HH:MM:SS

TYPTIM:	PUSH	P,T2		;SAVE IT
	HLRZ	T1,T2		;GET DAY
	POP	P,T2		;RESTORE DAY/TIME
	HRRZ	T2,T2		;SAVE 1/3'S OF SECONDS
	IDIVI	T2,3
	PUSHJ	P,HHMMSS	;TYPE HH:MM:SS
	POPJ	P,		;RETURN
>;END TOPS10 SUBROUTINES

SUBTTL	TOPS20 SUBROUTINES

IFN TOPS20,<

TYPDEC:	HRRZI	T1,.PRIOU
	MOVEI	T3,^D10
	NOUT
	 JSERR			;JSYS ERROR COMPLAIN
	POPJ	P,		;RETURN, NUMBER OUTPUT

TYPOCT:	HRRZI	T1,.PRIOU
	MOVEI	T3,^D8
	NOUT
	 JSERR
	POPJ	P,

>;END TOPS20 SUBROUTINES
SUBTTL	COMMON SUBROUTINES

;CONSISTANCY CHECK
CSTCHK:	HRRZ	T2,FILINF+.LDNFL	;GET # OF CURRENT FILE
	HLRZ	T3,FILINF+.LDNFL	;GET # OF FILES
	CAILE	T2,(T3)		;IS FILE EXHAUSTED?
	 JRST	FILEXH		;YES--GO SET FLAG
	CAILE	T2,^D100	;MORE THAN 100 FILES?
	 JRST	TOOMNY		;YES
	CAILE	T3,^D100	;MORE THAN 100 FILES ALLOWED?
	 JRST	TOOMN1		;YES! (HOW DID THIS HAPPEN??)
	AOS	(P)		;ALL OK
	POPJ	P,

FILEXH:	TXO	F,F.EXH		;REMEMBER FILE EXHAUSTED
	OUTSTR	[ASCIZ/[OLD FILE IS EXHAUSTED]
/]
	AOS	(P)
	POPJ	P,

TOOMNY:	OUTSTR	[ASCIZ/? CURRENT FILE NUMBER IS TOO LARGE
/]
	POPJ	P,

TOOMN1:	OUTSTR	[ASCIZ/? # FILES COUNTER IS GREATER THAN 100
/]
	POPJ	P,

;WRITE CHARACTERS AND STRINGS TO DUMPER/BACKUP OUTPUT COMMAND FILE.

OCH:				;CHARACTER TO BE OUTPUT IS IN T2
IFE TOPS20,<
	SOSG	OBUF+2
	 JRST	OCHBUF
	IDPB	T2,OBUF+1
	POPJ	P,
OCHBUF:	OUT	DSKO,
	 JRST	OCH+2
	OUTSTR	[ASCIZ/? OUT FAILED FOR BACKUP COMMAND FILE
/]
	EXIT			;DIE OFF NOW!!
>
IFN TOPS20,<
	MOVE	T1,OJFN
	BOUT
	 ERJMP	BUTERR		;?BOUT FAILED - WE DON'T EXPECT THIS!
	POPJ	P,
BUTERR:	HRROI	T1,[ASCIZ/? BOUT FAILED WHILE WRITING DUMPER COMMAND FILE!
/]
	PSOUT
SYSERR:	JSERR			;TYPE ERROR
	HALTF
	JRST	ST		;RESTART IF "CONTINUE"
>;END IFN TOPS20

WRTSTR:	ILDB	T2,P1		;GET CHAR
	JUMPE	T2,CPOPJ	;RETURN AT NULL
	PUSHJ	P,OCH		;WRITE THE CHARACTER
	JRST	WRTSTR		;LOOP UNTIL NULL
;GET CHAR / LINE FROM FILE-SPEC FILE

IFE TOPS20,<
GETFSP:	SOSG	FSPBUF+2
	 JRST	GETFBF
	ILDB	C,FSPBUF+1
	JUMPE	C,GETFSP	;IGNORE NULLS
	AOS	(P)
	POPJ	P,
GETFBF:	IN	FSP,
	 JRST	GETFSP+2
	POPJ	P,		;ASSUME EOF
>
IFN TOPS20,<
GETFSP:	MOVE	T1,CMDJFN
	BIN
	 ERJMP	GETFS1		;BIN ERROR - CHECK FOR EOF
	JUMPE	T2,GETFSP	;IGNORE NULLS
	AOS	(P)
	POPJ	P,		;RETURNS BYTE IN AC2
GETFS1:	CAIN	T2,0
	 POPJ	P,		;EOF
	JSERR			;SOME BAD ERROR!
	JRST	NEWCMD

GETFLN:	TXNE	F,F.FEF		;EOF SEEN?
	 POPJ	P,		;YES, RETURN POPJ
	MOVEI	T3,LINLEN
	MOVE	T4,[POINT 7,LINE]
	MOVEM	T4,LINBP
	TXZ	F,F.SOL		;NO STUFF ON LINE YET
GETFL1:	PUSHJ	P,GETFSP	;GET CHAR FROM FILE
	 JRST	EOFFSP		;EOF
	CAIN	T2,15		;IGNORE CR
	JRST	GETFL1
	CAIN	T2,12		;IS IT LF?
	 JRST	EOLFSP		;YES
	SOJL	T3,BIGFLN	;LINE TOO LONG, TRUNCATED
	TXO	F,F.SOL		;THERE IS STUFF ON LINE
	IDPB	T2,T4		;STORE CHAR
	JRST	GETFL1		;LOOP
EOLFSP:	IDPB	T2,T4		;STORE EOL
	MOVEI	T2,0		;GET NULL
	IDPB	T2,T4		;STORE THAT TOO
	TXNN	F,F.SOL		;ANY STUFF ON LINE?
	 JRST	GETFLN		;NO, TRY AGAIN
	AOS	(P)		;GOT SOMETHING
	POPJ	P,		;RETURN, LINE DONE
EOFFSP:	MOVEI	T2,12		;GET EOL
	TXO	F,F.FEF		;EOF ON FILE-SPEC-FILE
	MOVE	T1,CMDJFN
	CLOSF			;CLOSE FILE (RELEASES JFN)
	 ERJMP	[JSERR
		POPJ P,]
	JRST	EOLFSP		;STORE EOL AND NULL
>;END IFN TOPS20

IFE TOPS20,<
;GET LINE
GETFLN:	TXNE	F,F.FEF		;EOF SEEN?
	 POPJ	P,		;YES, RETURN POPJ
	MOVEI	T2,LINLEN
	MOVE	T1,[POINT 7,LINE] ;INTO "LINE"
	MOVEM	T1,LINBP
	TXZ	F,F.SOL		;NOTHING ON LINE SO FAR
GETFL1:	PUSHJ	P,GETFSP	;GET CHAR FROM FILE
	 JRST	EOFFSP		;EOF
	CAIN	C,15		;IGNORE CR
	JRST	GETFL1
	CAIN	C,12		;IS IT LF?
	JRST	EOLFSP		;YES
	SOJL	T2,BIGFLN	;LINE TOO LONG, TRUNCATED
	TXO	F,F.SOL		;SAW SOMETHING ON LINE
	IDPB	C,T1		;STORE CHAR
	JRST	GETFL1		;LOOP
EOLFSP:	IDPB	C,T1		;STORE EOL
	MOVEI	C,0		;GET NULL
	IDPB	C,T1		;STORE THAT TOO
	TXNN	F,F.SOL		;SKIP IF SOMETHING ON LINE
	  JRST	GETFLN		;NOPE, TRY AGAIN
	AOS	(P)		;GOT SOMETHING
	POPJ	P,		;RETURN, LINE DONE

EOFFSP:	MOVEI	C,12		;GET EOL
	TXO	F,F.FEF		;EOF ON FILE-SPEC-FILE
	RELEAS	FSP,		;RELEASE CHANNEL
	JRST	EOLFSP		;STORE EOL AND NULL
>;END IFE TOPS20

;LINE TOO LONG -- TRUNCATE BUT DON'T BOTHER TO GIVE WARNING
BIGFLN:	PUSHJ	P,GETFSP	;GET CHARS
	 JRST	EOFFSP		;UNTIL EITHER EOF
	CAIE	C,12
	JRST	BIGFLN		;OR EOL
	JRST	EOLFSP
;TYPE A TIME (# SECS IN T2) AS HH:MM:SS

HHMMSS:	IDIVI	T2,^D60*^D60
	PUSH	P,T3
	PUSHJ	P,TYPNN
	TMSG	<:>
	POP	P,T2
	IDIVI	T2,^D60
	PUSH	P,T3
	PUSHJ	P,TYPNN
	TMSG	<:>
	POP	P,T2
	PUSHJ	P,TYPNN
	POPJ	P,

;TYPE 2 DIGITS OF NUMBER IN T2
TYPNN:
IFE TOPS20,<
	IDIVI	T2,^D10
	ADDI	T2,"0"
	ADDI	T3,"0"
	OUTCHR	T2
	OUTCHR	T3
	POPJ	P,
>
IFN TOPS20,<
	IDIVI	T2,^D10
	MOVEI	T1,"0"(T2)
	PBOUT
	MOVEI	T1,"0"(T3)
	PBOUT
	POPJ	P,
>
;SETUP DEFAULTS

DEFSET:	MOVE	T1,[1,,0]	;TIME LIMIT ON BOTH SYSTEMS IS 1 DAY
	MOVEM	T1,FILINF+.LDTML
IFE TOPS20,<
	MOVEI	T1,^D4000	;4000 BLOCK LIMIT FOR TOPS10 FILES
>
IFN TOPS20,<
	MOVEI	T1,^D1000	;1000 PAGE LIMIT FOR TOPS20 FILES
>
	MOVEM	T1,FILINF+.LDSZL
	SETZM	FILINF+.LDFWR	;NOBODY WROTE TO 1ST FILE YET
	MOVE	T1,[DEFLEN,,1]	;DEFLEN FILES IN DIRECTORY, CURRENT FILE IS #1
	MOVEM	T1,FILINF+.LDNFL
	MOVE	T1,[POINT 7,.LDAFN]	;POINTER TO 1ST FILE
	MOVEM	T1,FILINF+.LDBPC
	ADDI	T1,FILINF	;MAKE ACTUAL BYTE PTR

;STICK IN DEFAULT FILENAMES

	SETZ	T2,		;POINTER INTO FILE NAME TABLE
FILLP:	HRRZ	T3,DEFFTB(T2)	;GET A DEFAULT FILENAME FROM LIST
	HRLI	T3,(POINT 7,)	;MAKE BP TO IT
FILLP1:	ILDB	T4,T3
	IDPB	T4,T1
	JUMPN	T4,FILLP1	;JUMP IF MORE CHARS IN THIS ONE
	AOJ	T2,		;GO ON TO NEXT
	CAIE	T2,DEFLEN	;DONE 'EM ALL?
	 JRST	FILLP		;NO, MORE.
	POPJ	P,		;DEFAULTS ALL DONE, RETURN

DEFINE DD(FILE),<
[ASCIZ/FILE/]
>

DEFFTB:	DD	OUT1.MTO
	DD	OUT2.MTO
	DD	OUT3.MTO
	DD	OUT4.MTO
	DD	OUT5.MTO
	DD	OUT6.MTO
	DD	OUT7.MTO
	DD	OUT8.MTO
	DD	OUT9.MTO
	DD	OUT10.MTO
	DD	OUT11.MTO
	DD	OUT12.MTO
	DD	OUT13.MTO
	DD	OUT14.MTO
	DD	OUT15.MTO
	DD	OUT16.MTO
	DD	OUT17.MTO
	DD	OUT18.MTO
	DD	OUT19.MTO
	DD	OUT20.MTO
	DD	OUT21.MTO
	DD	OUT22.MTO
	DD	OUT23.MTO
	DD	OUT24.MTO
	DD	OUT25.MTO
	DD	OUT26.MTO
	DD	OUT27.MTO
	DD	OUT28.MTO
	DD	OUT29.MTO
	DD	OUT30.MTO
	DD	OUT31.MTO
	DD	OUT32.MTO
	DD	OUT33.MTO
	DD	OUT34.MTO
	DD	OUT35.MTO
	DD	OUT36.MTO
	DD	OUT37.MTO
	DD	OUT38.MTO
	DD	OUT39.MTO
	DD	OUT40.MTO
	DD	OUT41.MTO
	DD	OUT42.MTO
	DD	OUT43.MTO
	DD	OUT44.MTO
	DD	OUT45.MTO
	DD	OUT46.MTO
	DD	OUT47.MTO
	DD	OUT48.MTO
	DD	OUT49.MTO
	DD	OUT50.MTO
	DD	OUT51.MTO
	DD	OUT52.MTO
	DD	OUT53.MTO
	DD	OUT54.MTO
	DD	OUT55.MTO
	DD	OUT56.MTO
	DD	OUT57.MTO
	DD	OUT58.MTO
	DD	OUT59.MTO
	DD	OUT60.MTO
	DD	OUT61.MTO
	DD	OUT62.MTO
	DD	OUT63.MTO
	DD	OUT64.MTO
	DD	OUT65.MTO
	DD	OUT66.MTO
	DD	OUT67.MTO
	DD	OUT68.MTO
	DD	OUT69.MTO
	DD	OUT70.MTO
	DD	OUT71.MTO
	DD	OUT72.MTO
	DD	OUT73.MTO
	DD	OUT74.MTO
	DD	OUT75.MTO
	DD	OUT76.MTO
	DD	OUT77.MTO
	DD	OUT78.MTO
	DD	OUT79.MTO
	DD	OUT80.MTO
	DD	OUT81.MTO
	DD	OUT82.MTO
	DD	OUT83.MTO
	DD	OUT84.MTO
	DD	OUT85.MTO
	DD	OUT86.MTO
	DD	OUT87.MTO
	DD	OUT88.MTO
	DD	OUT89.MTO
	DD	OUT90.MTO
	DD	OUT91.MTO
	DD	OUT92.MTO
	DD	OUT93.MTO
	DD	OUT94.MTO
	DD	OUT95.MTO
	DD	OUT96.MTO
	DD	OUT97.MTO
	DD	OUT98.MTO
	DD	OUT99.MTO
	DD	OUT100.MTO
DEFLEN==.-DEFFTB
SUBTTL	DATA STORAGE

XLIST		;DUMP LITERALS
LIT
LIST

IFN TOPS20,<
;TEXTI BLOCK FOR READING LINES
TXTIBL:	.RDRTY			;LAST WORD GIVEN
	0			;FLAGS
	.PRIIN,,.PRIOU		;INPUT,,OUTPUT JFNS
	0			;DESTINATION PTR (FILLED IN)
	0			;BYTES AVAILABLE (FILLED IN)
	0			;USE START OF BUFFER AS ABOVE
	0			;CONTROL-R BUFFER (FILLED IN)
>;END IFN TOPS20

STBEG==.
PDL:	BLOCK	PDLSIZ		;PUSHDOWN STACK
OLDSIZ:	BLOCK	1		;-LEN,,0 FOR OLD FILE SIZE
FILINF:	BLOCK	FILLEN		;FILE INFO
LINBP:	BLOCK	1
LINE:	BLOCK	<LINLEN+4>/5
OUTLIN:	BLOCK	<LINLEN+4>/5
IFE TOPS20,<
FILDEV:	BLOCK	1		;INPUT DEVICE
INFIL:	BLOCK	4		;INPUT FILESPEC
OBUF:	BLOCK	3		;OUTPUT BUFFER HEADER
FSPBUF:	BLOCK	3		;FILE-SPEC FILE BUFFER HEADER
>
IFN TOPS20,<
CMDJFN:	BLOCK	1		;JFN OF COMMAND FILE ("F" COMMAND)
TJFN:	BLOCK	1		;TEMP JFN
OJFN:	BLOCK	1		;OUTPUT JFN FOR DUMPER COMMAND FILE
>;END IFN TOPS20
INTIM:	BLOCK	1		;INPUT DATE/TIME
STEND==.-1

END ST