Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-12 - 43,50551/dumper.mac
There are 42 other files named dumper.mac in the archive. Click here to see a list.
	DUMVER==1		;Version
	DUMMIN==0		;SOUP
	DUMEDT==4		;Edit
	DUMWHO==0		;Who

	Subttl	Timothe Litt 7-Oct-82

	Search MACTEN,UUOSYM

	Title.	DUM,DUMPER,DECsystem-10 Utility for reading DUMPER-20 tapes

	DUMTTL			;Generate a TITLE statement
	DUMPTX			;Generate a PRINTX for PASS2
	.DIRECTIVE FLBLST,.XTABM

	Twoseg
	Reloc	400K

	.REQUEST REL:HELPER


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

	;COPYRIGHT (C) 1982
			;Timothe Litt, Waltham Massachusetts

	;This software may be used, copied, or modified without
	;fee - Subject only to the inclusion of this notice.
	;Users who modify this code are encouraged (begged, even) to
	;submit their changes to either DECUS or the author.

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


	DUM137			;Store the version in JOBDAT
	Subttl	Table of contents

;		Table of Contents for DUMPER-10
;
;
;			   SECTION			      PAGE
;    1. Table of contents.....................................   2
;    2. Revision History......................................   3
;    3. Definitions...........................................   4
;    4. Initialization........................................   6
;    5. Command processor
;         5.1   Dispatch table................................   7
;         5.2   ACCOUNT.......................................   8
;         5.3   CHECKSUM......................................   9
;         5.4   DENSITY.......................................  10
;         5.5   HELP..........................................  11
;         5.6   LIST..........................................  12
;         5.7   PRINT.........................................  13
;         5.8   RESTORE.......................................  14
;         5.9   REWIND........................................  15
;         5.10  SSNAME........................................  16
;         5.11  TAPE..........................................  17
;         5.12  TIMEZONE......................................  18
;    6. Common routines
;         6.1   OPEN tape for processing......................  19
;         6.2   Blocking factor recognition...................  20
;         6.3   Build buffers for tape IO.....................  21
;         6.4   CLOSE tape when done..........................  22
;    7. Input processing
;         7.1   Get record and dispatch on type...............  23
;         7.2   Saveset header records........................  25
;         7.3   File header record............................  30
;         7.4   File data records.............................  33
;         7.5   File trailer record...........................  34
;         7.6   Deal with EOF marks...........................  35
;         7.7   Saveset trailer record........................  37
;    8. Checksum calculation routines.........................  39
;    9. Utility routines
;         9.1   Masked table lookup...........................  40
;         9.2   Read a TOPS-10 filespec.......................  41
;         9.3   Read number...................................  43
;         9.4   Read a masked SIXBIT word.....................  44
;         9.5   Skip leading blanks...........................  45
;         9.6   Input a command character.....................  46
;         9.7   ASCII - SIXBIT conversion.....................  47
;         9.8   UDT conversion................................  48
;         9.9   Accumulator coroutines........................  52
;   10. Listing routines
;        10.1   Open listing file.............................  53
;        10.2   Numeric output................................  54
;        10.3   Primitives....................................  55
;   11. Impure storage........................................  56
	Subttl	Revision History

	Comment	@

Edit	Who			What/Why
----	---	-------------------------------------------------
1	TL	Initial development
2	TL	Add SSNAME support.  Add ^Z support.  Fix RESTORE
		to properly stop at each SaveSet.
3	TL	Add revision history.  Remove more magic numbers.
		Fix various listing bugs.
4	TL	Fix SSNAME so maximum length properly checks final <NUL>
5	TL	Modify Copyright notice for DECUS release.

	Things to improve:
 o	Memory management of page header; should be able to reuse,
	perhaps with list of chunks, or just reset .jbff to header if #0
 o	Print destination filespec on restore from lookup block and path.
 o	Replace halts with error messages
 o	Error recovery.  Include more info in error messages
 o	SSNAME should take explicitly quoted string, and skip leading blanks.
 o	Define and use symbols for tape record offsets, FDB words.
 o	List more of FDB on PRINT output
 o	Add SKIP command.  (Read backwards for skip .le. 0)
 o	RESTORE should take 10-filespec=20-filespec.  Including wildcards.
	TSKSER has reasonable code for -20 style ASCII wildcards.
 o	Maybe there should be a SAVE command after all.
 o	Add support (or at least recognition) of labeled tapes.
		@
	Subttl	Definitions

ND	LN$REC,^D518			;Size of a record
ND	MX$BLK,^D20			;Maximum allowed blocking factor
ND	T$BUF,^D6			;Number of tape buffers
ND	DF$TZN,^D5			;Default timezone of 20 system
ND	LN$PDL,30
ND	NM$LPP,^D60			;Number of data lines/listing page
ND	MX$SSN,^D200			;Max chars in a SaveSet name
ND	FDB,^O206			;Offset of FDB data in file header
ND	HLP,0
ND	MTA,1
ND	FIL,2
ND	LST,3

	;ACs

	F=0
	T1=1
	T2=2
	T3=3
	T4=4
	P1=5
	P2=6
	P3=7
	P4=10
	R=11
	C=12
	P=17

	;Bits in F

	F.SAVE==1			;SAVE in progress
	F.REST==2			;RESTORE in progress
	F.LIST==4			;LIST in progress
	F.EOF==10			;EOF mark seen on last IN UUO
	F.RGT==20			;Char re-getter
	F.PRNT==40			;PRINT in progress
	F.INT==100			;Listing device is "interactive"
	F.TTYL==200			;Listing device is my TTY
	F.REW==400			;Rewind tape before command
	F.NCKS==1K			;NOCHECksum on input
	F.NACT==2K			;NOACCOunt from tape
	F.SSNM==4K			;Working on an explicit SSNAME
	F.SSOK==10K			;Current SS is specified one
	;File spec block layout

	$FSDEV==0
	$FSNAM==1
	$FSEXT==2
	$FSPPN==3
	$FSPTH==4
	$FSLEN==$FSPTH+.PTMAX
	Subttl	Initialization

START:	TDZA	T1,T1			;Zero offset
	 MOVEI	T1,1			;CCL start
	MOVEM	T1,OFFSET
	RESET
	MOVE	P,[IOWD	LN$PDL,PDL]	;Set up a stack
	SETZM	BLKFCT			;Clear old blocking factor
	SETZM	TAPDEN			;Default is don't touch
	MOVX	T1,-^D100		;Use impossible value
	MOVEM	T1,TIMZON		;To say we don't know
	SETZ	F,			;Clear our flags
NEWCMD:	HLRZ	T1,.JBSA		;Get original .JBFF
	HRRM	T1,.JBFF		;And reset it
	SETZM	HDRPTR
	SETZM	HEADER
	OUTCHR	["/"]			;Prompt
	PUSHJ	P,RDSIXM		;Read a masked SIXBIT word
	JUMPE	T2,CHKEOL		;If null, be sure at EOL
	MOVE	T3,CMDIOW		;Fetch an IOWD to our command table
	PUSHJ	P,LUKTAB		;Look up the command
	 JRST	E$$URC			;Unrecognized or ambiguous
	MOVE	T1,CMDDSP(T1)		;Get dispatch
	PUSHJ	P,0(T1)			;Call action routine
	 JRST	CMDFLH			;Error, flush to EOL
CHKEOL:	TXZ	F,F.RGT
	JUMPLE	C,NEWCMD		;If at EOL, done
	OUTSTR	[Asciz	.
? Junk in command line -- ignored
.]
	JRST	CMDFLH
E$$URC:	OUTSTR	[Asciz	.
? Unrecognized (or ambiguous) command
.]
CMDFLH:	TXZ	F,F.RGT
	JUMPLE	C,NEWCMD		;If at EOL, done
	PUSHJ	P,TYI			;Read a char
	JRST	CMDFLH			;And see what we got
	Subttl	Command processor -- Dispatch table

	;Dispatch flags

	CP.NO==(1B0)			;This is a NO form command

	DEFINE	CMDS,
		<
X	ACCOUNT	,$ACCOUNT
	XLIST
X	CHECKSU	,$CHECKSUM
X	DENSITY	,$DENSITY
X	HELP	,$HELP
X	LIST	,$LIST
X	NOACCOU	,$ACCOUNT,CP.NO
X	NOCHECK	,$CHECKSUM,CP.NO
X	NOLIST	,$LIST,CP.NO
X	NOREWIN	,$REWIND,CP.NO
X	NOSSNAME,$SSNAME,CP.NO
X	PRINT	,$PRINT
X	RESTORE	,$RESTO
X	REWIND	,$REWIND
X	SSNAME	,$SSNAME
X	TAPE	,$TAPE
X	TIMEZON	,$TIMZONE
	LIST
		>

	DEFINE	X(C,P,F<0>),
		<
	EXP	<SIXBIT	/C/>>

CMDTAB:	CMDS
	CMDNUM==.-CMDTAB

CMDIOW:	IOWD	CMDNUM,CMDTAB		;Iowd to command table

	DEFINE	X(C,P,F<0>),
		<
	XWD	<F>,P>

CMDDSP:	CMDS
	Subttl	Command processor -- ACCOUNT

$ACCOUNT:
	TLNE	T1,CP.NO		;NOACCOUNT?
	 TXOA	F,F.NACT		;Yes
	TXZ	F,F.NACT		;No
	JRST	CPOPJ1			;Done
	Subttl	Command processor -- CHECKSUM

$CHECKSUM:
	TLNE	T1,CP.NO		;NOCHECKsum?
	 TXOA	F,F.NCKS		;Yes
	TXZ	F,F.NCKS		;No
	JRST	CPOPJ1			;Done
	Subttl	Command processor -- DENSITY

$DENSITY:
	TXO	F,F.RGT			;Have a char
	JUMPLE	C,E$$IDN
	PUSHJ	P,RDDEC			;Get a number
	MOVSI	T4,-DENNUM		;Legal densities table
DENST0:	MOVE	T2,DENTAB(T4)		;Get one
	CAIN	T1,(T2)			;Match?
	 JRST	DENSTF			;Yes
	AOBJN	T4,DENST0		;Keep looking
E$$IDN:	OUTSTR	[Asciz	.
?Illegal value for density
.]
	POPJ	P,			;Sigh

DENSTF:	HLRZS	T2			;Get code
	MOVEM	T2,TAPDEN		;Save
	JRST	CPOPJ1			;Done

	DEFINE	D(DN,CD),
		<
	XWD	<CD>,^D<DN>>

DENTAB:	D	200,.TFD20
	D	556,.TFD55
	D	800,.TFD80
	D	1600,.TFD16
	D	6250,.TFD62
	DENNUM==.-DENTAB
	Subttl	Command processor -- HELP

$HELP:
	MOVE	T1,[SIXBIT .DUMPER.]	;Our name
	PUSHJ	P,.HELPR##		;Call the inefficient system routine
	JRST	CPOPJ1			;Done
	Subttl	Command processor -- LIST

$LIST:
	TLNE	T1,CP.NO		;NO form?
	 JRST	[TXZ	F,F.LIST	;Yes, turn it off
		 JRST	CPOPJ1]
	TXO	F,F.LIST		;Turn LISTing on
	MOVEI	T1,LSTSPC		;Point to listing spec
	PUSHJ	P,FILS10		;Read a 10 filespec
	 POPJ	P,			;Oops
	JRST	CPOPJ1			;Done
	Subttl	Command processor -- PRINT

$PRINT:
	TXZ	F,F.SAVE		;Not SAVE
	TXO	F,F.PRNT		;Is PRINT
	MOVEI	T1,LSTSPC		;Point to listing spec
	PUSHJ	P,FILS10		;Read a 10 filespec
	 POPJ	P,			;Error
DOPRT:	PUSHJ	P,OPNTAP		;Open the tape
	 POPJ	P,			;Can't
	PUSHJ	P,OPNLST		;Get the listing file open
	 JRST	PRTEND			;No point in continuing
	PUSHJ	P,RDTAPE		;Process the tape
	 JFCL
PRTEND:	PUSHJ	P,CLSTAP		;Close the tape
	JRST	CPOPJ1
	Subttl	Command processor -- RESTORE

$RESTORE:
	TXZ	F,F.SAVE!F.PRNT		;Neither SAVE nor PRINT
	JUMPLE	C,DORST			;If no args, just do restore
	JRST	CPOPJ1
DORST:	PUSHJ	P,OPNTAP		;Open the tape
	 POPJ	P,			;Can't
	PUSHJ	P,OPNLST		;Get the listing file if on
	 JRST	RSTEND			;Sigh
	PUSHJ	P,RDTAPE		;Process the tape
	 JFCL
RSTEND:	PUSHJ	P,CLSTAP		;Close the tape
	JRST	CPOPJ1
	Subttl	Command processor -- REWIND

$REWIND:
	TLNE	T1,CP.NO		;No form?
	 JRST	[TXZ	F,F.REW		;Yes, don't to that
		 JRST	CPOPJ1]
	JUMPLE	C,REWND1		;If no arg, use present device
	TXO	F,F.RGT			;Already have a char
	PUSHJ	P,RDSIXM		;Read a tape name
	CAIN	C,":"			;Trash extra colon
	 PUSHJ	P,TYI
	JUMPE	T2,E$$ILD		;Bitch if illegal
	MOVEM	T1,DEVICE		;Save as new device
REWND1:	TXO	F,F.REW			;Remember to rewind it
	JRST	CPOPJ1			;Done
	Subttl	Command processor -- SSNAME

$SSNAME:
	TLNE	T1,CP.NO		;NOSSNAME?
	 JRST	[TXZ	F,F.SSNM	;Yes, forget it
		 JRST	CPOPJ1]		;Done
	MOVE	T4,[POINT 7,SSNBUF]	;Point to buffer
	MOVEI	T3,MX$SSN		;Maximum size allowed
SSNLUP:	PUSHJ	P,TYI			;Get a character
	JUMPLE	C,SSNEND		;End of line, stop
	CAIL	C,"a"			;If lowercase,
	 CAILE	C,"z"			;...
	CAIA
	 TRZ	C,40			;Make upper
	IDPB	C,T4			;Store now
	SOJG	T3,SSNLUP		;Loop for next char
	OUTSTR	[Asciz	/
? SSNAME exceeds maximum length
/]
	POPJ	P,

SSNEND:	SETZ	T1,			;Get a null
	IDPB	T1,T4			;Terminate the string
	TXO	F,F.SSNM		;Remember we want a specific SS
	JRST	CPOPJ1			;Done
	Subttl	Command processor -- TAPE

$TAPE:	TXO	F,F.RGT			;Already have a char
	PUSHJ	P,RDSIXM		;Read a tape name
	CAIN	C,":"			;If trailing colon,
	 PUSHJ	P,TYI			;Eat it here
	JUMPE	T2,E$$ILD		;Illegal device
	MOVEM	T1,DEVICE		;Save requested device
	JRST	CPOPJ1			;Done

E$$ILD:	OUTSTR	[ASCIZ	.
? Illegal device name
.]
	POPJ	P,
	Subttl	Command processor -- TIMEZONE

$TIMZONE:
	TXO	F,F.RGT			;Already may have a char
	JUMPLE	C,E$$ITZ		;Required
	PUSHJ	P,RDDEC			;Get one
	CAML	T1,[^D-24]
	 CAILE	T1,^D24			;See that it's reasonable
	JRST	E$$ITZ
	MOVEM	T1,TIMZON		;Save it
	JRST	CPOPJ1			;Seems OK

E$$ITZ:	OUTSTR	[Asciz	.
?Illegal value for timezone
.]
	POPJ	P,
	Subttl	Common routines -- OPEN tape for processing

OPNTAP:	MOVX	T1,UU.SOE!.IODMP	;Set up DUMP mode to read first record
	SKIPN	T2,DEVICE		;See if a device was specified
	 MOVE	T2,[SIXBIT/DUMPER/]	;Use logical device name
	MOVEI	T3,MTAHDR		;Point to input header
	TXNE	F,F.SAVE		;If doing a SAVE,
	 MOVSS	T3			;Need an OUTPUT header
	OPEN	MTA,T1			;Get the device
	 JRST	[OUTSTR	[Asciz	.
? Can't OPEN tape device
.]
		 POPJ	P,]
	MOVE	T1,[XWD	3,T2]		;UUO pointer
	MOVEI	T2,.TFDEN+.TOSET	;To set density
	MOVEI	T3,MTA			;For our tape
	SKIPE	T4,TAPDEN		;If specified
	 TAPOP.	T1,			;Set it
	JFCL
	MOVE	T1,[XWD 3,T2]		;Once more
	MOVEI	T2,.TFRDB+.TOSET	;To clear any read backwards
	SETZ	T4,			;Left behind
	TAPOP.	T1,			;Do it
	 JFCL				;Probably wrong kind of drive
	TXZE	F,F.REW			;Were we supposed to rewind first?
	 MTREW.	MTA,			;Yes
	MTWAT.	MTA,			;Wait in any case, for old monitors
	SETOM	OURSEQ			;We've lost position
	MOVEI	T1,MTA			;Get channel number
	DEVNAM	T1,			;Turn into physical device
	 HALT	.			;It must exist(!)
	MOVEM	T1,PHYMTA		;Save physical device name
	Subttl	Common routines -- Blocking factor recognition

	TXNE	F,F.SAVE		;Doing a SAVE?
	 JRST	BLDBUF			;Yes, use specified blocking factor
	PUSH	P,[EXP 0]		;Save a small buffer
	MOVSI	T1,-1			;Build an
	HRRI	T1,-1(P)		;Iowd
	SETZ	T2,			;List
	INPUT	MTA,T1			;Read the first record
	POP	P,(P)			;Throw it out
	MOVE	T1,[XWD 2,T2]		;Point to TAPOP. block
	MOVEI	T2,.TFCNT		;Read frame count of last record
	MOVEI	T3,MTA			;Read on channel MTA
	TAPOP.	T1,			;Ask for it
	 MOVEI	T1,LN$REC*5		;Assume blocked 1
	JUMPE	T1,[TXON  F,F.EOF	;Must have hit an EOF mark
		     JRST  OPNTAP	;Stray one, try again
		    MOVX   T1,UU.PHS!UU.SOE!.IODMP ;Clear the status bits
		    MOVE   T2,PHYMTA    ;The hard way
		    SETZ   T3,
		    OPEN   MTA,T1
		     HALT   .
		    JRST   FNDEOT]	;Found logical EOT.  Stop
	IDIVI	T1,^D5			;Turn frames into 10 words
	JUMPN	T2,NOTDPF		;If not even, can't be DUMPER format
	IDIVI	T1,LN$REC		;Divide into records
	JUMPN	T2,NOTDPF		;If not even, not DUMPER
	CAILE	T1,MX$BLK		;Legal blocking?
	 JRST	NOTDPF			;No, not DUMPER format
	MOVEM	T1,BLKFCT		;Save blocking factor
	MTBSR.	MTA,			;Put tape back where it belongs
	MTWAT.	MTA,			;Wait for completion
	Subttl	Common routines -- Build buffers for tape IO

BLDBUF:	SETSTS	MTA,.IOIMG		;Use buffered image mode
	SKIPLE	T1,BLKFCT		;Get blocking factor
	 CAILE	T1,MX$BLK		;Be sure it's legal
	MOVEI	T1,1			;Default blocking factor
	MOVEM	T1,BLKFCT		;Save result
	IMULI	T1,LN$REC		;Now size of buffer's data
	ADDI	T1,3			;Add buffer header size
	MOVE	T4,T1			;Size of a buffer
	IMULI	T1,T$BUF		;Times number of buffers
	EXCH	T1,.JBFF		;Get address of first
	MOVE	T2,T1			;Save address
	ADDB	T2,.JBFF		;Allocate the core
	CAMG	T2,.JBREL		;Is it in core?
	 JRST	GOTCOR			;Yes, all set
	CORE	T2,			;No, make room
	 CAIA
	JRST	GOTCOR			;Got it
	OUTSTR	[Asciz	.
?Core expansion failed for IO buffers.]
	EXIT
GOTCOR:	MOVEI	T3,T$BUF-1		;Get number of buffers - 1
	AOJ	T1,			;Point to second word of buffer
	TLO	T1,(BF.VBR)		;Set virgin ring bit
	MOVEM	T1,MTAHDR+.BFADR	;Point ring header to first
BUFLUP:	HRRZ	T2,T1			;Get address of current buffer
	ADDI	T2,0(T4)		;Point to next buffer
	HRLI	T2,-2(T4)		;Size of buffer +1
	MOVEM	T2,0(T1)		;Point this to next
	MOVE	T1,T2			;Step to next
	SOJG	T3,BUFLUP		;Loop over all but last buffer
	HRRZ	T3,MTAHDR+.BFADR	;Get address of first
	HRLI	T3,-2(T4)		;Size of last buffer
	MOVEM	T3,0(T2)		;Point last to first
	JRST	CPOPJ1			;Tape is now ready for IO
	Subttl	Common routines -- CLOSE tape when done

CLSTAP:	TXNE	F,F.SAVE		;SAVE?
	 JRST	CLSTPZ			;Yes, don't mess around
	WAIT	MTA,			;Make sure we have stopped
	SETZ	T1,			;Clear count of preread buffers
	HRRZ	T2,MTAHDR+.BFADR	;Get address of current buffer
	SKIPN	T2			;Be sure buffers are present
	 HALT	.			;Debug this
	HRRZ	T3,0(T2)		;Start with the next one
CLSTP1:	CAMN	T3,T2			;Returned to current buffer yet?
	 JRST	CLSTP2			;Yes, see what we have
	SKIPGE	0(T3)			;Is the "USE" bit set?
	 AOJ	T1,			;Yes, it's full
	HRRZ	T3,0(T3)		;Get next buffer in ring
	JRST	CLSTP1			;And look at it

CLSTP2:	JUMPLE	T1,CLSTPZ		;Exit if no extra records read
	MOVE	T2,[XWD 2,T3]		;Set up TAPOP.
	MOVEI	T3,.TFBSB		;Backspace a record
	MOVEI	T4,MTA			;For this device
CLSTP3:	TAPOP.	T2,			;For each extra record read
	 MTBSR.	MTA,			;Old way
	SOJGE	T1,CLSTP3		;So we don't miss any

CLSTPZ:	RELEAS	MTA,			;Get rid of the tape
	POPJ	P,			;Done
	Subttl	Input processing -- Get record and dispatch on type

RDTAPE:	MOVEI	T1,NM$LPP		;Start a fresh page
	MOVEM	T1,LINLFT		;In case we are listing/printing
	TXZ	F,F.SSOK		;Clear process this SS flag

RECLUP:	SKIPLE	MTAHDR+.BFCTR		;Records left?
	 JRST	GOTREC			;Yes
RECLP1:	IN	MTA,
	 JRST	RECLUP			;Got a new one, process
	STATZ	MTA,IO.EOF
	 JRST	INEOF
	OUTSTR	[ASCIZ	.
?Input error, continuing
.]
	JRST	RECLP1			;Read next record

NOTDPF:	MTBSR.	MTA,			;Un-move the tape
	MTWAT.	MTA,			;Wait for it to finish
	OUTSTR	[Asciz	.
?Not DUMPER format.]
	POPJ	P,
GOTREC:	TXZ	F,F.EOF			;Last record not EOF
	MOVNI	R,LN$REC		;Get size of a record
	ADDM	R,MTAHDR+.BFCTR		;Count it off
	SKIPGE	MTAHDR+.BFCTR		;Did it go negative?
	 JRST	[OUTSTR	[Asciz	. Record length error, continuing.]
		 JRST	RECLUP]
	MOVNS	R			;Get positive length
	EXCH	R,MTAHDR+.BFPTR		;Get new address
	ADDM	R,MTAHDR+.BFPTR		;Update for next record
	AOJ	R,			;Point to real first word
	MOVE	T1,5(R)			;Get record sequence
	AOSG	OURSEQ			;Figure what comes next
	 MOVEM	T1,OURSEQ		;First one, take what we get
	CAME	T1,OURSEQ		;Do they match?
	 JRST	[OUTSTR	[Asciz	. Sequence error, continuing.]
		 MOVEM	T1,OURSEQ	;Save what last we got
		 JRST	.+1]
	TXNE	F,F.NCKS		;Suppress checksumming?
	 JRST	GOTRC1			;Yes, not recommended, but fast
	PUSHJ	P,CHKCKS		;Check the checksum
	 OUTSTR	[Asciz	. Checksum error.]
GOTRC1:	MOVN	T1,4(R)			;Get record type
	CAIL	T1,0			;If illegal
	 CAILE	T1,7			;...
	JRST	RECLUP			;Flush it
	JRST	@DSPTAB(T1)		;Dispatch on record type

DSPTAB:	Z	DATA
	Z	SSNAME
	Z	FILEST
	Z	FILEND
	Z	EOTREC
	Z	RECLUP			;User directory info
	Z	SSNAM2
	Z	RECLUP			;Fill record
	Subttl	Input processing -- Saveset header records

	;Here at the beginning of a save set...

SSNAME:	MOVE	T1,F
	ANDX	T1,F.SSOK
	MOVEM	T1,LSSOK		;Remember if last ss was processed
	PUSHJ	P,SETHDR		;Set up for writing header
	MOVEI	T1,[Asciz	.
DUMPER tape #.]
	PUSHJ	P,HDRSTR		;Output it
	HRRZ	T1,2(R)			;Get tape #
	PUSHJ	P,HDRDEC		;That too
	MOVEI	T1,[Asciz ., ".]
	PUSHJ	P,HDRSTR
	TXNN	F,F.SSNM		;SS specified?
	 JRST	SSNAM1			;No, don't bother checking
	MOVE	T4,[POINT 7,11(R)]	;Get a pointer to Tape
	MOVE	T3,[POINT 7,SSNBUF]	;And one to desired SS
	TXZ	F,F.SSOK		;Assume bad
	PUSH	P,P1			;Save an AC
	MOVEI	P1,MX$SSN		;Maximum chars to check
SSNAM0:	ILDB	T1,T4			;Get a char from tape
	CAIL	T1,"a"			;Upcase the tape
	 CAILE	T1,"z"			; (The user's was fixed earlier)
	CAIA
	 TRZ	T1,40			;LC, do the UPcase
	ILDB	T2,T3			;And one from user
	CAIE	T1,(T2)			;Do they match?
	 JRST	SSNM1			;No
	JUMPE	T1,SSNAMO		;If hit end of string, OK
	SOJGE	P1,SSNAM0		;Not yet, keep trying
	JRST	SSNM1			;Strange, but no match
SSNAMO:	TXO	F,F.SSOK		;Remember that this is good
SSNM1:	POP	P,P1
SSNAM1:	MOVEI	T1,11(R)		;Point to SSNAME
	PUSHJ	P,HDRSTR		;List it
	MOVEI	T1,[Asciz .", .]
	PUSHJ	P,HDRSTR
	PUSHJ	P,UDTFUD		;Get fudge factor for GMT
	MOVE	T2,10(R)		;Get UDT of save -GMT
	SUBM	T2,T1			;Make a local time
	HLRZS	T1			;Get days since only
	IDIVI	T1,^D7			;Find weekday of save
	MOVE	T1,[[ASCIZ .Wednesday.]
		    [ASCIZ .Thursday.]
		    [ASCIZ .Friday.]
		    [ASCIZ .Saturday.]
		    [ASCIZ .Sunday.]
		    [ASCIZ .Monday.]
		    [ASCIZ .Tuesday.]](T2)
	PUSHJ	P,HDRSTR		;Add that
	MOVEI	T1,[ASCIZ ., .]		;And that
	PUSHJ	P,HDRSTR
	MOVE	T1,10(R)		;Get save time again
	PUSHJ	P,UDTSDT		;Turn into a system date
	PUSH	P,T1			;Save time
	MOVE	T1,T2			;Get date
	IDIVI	T1,^D31			;Find days
	PUSH	P,T1			;Save rest
	AOS	T1,T2			;Get day
	PUSHJ	P,HDRDEC		;Output it
	MOVE	T1,(P)			;Get fraction
	IDIVI	T1,^D12			;Split years, months
	MOVEM	T1,(P)			;Save years
	PUSH	P,[ASCII .-Jan--Feb--Mar--Apr--May--Jun--Jul--Aug--Sep--Oct--Nov--Dec-.](T2)
	PUSH	P,[EXP	0]		;Make ASCIZ
	MOVEI	T1,-1(P)		;Point to value
	PUSHJ	P,HDRSTR		;Send it along
	POP	P,(P)
	POP	P,(P)
	POP	P,T1			;Years
	ADDI	T1,^D64			;Relocate to reality
	PUSHJ	P,HDRDEC		;Now, output it
	MOVEI	T2," "
	PUSHJ	P,HDRCHR
	POP	P,T1			;Get time back
	ADDI	T1,^D30K		;Round to minutes
	IDIVI	T1,^D60K		;From MS
	IDIVI	T1,^D60			;Now, split hours from minutes
	IMULI	T1,^D100		;Time in split radix
	ADDI	T1,(T2)			;with the minutes, of course
	PUSHJ	P,HDRDEC		;Send it out
	MOVEI	T1,[CRLF: BYTE(7).CHCRT,.CHLFD,.CHNUL]
	PUSHJ	P,HDRSTR
	PUSHJ	P,HDREND		;Done with header
	MOVE	T1,HEADER		;Get pointer to result
	TXNN	F,F.TTYL
	 OUTSTR	(T1)
	MOVEI	T1,[Asciz .

File
	Eof(bytsz) Pgs

.]
	PUSHJ	P,HDRSTR
	PUSHJ	P,HDREND
	MOVE	T1,HEADER		;Point to result
	PUSHJ	P,LSTSTR
	TXNE	F,F.SSNM		;If generic SS
	 SKIPN	LSSOK			; or last one not processed
	JRST	RECLUP			;keep going
	TXNE	F,F.PRNT		;If printing, 
	 JRST	RECLUP			;Continue
	JRST	CPOPJ1			;Restore, stop at end of SS

	;Here with a continuation save set...

SSNAM2:;	MOVEI	T1,[Asciz .
;Continuation saveset ".]
;	PUSHJ	P,LSTMSG
;	JRST	SSNAM1
	jrst	ssname
SETHDR:	HRRZ	T1,.JBFF		;Get a place to find core
	MOVEM	T1,HEADER		;Save the place
	AOS	.JBFF			;Allocate the core
	HRLI	T1,(POINT 7,0)		;Get a pointer to it
	MOVEM	T1,HDRPTR		;Save for later
SETHWD:	HRRZS	T1
	CAMG	T1,.JBREL		;In core?
	 JRST	SETHW1			;Yes
	PUSH	P,T1
	CORE	T1,
	 JRST	[OUTSTR	[Asciz .
?Core expansion failed for SSNAME
.]
		 EXIT]
	POP	P,T1
SETHW1:	SETZM	(T1)			;Clear the core
	POPJ	P,

HDRSTR:	HRLI	T1,(POINT 7,0)
HDRST1:	ILDB	T2,T1
	JUMPE	T2,CPOPJ
	PUSHJ	P,HDRCHR
	JRST	HDRST1

HDRDEC:	IDIVI	T1,12
	HRLM	T2,(P)
	SKIPE	T1
	 PUSHJ	P,HDRDEC
	HLRZ	T2,(P)
	ADDI	T2,"0"
HDRCHR:	MOVE	T3,HDRPTR		;Get the output pointer
	TLNE	T3,(76B5)		;Word full?
	 JRST	HDRCH1			;No
	PUSH	P,T1
	AOS	T1,.JBFF
	SOJ	T1,
	PUSHJ	P,SETHWD
	POP	P,T1
HDRCH1:	IDPB	T2,HDRPTR
	POPJ	P,

HDREND:	SETZ	T2,
	PUSH	P,HDRPTR
	PUSHJ	P,HDRCHR
	POP	P,HDRPTR
	POPJ	P,
	Subttl	Input processing -- File header record

	;Here with the beginning of a new file...

FILEST:	TXNE	F,F.SSNM
	 TXNE	F,F.SSOK
	CAIA
	 JRST	RECLUP
	TXNN	F,F.TTYL!F.PRNT
	 OUTSTR	[ASCIZ .
Restoring file .]
	MOVEI	T1,6(R)
	TXNN	F,F.PRNT
	 OUTSTR	(T1)
	PUSHJ	P,LSTSTR
	MOVEI	T1,CRLF
	PUSHJ	P,LSTSTR
	MOVEI	T1,[Asciz .	.]
	PUSHJ	P,LSTSTR
	SETZM	LKPBLK
	MOVE	T1,[XWD	LKPBLK,LKPBLK+1]
	BLT	T1,CLREND
	MOVE	T1,FDB+12(R)		;(.FBSIZ)Bytes in file
	PUSHJ	P,LSTDEC
	MOVEI	T1,[Asciz .(.]
	PUSHJ	P,LSTSTR
	LDB	T1,[POINT 6,FDB+11(R),11] ;(.FBBYZ)Byte size
	PUSHJ	P,LSTDEC
	MOVEI	T1,[Asciz .).]
	PUSHJ	P,LSTSTR
	HRRZ	T1,FDB+11(R)		;(.FBBYZ)Page count
	MOVE	T2,T1			;Make a copy
	LSH	T2,2			;Turn into blocks
	MOVEM	T2,LKPBLK+.RBEST	;Help FILSER
	PUSHJ	P,LSTDEC
	HRLZ	T2,FDB+4(R)		;(.FBPRT)Protection
	MOVE	T3,[POINT 3,LKPBLK+.RBPRV]
	MOVEI	T4,3
PRTCVT:	SETZ	T1,			;Clear 10 protection
	LSHC	T1,6			;Get 20 protection
	TLO	T1,7			;Assume no access
	TRNE	T1,10			;Execute ok?
	 HRLI	T1,6
	TRNE	T1,40			;Read?
	 HRLI	T1,5
	TRNE	T1,4			;Append?
	 HRLI	T1,4
	TRNE	T1,20			;Write?
	 HRLI	T1,2
	TRC	T1,77			;77 usually means "anything"
	TRCN	T1,77			;On TOPS-20, so allow rename
	 HRLI	T1,0			;In this case (20 has no equiv)
	LSH	T1,-22			;Position new protection
	IDPB	T1,T3			;Store in RIB
	SOJG	T4,PRTCVT		;Loop for group, world access
	HLRZ	T1,FDB+7(R)		;(.FBGEN)Generation of file
	MOVEM	T1,LKPBLK+.RBVER	;Store for directory cmd
	MOVEI	T1,CRLF
	PUSHJ	P,LSTSTR
	TXNE	F,F.PRNT		;PRINTing?
	 JRST	RECLUP			;Yes, don't restore
	MOVE	T4,[POINT 7,6(R)]
FILST1:	ILDB	T1,T4
	CAIE	T1,">"
	 JRST	FILST1
	MOVE	T3,[POINT 6,FILNAM]
FILST2:	ILDB	T1,T4
	CAIN	T1,"."
	 JRST	FILST3
	PUSHJ	P,SIXFIX
	TLNE	T3,(77B5)
	 IDPB	T1,T3
	JRST	FILST2
FILST3:	MOVE	T3,[POINT 6,FILEXT,17]
FILST4:	ILDB	T1,T4
	CAIN	T1,"."
	 JRST	FILST5
	PUSHJ	P,SIXFIX
	TLNE	T3,(77B5)
	 IDPB	T1,T3
	JRST	FILST4
FILST5:	MOVSS	FILEXT
	CAIA
FILST6:	 JUMPE	T1,FILST8
	ILDB	T1,T4
	CAIE	T1,";"
	 JRST	FILST6
	ILDB	T1,T4
	CAIE	T1,"A"
	 JRST	FILST6
	MOVE	T2,[POINT 7,LKPBLK+.RBACT]
	MOVEI	T3,^D40
FILST7:	ILDB	T1,T4
	CAIE	T1,";"
	 SKIPN	T1
	JRST	FILST8
	TXNN	F,F.NACT
	 IDPB	T1,T2
	SOJG	T3,FILST7
FILST8:	MOVE	T1,FDB+13(R)		;(.FBCRV)File creation
	PUSHJ	P,UDTSDT		;Turn into 15 bit format
	DPB	T2,[POINTR(LKPBLK+.RBPRV,RB.CRD)] ;Store 12
	LSH	T2,-^D12
	DPB	T2,[POINTR(LKPBLK+.RBEXT,RB.CRX)] ;and high 3
	IDIVI	T1,^D<60*1K>		;Turn MS into minutes
	DPB	T1,[POINTR(LKPBLK+.RBPRV,RB.CRT)] ;Save creation time
	MOVE	T1,FDB+5(R)		;(.FBCRE)Last write close
	MOVE	T2,FDB+15(R)		;(.FBREF)Last non-write close)
	CAMGE	T1,T2			;Which is later
	 MOVE	T1,T2
	PUSHJ	P,UDTSDT		;Use result as access date
	DPB	T2,[POINTR(LKPBLK+.RBEXT,RB.ACD)] ;For RIB
	MOVEI	T1,.RBAC8
	MOVEM	T1,LKPBLK
	TXNN	F,F.TTYL!F.PRNT
	 OUTSTR	[Asciz	/ .../]
	MOVEI	T1,.IODMP
	MOVSI	T2,(SIXBIT /DSK/)
	MOVSI	T3,0
	OPEN	FIL,T1
	 HALT	.
	ENTER	FIL,LKPBLK
	 HALT	.
	MOVEI	T1,FIL			;Get the file channel
	MOVEM	T1,FILPTH+.PTFCN	;We want it's path
	MOVE	T1,[XWD .PTMAX,FILPTH]	;Arg pointer
	PATH.	T1,			;Do it
	 HALT	.			;Huh?
	JRST	RECLUP
	Subttl	Input processing -- File data records

	;Here with a data record.  Presumably the file is open...

DATA:	TXNE	F,F.SSNM
	 TXNE	F,F.SSOK
	CAIA
	 JRST	RECLUP
	TXNE	F,F.PRNT		;PRINTing?
	 JRST	RECLUP			;Yes, ignore data
	HRRZ	T3,3(R)			;Get file page number
	LSH	T3,2			;Make block number
	CAMN	T3,CURBLK		;Don't bother if already there
	 JRST	DATA1			;Contiguous page, continue
	MOVE	T1,[XWD 2,T2]		;Point to FILOP.
	MOVE	T2,[XWD FIL,.FOUSO]	;What to do
	AOJ	T3,			;Turn offset into block number
	FILOP.	T1,			;Put it there
	 USETO	FIL,(T3)		;Try the old way
	SOJ	T3,			;Restore block offset (usually faster)
DATA1:	ADDI	T3,4			;We are doing this much more...
	MOVEM	T3,CURBLK		;So save for next time
	MOVSI	T1,-1000		;Count
	HRRI	T1,6-1(R)		;Address-1 of data
	SETZ	T2,
	OUT	FIL,T1
	 JRST	RECLUP
	OUTSTR	[ASCIZ	.
?Output error.]
	EXIT
	Subttl	Input processing -- File trailer record

	;Here with the End of File record...

FILEND:	TXNE	F,F.SSNM
	 TXNE	F,F.SSOK
	CAIA
	 JRST	RECLUP
	TXNE	F,F.PRNT		;PRINTing?
	 JRST	RECLUP			;Yes, ignore
	TXNN	F,F.TTYL
	 OUTSTR	[ASCIZ	.[EOF].]
	CLOSE	FIL,CL.ACS
	STATZ	FIL,IO.ERR
	 JRST	[OUTSTR	[ASCIZ	.
?Error on close.]
		 EXIT]
	RELEAS	FIL,
	JRST	RECLUP
	Subttl	Input processing -- Deal with EOF marks

	;Here at EOF mark

INEOF:	CLOSE	MTA,			;Flush buffer ring
;	PUSH	P,MTAHDR+.BFADR		;Save pointer to ring
;	MOVX	T1,UU.PHS!UU.SOE!.IOIMG	;Image mode
;	MOVE	T2,PHYMTA		;The physical device
;	MOVEI	T3,MTAHDR		;Point to the control block
;	TXNE	F,F.SAVE		;Doing output?
;	 MOVSS	T3			;Yes
;	OPEN	MTA,T1			;Get the device again
;	 HALT	.			;Who stole it (and how?)
;	POP	P,MTAHDR+.BFADR		;Restore our buffer ring
	TXON	F,F.EOF			;Was last record an EOF?
	 JRST	RECLUP			;No, continue
FNDEOT:	MOVEI	T1,[Asciz	|
End of tape.
|]
	PUSHJ	P,LSTMSG		;Tell folks
	MTBSR.	MTA,			;Back over the last mark
	MTWAT.	MTA,			;And wait
	SETOM	OURSEQ			;We've lost position
	TXNE	F,F.PRNT!F.LIST		;PRINTing or LISTing?
	 RELEAS	LST,			;Yes, close file
	JRST	CPOPJ1			;Done with command

	Subttl	Input processing -- Saveset trailer record

	;Here on EOF record

EOTREC:	MOVEI	T1,[Asciz	|
End of saveset.
|]
	PUSHJ	P,LSTMSG
	TXNE	F,F.PRNT		;If PRINTing
	 JRST	RECLUP			;Loop for next record
	TXNE	F,F.LIST		;Listing?
	 RELEAS	LST,			;Yes, close file
	JRST	CPOPJ1			;Done with command
	Subttl	Checksum calculation routines

CHKCKS:	PUSHJ	P,CKSREC		;Checksum this record
	CAMN	T1,[EXP -1]		;Is it right?
CPOPJ1:	 AOS	(P)			;Yes
CPOPJ:	POPJ	P,

SETCKS:	SETZM	0(R)			;Clear checksum
	PUSHJ	P,CKSREC		;Compute a checksum
	SETCAM	T1,0(R)			;Store result
	POPJ	P,

CKSREC:	SETZ	T1,			;Clear answer
	JCRY0	.+1			;Clear carry
	MOVSI	T2,-LN$REC		;Record size
	HRRI	T2,0(R)			;Point to record
CKSRC1:	ADD	T1,0(T2)		;Add this word into sum
	JCRY0	[AOJA	T1,.+1]		;If went to zero, make 1
	AOBJN	T2,CKSRC1		;Loop over whole record
	POPJ	P,
	Subttl	Utility routines -- Masked table lookup

LUKTAB:	PUSH	P,P1			;Save an AC
	PUSH	P,P2
	SETZ	P1,			;Location of match
	MOVE	P2,T3			;Original table pointer
LUKTBL:	MOVE	T4,1(T3)		;Get the next entry
	XOR	T4,T1			;See if matches input
	JUMPE	T4,LKTBM1		;Yes, match (exact)
	AND	T4,T2			;No, see if partial
	JUMPN	T4,LUKTBE		;No, advance to next
	JUMPN	P1,LUKTBF		;If second match, fail
	MOVE	P1,T3			;Yes, save this match
LUKTBE:	AOBJN	T3,LUKTBL		;Loop for next word
	JUMPN	P1,LUKTBM		;If we had a match, use it
LUKTBF:	POP	P,P2			;Restore P1
	POP	P,P1
	POPJ	P,

LUKTBM:	MOVE	T3,P1			;Get offset of success
LKTBM1:	SUB	T3,P2			;Compute offset
	HRRZS	T1,T3
	AOS	-2(P)			;Success
	JRST	LUKTBF			;Return
	Subttl	Utility routines -- Read a TOPS-10 filespec

FILS10:	PUSHJ	P,SAVE1			;Save an AC
	MOVE	P1,T1			;Now, keep a pointer to the FS block
	SETZM	0(P1)			;Clear it out
	HRLI	T1,(T1)			;Make BLT pointer
	HRRI	T1,1(T1)		;Finish it
	BLT	T1,$FSLEN-1(P1)		;Clear to end
	JUMPLE	C,CPOPJ1		;Return if none
FILS1A:	PUSHJ	P,RDSIXM		;Get the next word
	CAIE	C,":"			;Was that a device?
	 JRST	FILS1B			;No
	JUMPE	T2,E$$ETF		;Error in 10 filespec
	SKIPE	$FSDEV(P1)		;Already specified?
	 JRST	E$$ETF			;Yes
	MOVEM	T1,$FSDEV(P1)		;No
	JRST	FILS1A			;Get next token

FILS1B:	JUMPE	T2,FILS1C		;If null, not file name
	SKIPE	$FSNAM(P1)		;Previously specified?
	 JRST	[TXO	F,F.RGT
		 JRST	E$$ETF]
	MOVEM	T1,$FSNAM(P1)		;Save
FILS1C:	CAIE	C,"."			;Ext next?
	 JRST	FILS1D			;No
	PUSHJ	P,RDSIXM		;Yes, read it
	TXO	F,F.RGT			;Stash delimiter
	SKIPE	$FSEXT(P1)		;Dup?
	 JRST	E$$ETF			;Yes
	HRRI	T1,2K			;Set extension seen bit
	MOVEM	T1,$FSEXT(P1)		;Save extension
	JRST	FILS1A			;Next token
FILS1D:	CAIE	C,"["			;Start of PPN?
	 JRST	[TXO	F,F.RGT		;No, stuff delimiter
		 JRST	CPOPJ1]		;And assume success
	SKIPE	$FSPPN(P1)		;Prev PPN?
	 JRST	E$$ETF			;Sigh
	PUSHJ	P,RDOCT			;Get project
	TRNE	T1,377777		;be sure something is there
	 TDNE	T1,[-1,,400K]		; ...But not too much
	JRST	E$$ETF			;Not good
	HRLZM	T1,$FSPPN(P1)		;Save
	CAIE	C,","			;Project next
	 JRST	[TXO	F,F.RGT
		 JRST	E$$ETF]
	PUSHJ	P,RDOCT			;Get programmer
	TRNE	T1,-1			;Must be present
	 TLNE	T1,-1
	JRST	E$$ETF
	HRRM	T1,$FSPPN(P1)		;Stuff that
	PUSH	P,P2			;Save another AC
	CAIE	C,","			;SFD coming?
	 JRST	FILS1F			;No
	MOVE	T1,$FSPPN(P1)		;Get PPN
	MOVEM	T1,$FSPTH+.PTPPN(P1)	;Put it in PATH. block
	MOVEI	T1,$FSPTH(P1)		;Get address of path block
	MOVEM	T1,$FSPPN(P1)		;Set up PPN word to point to it
	MOVEI	P2,$FSPTH+.PTSFD(P1)	;Get pointer to next SFD
FILS1E:	PUSHJ	P,RDSIXM		;Get next SFD
	JUMPE	T2,[TXO	F,F.RGT
		    JRST E$$ET2]
	MOVEM	T1,0(P2)		;Store this one
	CAIE	P2,$FSPTH+.PTSFD+4(P1)	;Last?
	 JRST	[CAIN	C,","		;More?
		  AOJA	P2,FILS1E	;Yes
		 JRST	.+1]
FILS1F:	JUMPLE	C,FILS1G		;If <EOL>, stop
	CAIE	C,"]"			;End of PPN?
	 JRST	E$$ET2
	POP	P,P2
	JRST	FILS1A			;Yes see what's next

FILS1G:	POP	P,P2
	JRST	CPOPJ1

E$$ET2:	POP	P,P2
E$$ETF:	OUTSTR	[ASCIZ	.
?Error in TOPS-10 file specification
.]
	POPJ	P,
	Subttl	Utility routines -- Read number

RDDEC:	SKIPA	T2,[^D10]
RDOCT:	 MOVEI	T2,^O10			;Set radix
	PUSHJ	P,SKIPB			;Skip leading blanks
	PUSH	P,[0]			;Assume positive
	CAIN	C,"-"			;True?
	 SETOM	(P)			;No
	SKIPL	(P)			;If had a "-"
	 TXO	F,F.RGT			;(we didn't, get the real char)
	SETZ	T1,			;Clear result
RDOCT1:	PUSHJ	P,TYI			;Get a char
	CAIL	C,"0"			;If not a
	 CAILE	C,"0"-1(T2)		;  digit
	JRST	[SKIPGE	(P)		;Negate?
		  MOVNS	T1		;Yes
		 POP	P,(P)
		 POPJ	P,]
	CAIN	T2,^D8
	 LSH	T1,3			;Radix shift
	CAIE	T2,^D8
	 IMULI	T1,(T2)			;For non binary radix
	ADDI	T1,-"0"(C)		;Add in new digit
	JRST	RDOCT1			;Continue
	Subttl	Utility routines -- Read a masked SIXBIT word

RDSIXM:	PUSHJ	P,SKIPB			;Skip blanks
	SETZB	T1,T2			;Clear results
	MOVE	T3,[POINT 6,T1]		;Point to word
	MOVE	T4,[POINT 6,T2]		;Point to mask
	CAIA
RDSXM1:	 PUSHJ	P,TYI			;Read next char
	JUMPLE	C,CPOPJ			;If eol, stop
	CAIL	C,"a"			;Worry about lower case
	 CAILE	C,"z"
	CAIA
	 TRZ	C,40
	CAIL	C,"A"
	 CAILE	C,"Z"
	CAIA
	 JRST	RDSXM2
	CAIL	C,"0"
	CAILE	C,"9"
	 POPJ	P,			;Return break
RDSXM2:	SUBI	C," "-' '		;Convert to sixbit
	TLNN	T3,(77B5)		;Space left?
	 JRST	RDSXM1			;No, keep parsing
	IDPB	C,T3			;Store char
	MOVEI	C,77			;Mask
	IDPB	C,T4			;Add to it
	JRST	RDSXM1			;Continue
	Subttl	Utility routines -- Skip leading blanks

SKIPB:	PUSHJ	P,TYI			;Get a char
	CAIE	C," "			;Space?
	 CAIN	C,.CHTAB		;or TAB
	JRST	SKIPB			;Yes, skip it
	POPJ	P,			;Done
	Subttl	Utility routines -- Input a command character

TYI:	TXZE	F,F.RGT			;Want last one again?
	 POPJ	P,			;Yes
	INCHWL	C			;Read one
	JUMPE	C,TYI			;Flush nulls
	CAIN	C,.CHCRT		;and <CR>
	 JRST	TYI
	CAIE	C,.CHLFD
	 CAIN	C,.CHFFD
	SETO	C,			;flag eol
	CAIN	C,.CHESC
	 SETZ	C,			;Flag escape
	CAIN	C,.CHCNZ	;[2] If ^Z
	 EXIT	1,		;[2] Stop
	POPJ	P,			;DONE
	Subttl	Utility routines -- ASCII - SIXBIT conversion

SIXFIX:	CAIL	T1,"a"
	 CAILE	T1,"z"
	CAIA
	 TRZ	T1,40
	SUBI	T1,40
	SKIPL	T1
	 CAILE	T1,'_'
	MOVEI	T1,'_'
	POPJ	P,
	Subttl	Utility routines -- UDT conversion

UDTSDT:	PUSH	P,T1		;SAVE TIME FOR LATER
	PUSHJ	P,UDTFUD	;Compute the offset from GMT
	EXCH	T1,(P)		;GMT - offset = local
	SUBB	T1,(P)		;Make GMT be local
	JUMPL	T1,CNTDT6	;DEFEND AGAINST JUNK INPUT
	HLRZ	T1,T1		;GET DATE PORTION (DAYS SINCE 1858)

	RADIX	10		;**** NOTE WELL ****

	ADDI	T1,<1857-1500>*365+<1857-1500>/4-<1857-1500>/100+<1857-1500>/400+31+28+31+30+31+30+31+31+30+31+17
				;T1=DAYS SINCE JAN 1, 1501
	IDIVI	T1,400*365+400/4-400/100+400/400
				;SPLIT INTO QUADRACENTURY
	LSH	T2,2		;CONVERT TO NUMBER OF QUARTER DAYS
	IDIVI	T2,<100*365+100/4-100/100>*4+400/400
				;SPLIT INTO CENTURY
	IORI	T3,3		;DISCARD FRACTIONS OF DAY
	IDIVI	T3,4*365+1	;SEPARATE INTO YEARS
	LSH	T4,-2		;T4=NO DAYS THIS YEAR
	LSH	T1,2		;T1=4*NO QUADRACENTURIES
	ADD	T1,T2		;T1=NO CENTURIES
	IMULI	T1,100		;T1=100*NO CENTURIES
	ADDI	T1,1501(T3)	;T1 HAS YEAR, T4 HAS DAY IN YEAR

	MOVE	T2,T1		;COPY YEAR TO SEE IF LEAP YEAR
	TRNE	T2,3		;IS THE YEAR A MULT OF 4?
	JRST	CNTDT0		;NO--JUST INDICATE NOT A LEAP YEAR
	IDIVI	T2,100		;SEE IF YEAR IS MULT OF 100
	SKIPN	T3		;IF NOT, THEN LEAP
	TRNN	T2,3		;IS YEAR MULT OF 400?
	TDZA	T3,T3		;YES--LEAP YEAR AFTER ALL
CNTDT0:	MOVEI	T3,1		;SET LEAP YEAR FLAG
				;T3 IS 0 IF LEAP YEAR
	;UNDER RADIX 10 **** NOTE WELL ****

CNTDT1:	SUBI	T1,1964		;SET TO SYSTEM ORIGIN
	IMULI	T1,31*12	;CHANGE TO SYSTEM PSEUDO DAYS
	JUMPN	T3,CNTDT2	;IF NOT LEAP YEAR, PROCEED
	CAIGE	T4,31+29	;LEAP YEAR--SEE IF BEYOND FEB 29
	JRST	CNTDT5		;NO--JUST INCLUDE IN ANSWER
	SOS	T4		;YES--BACK OFF ONE DAY
CNTDT2:	MOVSI	T2,-11		;LOOP FOR 11 MONTHS

CNTDT3:	CAMGE	T4,MONTAB+1(T2)	;SEE IF BEYOND THIS MONTH
	JRST	CNTDT4		;YES--GO FINISH UP
	ADDI	T1,31		;NO--COUNT SYSTEM MONTH
	AOBJN	T2,CNTDT3	;LOOP THROUGH NOVEMBER

CNTDT4:	SUB	T4,MONTAB(T2)	;GET DAYS IN THIS MONTH
CNTDT5:	ADD	T1,T4		;INCLUDE IN FINAL RESULT

CNTDT6:	EXCH	T1,(P)		;SAVE ANSWER, GET TIME
	TLZ	T1,-1		;CLEAR DATE
	MUL	T1,[24*60*60*1000]	;CONVERT TO MILLI-SEC.
	ASHC	T1,17		;POSITION RESULT
	POP	P,T2		;RECOVER DATE
	POPJ	P,		;RETURN
	;UNDER RADIX 10 **** NOTE WELL ****

SDTUDT:	PUSHJ	P,SAVE1		;PRESERVE P1
	PUSH	P,T1		;SAVE TIME FOR LATER
	IDIVI	T2,12*31	;T2=YEARS-1964
	CAILE	T2,2217-1964	;SEE IF BEYOND 2217
	JRST	GETNW2		;YES--RETURN -1
	IDIVI	T3,31		;T3=MONTHS-JAN, T4=DAYS-1
	ADD	T4,MONTAB(T3)	;T4=DAYS-JAN 1
	MOVEI	P1,0		;LEAP YEAR ADDITIVE IF JAN, FEB
	CAIL	T3,2		;CHECK MONTH
	MOVEI	P1,1		;ADDITIVE IF MAR-DEC
	MOVE	T1,T2		;SAVE YEARS FOR REUSE
	ADDI	T2,3		;OFFSET SINCE LEAP YEAR DOES NOT GET COUNTED
	IDIVI	T2,4		;HANDLE REGULAR LEAP YEARS
	CAIE	T3,3		;SEE IF THIS IS LEAP YEAR
	MOVEI	P1,0		;NO--WIPE OUT ADDITIVE
	ADDI	T4,<1964-1859>*365+<1964-1859>/4+<31-18>+31(T2)
				;T4=DAYS BEFORE JAN 1,1964 +SINCE JAN 1
				; +ALLOWANCE FOR ALL LEAP YEARS SINCE 64
	MOVE	T2,T1		;RESTORE YEARS SINCE 1964
	IMULI	T2,365		;DAYS SINCE 1964
	ADD	T4,T2		;T4=DAYS EXCEPT FOR 100 YR. FUDGE
	HRREI	T2,64-100-1(T1)	;T2=YEARS SINCE 2001
	JUMPLE	T2,GETNW1	;ALL DONE IF NOT YET 2001
	IDIVI	T2,100		;GET CENTURIES SINCE 2001
	SUB	T4,T2		;ALLOW FOR LOST LEAP YEARS
	CAIE	T3,99		;SEE IF THIS IS A LOST L.Y.
GETNW1:	ADD	T4,P1		;ALLOW FOR LEAP YEAR THIS YEAR
	CAILE	T4,^O377777	;SEE IF TOO BIG
GETNW2:	SETOM	T4		;YES--SET -1

	POP	P,T1		;GET MILLISEC TIME
	MOVEI	T2,0		;CLEAR OTHER HALF
	ASHC	T1,-17		;POSITION
	DIV	T1,[24*60*60*1000]  ;CONVERT TO 1/2**18 DAYS
	HRL	T1,T4		;INCLUDE DATE
GETNWX:	MOVE	T4,T1		;Save local UDT
	PUSHJ	P,UDTFUD	;Compute GMT offset
	ADDM	T4,T1		;Turn local into GMT
	POPJ	P,		;RETURN
	;UNDER RADIX 10 **** NOTE WELL ****

MONTAB:	EXP	0,31,59,90,120,151,181,212,243,273,304,334,365


UDTFUD:	MOVE	T1,TIMZON	;Get alleged timezone
	CAML	T1,[-24]	;If too small
	 CAILE	T1,24		;or too big
	MOVEI	T1,DF$TZN	;Use something reasonable
	IMULX	T1,60*60*1000	;Make hours into MS
	SETZ	T2,		;Clear other half
	ASHC	T1,-17		;Slip the binary point
	DIV	T1,[24*60*60*1000] ;Make fractional days
	POPJ	P,		;Return offset from GMT

	RADIX	8
	Subttl	Utility routines -- Accumulator coroutines

SAVE1:	EXCH	P1,(P)			;Save
	HRLI	P1,(P)
	PUSHJ	P,SAVJMP
	 SOS	-1(P)
	JRST	RET1

SAVE2:	EXCH	P1,(P)
	HRLI	P1,(P)
	PUSH	P,P2
	PUSHJ	P,SAVJMP
	 SOS	-2(P)
	JRST	RET2

SAVE3:	EXCH	P1,(P)
	HRLI	P1,(P)
	PUSH	P,P2
	PUSH	P,P3
	PUSHJ	P,SAVJMP
	 SOS	-3(P)
	JRST	RET3

SAVE4:	EXCH	P1,(P)
	HRLI	P1,(P)
	PUSH	P,P2
	PUSH	P,P3
	PUSH	P,P4
	PUSHJ	P,SAVJMP
	 SOS	-4(P)
RET4:	POP	P,P4
RET3:	POP	P,P3
RET2:	POP	P,P2
RET1:	POP	P,P1
	JRST	CPOPJ1

SAVJMP:	JRA	P1,(P1)
	Subttl	Listing routines -- Open listing file

OPNLST:	TXZ	F,F.TTYL		;Listing device isn't TTY ...yet
	TXNN	F,F.LIST!F.PRNT		;If not LISTing or PRINTing
	 JRST	CPOPJ1			;  ...Don't waste our time
	PUSHJ	P,SAVE1
	MOVE	T1,[XWD LST,.FOAPP]	;FILOP. append
	MOVEM	T1,FOPBLK+.FOFNC	;Set function
	MOVEI	T1,.IOASL		;ASCII line mode for listing
	SKIPN	T2,LSTSPC+$FSDEV	;Get device
	 MOVX	T2,SIXBIT .DSK.		;Default to DSK
	MOVSI	T3,LSTHDR		;Point to header
	MOVE	T4,[XWD T1,FOPBLK+.FOIOS] ;Move to FILOP. block
	BLT	T4,FOPBLK+.FOBRH	;(Instead of OPEN
	MOVSI	T1,-1			;Output buffer count
	MOVEM	T1,FOPBLK+.FONBF	;Default number of buffers
	MOVEI	T1,T1			;Address of LOOKUP block
	MOVEM	T1,FOPBLK+.FOLEB	;Put in FILOP.
	SKIPN	T1,LSTSPC+$FSNAM	;Get file name
	 MOVE	T1,[SIXBIT .DUMPER.]	;Default
	SKIPN	T2,LSTSPC+$FSEXT	;Extension
	 MOVSI	T2,(SIXBIT .LST.)	;Default
	TRZ	T2,-1			;Clear forced ext flag
	SETZ	T3,			;Default protection
	MOVE	T4,LSTSPC+$FSPPN	;PPN or PATH
	MOVE	P1,[XWD .FOLEB+1,FOPBLK] ;Point to arg block
	FILOP.	P1,			;Open the file
	 JRST	E$$COL			;Sigh
	MOVEI	T1,LST			;Point to listing device
	DEVTYP	T1,			;Find out about it
	 HALT	.
	TXNE	T1,TY.INT		;Interactive device?
	 TXOA	F,F.INT			;Yes, remember that
	TXZ	F,F.INT			;No, don't waste OUTPUTs
	MOVX	T1,SIXBIT .TTY.		;Get our TTY
	IONDX.	T1,UU.PHY		; UDX
	 HALT	.
	MOVEI	T2,LST			;Now the listing device
	IONDX.	T2,UU.PHY		;Same way
	 HALT	.
	CAMN	T1,T2			;Same device?
	 TXO	F,F.TTYL		;Yes, don't duplicate output
	JRST	CPOPJ1			;Success

E$$COL:	OUTSTR	[ASCIZ	.
? Can't OPEN listing file
.]
	POPJ	P,
	Subttl	Listing routines -- Numeric output

LSTDEC:	MOVEI	T3,^D10			;Radix
LSTRDX:	IDIV	T1,T3			;Split a digit
	HRLM	T2,(P)			;Save
	SKIPE	T1			;Done?
	 PUSHJ	P,LSTRDX		;No
	HLRZ	T1,(P)			;Yes, retrieve digit
	ADDI	T1,"0"			;Make ASCII
	PJRST	LSTCHR			;Output it
	Subttl	Listing routines -- Primitives

LSTMSG:	TXNN	F,F.TTYL		;Is list device TTY?
	 OUTSTR	(T1)			;No, tell user

LSTSTR:	TXNN	F,F.LIST!F.PRNT		;Should we?
	 POPJ	P,			;No
	HRLI	T1,(POINT 7,0)		;Make a byte pointer
	MOVE	T2,T1			;Copy pointer
LSTST1:	ILDB	T1,T2			;Get next byte
	JUMPE	T1,CPOPJ		;Done when null
	PUSHJ	P,LSTCHC		;Output it
	JRST	LSTST1			;Loop forever

LSTCHR:	TXNN	F,F.LIST!F.PRNT		;Should we?
	 POPJ	P,
LSTCHC:	SOSL	LSTHDR+.BFCTR		;Room for it?
	 JRST	LSTCH1			;Yes
	OUT	LST,			;No, make room
	 JRST	LSTCHC			;Try again
	OUTSTR	[Asciz	.
?Listing output error
.]
	EXIT
LSTCH1:	IDPB	T1,LSTHDR+.BFPTR	;Store it
	CAIE	T1,.CHTAB		;Tab
	 CAIL	T1,40			;No, control?
	POPJ	P,			;No, nothing special
	CAIN	T1,.CHCRT		;<CR> is ignored (till LF)
	 POPJ	P,
	CAIN	T1,.CHFFD		;If a FF,
	 JRST	[PUSH	P,[EXP NM$LPP]	;Reset line counter
		 POP	P,LINLFT	;For later processing
		 JRST	LSTCH2]		;But don't output header (contains ^L)
	SOSLE	LINLFT			;Yes, end of page?
	 JRST	LSTCH2			;No
	PUSH	P,T2			;Save our place (in case in string)
	MOVEI	T2,NM$LPP		;Yes, reset counter
	MOVEM	T2,LINLFT		;To page size
	MOVE	T1,HEADER		;Get address of header
	PUSHJ	P,LSTSTR		;Go output it
	POP	P,T2			;Restore place
	POPJ	P,

LSTCH2:	TXNE	F,F.INT			;Interactive device?
	 OUTPUT	LST,			;Yes, flush buffer now
	POPJ	P,			;Done
	Subttl	Impure storage

	XLIST	;LIT
	LIT
	LIST
	RELOC

MTAHDR:	BLOCK	3
LSTHDR:	BLOCK	3
PDL:	BLOCK	LN$PDL
OFFSET:	BLOCK	1
BLKFCT:	BLOCK	1
TAPDEN:	BLOCK	1
DEVICE:	BLOCK	1
PHYMTA:	BLOCK	1
TIMZON:	BLOCK	1
SSNBUF:	BLOCK	^D<<MX$SSN+1+4>/5>
LSSOK:	BLOCK	1
LSTSPC:	BLOCK	$FSLEN
FILPTH:	BLOCK	.PTMAX
LINLFT:	BLOCK	1
OURSEQ:	BLOCK	1
HEADER:	BLOCK	1
HDRPTR:	BLOCK	1
FOPBLK:	BLOCK	.FOLEB+1
LKPBLK:	BLOCK	.RBAC8+1
	FILNAM=LKPBLK+.RBNAM
	FILEXT=LKPBLK+.RBEXT
CURBLK:	BLOCK	1
	CLREND==.-1

	END	START