Google
 

Trailing-Edge - PDP-10 Archives - ap-c796e-sb - backrs.mac
There are 14 other files named backrs.mac in the archive. Click here to see a list.
	TITLE	BACKRS -- MODULE TO DO THE WORK FOR BACKUP -- %2(216)
	SUBTTL	FRANK NATOLI/FJN/PFC/KCM/JEF		20-FEB-76

CUSTVR==0		;DEC DEVELOPMENT
DECVER==2		;MAJOR VERSION
DECMVR==0		;MINOR VERSION
DECEVR==216		;EDIT NUMBER


;+
;.AUTOPARAGRAPH.FLAG INDEX.FLAG CAPITAL.LOWER CASE
;.TITLE ^PROGRAM ^LOGIC ^MANUAL FOR ^^BACKRS\\
;.SKIP 10.CENTER;^^BACKRS\\
;.SKIP 1.CENTER;^PROGRAM ^LOGIC ^MANUAL
;.SKIP 1.CENTER;^VERSION 2
;.SKIP -20.CENTER;<ABSTRACT
;.SKIP 1

;<BACKUP IS A PROGRAM WHICH BACKS UP THE DISK FILE SYSTEM
;ONTO MAG TAPE AND RESTORES FROM THIS TAPE.  <BACKRS IS A
;SEPARATE MODULE (ACTUALLY THE SECOND MODULE) OF THE
;PROGRAM AND HANDLES ALL THE WORK.
;^THE FIRST MODULE IS THE COMMAND SCANNER AND SETUP.
;^THIS WORKER MODULE LIVES IN THE LOW SEGMENT
;AND RELEASES AND RESTORES THE HIGH SEGMENT TO ELIMINATE MOST
;OF THE CORE WHEN RUNNING.

;.PAGE;^^
;***COPYRIGHT 1974,1975,1976 DIGITAL EQUIPMENT CORP., MAYNARD,MASS.***
;-\\

;               TABLE OF CONTENTS FOR BACKRS
;
;
;                        SECTION                                   PAGE
;    1. GENERAL INFORMATION.......................................   3
;    2. DEFAULT PARAMETERS........................................   4
;    3. DEFINITIONS...............................................   5
;    4. IMPURE STORAGE............................................  10
;    5. TAPE FORMAT...............................................  12
;    6. INITIALIZATION............................................  24
;    7. DISK TO TAPE MAIN ROUTINES................................  27
;    8. DISK TO TAPE SUBROUTINES..................................  42
;    9. TAPE TO DISK MAIN ROUTINES................................  49
;   10. TAPE TO DISK SUBROUTINES..................................  64
;   11. TAPE INPUT/OUTPUT SUBROUTINES.............................  69
;   12. DISK INPUT/OUTPUT ROUTINE.................................  82
;   13. LIST OUTPUT SUBROUTINES...................................  83
;   14. DATE CONVERSION SUBROUTINES...............................  92
;   15. FILE VERIFICATION SUBROUTINES.............................  94
;   16. SORT SUBROUTINES..........................................  97
;   17. CORE ALLOCATION SUBROUTINES...............................  99
;   18. TELETYPE I/O SUBROUTINES.................................. 100
;   19. ERROR MESSAGES............................................ 104
;+
;.LEFT MARGIN 5.RIGHT MARGIN 55
;.SKIP 3
;^THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT
;NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
;BY ^DIGITAL ^EQUIPMENT ^CORPORATION.
;.SKIP 3
;^DIGITAL ^EQUIPMENT ^CORPORATION ASSUMES NO
;RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
;^DIGITAL ^EQUIPMENT ^CORPORATION.
;.SKIP 3
;^THIS SOFTWARE IS FURNISHED TO PURCHASER UNDER A LICENSE
;FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED (WITH
;INCLUSION OF ^DIGITAL ^EQUIPMENT ^CORPORATION'S
;COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS MAY
;OTHERWISE BE PROVIDED FOR IN WRITING BY ^DIGITAL ^EQUIPMENT
;^CORPORATION.
;.LEFT MARGIN 0.RIGHT MARGIN 60

;.PAGE.SUBTITLE ^TABLE OF ^CONTENTS
;.CENTER;^TABLE OF ^CONTENTS
;.NOFILL.NOAUTOP.LM10.TAB STOPS 15,18.SKIP 2

;1.	^GENERAL ^INFORMATION
;2.	^DEFAULT ^PARAMETERS
;3.	^DEFINITIONS
;		^A^CS
;		^SOFTWARE ^CHANNELS
;		^MACROS
;		^OTHER ^DEFINITIONS
;		^FLAG BITS IN <AC ^F
;		^HOME ^BLOCK ^WORDS
;4.	^IMPURE ^STORAGE
;5.	^TAPE ^FORMAT
;6.	^PROGRAM ^INITIALIZATION
;7.	^DISK TO ^TAPE ^MAIN ^ROUTINES
;8.	^DISK TO ^TAPE ^SUBROUTINES
;9.	^TAPE TO ^DISK ^MAIN ^ROUTINES
;10.	^TAPE TO ^DISK ^SUBROUTINES
;11.	^TAPE ^INPUT/^OUTPUT ^SUBROUTINES
;12.	^DISK ^INPUT/^OUTPUT ^ROUTINE
;13.	^LIST ^OUTPUT ^SUBROUTINES
;14.	^DATE ^CONVERSION ^SUBROUTINES
;15.	^FILE ^VERIFICATION ^SUBROUTINES
;16.	^SORT ^SUBROUTINES
;17.	^CORE ^ALLOCATION ^SUBROUTINES
;18.	^TELETYPE ^I/^O ^SUBROUTINES
;19.	^ERROR ^MESSAGES
;^INDEX

;.PAGE.FILL.AUTOP.LM0.TS5,8
	SUBTTL GENERAL INFORMATION

;.CHAPTER GENERAL INFORMATION
;
;^SEARCHES ^^MACTEN, UUOSYM\\ AND ^^SCNMAC\\
;-

	SEARCH	MACTEN,UUOSYM,SCNMAC		;[174]
;%%C==%%C	;SHOW VERSION OF C
%%MACT==%%MACT	;SHOW VERSION OF MACTEN		[174]
%%SCNM==%%SCNM	;SHOW VERSION OF SCNMAC

	SALL		;CLEAN LISTING


%%%BKP==:DECVER		;ENSURE CONSISTENT VERSION OF BACKUP
	SUBTTL	DEFAULT PARAMETERS

;+
;.CHAPTER DEFAULT PARAMETERS
;
;\\ ^THE FOLLOWING PARAMETERS CAN NOT BE CHANGED WITHOUT
;RISKING FURTHER DEBUGGING:		^^
;.TS20.LM20.P-20,0.SK.SELECT D
;D+

ND FT$DBG,1		;PARANOIA CODE
ND FT$IND,0		;CODE TO DO ALL DISK IO INDEPENDENTLY
ND FT$RCV,1		;TAPE ERROR RECOVERY CODE
ND FT$CHK,1		;CODE TO COMPUTE CHECKSUMS
ND FT$EMX,1		;CODE TO GIVE UP AFTER MAX NBR TAPE ERRORS

ND M,^D32		;SIZE OF RECORD HEADER
ND N,4			;NUMBER OF DISK BLOCKS PER RECORD

ND HMBNBR,1		;UNIT HOME BLOCK ADDRESS
ND FORMAT,1		;FORMAT NUMBER
ND NDSKBF,8		;DISK BUFFERS
ND OPRNDB,^D20		;DISK BUFFERS FOR OPERATORS
ND EMAX,^D100		;MAX NUMBER OF TAPE ERRORS BEFORE GIVING UP
ND EOTEMX,1		;MAX NUMBER OF TAPE ERRORS AFTER EOT
			;BEFORE GIVING UP ON WRITING REPEATER RECORDS


;D.SELECT _;
;&.FILL;\\
	SUBTTL	DEFINITIONS

;+
;.FLAGS.LM 0.NOAUTOT.UPPER CASE
;.CHAPTER DEFINITIONS
;.HL1 AC DEFINITIONS
;.NOFILL.TS16;.P0,-1
;-


;AC'S

;&.END SELECT

F=0		;STATUS FLAGS
T1=1		;TEMP
T2=T1+1		; ..
T3=T2+1		; ..
T4=T3+1		; ..
P1=T4+1		;PERMANENT
P2=P1+1		; ..
P3=P2+1		; ..
P4=P3+1		; ..
SP=12		;FILE SPECIFICATION ADDRESS
LVL=13		;SFD LEVEL COUNTER
DBUF=14		;DISK BUFFER ADDRESS
MH=15		;TAPE HEADER REGION ADDRESS
CH=16		;ASCII CHARACTER
P=17		;PUSHDOWN POINTER

			;&

;+
;.HL1 SOFTWARE CHANNELS
;-.NOFILL.END SELECT

F.LIST==1	;LIST CHANNEL (OPEN/CLOSE BY BACKUP) **DUPLICATED IN BACKUP**
F.MTAP==2	;MAG TAPE CHANNEL (OPEN/CLOSE BY BACKUP) **DUPLICATED IN BACKUP**
FILE==3		;FILE
STR==4		;STRUCTURE
MFD==5		;MASTER-FILE-DIRECTORY
UFD==6		;USER-FILE-DIRECTORY
		;UFD+1 THRU UFD+.FXLND-1 RESERVED FOR SFDS

				;&
IFG UFD+.FXLND-20,<PRINTX ? SFD LEVEL TOO DEEP
			PASS2
			END>
;+
;.AUTOP.LOWER CASE

;.HL1 MACROS
;-

;+
;<SAVE$ _<LIST_> PUSHS THE LIST OF LOCATIONS
;ONTO THE STACK.
;-

	DEFINE	SAVE$	(LIST$),<
	XLIST
IRP (LIST$),<	PUSH	P,LIST$	>
	LIST
>


;+
;<RSTR$ _<LIST_> POPS THE LIST OF LOCATIONS FROM THE STACK.
;-

	DEFINE	RSTR$	(LIST$),<
	XLIST
IRP (LIST$),<	POP	P,LIST$	>
	LIST
>
;+
;<WARN$ (PREFIX,TEXT) ISSUES WARNING MESSAGE.
;-

	DEFINE	WARN$	(PFX$,TEXT$),<
	PUSHJ	P,WRNMSG
	JRST	E$$'PFX$
	OUTSTR	[ASCIZ\BKP'PFX$\]
	OUTSTR	[ASCIZ \ TEXT$
\]
E$$'PFX$::>


;+
;<WARN$N (PREFIX,TEXT) ISSUES WARNING MESSAGE (NO CARRIAGE RETURN).
;-

	DEFINE	WARN$N	(PFX$,TEXT$),<
	PUSHJ	P,WRNMSG
	JRST	E$$'PFX$
	OUTSTR	[ASCIZ\BKP'PFX$\]
	OUTSTR	[ASCIZ\ TEXT$ \]
E$$'PFX$::>


;+
;<OPER$ (PREFIX,TEXT) ISSUES OPERATOR MESSAGE.
;-

	DEFINE	OPER$	(PFX$,TEXT$),<
E$$'PFX$::OUTSTR	[ASCIZ \
$BKP'PFX$ TEXT$
\]
>
;+
;.HL1 OTHER DEFINITIONS
;.UPPER CASE.TS8,16,24
;-.NOFILL.NOAUTOPARAGRAPH.NOFLAGS.END SELECT

MTBBKP==M+<200*N>	;SIZE OF BACKUP RECORD ON TAPE
MTBFRS==24+5*200	;SIZE OF FRS BLOCK ON TAPE
MTBFSZ==MTBBKP		;SIZE OF INPUT READ
IFG MTBFRS-MTBFSZ,<MTBFSZ==MTBFRS> ;	**DUPLICATED IN BACKUP**
NM$TBF==6		;NUMBER OF TAPE BUFFERS **DUPLICATED IN BACKUP**
CP$INC==^D1000		;CHECKPOINT INCREMENT
CP$MRG==<NM$TBF+1>*N+10	;CHECKPOINT MARGIN
NRIB==.RBTIM+1		;NUMBER OF RIB ARGS USED
NDCH==.DCUCH+1		;NUMBER OF DSKCHR ARGS USED
LN$SYS==5		;LENGTH OF SYSTEM NAME BLOCK
LN$SSN==6		;LENGTH OF SAVE SET NAME BLOCK **DUPLICATED IN BACKUP**
LN$STR==^D36		;MAX NBR OF STRUCTURES **DUPLICATED IN BACKUP**
FX$MBF==.FXLEN+0	;/MBEFORE	**DUPLICATED IN BACKUP**
FX$MSN==.FXLEN+1	;/MSINCE	**DUPLICATED IN BACKUP**
FX$CNT==.FXLEN+2	;COUNTS MATCHES	**DUPLICATED IN BACKUP**
FX$STR==.FXLEN+3	;STRUCTURE FLAGS **DUPLICATED IN BACKUP**
FX$LEN==.FXLEN+4	;LENGTH OF SCAN BLOCK **DUPLICATED IN BACKUP**
ZERO5==0		;NO ARGS ALLOWED IN LOW ORDER FIVE BITS
IO.END==40		;END OF FILE BIT IN LH OF BUFFER STATUS WORD

VR.CUS==7B2		;CUSTOMER VERSION MASK
VR.MAJ==777B11		;MAJOR VERSION MASK
VR.MIN==77B17		;MINOR VERSION MASK
VR.EDT==777777B35	;EDIT VERSION MASK

				;&.PAGE

IFN FT$RCV,<
		 IFE NM$TBF-1, <
		PRINTX ? TAPE ERROR RECOVERY CODE REQUIRES MULTIPLE BUFFERS
		PASS2
		END>>
;+
;.HL1 FLAG BITS IN AC F
;-.NOFILL.END SELECT

FL$IND==1B0	;INDEPENDENT DISK IO
FL$UFD==1B1	;FIRST FILE USED IN UFD
FL$FLP==1B2	;BUBBLE INVERSION
FL$STR==1B3	;FIRST TIME STRUCTURE USED
FL$EF1==1B4	;FIRST TAPE EOF
FL$EF2==1B5	;SECOND TAPE EOF
FL$INI==1B6	;ENCRIPTION CODE INITIALIZED
FL$PAO==1B7	;PARTIAL ALLOCATION ONLY
FL$MAT==1B8	;FILE SPEC MATCHED
FL$EOV==1B9	;END-OF-VOLUME RECORD BEING SENT
FL$SLE==1B10	;SLE MESSAGE ISSUED
FL$D75==1B11	;MATCH ONLY BECAUSE OF /DATE75
FL$CHK==1B12	;/CHECK
FL$NBF==1B13	;ISSUED NBF MESSAGE
FL$FRS==1B14	;DOING FRS CONVERSION
FL$KIL==1B15	;ABORT OPERATION
FL$TPE==1B16	;FILE HAD TAPE I/O ERROR
FL$PSI==1B17	;PSI ENABLED
FL$INP==1B18	;INPUT FORCED
FL$RCV==1B19	;RECOVERY CODE
FL$END==1B20	;END TAPE OUTPUT
FL$OPN==1B21	;DISK OUTPUT FILE IS OPEN

				;&

;+.HL1 HOME BLOCK WORDS
;.NOFILL.FLAG CONTROL #
;#END SELECT
;-

.HMNAM==0	;SIXBIT HOM
.HMCNP==16	;BP CLUSTER COUNT (E=7)
.HMCKP==17	;BP CHECKSUM (E=7)
.HMCLP==20	;BP CLUSTER ADDRESS (E=7)
.HMMFD==46	;LOGICAL BLOCK NUMBER WITHIN STRUCTURE OF 1ST RIB FOR MFD

NHOM==.HMMFD+1	;NUMBER OF HOME BLOCK WORDS USED

		;&#FLAG CONTROL . 
	SUBTTL	IMPURE STORAGE

;+
;.TS8,16,24
;.CHAPTER IMPURE STORAGE
;-.NOFILL.NOAUTOPARAGRAPH.NOFLAGS.END SELECT

STOBEG==.		;BEGINNING OF STORAGE

USYSNM:	BLOCK	LN$SYS	;SYSTEM NAME
UMONTP:	BLOCK	1	;MONITOR TYPE
UMONVR:	BLOCK	1	;MONITOR VERSION
MFDPPN:	BLOCK	1	;MFD PPN
UAPRSN:	BLOCK	1	;APR SERIAL NUMBER
UPHYN:	BLOCK	1	;PHYSICAL DEVICE NAME
UMTCHR:	BLOCK	1	;TAPE CHARACTERISTICS
PSIVCT:: BLOCK	4	;PSI VECTOR

IFN FT$IND,<
CMDHMB:	BLOCK	2	;<IOWD NHOM,HMBBLK>
HMBBLK:	BLOCK	NHOM	;HOME BLOCK
CMDRIB:	BLOCK	2	;<IOWD 200,BLKRIB>
BLKRIB:	BLOCK	200	;RIB BLOCK
>;END IFN FT$IND

DSKHDR:	BLOCK	3	;DISK BUFFER HEADER
MDATA:	BLOCK	1	;POINTS TO INPUT TAPE DATA AREA
XMTABF:	BLOCK	1	;POINTS TO BUFFER TAKEN OUT OF RING
ERRCNT:	BLOCK	1	;COUNT OF TAPE ERRORS
SUSDF:	BLOCK	1	;SUPERSEDE DISK FILE			[206]

FRSHDR:	BLOCK	M	;CONVERTED FRS BLOCK HEADER
FRSTIM:	BLOCK	1	;LABEL TIME	**DON'T CHANGE ORDER**
FRSDAT:	BLOCK	1	;LABEL DATE	**DON'T CHANGE ORDER**
FRSDSD:	BLOCK	1	;LABEL DESTROY DATE **DON'T CHANGE ORDER**
FRSSTM:	BLOCK	1	;SAVE SET TIME	**DON'T CHANGE ORDER**
FRSSDT:	BLOCK	1	;SAVE SET DATE	**DON'T CHANGE ORDER**
FRSSMD:	BLOCK	1	;SAVE SET MODE	**DON'T CHANGE ORDER**
FRSSTK:	BLOCK	1	;SAVE SET TRACKS **DON'T CHANGE ORDER**
FRSSTR:	BLOCK	1	;STR NAME	**DON'T CHANGE ORDER**
FRSNAM:	BLOCK	1	;FILE NAME	**DON'T CHANGE ORDER**
FRSEXT:	BLOCK	1	;EXTENSION	**DON'T CHANGE ORDER**
FRSPPN:	BLOCK	1	;FRS PPN	**DON'T CHANGE ORDER**
FRSRDB:	BLOCK	1	;RELATIVE DATA BLOCK	**DONT' CHANGE ORDER**
FRSSDB:	BLOCK	1	;NBR SDB	**DON'T CHANGE ORDER**
FRSSIZ:	BLOCK	1	;SIZE LAST BLOCK	**DON'T CHANGE ORDER**
FRSLVL:	BLOCK	1	;SFD DEPTH	**DON'T CHANGE ORDER**
FRSHDE==.-1		;END OF FRS CONVERSION BLOCKS
CSTR:	BLOCK	1	;STRUCTURE
CSTRFL:	BLOCK	1	;STRUCTURE FLAGS
ACSTR:	BLOCK	1	;ALIAS STRUCTURE
CNAM:	BLOCK	1	;FILE
ACNAM:	BLOCK	1	;ALIAS FILE
CEXT:	BLOCK	1	;EXT
ACEXT:	BLOCK	1	;ALIAS EXT
CBLOCK:	BLOCK	1	;LOGICAL BLOCK ON STRUCTURE
CCDATI:	BLOCK	1	;CREATION DATE/TIME
CADATI:	BLOCK	1	;ACCESS DATE
CMDATI:	BLOCK	1	;MODIFY DATE/TIME
CWSIZE:	BLOCK	1	;BLOCK SIZE
LSTSTR:	BLOCK	1	;LAST STRUCTURE FOR LIST FILE COMPARISON
LSTPTH:	BLOCK	.FXLND+1;PATH FOR LIST FILE COMPARISON
NTPE:	BLOCK	1	;RELATIVE TAPE NUMBER
NSEQ:	BLOCK	1	;RELATIVE SEQUENCE NUMBER
SAVADR:	BLOCK	1	;ORIGINAL MATCHED FILE SPECIFICATION
D75ADR:	BLOCK	1	;DITTO DUE TO /DATE75
SRTDIR:	BLOCK	1	;WHERE TO GO TO SORT DIRECTORIES
SRTFIL:	BLOCK	1	;WHERE TO GO TO SORT FILES
CHKCNT:	BLOCK	1	;COUNT OF CHECK DIFFERENCES
PTHCHK:	BLOCK	1	;CHECKSUM OF ASCIZ FULL PATH BLOCK

PRESTR:	BLOCK	1	;LAST STRUCTURE
PREPPN:	BLOCK	1	;LAST PPN
SAVACS:	BLOCK	10	;PLACE TO SAVE REGISTERS
SVCODE:	BLOCK	1	;SEED WORD
THSRDB:	BLOCK	1	;RELATIVE DATA BLOCK OF FILE
CHKPNT:	BLOCK	1	;CHECKPOINTS
BKSCLS:	BLOCK	1	;BLOCKS PER CLUSTER
DCHBLK:	BLOCK	NDCH	;FOR DSKCHR UUO

EXLFIL:	BLOCK	NRIB	;EXTENDED LOOKUPS/ENTERS/RENAMES
EXLUFD:	BLOCK	NRIB	; ..

DSKBLT:	BLOCK	1	;EITHER BLT OR PUSHJ P,COMPAR
DSKIO:	BLOCK	1	;EITHER DSKIN OR DSKOUT

PTHBLK:	BLOCK	.FXLND+3;ROOM FOR PATHING
UPTBLK:	BLOCK	.FXLND+3;ROOM FOR PATHING
APATH:	BLOCK	.FXLND+3;ROOM FOR PATHING
ADRLST:	BLOCK	.FXLND	;ADDRESS OF RIBS

STOEND==.-1	;END OF STORAGE

				;&
	SUBTTL	TAPE FORMAT

;+.AUTOPA.FLAGS.TS8,16,24,32,,,,,,,,,.P0,-1.FILL.LOWER CASE

;.CHAPTER BACKUP TAPE FORMAT

; <NOTE:  ^BACKUP IS DESIGNED FOR TWO PRIMARY FUNCTIONS; PERFORMING SYSTEM
;BACKUP AND INTERCHANGING FILES BETWEEN SYSTEMS.  ^FOR THE LATTER FUNCTION,
;^BACKUP PROVIDES AN "INTERCHANGE" SWITCH WHICH CAUSES SYSTEM DEPENDENT 
;DATA TO BE IGNORED AND ONLY CRITICAL FILE INFORMATION TO BE WRITTEN ON
;TAPE. ^A RESTORE OPERATION IN INTERCHANGE MODE ALSO IGNORES SYSTEM 
;DEPENDENT DATA, ALLOWING THE OPERATING SYSTEM TO SUPPLY DEFAULTS WHERE
;NECESSARY. ^ITEMS NOT INCLUDED IN INTERCHANGE
;MODE ARE NOTED IN THE DESCRIPTION WHICH FOLLOWS.

;.HL1 TAPE RECORD TYPES

;<BACKUP TAPES ARE MADE UP OF A SERIES OF TAPE RECORDS OF VARIOUS TYPES.
;^EACH RECORD IS SELF IDENTIFYING. ^ALL RECORDS ON THE TAPE ARE WRITTEN
;AT THE STANDARD LENGTH OF 544(10) WORDS, MADE UP OF A 32(10) WORD HEADER
;AND A 512(10) DATA AREA. ^EVEN IF THE DATA AREA IS NOT NEEDED, OR IS
;ONLY PARTIALLY NEEDED, IT IS FULLY WRITTEN. ^ALL UNDEFINED OR UNUSED
;WORDS ARE WRITTEN WITH ZEROS AND IGNORED ON READ. ^THIS MAXIMIZES
;THE PROBABILITY OF READING OLD TAPES. ^ALSO THE TAPE FORMAT IS INCLUDED
;IN THE LABELS AND THE SAVE SET HEADERS.
; ^THE RECORD TYPES ARE:

;.LS

;.LE;<T$LBL -- TAPE LABEL USED TO IDENTIFY REEL <ID AND
;DESTRUCTION DATE/TIME. ^THIS RECORD IS OPTIONAL, BUT IF PRESENT
;MUST BE AT THE START OF THE TAPE.

;.LE;<T$BEG -- BEGINNING OF A SAVE SET USED TO IDENTIFY WHEN
;THE SAVE SET WAS WRITTEN AND ON WHAT DEVICE OF WHAT SYSTEM.
;^IT ALSO INCLUDES THE SAVE SET NAME. ^THIS RECORD IS MANDATORY
;AND MUST BE THE FIRST RECORD OF THE SAVE SET.

;.LE;<T$END -- END OF A SAVE SET. ^THIS IS IDENTICAL TO THE <T$BEG
;RECORD EXCEPT THAT IT APPEARS AT THE END.

;.LE;<T$FIL -- THIS IS THE ACTUAL DATA WHICH HAS BEEN SAVED. ^IT IS
;THE ONLY TYPE OF RECORD WHICH IS ENCRYPTED. ^IT IS SELF-IDENTIFYING
;AS TO THE POSITION WITHIN THE FILE, BUT CONTAINS ONLY PART OF
;THE FULL PATH NAME OF THE FILE.

;.LE;<T$UFD -- CONTAINS THE INFORMATION FOR EACH DIRECTORY. ^IT
;GIVES ALL INFORMATION NECESSARY TO RE-CREATE THE DIRECTORY.
;(^NOT WRITTEN IN INTERCHANGE MODE.)

;.LE;<T$EOV -- INDICATES END OF VOLUME (FUTURE).

;.LE;<T$COM -- COMMENT (IGNORED).

;.LE;<T$CON -- CONTINUATION OF SAVE SET. ^THIS IS IDENTICAL TO
;<T$BEG EXCEPT THAT IT INDICATES THE CONTINUATION OF THE SAVE
;SET AT THE START OF A NEW VOLUME. ^THIS ENSURES THAT EACH
;VOLUME IS COMPLETELY SELF IDENTIFYING.

;-.ELS

T$LBL==1	;LABEL IDENTIFICATION RECORD
T$BEG==2	;SAVE START
T$END==3	;SAVE END
T$FIL==4	;DISK FILE DATA
T$UFD==5	;UFD RIB
T$EOV==6	;END OF VOLUME
T$COM==7	;COMMENT
T$CON==10	;CONTINUE (SAME DATA AS T$BEG-T$END)

T$MAX==T$CON	;MAXIMUM RECORD TYPE
;+.HL1 STANDARD RECORD FORMAT

;^EVERY TAPE RECORD HAS THE SAME GENERAL FORMAT. ^THIS
;CONSISTS OF A 32(10) WORD RECORD HEADER FOLLOWED BY ONE
;PAGE OF DATA (512(10) WORDS). ^ALL RECORD HEADERS START
;WITH THE SAME FIRST TWELVE WORDS. ^THE FIRST SEVEN WORDS ARE:

;.LS.LE;<G$TYPE -- RECORD TYPE AS DESCRIBED IN
;THE PREVIOUS SECTION. ^THIS IS A SMALL POSITIVE INTEGER.

;.LE;<G$SEQ -- RECORD SEQUENCE NUMBER. ^THIS IS INCREMENTED BY
;ONE FOR EACH RECORD ON THE TAPE. ^IF A RECORD IS REPEATED
;BECAUSE OF A TAPE WRITE ERROR, THE NUMBER OF THE REPEATED RECORD
;IS THE SAME AS THAT OF THE ORIGINAL.

;.LE;<G$RTNM -- RELATIVE TAPE NUMBER. ^THIS IS INCREMENTED BY
;ONE FOR EACH VOLUME.

;-.LE;<G$FLAG -- VARIOUS FLAG BITS:

G$TYPE==0	;RECORD TYPE
G$SEQ==1	;SEQUENCE NUMBER
G$RTNM==2	;RELATIVE TAPE NUMBER
G$FLAG==3	;RECORD DEPENDENT BITS

;+.LS.LE;<GF$EOF -- THIS FLAG IS SET IF THIS IS THE LAST TAPE
;RECORD FOR THIS DISK FILE. ^ON SHORT FILES,
;THIS CAN EVEN BE SET ON THE FIRST RECORD OF THE FILE!

;.LE;<GF$RPT -- THIS FLAG IS SET IF THIS TAPE RECORD IS A REPEAT
;OF THE PREVIOUS RECORD. ^THIS IS SET WHENEVER THE RECORD IS
;REWRITTEN BECAUSE OF A TAPE WRITE ERROR.

;.LE;<GF$NCH -- THIS FLAG IS SET IF NO CHECKSUM HAS BEEN
;COMPUTED FOR THE TAPE RECORD.

;.LE;<GF$SOF -- THIS FLAG IS SET IF THIS IS THE FIRST
;TAPE RECORD FOR THIS DISK FILE.
;-.ELS

GF$EOF==1B0	;LAST RECORD OF FILE
GF$RPT==1B1	;REPEAT OF LAST RECORD WRITE ERROR
GF$NCH==1B2	;IGNORE CHECKSUM
GF$SOF==1B3	;START OF FILE

;+.LE;<G$CHK -- CHECKSUM OF THE TAPE RECORD.

;.LE;<G$SIZ -- NUMBER OF WORDS USED FOR DATA IN THIS TAPE RECORD.

;.LE;<G$LND -- NUMBER OF WORDS TO SKIP BEFORE THE DATA STARTS.

;.ELS; ^THE NEXT FOUR WORDS ARE RESERVED FOR FUTURE EXPANSION.
;^THE TWELVTH (LAST) WORD IN THE GENERAL SECTION OF THE RECORD
;HEADER IS RESERVED FOR CUSTOMER USE. ^THE REMAINING 20 WORDS IN THE 
;RECORD HEADER VARY FOR EACH RECORD TYPE, WITH THE LAST WORD OF EACH
;RECORD HEADER BEING RESERVED FOR CUSTOMER USE. ^IN INTERCHANGE MODE,
;CUSTOMER RESERVED WORDS WILL BE WRITTEN WITH ZEROS ON A SAVE AND IGNORED ON A READ.
;-


G$CHK==4	;CHECKSUM
G$SIZ==5	;NUMBER OF DATA WORDS
G$LND==6	;TOTAL LENGTH OF NON-DATA SECTION
G$CUSW==13	;RESERVED FOR CUSTOMER USE
;+.HL1 NON-DATA BLOCKS

;^THE DATA PORTION OF A TAPE RECORD IS PRIMARILY FOR STORING FILE DATA, BUT
;MAY BE USED FOR SAVING SOME OVERHEAD INFORMATION. ^ANY NON-DATA
;INFORMATION WRITTEN IN THE DATA AREA OF A TAPE RECORD IS PREFACED
;WITH A CONTROL WORD OF THE FORM:
; <LH = TYPE, <RH = LENGTH IN WORDS INCLUDING THIS WORD.

; ^MORE THAN ONE OVERHEAD REGION CAN APPEAR. ^IN THIS CASE, THEY FOLLOW
;EACH OTHER WITH NO INTERVENING SPACE. ^THE CURRENTLY DEFINED TYPES FOR
;OVERHEAD  BLOCKS ARE:

;.LS

;.LE;<O$NAME --  GIVES THE FULL PATH IDENTIFICATION OF THE FILE WITHOUT
;PUNCTUATION. ^THE PATH COMPONENTS ARE TREATED AS IF THE USER GAVE A 
;QUOTED REPRESENTATION IN "<DEC ^INTEGRATED ^COMMAND ^LANGUAGE".
;^THIS BLOCK CONSISTS OF SUB-BLOCKS IN THE STANDARD ORDER:  DEVICE,
;DIRECTORIES (TOP DOWN), FILE NAME, EXTENTION, VERSION, GENERATION.
;^SUB-BLOCKS CORRESPONDING TO MISSING FIELDS IN THE PATH SPECIFICATION
;ARE OMITTED. ^EACH SUB-BLOCK IS IN THE FORMAT:
; <WORD0: <LH = TYPE, <RH = LENGTH IN WORDS INCLUDING THIS WORD.

; ^THE REST OF THE SUB-BLOCK IS THE PATH FIELD IN <ASCIZ
;WITHOUT LEADING OR IMBEDDED NULLS, TERMINATED BY AT LEAST
;ONE NULL. ^FOR THE <UFD DIRECTORY FIELD, THE PROJECT AND 
;PROGRAMMER HALVES ARE CONVERTED TO OCTAL NUMBERS AND SEPARATED
;BY AN UNDERLINE CHARACTER. ^OMITTED FIELDS WILL BE DEFAULTED. ^IN INTERCHANGE
;MODE, ONLY THE NAME, EXTENSION AND VERSION ARE WRITTEN. ^IN
;INTERCHANGE RESTORE, ONLY NAME, EXTENSION AND VERSION ARE USED.
; ^SUB-BLOCK TYPE CODES ARE:

; 1 = DEVICE
; 2 = NAME
; 3 = EXTENSION
; 4 = VERSION
; 5 = GENERATION
; 40 = DIRECTORY  (LOWER DIRECTORIES ARE 41,42, ...)
;.LE;<O$FILE -- A BLOCK CONTAINING  FILE ATTRIBUTES. ^THE FIRST SECTION
;OF THIS BLOCK IS A FIXED LENGTH HEADER AREA CONTAINING IN FIXED
;LOCATIONS EITHER SINGLE WORD ATTRIBUTES OR BYTE POINTERS TO <ASCIZ
;STRING ATTRIBUTES  LOCATED IN THE REMAINING SECTION. ^ALL DATES AND TIME
;ARE IN UNIVERSAL DATE/TIME FORMAT. ^IN INTERCHANGE MODE ONLY THE CRITICAL
;ATTRIBUTES (STARRED)  WILL BE WRITTEN, AND THE REST OF THIS BLOCK WILL
;CONTAIN ZEROS. ^IN THE DESCRIPTION WHICH FOLLOWS, THE SYMBOLS IN BRACKETS
;REPRESENT THE <RIB DATA FROM WHICH THE ATTRIBUTE VALUES WILL BE CONVERTED.
;(^IF NONE IS GIVEN, THE LOCATION WILL BE ZERO)

;.LS;.LE;<A$FHLN (*) -- FIXED HEADER LENGTH IN WORDS.

;.LE;<A$FLGS -- FLAGS:

;.LS;.LE;<B$PERM -- PERMANENT (NOT DELETABLE) [<RP.NDL]

;.LE;<B$TEMP -- TEMPORARY

;.LE;<B$DELE -- ALREADY DELETED

;.LE;<B$DLRA -- DON'T DELETE FOR LACK OF RECENT ACCESS [<RP.ABU]

;.LE;<B$NQCF -- NOT QUOTA CHECKED [<RP.NQC]

;.LE;<B$NOCS -- DOES NOT HAVE VALID CHECKSUMS [<RP.ABC]

;.LE;<B$CSER -- HAS CHECKSUM ERROR [<RP.FCE]

;.LE;<B$WRER -- HAS DISK WRITE ERROR [<RP.FWE]

;.LE;<B$MRER -- HAD <BACKUP READ ERROR ON <RESTORE [<RP.BFA]

;.LE;<B$DAER -- DECLARED BAD BY DAMAGE ASSESSMENT [<RP.BDA]

;-.ELS

B$PERM==1B0	;PERMANENT
B$TEMP==1B1	;TEMPORARY
B$DELE==1B2	;ALREADY DELETED
B$DLRA==1B3	;DON'T DELETE FOR LACK OF RECENT ACCESS
B$NQCF==1B4	;NOT QUOTA CHECKED
B$NOCS==1B5	;DOES NOT HAVE VALID CHECKSUMS
B$CSER==1B6	;HAS CHECKSUM ERROR
B$WRER==1B7	;HAS DISK WRITE ERROR
B$MRER==1B8	;HAD <BACKUP READ ERROR ON RESTORE
B$DAER==1B9	;DECLARED BAD BY DAMAGE ASSESMENT
;TABLE OF BACKUP FLAGS:

BKPFLG:	EXP	B$PERM
	EXP	B$TEMP
	EXP	B$DELE
	EXP	B$DLRA
	EXP	B$NQCF
	EXP	B$NOCS
	EXP	B$CSER
	EXP	B$WRER
	EXP	B$MRER
	EXP	B$DAER
LN$FLG==.-BKPFLG

;TABLE OF CORRESPONDING RIB FLAGS:

RIBFLG:	EXP	RP.NDL
	EXP	Z
	EXP	Z
	EXP	RP.ABU
	EXP	RP.NQC
	EXP	RP.ABC
	EXP	RP.FCE
	EXP	RP.FWE
	EXP	RP.BFA
	EXP	RP.BDA

;+.LE;<A$WRIT (*) -- DATE/TIME OF LAST WRITE [<RB.CRD AND <RB.CRT]

;.LE;<A$ALLS (*) -- ALLOCATED SIZE IN WORDS [<.RBALC]

;.LE;<A$MODE (*) -- MODE OF LAST WRITE [<RB.MOD]

;.LE;<A$LENG (*) -- LENGTH IN BYTES (1^B0 IF _> 2_^35-1) [<.RBSIZ]

;.LE;<A$BSIZ (*) -- BYTE SIZE (7 OR 36).

;.LE;<A$VERS (*) -- VERSION IDENTIFICATION (<.JBVER FORMAT) [<.RBVER]

;.LE;<A$PROT -- PROTECTION [<RB.PRV]. ^THE PROTECTION FOR DIRECTORIES APPEARS
;IN THE DIRECTORY ATTRIBUTE BLOCK (<O$DIRT). ^FOR FILES, THE PROTECTION
;WORD IS DEFINED AS FOUR FIELDS OF EIGHT BITS EACH WITH A "5" STORED
;IN THE LEFTMOST THREE BITS IN ORDER TO AVOID LOOKING LIKE A BYTE POINTER:

; BITS 0-2		"5"

; BIT  3		RESERVED FOR FUTURE

; BITS 4-11		FUTURE ACCESS

; BITS 12-19		OWNER ACCESS

; BITS 20-27		AFFINITY GROUP ACCESS

; BITS 28-35		"WORLD" ACCESS

; ^EACH FILE ACCESS FIELD IS SUBDIVIDED INTO BYTES WHICH DESCRIBE THE
;ATTRIBUTE, WRITE AND READ (RESPECTIVELY) PROTECTIONS ASSOCIATED WITH THE
;FILE. ^A DESCRIPTION OF THE "WORLD" ACCESS FIELD FOLLOWS, WITH THE
;ASSOCIATED <TOPS-10 PROTECTION GIVEN IN PARENTHESES, IF APPLICABLE.
;^THE OWNER AND AFFINITY GROUP (PROJECT) FIELDS ARE SIMILARLY DEFINED.
;.LS

;.LE;<PR$SPC (BIT 28) -- RESERVED FOR SPECIAL CHECKING. ^THE REST OF THE FIELD IS
;SPECIAL IF THIS BIT IS SET.

;.LE;<PR$ATR (BITS 29-31) -- THE ATTRIBUTE SUBFIELD IS A 3-BIT BYTE INTERPRETED AS FOLLOWS:

; 0 -- FILE IS COMPLETELY HIDDEN.
; 1 -- FLIE NAME IS VISIBLE (7-6).
; 2 -- FILE ATTRIBUTES ARE VISIBLE (5-2).
; 3 -- CAN CHANGE UNPROTECTED ATTRIBUTES.
; 4-5 -- (FUTURE)
; 6 -- CAN CHANGE PROTECTION (0).
; 7 -- CAN DELETE THE FILE (1).

;.LE;<PR$WRT (BITS 32-33) -- THE WRITE ACCESS  SUBFIELD IS DEFINED AS:

; 0 -- NO WRITE ACCESS (7-5).
; 1 -- APPEND (4).
; 2 -- WRITE (3).
; 3 -- SUPERSEDING GENERATION (2-0).

;.LE;<PR$RED (BITS 34-35) -- THE READ ACCESS SUBFIELD IS DEFINED AS:

; 0 -- NO READ ACCESS (7).
; 1 -- EXECUTE ONLY (6).
; 2 -- CAN READ THE FILE (5-0).
; 3 -- (FUTURE).

;.ELS
;.LE;<A$ACCT -- BYTE POINTER TO ACCOUNT STRING

;.LE;<A$NOTE -- BYTE POINTER TO ANNOTATION STRING [<.RBSPL]

;.LE;<A$CRET -- CREATION DATE AND TIME OF THIS GENERATION 

;.LE;<A$REDT -- LAST READ DATE AND TIME OF THIS GENERATION [<RB.ACD]

;.LE;<A$MODT -- MONITOR SET LAST WRITE DATE AND TIME [<.RBTIM]

;.LE;<A$ESTS -- ESTIMATED SIZE IN WORDS [<.RBEST]

;.LE;<A$RADR -- REQUESTED DISK ADDRESS [<.RBPOS]

;.LE;<A$FSIZ -- MAXIMUM FILE SIZE IN WORDS

;.LE;<A$MUSR -- BYTE POINTER TO IDENTIFICATION OF LAST MODIFIER

;.LE;<A$CUSR -- BYTE POINTER TO IDENTIFICATION OF CREATOR [<.RBAUT]

;.LE;<A$BKID -- BYTE POINTER TO IDENTIFICATION OF PREVIOUS <BACKUP [<.RBMTA]

;.LE;<A$BKDT -- DATE AND TIME OF LAST BACKUP

;.LE;<A$NGRT -- NUMBER OF GENERATIONS TO RETAIN

;.LE;<A$NRDS -- NUMBER OF OPENS FOR READ THIS GENERATION

;.LE;<A$NWRT -- NUMBER OF OPENS FOR WRITE THIS GENERATION

;.LE;<A$USRW -- UNDEFINED USER WORD [<.RBNCA]

;.LE;<A$PCAW -- PRIVILEGED CUSTOMER WORD [<.RBPCA]

;-.ELS

A$FHLN==0	;HEADER LENGTH WORD
A$FLGS==1	;FLAGS
A$WRIT==2	;CREATION DATE/TIME
A$ALLS==3	;ALLOCATED SIZE
A$MODE==4	;MODE
A$LENG==5	;LENGTH
A$BSIZ==6	;BYTE SIZE
A$VERS==7	;VERSION
A$PROT==10	;PROTECTION
A$ACCT==11	;BYTE POINTER ACCOUNT STRING
A$NOTE==12	;BYTE POINTER TO ANONOTATION STRING
A$CRET==13	;CREATION DATE/TIME OF THIS GENERATION
A$REDT==14	;LAST READ DATE/TIME OF THIS GENERATION
A$MODT==15	;MONITOR SET LAST WRITE DATE/TIME
A$ESTS==16	;ESTIMATED SIZE IN WORDS
A$RADR==17	;REQUESTED DISK ADDRESS
A$FSIZ==20	;MAXIMUM FILE SIZE IN WORDS
A$MUSR==21	;BYTE POINTER TO ID OF LAST MODIFIER
A$CUSR==22	;BYTE POINTER TO ID OF CREATOR
A$BKID==23	;BYTE POINTER TO SAVE SET OF PREVIOUS <BACKUP
A$BKDT==24	;DATE/TIME OF LAST BACKUP
A$NGRT==25	;NUMBER OF GENERATIONS TO RETAIN
A$NRDS==26	;NBR OPENS FOR READ THIS GENERATION
A$NWRT==27	;NBR OPENS FOR WRITE THIS GENERATION
A$USRW==30	;USER WORD
A$PCAW==31	;PRIVILEGED CUSTOMER WORD

LN$AFH==32	;LENGTH OF FIXED HEADER

;PROTECTION BYTES:

AC$OWN==377B19	;OWNER ACCESS FIELD
AC$GRP==377B27	;AFFINITY GROUP ACCESS FIELD
AC$WLD==377B35	;WORLD ACCESS FIELD

PR$ATR==7B31	;ATTRIBUTE PROTECTION SUBFIELD
PR$WRT==3B33	;WRITE PROTECTION SUBFIELD
PR$RED==3B35	;READ PROTECTION SUBFIELD

;+
;^THE REMAINDER OF THIS BLOCK IS RESERVED FOR FUTURE EXPANSION.
;.LE;<O$DIRT -- A BLOCK CONTAINING DIRECTORY ATTRIBUTES (NOT WRITTEN
;IN INTERCHANGE MODE). ^THE FIRST SECTION OF THIS BLOCK IS A FIXED
;LENGTH HEADER AREA CONTAINING EITHER DIRECTORY ATTRIBUTES OR  POINTERS
;TO ATTRIBUTES LOCATED IN THE REMAINING SECTION. ^THE SYMBOLS IN
;BRACKETS REPRESENT THE <RIB DATA USED FOR CONVERSION (THE LOCATION IS ZERO
;IF NONE IS GIVEN). ^THE DIRECTORY PROTECTION WORD APPEARS IN THIS BLOCK
;RATHER THAN IN THE <O$FILE BLOCK (<A$PROT IS ZERO FOR DIRECTORIES).

;.LS
;.LE;<D$FHLN -- FIXED HEADER LENGTH IN WORDS

;.LE;<D$FLGS -- DIRECTORY FLAGS:

;.LS.LE;<DF$FOD -- FILES ONLY DIRECTORY

;.LE;<DF$AAL -- ALPHA ACCOUNTS ARE LEGAL

;.LE;<DF$RLM -- REPEAT LOGIN MESSAGES
;-.ELS

DF$FOD==1B0	;FILES ONLY DIRECTORY
DF$AAL==1B1	;ALPHA ACCOUNTS ARE LEGAL
DF$RLM==1B2	;REPEAT LOGIN MESSAGES

;+.LE;<D$ACCT -- ACCOUNT NUMBER OR <ASCII BYTE POINTER TO ACCOUNT STRING

;.LE;<D$PROT -- DIRECTORY PROTECTION [<RB.PRV]. 
;^THE DIRCTORY PROTECTION WORD IS DIVIDED INTO THE SAME ACCESS FIELDS
;AS THE FILE PROTECTION WORD, <A$PROT, BUT EACH DIRECTORY ACCESS FIELD
;HAS BITS AS FOLLOWS (<RIB BITS GIVEN IN PARENTHESES):

; ^BIT 28 -- RESERVED FOR SPECIAL CHECKING. ^THE REST OF THE
;FIELD IS SPECIAL IS THIS BIT IS SET.
; ^BITS 29-31 -- (FUTURE)
; ^BIT 32 -- CONNECT ALLOWED
; ^BIT 33 -- CAN OPEN FILES (4)
; ^BIT 34 -- CAN CREATE GENERATIONS (2)
; ^BIT 35 -- DIRECTORY CAN BE READ (1)

;.LE;<D$FPRT -- DEFAULT FILE PROTECTION

;.LE;<D$LOGT -- DATE/TIME OF LAST LOGIN IN <DEC-10 UNIVERSAL FORMAT [<RB.CRD AND <RB.CRT]

;.LE;<D$GENR -- DEFAULT NUMBER OF GENERATIONS TO KEEP

;.LE;<D$QTF -- FIRST-COME-FIRST-SERVED LOGGED-IN QUOTA IN WORDS [<.RBQTF]

;.LE;<D$QTO -- LOGGED OUT QUOTA IN WORDS [<.RBQTO]

;.LE;<D$ACSL -- LIST OF GROUPS WHICH CAN ACCESS THIS DIRECTORY (SEE BELOW)

;.LE;<D$USRL -- LIST OF GROUPS WHICH THIS USER IS IN (SEE BELOW)

;.LE;<D$PRVL -- PRIVILEGE LIST (SEE BELOW)

;.LE;<D$PSWD -- <ASCII BYTE POINTER TO PASSWORD
;.ELS

;^THE LIST ATTRIBUTE WORDS GIVEN ABOVE (<D$ACSL, <D$USRL, <D$PRVL)
;MAY BE IN ANY ONE OF THE FOLLOWING FORMATS:

; A) AN <ASCII STRING POINTER
; B) 5^B2 _+ GROUP (OR 5^B2 _+ PRIVILEGE FOR <D$PRVL)
; C) _-^N,,RELATIVE LOCATION OF START OF LIST

; ^IF IN FORMAT (C), EACH WORD OF THE LIST IS 5^B2 _+ GROUP (5^B2 _+ PRIVILEGE FOR <D$PRVL)
;-

D$FHLN==0	;FIXED HEADER LENGTH WORD
D$FLGS==1	;DIRECTORY FLAGS
D$ACCT==2	;ACCOUNT NUMBER
D$PROT==3	;DIRECTORY PROTECTION
D$FPRT==4	;DEFAULT FILE PROTECTION
D$LOGT==5	;LOGIN DATE/TIME
D$GENR==6	;NUMBER GENERATIONS TO KEEP
D$QTF==7	;LOGGED-IN QUOTA
D$QTO==10	;LOGGED-OUT QUOTA
D$ACSL==11	;ACCESS LIST
D$USRL==12	;USER LIST
D$PRVL==13	;PRIVILEGE LIST
D$PSWD==14	;PASSWORD

LN$DFH==15	;LENGTH OF DIRECTORY FIXED HEADER

;+.LE;<O$SYSN -- A BLOCK CONTAINING THE SYSTEM HEADER LINE IN <ASCIZ.

;.LE;<O$SSNM  -- A  BLOCK CONTAINING THE USER SUPPLIED
;SAVE SET NAME IN <ASCIZ (MAX OF 30 CHARACTERS).
;^THIS BLOCK IS OMITTED IF NO SAVE SET NAME WAS SPECIFIED.
;-.ELS

O$NAME==1	;FULL PATH NAME BLOCK
O$FILE==2	;FILE ATTRIBUTE BLOCK
O$DIRT==3	;DIRECTORY ATTRIBUTE BLOCK
O$SYSN==4	;SYSTEM HEADER BLOCK
O$SSNM==5	;SAVE SET NAME BLOCK
;+.HL1 LOCATIONS IN T$LBL RECORD

;^THIS RECORD HAS NO CONTENTS IN THE "DATA" REGION. ^THE REMAINING
;LOCATIONS IN THE RECORD HEADER ARE DEFINED AS FOLLOWS:

;.LS

;.LE;<L$DATE -- DATE/TIME OF LABELLING IN <DEC-10 UNIVERSAL FORMAT
;(I.E. <LH=DAYS SINCE 17-^NOV-1858, <RH=FRACTION OF DAY)

;.LE;<L$FMT -- <BACKUP TAPE FORMAT (CONSTANT = 1).

;.LE;<L$BVER -- VERSION OF <BACKUP WRITING LABEL IN STANDARD
;<.JBVER FORMAT.

;.LE;<L$MON -- MONITOR TYPE (%<CNMNT).

;.LE;<L$SVER -- SYSTEM VERSION (<%CNDVN).

;.LE;<L$APR -- <APR PROCESSOR SERIAL NUMBER ON WHICH
;THIS LABEL WAS WRITTEN (INTEGER).

;.LE;<L$DEV -- PHYSICAL DEVICE ON WHICH THE TAPE WAS WRITTEN
;IN <SIXBIT.

;.LE;<L$MTCH -- <BYTE (31) 0 (1) 7-TRACK (1) 0 (3) DENSITY.
;^DENSITY IS 1=200, 2=556, 3=800, 4=1600, 5=6250.

;.LE;<L$RLNM -- <REELID IN <SIXBIT.

;.LE;<L$DSTR -- DATE/TIME BEFORE WHICH TAPE CAN NOT BE SCRATCHED.
;^BEFORE THIS TIME, THE ONLY VALID OPERATION IS TO APPEND.

;-.ELS

L$DATE==14	;DATE/TIME OF LABELING
L$FMT==15	;BACKUP FORMAT
L$BVER==16	;BACKUP VERSION
L$MON==17	;MONITOR TYPE
L$SVER==20	;SYSTEM VERSION
L$APR==21	;APR SERIAL NUMBER WRITING LABEL
L$DEV==22	;DEVICE ID WRITING LABEL
L$MTCH==23	;TAPE WRITE PAREMETERS
L$RLNM==24	;SIXBIT TAPE REEL NAME
L$DSTR==25	;DATE/TIME FOR DESTRUCTION
L$CUSW==37	;RESERVED CUSTOMER WORD
;+.HL1 LOCATIONS IN T$BEG, T$END, T$CON RECORDS

;^THESE SAVE SET RECORDS ALL HAVE THE SAME FORMAT AND ARE DISTINGUISHED
;BY THEIR RECORD TYPES AND THEIR LOCATION ON THE TAPE. ^ALL ITEMS ARE
;FILLED IN AT THE TIME OF WRITTING. ^THE DATA AREA CONTAINS TWO NON-DATA
;BLOCKS, TYPES <O$SYSN AND <O$SSNM.  ^RECORD HEADER LOCATIONS FOLLOWING
;THE FIRST STANDARD TWELVE WORDS ARE DEFINED AS FOLLOWS:

;.LS

;.LE;<S$DATE -- DATE/TIME OF WRITING THIS RECORD IN UNIVERSAL FORMAT.

;.LE;<S$FMT -- <BACKUP TAPE FORMAT (CONSTANT = 1).

;.LE;<S$BVER -- <BACKUP VERSION IN <.JBVER FORMAT.

;.LE;<S$MON -- MONITOR TYPE (%<CNMNT).

;.LE;<S$SVER -- SYSTEM VERSION (<%CNDVN).

;.LE;<S$APR -- APR SERIAL NUMBER ON WHICH WRITTEN.

;.LE;<S$DEV -- PHYSICAL NAME OF DEVICE ON WHICH WRITTEN IN <SIXBIT.

;.LE;<S$MTCH -- <BYTE (31) 0 (1) 7-TRACK (1) 0 (3) DENSITY.
;^DENSITY IS 1=200, 2=556, 3=800, 4=1600, 5=6250.

;.LE;<S$RLNM -- <REELID IN <SIXBIT.

;-.ELS

S$DATE==14	;DATE/TIME OF START/END OF SAVE
S$FMT==15	;RETRIEVAL VERSION
S$BVER==16	;BACKUP VERSION
S$MON==17	;MONITOR TYPE
S$SVER==20	;SYSTEM VERSION
S$APR==21	;APR SERIAL NUMBER
S$DEV==22	;DEVICE ID WRITING SAVE SET
S$MTCH==23	;TAPE WRITE PARAMETERS
S$RLNM==24	;REELID
S$CUSW==37	;CUSTOMER WORD
;+.HL1 LOCATIONS IN T$UFD RECORD

;^THIS RECORD IS NOT WRITTEN IN INTERCHANGE MODE.
;^WHEN WRITTEN, THE DATA PORTION CONTAINS TWO OR THREE NON-DATA BLOCKS:
;TYPES <O$NAME, <O$FILE (OPTIONAL) AND <O$DIRT.
;^REMAINING LOCATIONS IN THE HEADER RECORD CONTAIN:

;.LS

;.LE;<D$PCHK -- CHECKSUM OF THE <O$NAME FULL PATH FILE NAME BLOCK.

;.LE;<D$LVL -- DIRECTORY LEVEL: 0=<UFD, 1=FIRST <SFD, ETC.

;.LE;<D$STR -- FILE STRUCTURE NAME STORED IN THE FOLLOWING FORMAT:
;<BYTE (7) DATA TYPE, LENGTH IN WORDS, <ASCII. (^DATA TYPES
;ARE DEFINED IN THE <T$FIL SECTION.)

;-.ELS

D$PCHK==14	;PATH CHECKSUM
D$LVL==15	;UFD LEVEL (UFD=0, SFD1=1, ETC.)
D$STR==16	;STRUCTURE OF UFD ( MAX OF 12(10) WORDS )
D$CUSW==37	;CUSTOMER WORD
;+.HL1 LOCATIONS IN T$FIL RECORD

;^THE FIRST TAPE RECORD FOR A FILE CONTAINS TWO NON-DATA BLOCKS,
;TYPES <O$NAME AND <O$FILE. ^THERE IS ROOM FOR TWO BLOCKS
;OF FILE DATA IN THE FIRST TAPE RECORD, AND IF THE FILE WILL
;COMPLETELY FIT IN ONE TAPE RECORD, THESE WILL BE USED.
;^IF THE FILE IS LONGER THAN TWO BLOCKS, THE FILE WILL
;BE STARTED IN THE SECOND TAPE RECORD, SO ITS PAGES
;WILL BE LINED UP WITH TAPE RECORDS. ^EACH TAPE RECORD
;IDENTIFIES THE LOGICAL DISK WORD WITH WHICH IT STARTS.
;^REMAINING LOCATIONS IN THE RECORD HEADER ARE:

;.LS

;.LE;<F$PCHK -- CHECKSUM OF THE FULL PATH FILE NAME BLOCK (<O$NAME).
;^THIS IS JUST A CONSISTENCY CHECK FOR CONSECUTIVE RECORDS OF THE FILE.

;.LE;<F$RDW -- RELATIVE DATA WORD OF FILE OF THE FIRST DATA WORD IN THIS TAPE RECORD.

;.LE;<F$PTH -- A TWELVE WORD BLOCK USED TO STORE INFORMATION
;SUITABLE FOR A RESTORATION OF THE FILE. ^THIS AREA IS BIG ENOUGH
;TO HOLD THE ENTIRE PATH TO A <TOPS-10 FILE IN A <UFD AND TWO <SFDS.
;^THE PATH INFORMATION WILL BE STORED IN THE STANDARD ORDER OF
;DEVICE, <UFD, FIRST <SFD, FILE NAME, EXTENSION; WITH MISSING FIELDS OMITTED.
;^THE PATH INFORMATION WILL BE STORED IN THE FORMAT:
;
;<BYTE (7) DATA TYPE, LENGTH IN WORDS, <ASCII
;
;WHERE DATA TYPES ARE DEFINED AS:
;
; DEVICE = 001
; FILE NAME = 002
; EXTENSION = 003
; DIRECTORY = 040
; (LOWER DIRECTORIES = 041,042, ...)

;-.ELS

F$PCHK==14	;PATH CHECKSUM
F$RDW==15	;RELATIVE DATA WORD OF FILE
F$PTH==16	;START OF PATH BLOCK
LN$PTH==14	;LENGTH OF F$PTH BLOCK
F$CUSW==37	;RESERVED CUSTOMER WORD

;DATA TYPES:

.FCDEV==1	;DEVICE
.FCNAM==2	;FILE NAME
.FCEXT==3	;EXTENSION
.FCVER==4	;VERSION
.FCGEN==5	;GENERATION
.FCDIR==40	;DIRECTORY
.FCSF1==41	;FIRST SFD
.FCSF2==42	;SECOND SFD
	SUBTTL	INITIALIZATION

;+
;.CHAPTER PROGRAM INITIALIZATION
;-

;+.HL1 INITIALIZATION
;
;^THE START ADDRESS IS ACTUALLY IN THE MODULE <BACKUP. ^WHEN
;COMMANDED TO START A SAVE OR RESTORE OPERATION, IT CALLS THIS MODULE
;AT ENTRY POINT <BACKRS. <BACKRS FIRST CLEARS THE IMPURE STORAGE AREA,
;THEN COPIES VARIOUS MONITOR INFORMATION FOR LATER USE. ^NEXT IT ENABLES
;FOR INTERRUPTS ON TELETYPE INPUT, IF <PSISER IS AVAILABLE IN THE
;MONITOR SOFTWARE CONFIGURATION. ^IT THEN DISPATCHES TO THE APPROPRIATE
;ROUTINE TO EXECUTE THE OPERATION.
;-

BACKRS::SETZB	F,STOBEG	;CLEAR STORAGE
	MOVE	T1,[STOBEG,,STOBEG+1] ;BLT POINTER
	BLT	T1,STOEND	; ..

IFN FT$IND,<
	MOVE	T1,[IOWD NHOM,HMBBLK] ;FOR READING HOME BLOCKS
	MOVEM	T1,CMDHMB	;STORE
	MOVE	T1,[IOWD 200,BLKRIB] ;FOR READING RIB BLOCKS
	MOVEM	T1,CMDRIB	;STORE
>;END IFN FT$IND

	MOVEI	T1,1		;INITIALIZE TAPE COUNTER
	MOVEM	T1,NTPE		;STORE

;HERE TO COPY SYSTEM NAME INTO MY CORE AREA

	MOVSI	T1,-LN$SYS	;FIVE WORDS
	MOVX	T2,%CNFG0	;GETTAB WORD
LOOP1:	MOVE	T3,T2		;GET GETTAB
	GETTAB	T3,		;ACCESS
	  SETZ	T3,		;LOSE
	MOVEM	T3,USYSNM(T1)	;STORE
	ADD	T2,[1,,0]	;NEXT WORD
	AOBJN	T1,LOOP1	;LOOP
;HERE TO COPY VARIOUS OTHER MONITOR WORDS

	MOVX	T1,%CNMNT	;MONITOR TYPE
	GETTAB	T1,		;ACCESS
	  SETZ	T1,		;LOSE
	MOVEM	T1,UMONTP	;STORE

	MOVX	T1,%CNDVN	;MONITOR VERSION
	GETTAB	T1,		;ACCESS
	  SETZ	T1,		;LOSE
	MOVEM	T1,UMONVR	;STORE

IFN FT$RCV,<
	TXZ	T1,VR.WHO!VR.MIN;LEAVE MAJOR VERSION NBR
	LSH	T1,-^D24	;POSITION
	CAIL	T1,602		;SEE IF 6.02 OR LATER
	TXO	F,FL$RCV	;YES, CAN USE RECOVERY CODE
>;END IFN FT$RCV

	MOVX	T1,%LDMFD	;MFD PPN
	GETTAB	T1,		;ACCESS
	  MOVE	T1,[1,,1]	;DEFAULT
	MOVEM	T1,MFDPPN	;STORE

	MOVX	T1,%CNSER	;GET SERIAL NUMBER
	GETTAB	T1,		;ACCESS
	  SETZ	T1,		;LOSE
	MOVEM	T1,UAPRSN	;STORE

;HERE TO ENABLE PSI IF AVAILABLE

	MOVX	T1,%CNST2	;SOFTWARE CONFIGURATION
	GETTAB	T1,		;ACCESS
	  SETZ	T1,		;LOSE
	TXNN	T1,ST%PSI	;PSISER AVAILABLE?
	JRST	SETSRT		;SKIP FOLLOWING IF NOT
	TXO	F,FL$PSI	;FLAG PSI

	MOVEI	T1,TTYSER	;SERVICE ROUTINE ADDRESS
	MOVEM	T1,PSIVCT+.PSVNP;STORE NEW PC IN PSI VECTOR
	MOVX	T1,PS.VTO	;DISABLE WITH DEBRK. UUO
	MOVEM	T1,PSIVCT+.PSVFL;STORE
	MOVEI	T1,PSIVCT	;BASE ADDRESS
	PIINI.	T1,		;INITIALIZE PSI
	  TXZ	F,FL$PSI	;ERROR--CLEAR PSI FLAG

	MOVSI	T2,'TTY'	;SET DEVICE
	MOVX	T3,PS.RID	;REASON=INPUT DONE
	SETZ	T4,		;ZILCH
	MOVX	T1,PS.FON!PS.FAC;TURN PSI ON
	HRRI	T1,T2		;ADDRESS OF ARG BLOCK
	PISYS.	T1,		;EXEC
	  TXZ	F,FL$PSI	;ERROR--ZILCH PSI FLAG
SETSRT:	MOVE	T1,S.SRTD##	;GET SORT INDEX
	HRRZ	T1,SRTDSP(T1)	;GET ADDRESS TO DISPATCH TO
	MOVEM	T1,SRTDIR	;STORE

	MOVE	T1,S.SRTF##	;GET SORT INDEX
	HRRZ	T1,SRTDSP(T1)	;GET ADDRESS TO DISPATCH TO
	MOVEM	T1,SRTFIL	;STORE

	MOVEI	T1,F.MTAP	;POINT TO TAPE CHANNEL
	DEVNAM	T1,		;GET PHYSICAL UNIT NAME
	  MOVE	T1,S.MOPN##+.OPDEV ; (LOGICAL IF UUO FAILS)
	MOVEM	T1,UPHYN	;STORE FOR LATER

	MOVEI	T2,.TFDEN	;INDICATE DENSITY
	MOVEI	T3,F.MTAP	;TAPE CHANNEL
	MOVE	T1,[XWD 2,T2]	;ARG FOR TAPEOP
	TAPOP.	T1,		;READ DENSITY
	  SETZ	T1,		;LOSE (NO INFO)
	DPB	T1,[POINTR (UMTCHR, MT.DEN)];STORE
	MOVEI	T2,.TFTRK	;TRACK
	MOVE	T1,[XWD 2,T2]	;RESET ARG
	TAPOP.	T1,		;GET TRACK
	  SETZ	T1,		;LOSE
	DPB	T1,[POINTR (UMTCHR, MT.7TR)];STORE TRACK

	SKIPN	UMTCHR		;SEE IF TAPOP. LOST
	JRST	[MOVEI	T1,F.MTAP ;CHANNEL
		 MTCHR.	T1,	;TRY MTCHR. FOR TAPE CHARACTERISTICS
		   SETZ	T1	;LOSE
		 ANDX	T1,MT.DEN!MT.7TR ;CLEAR JUNK
		 MOVEM	T1,UMTCHR;SAVE
		 JRST	.+1]	;PROCEED

	SKIPGE	S.OPER##	;IF WRITE OPERATION,
	PUSHJ	P,DUMOUT	; ISSUE DUMMY OUTPUT

	MOVE	T1,S.OPER##	;RETRIEVE FUNCTION
	PJRST	@CMDTBL-1(T1)	;DISPATCH AND RETURN

CMDTBL:	XWD	ZERO5,CHKALL
	XWD	ZERO5,RSTALL
	XWD	ZERO5,SAVALL

SRTDSP:	EXP	CPOPJ,ALPSRT,LOCSRT
	SUBTTL	DISK TO TAPE MAIN ROUTINES

;+
;.CHAPTER DISK TO TAPE MAIN ROUTINES
;-

;+
;<SAVALL IS THE ROUTINE CALLED TO EXECUTE THE SAVE OPERATION. ^IT FIRST WRITES
;A START-OF-SAVE-SET (<T$BEG) RECORD ON TAPE. ^NEXT, IT SELECTS  FROM THE SYSTEM'S
;STRUCTURE LIST, FOR FURTHER PROCESSING, THE FILE STRUCTURES INDICATED BY THE USER
;SPEC LIST PASSED FROM THE <BACKUP MODULE. ^WHEN THE SAVE IS COMPLETED
;AN END-OF-SAVE-SET RECORD (<T$END) IS WRITTEN ON TAPE.
;-

SAVALL:	PUSHJ	P,SAVE1		;SAVE 1 PERMANENT

;HERE TO WRITE BEGINNING-OF-SAVE RECORD ON TAPE

	MOVEI	T1,T$BEG	;INDICATE START OF SAVE
	SKIPE	S.RSUM##	;SEE IF /RESUME
	JRST	[MTBSR.	F.MTAP,	;BACKSPACE IN CASE CRASH WROTE
		 MTBSR.	F.MTAP,	;JUNK ON TAPE
		 JRST	.+2]	;NO T$BEG RECORD IF RESUMING
	PUSHJ	P,GENSAV	;FILL IN REST OF CHARS

	MOVE	P1,S.NGST##	;AOBJN WORD FOR STRUCTURE LIST

;HERE TO SELECT A STRUCTURE

GETSTR:	SKIPN	T1,S.STRS##(P1)	;GET STRUCTURE NAME
	JRST	FINSTR		;NULL--LIST FINISHED
	MOVSI	T2,(1B0)	;START WITH BIT 0
	MOVNI	T3,(P1)		;SET ARG FOR SHIFTING RIGHT
	LSH	T2,(T3)		;SHIFT TO CORRECT BIT FOR THIS STR
	SKIPN	S.INIT+.FXDEV	;ANY INITIAL DEVICE?
	JRST	GETST1		;NO
	CAME	T1,S.INIT##+.FXDEV;SEE IF EXACT MATCH
	TDNE	T2,S.INIT##+FX$STR;OR IF THIS STR INDICATED BY FLAG
	SKIPA			;YES
	JRST	NXTSTR		;NO. DROP THIS STRUCTURE
	SETZM	S.INIT##+.FXDEV	;ZILCH

GETST1:	MOVEM	T1,CSTR		;STORE
	MOVEM	T1,DCHBLK	; ..
	MOVEM	T2,CSTRFL	; ..

;HERE TO CHECK IF ANY FILE SPEC ASKS FOR STRUCTURE

	MOVE	SP,S.FRST##	;LOAD ADDRESS OF SPECS

CHKSTR:	CAME	T1,FX$LEN+.FXDEV(SP);CHECK FOR EXACT MATCH
	TDNE	T2,FX$LEN+FX$STR(SP); OR IF THIS STR FLAGGED BY SPEC DEVICE
	JRST	GOTSTR		;OK. USE THIS STRUCTURE
	ADDI	SP,FX$LEN*2	;NEXT FILE SPEC
	CAMGE	SP,S.LAST##	;SKIP IF DONE
	JRST	CHKSTR		;CONTINUE

	JRST	NXTSTR		;CHECK NEXT STRUCTURE

;HERE IF AT LEAST ONE FILE SPEC NEEDS THIS STRUCTURE

GOTSTR:	PUSH	P,.JBFF##	;SAVE JOBFF
	PUSH	P,.JBREL##	;SAVE JOBREL
	PUSHJ	P,SAVSTR	;SAVE STRUCTURE
	POP	P,T1		;RESTORE JOBREL
	PUSHJ	P,DRPCOR	;DROP CORE USED FOR THIS STR
	POP	P,.JBFF##	;RESTORE JOBFF

	TXNE	F,FL$KIL	;SEE IF OPERATOR SAID KILL
	POPJ	P,		; YES--QUIT NOW

NXTSTR:	AOBJN	P1,GETSTR	;LOOP FOR ALL STRUCTURES

;HERE TO WRITE END-OF-SAVE RECORD ON TAPE

FINSTR:	TXO	F,FL$END	;WILL FORCE OUTPUT OF ALL BUFFERS
	MOVEI	T1,T$END	;INDICATE END OF SAVE
	PUSHJ	P,GENSAV	;WRITE REST OF RECORDS
	CLOSE	F.MTAP,		;CLOSE CHANNEL
	JRST	CPOPJ1		;RETURN TO BACKUP WITH OPERATION DONE
;+
;<GENSAV IS A SUBROUTINE TO GENERATE THE SAVE SET RECORDS.
;^IT IS CALLED WITH ^T1 = RECORD TYPE (<T$BEG, <T$CON, <T$END).
;-

GENSAV:	MOVEM	T1,G$TYPE(MH)	;STORE
	MOVE	T1,UMONTP	;GET MONITOR TYPE
	MOVEM	T1,S$MON(MH)	;STORE
	MOVE	T1,UMONVR	;GET MONITOR VERSION
	MOVEM	T1,S$SVER(MH)	;STORE
	MOVEI	T1,FORMAT	;CURRENT BACKUP FORMAT
	MOVEM	T1,S$FMT(MH)	;STORE
	MOVE	T1,.JBVER##	;BACKUP VERSION
	MOVEM	T1,S$BVER(MH)	;STORE
	MOVX	T1,%CNDTM	;GET DATE/TIME
	GETTAB	T1,		;ACCESS O/S
	  SETZ	T1,		;SUBSTITUTE ZERO
	MOVEM	T1,S$DATE(MH)	;STORE
	MOVE	T1,UPHYN	;GET PHYSICAL DEVICE NAME
	MOVEM	T1,S$DEV(MH)	;STORE
	MOVE	T1,UAPRSN	;GET SERIAL NUMBER
	MOVEM	T1,S$APR(MH)	;STORE
	MOVE	T1,UMTCHR	;GET CHARACTERISTICS
	MOVEM	T1,S$MTCH(MH)	;STORE
	MOVE	T2,UPHYN	;PHYSICAL TAPE NAME
	MOVE	T1,[.MTRID,,T2]	;ARG FOR MTCHR.
	MTCHR.	T1,		;GET REELID
	  SETZ	T3,		;LOSE
	MOVEM	T3,S$RLNM(MH)	;STORE
	MOVEI	T2,M(MH)	;LOC FOR SYSTEM NAME BLOCK
	MOVEI	T1,LN$SYS+2	;TOTAL LENGTH
	HRLI	T1,O$SYSN	;TYPE CODE
	MOVEM	T1,(T2)		;STORE
	MOVEI	T1,1(T2)	;LOC FOR SYSTEM NAME
	HRLI	T1,USYSNM	;WHERE I HAVE IT
	BLT	T1,LN$SYS(T2)	;XFR
	SETZM	LN$SYS+1(T2)	;INSURE TRAILING NULL FOR ASCIZ
	ADDI	T2,LN$SYS+2	;UPDATE POINTER
	SKIPN	S.SSNM##	;SEE IF SAVE SET NAME SUPPLIED
	JRST	LSTSAV		;NO, OMIT O$SSNM BLOCK
	HRLI	T1,O$SSNM	;TYPE CODE FOR SAVE SET NAME
	HRRI	T1,LN$SSN+2	;NUMBER OF WORDS
	MOVEM	T1,(T2)		;STORE CONTROL WORD
	MOVEI	T1,1(T2)	;LOC FOR SAVE SET NAME
	HRLI	T1,S.SSNM##	;WHERE IT IS
	BLT	T1,LN$SSN(T2)	;XFR
	SETZM	LN$SSN+1(T2)	;INSURE TRAILING NULL
	ADDI	T2,LN$SSN+2	;UPDATE
LSTSAV:	SETZM	(T2)		;FIRST CLEAR REST OF TAPE BUFFER
	MOVSI	T1,(T2)		;MAKE BLT POINTER
	HRRI	T1,1(T2)	; ...
	BLT	T1,MTBBKP-1(MH)	;ZILCH
	SUBI	T2,M(MH)	;SUBTRACT START ADDRESS
	MOVEM	T2,G$LND(MH)	;STORE TOTAL LENGTH NON-DATA
	PUSHJ	P,LSTXXX	;LIST START/END OF SAVE
	JRST	MTAOUT		;SEND BUFFER & RETURN
;+
;<SAVSTR IS CALLED ONCE FOR EACH STRUCTURE INDICATED BY THE USER'S SPEC
;LIST. <IO CHANNELS ARE INITIALIZED AND THE FILE STRUCTURE'S <MFD READ
;INTO CORE, AND SORTED IF NEEDED. ^THEN THE ^^UFD\\S SPECIFIED FOR THE 
;CURRENT STRUCTURE ARE CHOSEN OUT OF THE <MFD FOR FURTHER PROCESSING.
;-

SAVSTR:	PUSHJ	P,SAVE2		;SAVE 2 PERMANENTS

	TXZ	F,FL$STR	;INITIALIZE STRUCTURE SEEN BIT

;HERE TO GET CHARACTERISTICS OF STRUCTURE

	MOVE	T1,[NDCH,,DCHBLK] ;CALL TO DSKCHR UUO
	DSKCHR	T1,UU.PHY	;GET STATUS OF STRUCTURE
	  TDZA	T1,T1		;ASSUME NO SUPER I/O
	LDB	T1,[POINTR (DCHBLK+.DCUCH,DC.UCC)] ;GET BLOCKS PER CLUSTER
	MOVEM	T1,BKSCLS	;STORE

;HERE TO INITIALIZE ALL STRUCTURE CHANNELS

	MOVE	T1,[EXP UU.PHS+.IODMP] ;DUMP MODE
	MOVE	T2,CSTR		;CURRENT STRUCTURE
	SETZ	T3,		;NO BUFFERS

	OPEN	MFD,T1		;OPEN CHANNEL FOR MFD
	  JRST	DVFAIL		;LOSE
	OPEN	STR,T1		;OPEN CHANNEL FOR SCREWING AROUND
	  JRST	DVFAIL		;LOSE

	MOVE	P1,[-.FXLND,,UFD] ;LEVELS AND CHANNELS
OPNCHN:	HRLZ	T4,P1		;GET LEVEL
	LSH	T4,5		;SHIFT TO AC FIELD
	IOR	T4,[OPEN T1]	;FORM OPEN UUO
	XCT	T4		;OPEN LEVEL
	  JRST	DVFAIL		;LOSE
	AOBJN	P1,OPNCHN	;LOOP FOR ALL LEVELS

	HRRI	T1,.IOBIN	;BUFFERED BINARY MODE
	MOVEI	T3,DSKHDR	;BUFFER HEADER

	OPEN	FILE,T1		;OPEN CHANNEL FOR DISK FILE
	  JRST	DVFAIL		;LOSE

	MOVEI	T1,NDSKBF	;NBR DISK BUFFERS
	SKIPE	S.FFA##		;SEE IF [1,2]
	MOVEI	T1,OPRNDB	;USE LARGER NBR DISK BUFFERS
	INBUF	FILE,(T1)	;GENERATE DISK BUFFERS

IFN FT$IND,<
	TXNN	F,FL$IND	;INDEPENDENT IO?
	JRST	CONT1		;NO--CONTINUE

	MOVE	T1,[STR_5,,[EXP HMBNBR]] ;ARG FOR SUPER USETI
	SUSET.	T1,		;SET TARGET BLOCK
	  HALT	.		;***TEMP***
	INPUT	STR,CMDHMB	;READ INTO CORE

	MOVSI	T1,'HOM'	;INSURE HOME BLOCK
	CAME	T1,HMBBLK+.HMNAM; ..
	JRST	NOHOME		;TELL HIM IT IS INACCESSABLE

	MOVE	T1,[STR_5,,HMBBLK+.HMMFD] ;ARG FOR SUPER USETI
	SUSET.	T1,		;SET TARGET BLOCK
	  HALT	.		;***TEMP***
	INPUT	STR,CMDRIB	;READ IN RIB
>;END IFN FT$IND
;HERE TO READ MFD INTO CORE

CONT1:	SETZM	EXLUFD		;ZERO EXTENDED BLOCK
	MOVE	T1,[EXLUFD,,EXLUFD+1] ; ..
	BLT	T1,EXLUFD+NRIB-1; ..

	MOVEI	T1,NRIB-1	;SET BLOCK FOR LOOKUP
	MOVEM	T1,EXLUFD+.RBCNT; ..
	MOVE	T1,MFDPPN	; ..
	MOVEM	T1,EXLUFD+.RBPPN; ..
	MOVEM	T1,EXLUFD+.RBNAM; ..
	MOVSI	T1,'UFD'	; ..
	MOVEM	T1,EXLUFD+.RBEXT; ..

	LOOKUP	MFD,EXLUFD	;EXTENDED LOOKUP
	  JRST	ELUFD		;LOSE

	SKIPG	T1,EXLUFD+.RBSIZ;HOW BIG IS IT?
	JRST	RLSSTR		;NULL--DROP IT
	PUSHJ	P,UCORE		;GET CORE TO READ MFD
	  SKIPA			;CORE NOT AVAILABLE
	JRST	CONT2		;CONTINUE
	WARN$N (CCM,Cannot copy MFD for)
 	MOVE	T1,CSTR		;TYPE STR NAME
	PUSHJ	P,SIXOUT	; ...
	OUTSTR	CRLF		;<CR><LF>
	JRST	RLSSTR		;DROP THIS STR

CONT2:	MOVNS	T1		;NEGATE
	HRL	P1,T1		;PUT NEGATIVE SIZE IN LH P1
	SUBI	P1,1		;ADJUST IOWD FOR INPUT CMD
	SETZ	P2,		;ZERO NEXT CMD WORD
	INPUT	MFD,P1		;TRY TO READ MFD INTO CORE
	PUSHJ	P,@SRTDIR	;SORT IT

;HERE TO SELECT A UFD

GETUFD:	SKIPE	T1,1(P1)	;GET FIRST UFD
	CAMN	T1,MFDPPN	;DO NOT REPEAT MFD
	JRST	NXTUFD		;LOSE
	HLRZ	T2,2(P1)	;GET EXTENSION
	CAIE	T2,'UFD'	;IT HAD BETTER BE UFD
	JRST	NXTUFD		;NOT--FORGET THIS ONE
	SKIPN	S.INIT##+.FXDIR	;ANY INITIAL PPN?
	JRST	GETUF1		;NO
	CAME	T1,S.INIT##+.FXDIR;MATCH?
	JRST	NXTUFD		;NO--DROP PPN
	SETZM	S.INIT##+.FXDIR	;ZILCH
GETUF1:	MOVEM	T1,PTHBLK+.PTPPN;STORE IN PATH BLOCK
	SETZM	PTHBLK+.PTPPN+1	;ZILCH NEXT WORD
;HERE TO CHECK IF ANY FILE SPEC ASKS FOR THIS UFD ON THIS STRUCTURE

	MOVE	SP,S.FRST##	;GET ADDRESS OF SPECS

CHKUFD:	MOVE	T1,CSTRFL	;GET STRUCTURE FLAG
	TDNN	T1,FX$LEN+FX$STR(SP);CHECK INPUT STR SPEC
	JRST	CHKUF1		;STR NO GOOD

	MOVE	T3,PTHBLK+.PTPPN;GET CURRENT PPN
	XOR	T3,FX$LEN+.FXDIR(SP) ;GET DIFF
	AND	T3,FX$LEN+.FXDIM(SP) ;ZERO DON'T CARES
	JUMPE	T3,GOTUFD	;BRANCH IF GOOD PPN

CHKUF1:	ADDI	SP,FX$LEN*2	;NEXT SPEC
	CAMGE	SP,S.LAST##	;SKIP IF DONE
	JRST	CHKUFD		;CHECK NEXT SPEC
	JRST	NXTUFD		;NO ONE WANTS IT

;HERE IF AT LEAST ONE FILE SPEC NEEDS THIS UFD ON THIS STR

GOTUFD:	MOVEI	LVL,0		;START AT LEVEL ZERO
	TXZ	F,FL$UFD	;UFD USE FLAG
	PUSH	P,.JBFF##	;SAVE JOBFF
	PUSH	P,.JBREL##	;SAVE JOBREL
	PUSHJ	P,SAVUFD	;SAVE FILES
	POP	P,T1		;RESTORE JOBREL
	PUSHJ	P,DRPCOR	;DROP CORE USED FOR THIS UFD
	POP	P,.JBFF##	;RESTORE JOBFF

	TXNE	F,FL$KIL	;SEE IF OPERATOR SAID KILL
	JRST	RLSSTR		;YES

NXTUFD:	AOBJN	P1,.+1		;SKIP ONE WORD
	AOBJN	P1,GETUFD	;CHECK NEXT UFD

;HERE TO RELEASE ALL STR CHANNELS

RLSSTR:	RELEAS	FILE,		;DONE
	RELEAS	STR,		; ..
	RELEAS	MFD,		; ..
	MOVE	T1,[-.FXLND,,UFD] ;LEVELS AND CHANNELS
RLSUFD:	HRLZ	T2,T1		;GET CHANNEL INTO LH
	LSH	T2,5		;SHIFT TO AC POSITION
	TLO	T2,(<RELEAS>)	;FORM RELEASE UUO
	XCT	T2		;EXECUTE
	AOBJN	T1,RLSUFD	;LOOP FOR ALL
	POPJ	P,		;RETURN
;+
;<SAVUFD IS CALLED ONCE FOR EACH <UFD AND <SFD WHICH MATCHES A DIRECTORY
;SPEC IN THE USER'S LIST. ^THE <UFD OR <SFD <RIB IS READ INTO CORE AND SAVED
;FOR LATER USE IN  WRITING <T$UFD RECORDS ON TAPE. ^NEXT, THE <UFD
;OR <SFD ITSELF IS READ INTO CORE AND SORTED, IF NEEDED. ^THE DIRECTORY
;IS THEN SEARCHED FOR FILES WHICH MATCH AN ENTRY IN THE USER'S SPEC LIST.
;^FILES WHICH MATCH A SPEC ARE THEN CHECKED TO SEE IF THEY ALSO
;MATCH ALL USER SET SWITCH RESTRICTIONS. ^FOR A FILE WHICH MATCHES,
;A <T$UFD RECORD IS WRITTEN ON TAPE FOR EACH DIRECTORY IN THE FILE'S
;PATH (UNLESS THE <INTERCHANGE SWITCH WAS GIVEN) AND THEN THE FILE IS SAVED.
;-

SAVUFD:	PUSHJ	P,SAVE2		;SAVE C(P1) & C(P2)

;HERE TO LOOKUP THE UFD

	SETZM	EXLUFD		;ZERO BLOCK
	MOVE	T1,[EXLUFD,,EXLUFD+1] ; ..
	BLT	T1,EXLUFD+NRIB-1; ..

	MOVEI	T1,NRIB-1	;SET BLOCK
	MOVEM	T1,EXLUFD+.RBCNT; ..
	JUMPG	LVL,SETSFD	;SET SFD BLOCK?
	MOVE	T1,MFDPPN	; ..
	MOVE	T2,PTHBLK+.PTPPN;CURRENT PPN
	MOVSI	T3,'UFD'	; ..
	JRST	SETFIN		;FINISH UP
SETSFD:	MOVE	T1,[PTHBLK,,UPTBLK] ;BLT POINTER
	BLT	T1,UPTBLK+.PTPPN-1(LVL) ;TRANSFER
	SETZM	UPTBLK+.PTPPN(LVL) ;ZILCH LAST ONE
	MOVEI	T1,UPTBLK	;PATH BLOCK
	MOVE	T2,PTHBLK+.PTPPN(LVL) ;GET SFD NAME
	MOVSI	T3,'SFD'	;EXTENSION
SETFIN:	MOVEM	T1,EXLUFD+.RBPPN;STORE
	MOVEM	T2,EXLUFD+.RBNAM; ..
	MOVEM	T3,EXLUFD+.RBEXT; ..

	MOVSI	T1,UFD(LVL)	;GET CHANNEL IN LH
	LSH	T1,5		;PUT IN AC FIELD
	IOR	T1,[LOOKUP EXLUFD] ;FORM UUO
	XCT	T1		;EXEC IT
	  JRST	ELUFD		;LOSE
;HERE TO SAVE A COPY OF THE UFD RIB FOR LATER USE.
;THE RIB INFO IS WRITTEN ON TAPE IN A T$UFD RECORD AND IS USED WHEN
;IN ORDER TO ENTER A SUBSEQUENT FILE ON TAPE THIS UFD IS NEEDED

	MOVEI	T1,NRIB		;NEED CORE
	PUSHJ	P,UCORE		;GET IT
	  SKIPA			;CORE NOT AVAILBLE
	JRST	CNTUFD		;CONTINUE
	WARN$N (CCR,Cannot copy UFD/SFD RIB for)
	MOVEI	P1,EXLUFD	;INDICATE WHICH
	PUSHJ	P,GUUO		;TYPE SPEC
	JRST	CLSUF1		;LOSE

CNTUFD:	MOVEM	P1,ADRLST(LVL)	;STORE FOR LATER REF

	MOVE	T1,P1		;WHERE TO SAVE IT
	HRLI	T1,EXLUFD	;WHERE IT NOW IS
	BLT	T1,NRIB(P1)	;XFR

;HERE TO READ THE DIRECTORY INTO CORE

	SKIPG	T1,EXLUFD+.RBSIZ;SEE IF SIZABLE
	JRST	CLSUF1		;DROP IT IF NULL
	PUSHJ	P,UCORE		;EXPAND CORE
	  SKIPA			;CORE NOT AVAILABLE
	JRST	CNTLVL		;CONTINUE
	WARN$N (CCU,Cannot copy UFD/SFD for)
	MOVEI	P1,EXLUFD	;INDICATE WHICH
	PUSHJ	P,GUUO		;TYPE SPEC
	JRST	CLSUF1		;LOSE

CNTLVL:	MOVNS	T1		;NEGATE LENGTH
	HRL	P1,T1		;MAKE DUMP MODE IO COMMAND WORD
	SUBI	P1,1		;COMPUTE IOWD
	SETZ	P2,		;ZERO NEXT CMD WORD
	MOVSI	T1,UFD(LVL)	;GET CHANNEL IN LH
	LSH	T1,5		;PUT IN AC FIELD
	IOR	T1,[INPUT P1]	;FORM UUO
	XCT	T1		;EXEC IT
	PUSHJ	P,@SRTFIL	;SORT IT

;HERE TO SELECT A FILE

GETFIL:	SKIPN	T1,1(P1)	;GET A FILE NAME
	JRST	NXTFIL		;NOT INTERESTED IN NULLS
	MOVEM	T1,CNAM		;STORE
	HLRZ	T1,2(P1)	;GET EXTENSION
	CAIE	T1,'SFD'	;SFD?
	JRST	NOTSFD		;NO--DO NORMAL HANDLING
;***START OF SFD NESTING HANDLER***

	CAIGE	LVL,.FXLND-1	;LEVEL EXCEEDED?
	AOJA	LVL,SAFE1	;NO--CONTINUE

	TXON	F,FL$SLE	;ISSUE ONCE
	WARN$	(SLE,SFD level exceeded)
	JRST	NXTFIL		;GET NEXT FILE

SAFE1:	MOVE	T2,LVL		;COPY LEVEL
	IMULI	T2,2		;MAKE INDEX FOR S.INIT SPEC
	SKIPN	T3,S.INIT+.FXDIR(T2) ;ANY INITIAL SFD?
	JRST	SAFE2		;NO
	CAME	T3,CNAM		;SEE IF MATCH
	SOJA	LVL,NXTFIL	;NO, DROP IT
	SETZM	S.INIT+.FXDIR(T2) ;MATCH--ZILCH

SAFE2:	HRLZM	T1,CEXT		;SAVE 'SFD' EXTENSION
	MOVE	T2,CNAM		;GET SFD NAME
	MOVEM	T2,PTHBLK+.PTPPN(LVL) ;STORE IN PATH BLOCK
	SETZM	PTHBLK+.PTPPN+1(LVL) ;ZILCH NEXT ENTRY

	MOVE	SP,S.FRST##	;ADDRESS OF SPECS

CHKSFD:	PUSHJ	P,VER1		;VERIFY STR,UFD,SFD'S
	  JRST	CHKSF1		;NO GOOD--SKIP THIS SPEC

	PUSH	P,.JBFF##	;SAVE C(JOBFF)
	PUSH	P,.JBREL##	;SAVE JOBREL
	PUSHJ	P,SAVUFD	;MATCH--CALL UFD(SFD) HANDLER
	POP	P,T1		;RESTORE JOBREL
	PUSHJ	P,DRPCOR	;DROP CORE IF SAVINGS OF 2K
	POP	P,.JBFF##	;RESTORE C(JOBFF)

	SETZM	PTHBLK+.PTPPN(LVL) ;ZERO
	TXNE	F,FL$KIL	;SEE IF OPERATOR SAID KILL
	SOJA	LVL,CLSUF1	;YES--UNNEST
	SOJA	LVL,NXTFIL	;CONTINUE

CHKSF1:	ADDI	SP,FX$LEN*2	;UP ADDRESS
	CAMGE	SP,S.LAST##	;SKIP IF DONE
	JRST	CHKSFD		;CHECK NEXT

	SETZM	PTHBLK+.PTPPN(LVL) ;ZERO
	SOJA	LVL,NXTFIL	;CONTINUE

;***END OF SFD NESTING HANDLER***
;HERE IF THE CURRENT FILE IS NOT AN SFD

NOTSFD:	SKIPE	S.INIT+.FXDIR+2(LVL);SEE IF INITIAL SFD GIVEN
	JRST	NXTFIL		;YES, DROP THIS FILE
	SKIPN	T2,S.INIT+.FXNAM;ANY INITIAL FILE NAME?
	JRST	SETEXT		;NO
	HLRZ	T3,S.INIT+.FXEXT;GET INITIAL EXTENSION
	CAMN	T2,CNAM		;MATCH?
	CAME	T3,T1		;EXTENSION MUST MATCH TOO
	JRST	NXTFIL		;NO, DROP IT
	SETZM	S.INIT+.FXNAM	;YES, ZILCH

SETEXT:	HRLZM	T1,CEXT		;STORE
	HRRZ	T1,2(P1)	;GET COMPRESSED-FILE-POINTER
	IMUL	T1,BKSCLS	;COMPUTE LOGICAL BLOCK ON STR
	MOVEM	T1,CBLOCK	;STORE
	TLNE	T1,(77774B14)	;MAKE SURE IT FITS IN SUSET.
	SETZM	CBLOCK		;IF NOT, CLEAR

;HERE TO CHECK IF ANY FILE SPEC ASKS FOR THIS FILE

	MOVE	SP,S.FRST##	;ADDRESS OF SPECS
	SETZ	P2,		;FLAG INITIAL READ OF FILE RIB

CHKFIL:	PUSHJ	P,VER1		;CHECK FILE ID
	  JRST	CHKFI1		;NO GOOD
	PUSHJ	P,VER2		; ..
	  JRST	CHKFI1		; ..

	JUMPL	P2,CHKSWT	;IF READ & DECODED ALREADY, GO CHECK SWITCHES

	SKIPN	S.USET##	;SKIP IF SHOULD USE SUPER USETIS
	JRST	STNCHK		;NO--USE LOOKUP UUO

	MOVSI	T1,STR_5	;GET CHANNEL
	ADD	T1,CBLOCK	;GET BLOCK NUMBER
	SKIPE	CBLOCK		;IF SET,
	SUSET.	T1,		;SET TARGET BLOCK
	  JRST	STNCHK		;FAILURE

	MOVE	T1,[IOWD NRIB,EXLFIL] ;MAKE COMMAND WORD
	SETZ	T2,		;ZILCH SECOND COMMAND WORD
	INPUT	STR,T1		;READ INTO CORE

	MOVE	T1,EXLFIL+.RBPPN;VERIFY RIB BLOCK
	CAME	T1,PTHBLK+.PTPPN; ..
	JRST	STNCHK		; ..
	MOVE	T1,EXLFIL+.RBNAM; ..
	CAME	T1,CNAM		; ..
	JRST	STNCHK		; ..
	HLLZ	T1,EXLFIL+.RBEXT; ..
	CAMN	T1,CEXT		; ..
	JRST	DECODE		;GO DECODE RIB
STNCHK:	SETZM	EXLFIL		;ZERO LOOKUP BLOCK
	MOVE	T1,[EXLFIL,,EXLFIL+1] ; ..
	BLT	T1,EXLFIL+NRIB-1; ..

	MOVEI	T1,NRIB-1	;LIMIT OF ARGS
	MOVEM	T1,EXLFIL+.RBCNT; ..
	CAIGE	LVL,1		;SEE IF FILE ACTUALLY IN SFD
	SKIPA	T1,PTHBLK+.PTPPN;IT IS IN UFD. DO NOT SUPPLY PATH ADDR
	MOVEI	T1,PTHBLK	;PPN AND SFD PATH
	MOVEM	T1,EXLFIL+.RBPPN; ..
	MOVE	T1,CNAM		;NAME
	MOVEM	T1,EXLFIL+.RBNAM; ..
	MOVE	T1,CEXT		;EXT
	MOVEM	T1,EXLFIL+.RBEXT; ..

	LOOKUP	STR,EXLFIL	; ..
	  JRST	GOTFIL		;ASSUME FILE IS GOOD
	CLOSE	STR,CL.ACS	; ..

;HERE TO CHECK IF FILE SATISFIES USER SWITCH RESTRICTIONS

DECODE:	MOVEI	T1,RP.NFS	;CHECK NO SAVE BIT
	TDNE	T1,EXLFIL+.RBSTS;ON?
	JRST	NXTFIL		;YES--SKIP THIS ONE

	MOVE	T1,EXLFIL+.RBSIZ;GET FILE SIZE
	MOVEM	T1,CWSIZE	;STORE

	SETZ	T1,		;ZERO ACCESS TIME
	LDB	T2,[POINTR (EXLFIL+.RBEXT,RB.ACD)] ;GET ACCESS DATE
	PUSHJ	P,CONVDT	;CONVERT TO SMITHSONIAN DATE/TIME
	MOVEM	T1,CADATI	;STORE

	LDB	T1,[POINTR (EXLFIL+.RBPRV,RB.CRT)] ;GET CREATION TIME
	IMULI	T1,^D60000	;CONVERT TO MILLISECONDS
	LDB	T2,[POINTR (EXLFIL+.RBEXT,RB.CRX)] ;GET EXTENSION OF CREATION
	LSH	T2,^D12		;SHIFT OVER
	LDB	T3,[POINTR (EXLFIL+.RBPRV,RB.CRD)] ;GET BASE CREATION DATE
	IOR	T2,T3		;UNITE
	PUSHJ	P,CONVDT	;CONVERT TO SMITHSONIAN DATE/TIME
	MOVEM	T1,CCDATI	;STORE
	MOVE	T1,EXLFIL+.RBTIM ;GET INTERNAL DATE/TIME
	MOVEM	T1,CMDATI	;SET FOR CHECKER

	SETO	P2,		;FLAG DECODING DONE

CHKSWT:	PUSHJ	P,CHKLIM	;CHECK LIMITS
	  JRST	CHKFI1		;NO GOOD
	  JRST	[TXON  F,FL$D75	;ONLY GOOD BECAUSE DATE75
		 MOVEM SP,D75ADR; SAVE FOR LATER
		 JRST  CHKFI1]	;CONTINUE LOOP, NOT COUNTING MATCH

	TXON	F,FL$MAT	;FLAG FIND
	MOVEM	SP,SAVADR	;SAVE ADDRESS
	AOS	FX$CNT(SP)	;COUNT MATCH
CHKFI1:	ADDI	SP,FX$LEN*2	;ADVANCE TO NEXT SPEC
	CAMGE	SP,S.LAST##	;SKIP IF DONE
	JRST	CHKFIL		;CHECK NEXT SPEC

	TXZN	F,FL$MAT	;ANY FILE MATCH?
	JRST	[TXZN F,FL$D75	;NOT MATCH, SEE IF DATE75 WORKS
		 JRST NXTFIL	;NO--JUST IGNORE FILE
		 MOVE SP,D75ADR	;YES--USE DATE75 MATCH
		 JRST GOTFIL]	;AND PROCEED

	MOVE	SP,SAVADR	;YES. RESTORE C(SP)

;HERE IF AT LEAST ONE FILE SPEC NEEDS THIS FILE

GOTFIL:	SKIPE	S.TYMS##	;SKIP IF TYPE OUT WANTED
	TXOE	F,FL$UFD	;FIRST FILE--ANY PREVIOUS?
	JRST	GOTFL1		;YES--GO SAVE IT

	HLRZ	T1,PTHBLK+.PTPPN;GET PROJECT
	PUSHJ	P,OCTOUT	;TYPE
	OUTCHR	COMMA		; ..

	HRRZ	T1,PTHBLK+.PTPPN;GET PROGRAMMER
	PUSHJ	P,OCTOUT	;TYPE
	TXOE	F,FL$STR	;SEE IF FIRST TIME FOR STR
	JRST	RECUFD		;NOPE--FORGET THIS

	OUTCHR	TAB		;TAB OVER
	MOVE	T1,CSTR		;GET STR NAME
	PUSHJ	P,SIXOUT	;TYPE IT
RECUFD:	OUTSTR	CRLF		;<CR><LF>

GOTFL1:	PUSHJ	P,XALIAS	;DO ALIASING
	SKIPN	S.INTR##	;SEE IF /INTERCHANGE 
	PUSHJ	P,WRTUFD	;NO--WRITE T$UFD RECORDS ON TAPE

	MOVEI	T1,2		;SEE IF FILE NAMES WANTED
	CAMN	T1,S.TYMS##	;SKIP IF NOT
	PUSHJ	P,TYPFIL	;TYPE FILE NAME

	PUSH	P,NTPE		;SAVE TAPE NUMBER
	PUSHJ	P,SAVFIL	;SAVE THE FILE
	POP	P,T1		;GET TAPE NUMBER BACK

	TXNE	F,FL$KIL	;SEE IF OPERATOR SAID KILL
	JRST	CLSUF1		;YES, STOP NOW

	CAMN	T1,NTPE		;SEE IF TAPE NUMBER CHANGED
	JRST	NXTFIL		;NO, PROCEED
	TXZ	F,FL$UFD	;ZILCH SO PPN WILL BE TYPED
	SKIPE	S.REPT##	;/REPEAT?
	JRST	GOTFIL		;YES--SAVE THIS FILE AGAN

NXTFIL:	AOBJN	P1,.+1		;ONE WORD
	AOBJN	P1,GETFIL	;TWO
;HERE TO TERMINATE I/O TO THIS UFD

CLSUF1:	MOVSI	T1,UFD(LVL)	;GET CHANNEL IN LH
	LSH	T1,5		;PUT IN AC FIELD
	IOR	T1,[CLOSE CL.ACS] ;FORM UUO
	XCT	T1		;EXEC IT

	SETZM	ADRLST(LVL)	;ZILCH IN CASE NO FILE FOUND
	SKIPN	S.LIST##	;SEE IF /LIST,
	POPJ	P,		;NO--RETURN

;AVOID SPAWNING A ZILLION FILES - I.E. ONE/PPN			[176]

	SETZ	T1,		; A SPOOLED LPT?		[176]
	DEVTYP	T1,		; GET DEVICE TYPE BITS		[176]
	 JRST	CLSUF2		; ERROR RET - IGNORE		[176]
	JUMPE	T1,CLSUF2	; NOT A DEVICE OR NOT INITED	[176]
	TXNN	T1,TY.SPL	; A SPOOLED DEVICE?		[176]
	JRST	CLSUF2		; NO				[176]
	LDB	T1,[POINT 6,T1,35]; GET DEVICE TYPE		[176]
	CAIN	T1,.TYLPT	; IS IT A LPT?			[176]
	POPJ	P,		; YES, AVOID PRESERVE CODE	[176]

;HERE TO PRESERVE LISTING FILE IN CASE OF SYSTEM CRASH

CLSUF2:	CLOSE	F.LIST,		;CLOSE LISTING FILE		[176]
	LOOKUP	F.LIST,S.LENT## ;DO LOOKUP
	  JRST	LSTERR		;REPORT ERROR
	ENTER	F.LIST,S.LENT##	;RE-ENTER
	  JRST	LSTERR		;OUCH!
	USETI	F.LIST,-1	;POSITION TO APPEND TO FILE
	POPJ	P,		;THAT'S ALL

LSTERR:	WARN$N (LF,Listing file error)
	SETZM	S.LIST##	;ZILCH TO PREVENT FURTHER TROUBLE
	MOVEI	P1,S.LENT##	;SPEC ADDRESS
	JRST	EGUUO		;TYPE OUT ERROR MESSAGE & RETURN
;+
;<WRTUFD IS A ROUTINE TO WRITE A <T$UFD RECORD ON TAPE FOR EACH DIRECTORY IN 
;THE FILE PATH.
;-

WRTUFD:	PUSHJ	P,SAVE2		;SAVE C(P1) & C(P2)
	MOVSI	P1,-.FXLND	;HOW MANY LEVELS PLUS ONE
WRIB:	SKIPG	P2,ADRLST(P1)	;ANYTHING TO WRITE?
	JRST	NORIB		;NO--CONTINUE
	HRROS	ADRLST(P1)	;YES--FLAG LH

	SETZM	M(MH)		;CLEAR BUFFER FIRST
	MOVSI	T1,M(MH)	;MAKE BLT POINTER
	HRRI	T1,M+1(MH)	; ...
	BLT	T1,MTBBKP-1(MH);CLEAR BUFFER

	MOVEI	T1,T$UFD	;LOAD UFD TYPE
	MOVEM	T1,G$TYPE(MH)	;STORE IN HEADER
	HRRZM	P1,D$LVL(MH)	;STORE LEVEL

	MOVEI	T3,D$STR(MH)	;MAKE BP TO D$STR IN HEADER
	HRLI	T3,440700	;...
	MOVE	T1,ACSTR	;GET ALIAS STRUCTURE NAME
	MOVEI	T2,.FCDEV	;INDICATE DATA TYPE
	PUSHJ	P,SETPTH	;STORE IN HEADER

	MOVE	T1,D$LVL(MH)	;INDICATE LEVEL
	PUSHJ	P,SETASC	;STORE O$NAME FULL PATH OF DIRECTORY
	MOVEM	T1,D$PCHK(MH)	;SAVE CHECKSUM OF PATH IN HEADER
	PUSHJ	P,SAVATR	;SAVE O$FILE ATTRIBUTE BLOCK ON TAPE

;HERE TO WRITE O$DIRT NON-DATA BLOCK IN T$UFD RECORD. OUTPUT PLACED AT M+400(MH)

	MOVEI	T1,200		;LENGTH OF BLOCK
	ADDM	T1,G$LND(MH)	;ADD TO NON-DATA LENGTH
	HRLI	T1,O$DIRT	;POSITION CONTROL CODE
	MOVEM	T1,400+M(MH)	;STORE CONTROL WORD
	MOVEI	T1,401+M(MH)	;MAKE POINTER TO DIRECTORY ATTRIBUTES
	MOVEI	T2,LN$DFH	;FIXED HEADER LENGTH
	MOVEM	T2,D$FHLN(T1)	;STORE
	MOVEI	T2,201+M(MH)	;MAKE POINTER TO O$FILE
	MOVE	T3,A$WRIT(T2)	;GET CREATION DATE/TIME FROM O$FILE BLOCK
	MOVEM	T3,D$LOGT(T1)	;SAVE FOR LOGIN TIME
	SETZB	T3,A$PROT(T2)	;ZILCH FILE PROTECTION WORD
	LDB	T4,[POINTR (.RBPRV(P2), RB.PRV)];GET RIB PROTECTION
	LSHC	T3,^D30		;POSITION PROGRAMMER PROTECTION IN T3
	DPB	T3,[POINTR (D$PROT(T1), AC$OWN)];SET OWNER ACCESS
	SETZ	T3,		;CLEAR
	LSHC	T3,3		;POSITION PROJECT PROTECTION IN T3
	DPB	T3,[POINTR (D$PROT(T1), AC$GRP)];SET AFFINITY GROUP PROT.
	LSH	T4,-^D33	;POSITION WORLD PROTECTION IN T4
	TLO	T4,(5B2)	;SET "5"
	IORM	T4,D$PROT(T1)	;STORE DIRECTORY PROTECTION
	MOVE	T2,.RBQTF(P2)	;GET QUOTA IN BLOCKS FROM RIB
	ASH	T2,7		;MULTIPLY BY 200 FOR QUOTA IN WORDS
	MOVEM	T2,D$QTF(T1)	;STORE
	MOVE	T2,.RBQTO(P2)	;GET LOGGED OUT QUOTA FROM RIB
	ASH	T2,7		;MULTIPLY BY 200 FOR QUOTA IN WORDS
	MOVEM	T2,D$QTO(T1)	;STORE

	PUSHJ	P,MTAOUT	;EXEC I/O
NORIB:	AOBJN	P1,WRIB		;CIRCLE
	POPJ	P,		;RETURN
;+
;<SAVFIL IS A ROUTINE TO MOVE AN INDIVIDUAL FILE FROM DISK TO TAPE.
;-

SAVFIL:	PUSHJ	P,SAVE3		;SAVE SOME ACS

	MOVEI	T1,NRIB-1	;SET FOR EXTENDED LOOKUP
	MOVEM	T1,EXLFIL+.RBCNT; ..
	CAIGE	LVL,1		;IF SFD, LOAD ADDRESS OF PATH BLOCK
	SKIPA	T1,PTHBLK+.PTPPN; ..
	MOVEI	T1,PTHBLK	; ..
	MOVEM	T1,EXLFIL+.RBPPN; ..
	MOVE	T1,CNAM		; ..
	MOVEM	T1,EXLFIL+.RBNAM; ..
	MOVE	T1,CEXT		; ..
	MOVEM	T1,EXLFIL+.RBEXT; ..

	LOOKUP	FILE,EXLFIL	;LOOKUP FILE
	  JRST	ELFIL		;LOSE

	MOVEI	T1,CP$INC	;CHECKPOINT INCREMENT
	ADDI	T1,CP$MRG	;CHECKPOINT MARGIN
	MOVEM	T1,CHKPNT	;SET INITIAL CHECKPOINT

	SETZM	THSRDB		;START WITH BLOCK ZERO

	SKIPN	T1,S.RSUM##	;RESUMING?
	JRST	STREC		;NO, PROCEED WITH FIRST BLOCK

	USETI	FILE,(T1)	;POSITION
	ADDI	T1,CP$MRG	;ADD ON MARGIN
	ADDI	T1,CP$INC	;ADD ON INCREMENT
	MOVEM	T1,CHKPNT	;SET NEXT CHECKPOINT
;HERE TO FILL IN THE TAPE RECORD HEADER

STREC:	MOVEI	T1,T$FIL	;FILE DATA RECORD
	MOVEM	T1,G$TYPE(MH)	;STORE
	MOVSI	T3,440700	;MAKE INITIAL BP
	HRRI	T3,F$PTH(MH)	;ADDRESS OF F$PTH BLOCK
	SKIPE	S.INTR##	;SEE IF /INTERCHANGE
	JRST	CONREC		;YES--DON'T INCLUDE PATH INFO
	MOVE	T1,ACSTR	;GET FS NAME
	MOVEI	T2,.FCDEV	;INDICATE DATA TYPE
	PUSHJ	P,SETPTH	;STORE IN HEADER BLOCK
	MOVE	T1,APATH+.PTPPN	;GET DIRECTORY
	MOVEI	T2,.FCDIR	;INDICATE DATA TYPE
	PUSHJ	P,SETPTH	;STORE
	MOVE	T1,APATH+.PTPPN+1;GET FIRST SFD NAME
	MOVEI	T2,.FCSF1	;INDICATE DATA TYPE
	PUSHJ	P,SETPTH	;STORE
	MOVE	T1,APATH+.PTPPN+2;SECOND SFD NAME
	MOVEI	T2,.FCSF2	;TYPE CODE
	PUSHJ	P,SETPTH	;STORE

CONREC:	MOVE	T1,ACNAM	;GET FILE NAME
	MOVEI	T2,.FCNAM	;DATA TYPE
	PUSHJ	P,SETPTH	;STORE
	MOVE	T1,ACEXT	;GET EXTENSION
	MOVEI	T2,.FCEXT	;DATA TYPE
	PUSHJ	P,SETPTH	;STORE
	SKIPE	T1,THSRDB	;LOAD RELATIVE DATA BLOCK
	SUBI	T1,1		;CALCULATE RELATIVE DATA WORD
	IMULI	T1,200		; ...
	MOVEM	T1,F$RDW(MH)	;STORE
	MOVE	T1,PTHCHK	;GET PATH CHECKSUM
	MOVEM	T1,F$PCHK(MH)	;SAVE IN HEADER

	TXNN	F,FL$PSI	;SKIP FOLLOWING IF PSI ENABLED
	JRST	[PUSHJ	P,OPRCMD##;HANDLE ANY TTY INPUT
		  TXO	F,FL$KIL;RETURN HERE IF OPERATOR SAID KILL
		 JRST	.+1]	;CONTINUE

	SKIPE	THSRDB		;FIRST BLOCK?
	JRST	STBLK		;NO
;HERE TO HANDLE THE FIRST TAPE RECORD FOR A FILE

	MOVX	T1,GF$SOF	;YES, LOAD START OF FILE FLAG
	SKIPN	S.RSUM##	;UNLESS RESUMING,
	IORM	T1,G$FLAG(MH)	;SET IN HEADER

	SETZM	M(MH)		;CLEAR FIRST TAPE RECORD FOR FILE
	MOVSI	T1,M(MH)	;MAKE BLT POINTER
	HRRI	T1,M+1(MH)	; ...
	BLT	T1,MTBBKP-1(MH)	;ZILCH ENTIRE BUFFER

	MOVEI	T1,.FXLND	;INDICATE FILE
	MOVEI	P2,EXLFIL	;SET ADDRESS OF LOOKUP BLOCK
	PUSHJ	P,SETASC	;SAVE O$NAME BLOCK
	MOVEM	T1,F$PCHK(MH)	;SAVE CHECKSUM IN HEADER
	MOVEM	T1,PTHCHK	;AND FOR LATER USE

	PUSHJ	P,SAVATR	;SAVE FILE ATTRIBUTES
	MOVEI	T1,M+200(MH)	;SET POINTER TO O$FILE BLOCK
	SKIPN	S.RSUM##	;UNLESS RESUMING,
	PUSHJ	P,LSTFIL	;LIST THIS FILE

	PUSHJ	P,DSKIN		;GET FIRST DISK BLOCK
	  JRST	CLSFIL		;ERROR -- QUIT
	  JRST	[SKIPE	S.RSUM## ;EOF RETURN
		 JRST	RSMERR  ;IF RESUMING MEANS USER GAVE BAD CHECKPOINT
		 JRST	SNDLST]	;IF NOT, MEANS ZERO LENGTH FILE -- DONE

	SKIPN	T1,S.RSUM##	;IF RESUMING, GET BLOCK NUMBER
	MOVEI	T1,1		;FIRST BLOCK
	MOVEM	T1,THSRDB	;STORE RELATIVE BLOCK NUMBER

	SKIPE	S.RSUM##	;IF RESUMING,
	PUSHJ	P,TYPRSM	;TYPE RESUME MESSAGE
	SETZM	S.RSUM##	; AND ZILCH

	MOVE	T1,EXLFIL+.RBSIZ;GET SIZE OF FILE
	CAILE	T1,400		;SEE IF OVER 2 BLOCKS
	JRST	SNDREC		;YES, START FILE IN 2ND TAPE RECORD

	MOVEI	P2,M+400(MH)	;WHERE TO START
	MOVEI	P1,N-2		;MAX OF 2 BLOCKS FOR FIRST RECORD
	CAIG	T1,200		;IF ONLY ONE BLOCK,
	MOVEI	P1,1		;ADJUST P1
;HERE TO TRANSFER A DISK BLOCK TO THE TAPE BUFFER

STBLK:	MOVSI	T1,(DBUF)	;ADDRESS OF DATA
	HRRI	T1,(P2)		;WHERE TO GO IN TAPE BUFFER
	BLT	T1,177(P2)	;XFR DISK BLOCK

	MOVEI	T1,200		;LENGTH OF BLOCK
	ADDM	T1,G$SIZ(MH)	;ADD TO RECORD SIZE COUNT
	MOVE	P3,DSKHDR+.BFCTR;SAVE ACTUAL NUMBER OF WORDS

	ADDI	P2,200		;NEXT BLOCK SLOT
	PUSHJ	P,DSKIN		;GET NEXT DATA BLOCK
	  JRST	CLSFIL		;QUIT IF ERROR
	  JRST	FINFIL		;EOF--DONE
	AOS	T1,THSRDB	;ANOTHER BLOCK READ
	SKIPE	S.CKPT##	;CHECKPOINTING?
	PUSHJ	P,TYPCKP	;YES
	SOJG	P1,STBLK	;GO XFR NEXT ONE

SNDREC:	PUSHJ	P,MTAOUT	;SEND TAPE RECORD

	MOVEI	P1,N		;HOW MANY BLOCKS
	MOVEI	P2,M(MH)	;WHERE TO WRITE
	TXNN	F,FL$KIL	;SEE IF OPERATOR SAID KILL
	JRST	STREC		;NO--GO START AGAIN

	PUSHJ	P,EAFIL		;YES--ABORT FILE
	MOVEI	T1,[ASCIZ/
	% SAVE ABORTED
/]
	SKIPE	S.LIST		;SKIP IF NO LISTING NEEDED
	PUSHJ	P,LSTMSG	;SEND TO LISTING FILE
	JRST	CLSFIL		;CLOSE FILE
;	HERE ON DISK EOF

FINFIL:	SUBI	P3,200		;ADJUST DATA WORD COUNT
	ADDM	P3,G$SIZ(MH)	;TO USE ACTUAL WORD SIZE OF LAST DISK BLOCK
	SOJLE	P1,SNDLST	;IF BUFFER FULL, SEND LAST RECORD
	SETZM	(P2)		;CLEAR REMAINDER OF BUFFER
	MOVSI	T1,(P2)		;MAKE BLT POINTER
	HRRI	T1,1(P2)	; ...
	BLT	T1,MTBBKP-1(MH)	;ZILCH TO END OF TAPE BUFFER

SNDLST:	MOVX	T1,GF$EOF	;MARK AS LAST BLOCK
	IORM	T1,G$FLAG(MH)	;SET FLAG
	PUSHJ	P,MTAOUT	;SEND LAST BUFFER

	SKIPN	S.DELT##	;/DELETE?
	JRST	CLSFIL		;NO, FINISH FILE
	MOVE	T1,EXLFIL+.RBNAM ;SAVE FILENAME IN CASE OF ERROR
	SETZM	EXLFIL+.RBNAM	;ZILCH TO DELETE
	RENAME	FILE,EXLFIL	;DELETE FILE
	  SKIPA			;ERROR RETURN
	POPJ	P,		;OK--THATS ALL
	WARN$N	(CDF,Cannot delete file)
	MOVEM	T1,EXLFIL+.RBNAM ;RESTORE FILENAME,
	MOVEI	P1,EXLFIL	;SET POINTER
	JRST	EGUUO		;TELL WHICH AND RETURN

CLSFIL:	CLOSE	FILE,CL.ACS	;INHIBIT ACCESS DATE UPDATING
	 POPJ	P,		;RETURN
	SUBTTL	DISK TO TAPE SUBROUTINES

;+
;.CHAPTER DISK TO TAPE SUBROUTINES
;-

;+
;<XALIAS IS THE SUBROUTINE TO DO ALIASING.
;^EACH MASKED CHARACTER IN THE OUTPUT FILE SPEC PATH IS REPLACED
;WITH THE CORRESPONDING CHARACTER OF THE CURRENT FILE BEING PROCESSED.
;^THE DEVICE IS SIMPLY RENAMED.
;-

XALIAS:	MOVE	T1,.FXDEV(SP)	;GET ALIAS STR
	CAMN	T1,[SIXBIT /ALL/] ;SKIP IF NOT ALL
	MOVE	T1,CSTR		;ALL. GET ORIGINAL STR BACK
	MOVEM	T1,ACSTR	;STORE

	MOVE	T1,CNAM		;GET FILE NAME
	TDZ	T1,.FXNMM(SP)	;ZILCH
	MOVE	T2,.FXNAM(SP)	;GET ALIAS
	AND	T2,.FXNMM(SP)	;ZILCH
	IOR	T1,T2		;FORM ALIAS FILE NAME
	MOVEM	T1,ACNAM	;STORE

	MOVE	T1,CEXT		;GET EXTENSION
	HRLZ	T2,.FXEXT(SP)	;GET MASK
	TDZ	T1,T2		;ZILCH
	HLLZ	T3,.FXEXT(SP)	;GET ALIAS
	AND	T3,T2		;ZILCH
	IOR	T1,T3		;FORM ALIAS FILE NAME
	MOVEM	T1,ACEXT	;STORE

	MOVSI	T1,-.FXLND		;START AT UFD LEVEL
	MOVE	T2,SP		;GET SPEC ADDRESS

XAPATH:	MOVE	T3,PTHBLK+.PTPPN(T1) ;GET UFD-SFD
	TDZ	T3,.FXDIM(T2)	;ZILCH
	MOVE	T4,.FXDIR(T2)	;GET ALIAS
	AND	T4,.FXDIM(T2)	;ZILCH
	IOR	T3,T4		;FORM ALIAS UFD-SFD
	MOVEM	T3,APATH+.PTPPN(T1) ;STORE
	JUMPE	T3,CPOPJ	;RETURN NOW IF END OF PATH

	ADDI	T2,2		;NEXT DIR-MSK PAIR
	AOBJN	T1,XAPATH	;GET NEXT UFD-SFD

	SETZM	APATH+.PTPPN(T1) ;INSURE TRAILING ZERO
	POPJ	P,		;RETURN
;+
;<SAVATR IS A ROUTINE TO HANDLE PUTTING FILE ATTRIBUTE INFORMATION ONTO THE TAPE.
;^IT PLACES <O$FILE AS THE SECOND BLOCK IN THE TAPE RECORD. ^INPUT IS
;FROM THE EXTENDED LOOKUP BLOCK (ADDRESS IN ^P2). ^OUTPUT PLACED AT ^M+200(<MH).
;-

SAVATR:	PUSHJ	P,SAVE1		;MAKE SOME ROOM
	MOVEI	T1,200		;LENGTH OF BLOCK
	ADDM	T1,G$LND(MH)	;ADD TO NON-DATA TOTAL
	HRLI	T1,O$FILE	;BLOCK TYPE
	MOVEM	T1,M+200(MH)	;STORE CONTROL WORD
	MOVEI	P1,M+201(MH)	;MAKE POINTER TO FIXED LENGTH SUBBLOCK
	MOVEI	T1,LN$AFH	;FIXED HEADER LENGTH
	MOVEM	T1,A$FHLN(P1)	;STORE
	SKIPE	T1,S.INTR##	;SEE IF /INTERCHANGE
	JRST	SETIME		;YES, IGNORE FLAGS
	MOVE	T2,.RBSTS(P2)	;GET FILE FLAGS
	MOVSI	T3,-LN$FLG	;FLAG TABLE LENGTH
SETFLG:	TDNE	T2,RIBFLG(T3)	;IF RIB FLAG SET,
	IOR	T1,BKPFLG(T3)	; SET CORRESPONDING BACKUP FLAG
	AOBJN	T3,SETFLG	;LOOP
	MOVEM	T1,A$FLGS(P1)	;STORE FLAGS

SETIME:	LDB	T1,[POINTR (.RBPRV(P2), RB.CRT)];GET CREATION TIME
	IMULI	T1,^D60000	;CONVERT TO MILLISECONDS
	LDB	T2,[POINTR (.RBEXT(P2) ,RB.CRX)];HIGH ORDER CREATION BITS
	LSH	T2,^D12		;POSITION
	LDB	T3,[POINTR (.RBPRV(P2), RB.CRD)];LOW ORDER CREATION BITS
	IOR	T2,T3		;UNITE
	PUSHJ	P,CONVDT	;CONVERT TO UNIVERSAL DATE/TIME
	MOVEM	T1,A$WRIT(P1)	;STORE DATE/TIME
	MOVE	T1,.RBALC(P2)	;NUMBER BLOCKS ALLOCATED
	ASH	T1,7		;WORDS PER BLOCK
	MOVEM	T1,A$ALLS(P1)	;STORE NBR WORDS ALLOCATED
	LDB	T1,[POINTR (.RBPRV(P2), RB.MOD)];GET MODE
	MOVEM	T1,A$MODE(P1)	;STORE
	MOVEI	T2,^D36		;ASSUME BINARY
	CAIG	T1,.IOASL	;SEE IF ASCII
	MOVEI	T2,7		;YES--CORRECT BYTE SIZE
	MOVEM	T2,A$BSIZ(P1)	;STORE BYTE SIZE
	MOVE	T2,.RBSIZ(P2)	;GET SIZE IN WORDS
	CAIG	T1,.IOASL	;SEE IF ASCII MODE
	IMULI	T2,5		;YES--GET SIZE IN BYTES
	TLZ	T2,(1B0)	;MAKE SURE BIT 0 IS CLEARED
	MOVEM	T2,A$LENG(P1)	;STORE LENGTH IN BYTES
	SKIPG	T1,.FXVER(SP)	;GET VERSION FROM USER, IF SET
	MOVE	T1,.RBVER(P2)	;IF NOT, USE VERSION FROM FILE
	MOVEM	T1,A$VERS(P1)	;STORE VERSION ON TAPE
	SKIPE	T1,S.INTR##	;SEE IF /INTERCHANGE
	POPJ	P,		;YES--THAT'S ALL FOR O$FILE
;HERE TO FILL REST OF O$FILE BLOCK FOR NON-INTERCHANGE MODE

	LDB	T2,[POINTR (.RBEXT(P2), RB.ACD)];GET ACCESS DATE
	PUSHJ	P,CONVDT	;CONVERT TO SMITHSONIAN
	MOVEM	T1,A$REDT(P1)	;STORE
	LDB	T1,[POINTR (.FXMOD(SP),FX.PRO)];GET /PROTECTION
	LDB	T2,[POINTR (.FXMOM(SP),FX.PRO)];SEE IF SET
	SKIPN	T2		;IF SET, USE IT
	LDB	T1,[POINTR (.RBPRV(P2),RB.PRV)];USE RIB PROTECTION
	PUSHJ	P,SETPRO	;CONVERT TO BACKUP PROTECTION
	MOVEM	T1,A$PROT(P1)	;STORE
	MOVE	T1,.RBTIM(P2)	;GET MONITOR SET CREATION DATE/TIME
	MOVEM	T1,A$MODT(P1)	;STORE
	SKIPG	T1,.FXEST(SP)	;GET USER ESTIMATE, IF SET
	MOVE	T1,.RBEST(P2)	;IF NOT, USE FILE ESTIMATE

	ASH	T1,7		;CONVERT TO WORD ESTIMATE
	MOVEM	T1,A$ESTS(P1)	;STORE
	MOVE	T1,.RBPOS(P2)	;GET LOGICAL BLOCK NUMBER
	ASH	T1,7		;CONVERT TO LOGICAL DISK ADDRESS
	MOVEM	T1,A$RADR(P1)	;STORE
	MOVE	T1,.RBNCA(P2)	;SAVE CUSTOMER WORDS
	MOVEM	T1,A$USRW(P1)	; ...
	MOVE	T1,.RBPCA(P2)	; ...
	MOVEM	T1,A$PCAW(P1)	; ...
	MOVSI	T3,440700	;MAKE ASCII BYTE POINTER
	HRRI	T3,LN$AFH	;POINT TO END OF FIXED HEADER SUBBLOCK
	SKIPE	T1,.RBSPL(P2)	;GET ANNOTATION IN SIXBIT
	MOVEM	T3,A$NOTE(P1)	;STORE ANNOTATION STRING BYTE POINTER
	ADDI	T3,M+201(MH)	;ADJUST FOR PHYSICAL ADDRESS
	PUSHJ	P,SETASZ	;STORE ASCIZ STRING
	MOVE	T2,T3		;COPY BYTE POINTER
	SUBI	T2,M+201(MH)	;MAKE RELATIVE BYTE POINTER
	SKIPE	T1,.RBAUT(P2)	;GET AUTHOR PPN
	MOVEM	T2,A$CUSR(P1)	;STORE CREATOR STRING BYTE POINTER
	PUSHJ	P,SETPPN	;STORE ASCIZ STRING
	SKIPN	T1,.RBMTA(P2)	;GET REEL ID OF LAST TAPE
	POPJ	P,		;IF NULL, DONE
	MOVE	T2,T3		;COPY NEW BYTE POINTER
	SUBI	T2,M+201(MH)	;MAKE RELATIVE BYTE POINTER
	MOVEM	T2,A$BKID(P1)	;STORE BP TO LAST BACKUP TAPE
				;FALL INTO SETASZ
;+
;<SETASZ IS A SUBROUTINE TO CONVERT A <SIXBIT WORD TO AN <ASCIZ STRING.
;^CALLED WITH ^T1 = <SIXBIT WORD AND ^T3 = <ASCII BYTE POINTER. ^USES ^T1-^T3.
;-

SETASZ:	JUMPE	T1,CPOPJ	;NOTHING TO STORE
	PUSHJ	P,STASSX	;CONVERT TO ASCII STRING
	MOVEI	T1,0		;NULL
	JRST	STASCH		;SET NULL & RETURN

;+
;<SETPRO IS A SUBROUTINE TO RETURN THE <BACKUP PROTECTION WORD FROM
;THE <TOPS-10 PROTECTION VALUE. ^CALL WITH ^T1 = <TOPS-10 PROTECTION,
;RETURNS <BACKUP PROTECTION IN ^T1. ^USES ^T1-^T4.
;-

SETPRO:	MOVE	T3,T1		;COPY PROTECTION
	SETZB	T1,T2		;CLEAR
	LSHC	T2,^D30		;POSITION PROGRAMMER PROTECTION IN T2
	PUSHJ	P,SETPRT	;SET OWNER ACCESS FIELD
	LSH	T1,^D8		;POISTION
	MOVEI	T2,0		;ZILCH
	LSHC	T2,3		;GET PROJECT PROTECTION IN T2
	PUSHJ	P,SETPRT	;SET AFFINITY GROUP ACCESS FIELD
	LSH	T1,^D8		;POSITION
	MOVEI	T2,0		;ZILCH
	LSHC	T2,3		;GET RIB WORLD PROTECTION
	PUSHJ	P,SETPRT	;SET WORLD ACCESS FIELD
	TLO	T1,(5B2)	;SET "5"
	POPJ	P,		;RETURN WITH PROTECTION IN T1

;+
;<SETPRT IS A SUBROUTINE TO SET A <BACKUP FILE ACCESS SUBFIELD. ^CALLED WITH
;^T2 = <TOPS-10 PROTECTION DIGIT, RETURNS WITH ACCESS SUBFIELD SET IN ^T1.
;^CLOBBERS ^T4.
;-

SETPRT:	MOVEI	T4,1		;ASSUME 1 FOR ATTRIBUTE ACCESS VALUE
	CAIG	T2,5		;SEE IF PROTECTION GREATER THAN FIVE
	ADDI	T4,1		;NO, STEP ATTRIBUTE ACCESS
	CAIG	T2,1		;SEE IF RIB PROTECTION > 1
	ADDI	T4,5		;NO, INCREMENT ACCESS FIELD
	SKIPG	T2		;SEE IF EQUAL TO ZERO
	SUBI	T4,1		;YES--ACCESS = 6
	DPB	T4,[POINTR (T1,PR$ATR)];SET ATTRIBUTE SUBFIELD

;HERE TO SET THE WRITE PROTECTION BITS

	MOVEI	T4,0		;START WITH ZERO
	CAIG	T2,4		;SEE IF RIB PROTECTION > 4
	ADDI	T4,1		;INCREMENT WRITE ACCESS SUBFIELD
	CAIG	T2,3		;CHECK RIB PROTECTION
	ADDI	T4,1		;INCREMENT WRITE ACCESS SUBFIELD
	CAIG	T2,2		;CHECK RIB PROTECTION
	ADDI	T4,1		;INCREMENT WRITE ACCESS SUBFIELD
	DPB	T4,[POINTR (T1, PR$WRT)];SET WRITE ACCESS SUBFIELD

;HERE TO SET READ PROTECTION BITS
	MOVEI	T4,0		;START WITH ZERO
	CAIG	T2,6		;CHECK RIB PROTECTION
	ADDI	T4,1		;INCREMENT READ ACCESS SUBFIELD
	CAIG	T2,5		;CHECK RIB PROTECTION
	ADDI	T4,1		;STEP READ ACCESS SUBFIELD
	DPB	T4,[POINTR (T1, PR$RED)];SET READ ACCESS SUBFIELD
	POPJ	P,		;RETURN
;+
;<SETASC IS A SUBROUTINE TO PUT A FILE'S CANONICAL FULL PATH NAME IN THE
;TAPE RECORD IN <O$NAME BLOCK FORMAT. ^SUB-BLOCKS APPEAR IN THE STANDARD
;ORDER: DEVICE, DIRECTORIES (TOP DOWN), FILE NAME, EXTENSION.
;^CALLED WITH  ^T1 = DIRECTORY LEVEL OR <.FXLND IF FILE.
;^INPUT FROM ALIAS INFO, OUTPUT PLACED AT <M(MH).
;^RETURNS CHECKSUM OF <O$NAME BLOCK IN ^T1. ^USES ^T1-^T4.
;-

SETASC:	PUSHJ	P,SAVE2		;SAVE SOME ACS
	SAVE$	T1		;SAVE LEVEL FOR LATER
	MOVEI	T1,200		;LENGTH OF BLOCK
	ADDM	T1,G$LND(MH)	;ADD TO TOTAL
	HRLI	T1,O$NAME	;INDICATE BLOCK TYPE
	MOVEM	T1,M(MH)	;STORE CONTROL WORD
	MOVEI	P1,M+1(MH)	;INITIALIZE SUB-BLOCK POINTER
	MOVE	T1,ACSTR	;GET DEVICE
	MOVEI	T2,.FCDEV	;DEVICE DATA TYPE
	PUSHJ	P,SETBLK	;SET SUB-BLOCK
	SKIPE	S.INTR##	;SEE IF /INTERCHANGE
	JRST	SETAS2		;YES--SKIP PATH INFO

	MOVN	P2,(P)		;GET NEGATIVE LEVEL OR .FXLND IF FILE
	HRLZS	P2		;FORM AOBJN WORD
SETAS1:	SKIPN	T1,APATH+.PTPPN(P2);SEE IF THIS ONE SET
	JRST	SETAS2		;NO--ALL DONE WITH DIRECTORIES
	MOVEI	T2,.FCDIR(P2)	;GET TYPE CODE
	PUSHJ	P,SETBLK	;SET SUB-BLOCK
	AOBJN	P2,SETAS1	;LOOP DOWN SFD CHAIN

SETAS2:	RSTR$	P2
	CAIE	P2,.FXLND	;SEE IF FILE
	JRST	SETAS3		;SKIP FOLLOWING IF DIRECCTORY
	MOVE	T1,ACNAM	;GET FILE NAME
	MOVEI	T2,.FCNAM	;INDICATE FILE NAME
	PUSHJ	P,SETBLK	;SET SUB-BLOCK
	HLLZ	T1,ACEXT	;GET EXTENSION
	MOVEI	T2,.FCEXT	;INDICATE TYPE
	PUSHJ	P,SETBLK	;SET SUB-BLOCK

;HERE TO COMPUTE CHECKSUM OF THE O$NAME BLOCK

SETAS3:	SETZ	T1,		;CLEAR FOR CHECKSUM
	MOVSI	T2,-200		;LENGTH OF BLOCK
	HRRI	T2,M(MH)	;START OF BLOCK
SETAS4:	ADD	T1,(T2)		;CHECKSUM O$NAME BLOCK
	ROT	T1,1		; ...
	AOBJN	T2,SETAS4	; ...
	POPJ	P,		;RETURN WITH CHECKSUM IN T1
;+
;<SETBLK IS A SUBROUTINE CALLED BY <SETASC TO SET CONSECUTIVE SUB-BLOCKS
;IN THE <O$NAME BLOCK. ^CALLED WITH ^T1 = PATH FIELD, ^T2 = PATH TYPE CODE.
;^ASSUMES ^P1 = ADDRESS TO START SUB-BLOCK.
;^UPDATES ^P1 TO FIRST ADDRESS PAST SUB-BLOCK. ^USES ^T1-^T4.
;-

SETBLK:	JUMPE	T1,CPOPJ	;OMIT SUB-BLOCK IF NULL PATH FIELD
	HRLM	T2,(P1)		;STORE PATH TYPE CODE
	MOVSI	T3,440700	;MAKE ASCII BYTE POINTER
	HRRI	T3,1(P1)	;START ADDRESS FOR ASCIZ STRING
	MOVEI	T4,SETASZ	;ASSUME SIXBIT CONVERSION ROUTINE
	CAIN	T2,.FCDIR	;SEE IF UFD
	MOVEI	T4,SETPPN	; YES--USE PPN CONVERSION ROUTINE
	PUSHJ	P,(T4)		;STORE ASCIZ STRING
	HRRZS	T3		;CLEAR LEFT HALF
	SUBI	T3,-1(P1)	;COMPUTE LENGTH OF SUB-BLOCK
	HRRM	T3,(P1)		;STORE IN CONTROL WORD
	ADD	P1,T3		;UPDATE POINTER
	POPJ	P,		;RETURN

;+
;<SETPPN IS A SUBROUITNE TO CONVERT A <PPN TO AN <ASCIZ STRING. ^THE PROJECT
;AND PROGRAMMER NUMBERS ARE SEPARATED BY AN UNDERLINE CHARACTER.
;^CALLED WITH ^T1 = <PPN AND ^T3 = <ASCII BYTE POINTER. ^USES ^T1-^T4.
;-

SETPPN:	SKIPN	T4,T1		;SAVE COPY FOR LATER
	POPJ	P,		;RETURN IF PPN NULL
	HLRZS	T1		;POSITION PROJECT NBR
	PUSHJ	P,STASOC	;SET ASCII STRING
	MOVEI	T1,"_"		;USE UNDERLINE AS DIVIDER
	IDPB	T1,T3		;SET IN STRING
	HRRZ	T1,T4		;GET PROGRAMMER NBR
	PUSHJ	P,STASOC	;SET ASCII STRING
	MOVEI	T1,0		;NULL
	JRST	STASCH		;SET NULL & RETURN

;+
;<STASSX IS A SUBROUTINE TO CONVERT A <SIXBIT WORD TO AN <ASCII STRING.
;^CALLED WITH ^T1 = <SIXBIT WORD AND ^T3 = <ASCII BYTE POINTER. ^USES ^T1-^T3.
;-

STASSX:	MOVE	T2,T1		;POSITION VALUE
STASS1:	JUMPE	T2,CPOPJ	;RETURN WHEN DONE
	MOVEI	T1,0		;CLEAR ACCUMULATOR
	LSHC	T1,6		;GET NEXT CHARACTER
	SKIPN	T1		;IF BLANK,
	MOVEI	T1,'?'		; FLAG PROBLEM
	ADDI	T1," "-' '	;CONVERT TO ASCII
	PUSHJ	P,STASCH	;SET CHARACTER
	JRST	STASS1		;LOOP
;+
;<STASOC IS A SUBROUTINE TO CONVERT AN OCTAL NUMBER TO AN <ASCII STRING.
;^CALL WITH ^T1 = OCTAL VALUE AND ^T3 = <ASCII BYTE POINTER. ^USES ^T1-^T3.
;-

STASOC:	IDIVI	T1,10		;SPLIT DIGIT
	HRLM	T2,(P)		;STORE DIGIT
	SKIPE	T1		;UNLESS DONE,
	PUSHJ	P,STASOC	; DO IT AGAIN
	HLRZ	T1,(P)		;GET BACK DIGIT
	ADDI	T1,"0"		;CONVERT TO ASCII
				;FALL INTO STASCH

;+
;<STASCH IS A SUBROUTINE TO OUTPUT A CHARACTER TO A STRING.
;^CALL WITH ^T1 = CHARACTER AND BYTE POINTER IN ^T3.
;-

STASCH:	IDPB	T1,T3		;POINTER IS IN T3
	POPJ	P,		;RETURN

;+
;<SETPTH IS A SUBROUTINE TO STORE FILE PATH INFOMATION IN THE FORMAT:
;<BYTE (7) DATA TYPE, LENGTH IN WORDS, <ASCII CHARACTERS (<F$PTH FORMAT).
;^CALLED WITH ^T1 = FILE INFO, ^T2 = DATA TYPE, BYTE POINTER IN ^T3.
;^USES ^T1-^T4.
;-

SETPTH:	JUMPE	T1,CPOPJ	;OMIT IN F$PTH IF NULL
	IDPB	T2,T3		;SET DATA TYPE
	MOVE	T4,T3		;SAVE COPY OF BP FOR LATER
	IBP	T3		;INCREMENT BP
	CAIE	T2,.FCDIR	;SEE IF DIRECTORY
	JRST	SETPT1		;NO, MUST BE SIXBIT WORD
	SAVE$	T1		;SAVE COPY FOR LATER
	HLRZS	T1		;GET PROJECT NUMBER
	PUSHJ	P,STASOC	;CONVERT TO ASCII STRING
	MOVEI	T1,"_"		;UNDERLINE
	IDPB	T1,T3		;SET UNDERLINE IN STRING
	RSTR$	T1		;GET PROGRAMMER NUMBER BACK
	HRRZS	T1		;CLEAR LEFT HALF
	PUSHJ	P,STASOC	;CONVERT TO ASCII
	SKIPA			;SKIP SIXBIT CONVERSION
SETPT1:	PUSHJ	P,STASSX	;CONVERT SIXBIT WORD TO ASCII STRING
	ADDI	T3,1		;ADVANCE TO NEXT LOCATION
	HRLI	T3,440700	;MAKE NEW BP
	HRRZ	T2,T3		;CALCULATE # OF WORDS USED
	SUBI	T2,(T4)		;...
	IDPB	T2,T4		;SAVE IN PROPER PLACE
	POPJ	P,		;RETURN
	SUBTTL	TAPE TO DISK MAIN ROUTINES

;+
;.CHAPTER TAPE TO DISK MAIN ROUTINES
;-

;+
;<CHKALL IS THE <CHECK COMMAND ENTRY POINT TO THE TAPE READ ROUTINE.
;^FOR THE <CHECK VERB, DISK FILES ARE READ (INSTEAD OF WRITTEN) AND
;COMPARED WORD BY WORD WITH THE TAPE FILES. "^INPUT" IS SET AS THE
;OPERATION FOR DISK <I/O, AND THE <COMPAR SUBROUTINE IS SET
;FOR LATER USE INSTEAD OF A <BLT INSTRUCTION.
;-

CHKALL:	TXO	F,FL$CHK	;INDICATE /CHECK
	MOVE	T1,[PUSHJ P,COMPAR] ;COMPARE DATA
	MOVEI	T2,DSKIN	;INPUT FROM DISK
	JRST	CHKRST		;GO TO COMMON HANDLER
;+
;<RSTALL IS THE ENTRY POINT TO THE TAPE READ ROUTINE FOR THE <RESTORE AND
;<PRINT COMMANDS. "^OUTPUT" IS SET AS THE DISK <I/O OPERATION AND A <BLT
;INSTRUCTION TO TRANSFER DATA FROM THE TAPE TO DISK BUFFERS IS SET
;FOR LATER EXECUTION INSTEAD OF THE <COMPAR SUBROUTINE.
;-

RSTALL:	TXZ	F,FL$CHK	;INDICATE NOT /CHECK
	MOVE	T1,[BLT T1,(T2)] ;COPY DATA
	MOVEI	T2,DSKOUT	;OUTPUT TO DISK


;+
;<CHKRST MARKS THE START OF COMMON CODE FOR THE TAPE READ ROUTINE.
;^IF A PARTICULAR SAVE SET HAS BEEN SPECIFIED, THE TAPE IS SEARCHED
;FROM THE CURRENT POSITION TO <EOT FOR THE START OF THE SAVE SET.
;^OTHERWISE, READING BEGINS FROM THE CURRENT TAPE POSITION.
;^THE CODE BRANCHES BASED ON THE TYPE OF RECORD IN THE TAPE BUFFER.
;-

CHKRST:	MOVEM	T1,DSKBLT	;SAVE OPERATION
	MOVEM	T2,DSKIO	;SAVE DISK ROUTINE
	PUSHJ	P,SAVE3		;SAVE C(P1), C(P2) & C(P3)

	SETZM	PRESTR		;ZERO LAST STR WORD
	SETZM	PREPPN		;ZERO LAST PPN WORD

	MOVEI	T1,NRIB*.FXLND	;WORDS FOR UFD & SFD RIBS
	PUSHJ	P,UCORE		;GET IT
	  POPJ	P,		;LOSE--BACK TO BACKUP
	MOVEM	P1,ADRLST	;SAVE FOR LATER

	SKIPE	P2,S.SSNM##	;SAVE SET SPECIFIED?
	CAMN	P2,[ASCII/ALL/]	; AND NOT "ALL"
	JRST	RSTREC		;NO--PUNT
;HERE TO FIND THE USER SPECIFIED SAVE SET ON TAPE

SPCSET:	PUSHJ	P,XMTAIN	;GET RECORD
	  SKIPA			;HERE ON EOF OR KILL
	JRST	SAVSET		;SEE IF SAVE SET RECORD
	TXNE F,FL$KIL		;SEE IF USER TYPED KILL
	POPJ P,			;YES, RETURN TO BACKUP
	TXNN F,FL$EF2		;EOT?
	JRST SPCSET		;NO, CONTINUE
	WARN$N (SNF,Save set not found)
	OUTSTR	S.SSNM##	;TELL WHICH
	OUTSTR	CRLF		;
	POPJ P,			;LOSE

SAVSET:	MOVE	T1,G$TYPE(MH)	;GET RECORD TYPE
	CAIE	T1,T$CON	;CONTINUE SAVE?
	CAIN	T1,T$BEG	;START OF SAVE?
	SKIPA			;YES
	JRST	SPCSET		;NEITHER--KEEP GOING

	MOVEI	T3,M(MH)	;START OF DATA AREA
	ADD	T3,G$LND(MH)	;END OF NON-DATA PORTION
	CAILE	T3,MTBFSZ(MH)	;RANGE CHECK, IN CASE JUNK ON TAPE
	MOVEI	T3,MTBFSZ(MH)	;USE MAX
	SKIPA	T1,MDATA	;LOAD START ADDRESS
FNDSSN:	ADD	T1,(T1)		;POINT TO NEXT BLOCK
	CAIG	T3,(T1)		;SEE IF DONE
	JRST	SPCSET		;YES, SAVE SET NOT SPECIFIED ON TAPE, SO REJECT
	HLRZ	T2,(T1)		;GET BLOCK TYPE CODE
	CAIE	T2,O$SSNM	;RIGHT ONE?
	JRST	FNDSSN		;NO, KEEP LOOKING

;HERE TO SEE IF SAVE SET NAMES MATCH (IGNORE UPPER/LOWER CASE DIFFERENCES)

	HRRZ	P1,(T1)		;GET LENGTH OF SSNAME BLOCK
	SOS	P1		;MINUS CONTROL WORD
	IMULI	P1,5		;GET COUNT OF CHARACTERS
	MOVSI	T3,440700	;MAKE ASCII BYTE POINTER TO USER SSNAME
	HRRI	T3,S.SSNM##	;ADDRESS OF USER SUPPLIED NAME
	ADDI	T1,1		;STEP TAPE POINTER
	HRLI	T1,440700	;MAKE ASCII BYTE POINTER TO TAPE SSNAME
CHKSSN:	SOJL	P1,SPCSET	;REJECT IF TAPE OVERFLOW
	ILDB	T2,T1		;GET CHARACTER FROM TAPE
	CAIL	T2,"a"		;SEE IF LOWER CASE ALPHABETIC
	CAILE	T2,"z"		; ...
	SKIPA			;NOT.
	SUBI	T2,40		;CONVERT TO UPPER CASE
	ILDB	T4,T3		;GET CHARACTER FROM USER SSNAME
	CAIL	T4,"a"		;SEE IF LOWER CASE ALPHABETIC
	CAILE	T4,"z"		; ...
	SKIPA			;NOT.
	SUBI	T4,40		;CONVERT TO UPPER CASE
	CAME	T2,T4		;COMPARE CHARACTERS
	JRST	SPCSET		;NO MATCH
	SKIPE	T2		;DONE IF NULL FOUND
	JRST	CHKSSN		;LOOP FOR MORE CHARACTERS
	PUSHJ	P,LSTXXX	;LIST RECORD
;HERE TO GET A TAPE RECORD AND DISPATCH BY RECORD TYPE

RSTREC:	PUSHJ	P,XMTAIN	;GET A BUFFER
	  JRST	[TXNE	F,FL$EF2;EOT?
		 AOSA	(P)	; YES--GIVE OPERATION DONE RETURN
		 TXNE	F,FL$KIL ;/KILL?
		 POPJ	P,	;RETURN TO BACKUP (NON-SKIP IF KILL)
		 JRST RSTREC]	;CONTINUE

	MOVE	T1,G$TYPE(MH)	;GET RECORD TYPE
	CAIN	T1,T$END	;END OF SAVE?
	JRST	HAVEND		;YES

	CAIN	T1,T$UFD	;IS IT UFD DATA?
	JRST	[PUSHJ	P,HAVUFD;YES--CREATE RIB
		 JRST	RSTREC]	;CONTINUE

	CAIN	T1,T$FIL	;IS IT FILE DATA?
	JRST	HAVFIL		;YES--CHECK IT OUT

	CAIE	T1,T$CON	;CONTINUATION OF SAVE SET?
	CAIN	T1,T$BEG	;START OF NEW SAVE SET?
	JRST	[PUSHJ P,LSTXXX	;YES, LIST IT AND
		 JRST  RSTREC]   ;CONTINUE

	JUMPLE	T1,NOSUCH	;UNRECOGNIZABLE RECORD TYPE
	CAIG	T1,T$MAX	;KNOW OF IT?
	JRST	RSTREC		;YES--CONTINUE READING

NOSUCH:	WARN$N	(URT,Unknown record type)
	PUSHJ	P,OCTOUT	; ..
	OUTSTR	CRLF		;<CR><LF>
	JRST	RSTREC		;GET NEXT

;HERE IF HAVE T$END TYPE RECORD IN BUFFER

HAVEND:	PUSHJ	P,LSTXXX	;LIST RECORD
	MOVE	T1,S.SSNM##	;SAVE SET SPECIFIED?
	CAMN	T1,[ASCII/ALL/]	; AND NOT "ALL"
	JRST	RSTREC		;NO--KEEP GOING
	JRST	CPOPJ1		;YES--THIS MUST BE END
;+
;<HAVUFD IS A SUBROUTINE CALLED TO RECREATE THE DIRECTORY <RIB FROM
;THE CURRENT TAPE <T$UFD RECORD. ^OUPUT PLACED AT <ADRLST _+ (36 _* LEVEL).
;^THE <RIB IS USED IF IT IS NECESSARY TO CREATE THE DIRECTORY
;IN ORDER TO RESTORE THE FILE TO THE USER SPECIFIED PATH.
;-

HAVUFD:	SKIPE	S.INTR##	;SEE IF /INTERCHANGE,
	POPJ	P,		;YES, IGNORE T$UFD RECORDS
	PUSHJ	P,SAVE3		;MAKE SOME ROOM
	SKIPL	P2,D$LVL(MH)	;GET UFD LEVEL
	CAILE	P2,.FXLND-1	;SEE IF LEVEL IN RANGE
	POPJ	P,		; IF NOT, DROP RECORD
	IMULI	P2,NRIB		;WORDS PER RIB
	ADD	P2,ADRLST	;ADD IN BASE ADDRESS

;HERE TO RE-CREATE DIRECTORY RIB FROM T$UFD RECORD

	MOVE	P3,MDATA	;GET START OF DATA
	ADD	P3,G$LND(MH)	;POINT TO END
	SKIPA	P1,MDATA	;GET START ADDRESS AND SKIP
GETRIB:	ADD	P1,(P1)		;ADD LENGTH OF NON-DATA BLOCK
	CAIG	P3,(P1)		;END OF NON-DATA YET?
	POPJ	P,		;YES--DROP RECORD
	HLRZ	T1,(P1)		;GET BLOCK TYPE CODE
	HRRZS	P1		;PREVENT ILL MEM REF AT RSTRIB	[207]
	CAIE	T1,O$FILE	;IS IT O$FILE?			[216]
	JRST	GETRI1		;NO				[216]
	SETZM	(P2)		;INITIALIZE RIB BLOCK		[216]
	HRLI	T2,(P2)		; --				[216]
	HRRI	T2,1(P2)	; --				[216]
	BLT	T2,NRIB-1(P2)	; DOIT				[216]
	PUSHJ	P,RSTRIB	;CONVERT TO RIB
GETRI1:	HLRZ	T1,(P1)		;GET BLOCK TYPE BACK		[216]
	CAIE	T1,O$DIRT	;IS IT O$DIRT?
	JRST	GETRIB		;NO--LOOP

;HERE TO FILL IN PROTECTION AND QUOTAS FROM O$DIRT BLOCK

	ADDI	P1,1		;POINT TO DIRECTORY DATA
	LDB	T1,[POINTR (D$PROT(P1), AC$OWN)];GET OWNER ACCESS
	LSH	T1,3		;SHIFT PROGRAMMER PROTECTION
	LDB	T2,[POINTR (D$PROT(P1), AC$GRP)];GET GROUP ACCESS
	IOR	T1,T2		;UNITE PROGRAMMER & PROJECT PROTECTIONS
	LSH	T1,3		;POSITION PROTECTIONS
	LDB	T2,[POINTR (D$PROT(P1), AC$WLD)];GET WORLD ACCESS
	IOR	T1,T2		;UNITE
	DPB	T1,[POINTR (.RBPRV(P2), RB.PRV)];SET RIB PROTECTION

	MOVE	T1,D$QTF(P1)	;GET FCFS LOGGED IN QUOTA IN WORDS
	IDIVI	T1,200		;COMPUTE QUOTA IN BLOCKS
	SKIPE	T2		;SEE IF OVERFLOW
	AOS	T1		;YES, ONE MORE BLOCK
	MOVEM	T1,.RBQTF(P2)	;SET QUOTA IN RIB
	MOVE	T1,D$QTO(P1)	;GET LOGGED OUT QUOTA IN WORDS
	IDIVI	T1,200		;COMPUTE QUOTA IN BLOCKS
	SKIPE	T2		;SEE IF OVERFLOW
	AOS	T1		;YES, ONE MORE BLOCK
	MOVEM	T1,.RBQTO(P2)	;SET QUOTA IN RIB
	POPJ	P,		;RETURN
;+
;^A BRANCH TO <HAVFIL OCCURS TO HANDLE FILE DATA RECORDS. ^MUST HAVE
;START OF FILE RECORD, UNLESS </RESUME WAS TYPED. ^FILE IDENTIFICATION
;INFO IS READ FROM THE <O$NAME BLOCK, OR THE RECORD HEADER IF RESUMING.
;^THEN THE USER'S SPECS AND SWITCHES ARE CHECKED AGAINST THE TAPE FILE,
;AND <RSTFIL IS CALLED IF THE TAPE FILE SHOULD BE RESTORED.
;-

HAVFIL:	MOVX	T1,GF$SOF	;START OF FILE?
	TDNN	T1,G$FLAG(MH)	;SEE IF FLAG SET
	JRST	[SKIPE	S.WRIT## ;NOT. SEE IF /NOWRITE
		 SKIPN	S.RSUM## ;UNLESS /RESUME,
		 JRST	RSTREC   ;DROP RECORD
		 SETZ	P2,	;FLAG TO USE RECORD HEADER INFO
		 JRST	GETINF] ;GO GET INFO FROM TAPE RECORD HEADER

	MOVE	P2,MDATA	;GET ADDRESS OF START OF DATA
	HLRZ	T1,(P2)		;GET BLOCK TYPE
	CAIE	T1,O$NAME	;SHOULD BE O$NAME BLOCK
	JRST	RSTREC		;BALK IF NOT

	MOVEI	P1,1(P2)	;FIRST O$NAME SUB-BLOCK
	HRRZ	T1,(P2)		;LENGTH OF O$NAME BLOCK
	ADD	P2,T1		;POINT TO END OF O$NAME BLOCK

;HERE TO GET THE PATH INFO FROM THE O$NAME BLOCK OR RECORD HEADER IF P2 = 0.

GETINF:	MOVSI	T1,'DSK'	;SET DSK AS DEVICE FOR INTERCHANGE MODE
	SKIPE	T2,S.INTR##	;SEE IF INTERCHANGE MODE
	MOVEM	T1,CSTR		; YES--SET DEVICE
	JUMPG	T2,GETNAM	; AND SKIP COPYING PATH INFO FROM TAPE

	MOVEI	T1,.FCDEV	;INDICATE DATA TYPE
	PUSHJ	P,GETDAT	;GET DEVICE NAME
	MOVEM	T1,CSTR		;STORE

	MOVE	SP,S.FRST	; ADDRESS OF SPECS		[175]
	MOVE	T1,.FXDEV(SP)	; THE OUTPUT DEVICE NAME	[175]
	SETOM	CSTRFL		; SET STR FLAG FOR "ALL"	[175]
	CAMN	T1,[SIXBIT/ALL/]; AND SKIP IF ITS NOT		[175]
	JRST	GETIN1		; IT IS "ALL"			[175]
	MOVSI	T2,777700	; NOW TRY FOR "DSK"		[175]
	MOVEM	T2,CSTRFL	; FLAG FOR "DSK"		[175]
	CAMN	T1,[SIXBIT/DSK/]; IS IT "DSK" ?			[175]
	JRST	GETIN1		; YES				[175]


	MOVE	T2,S.NGST	;LOAD AOBJN WORD TO STR TABLE
	CAME	T1,S.STRS##(T2)	;FIND MATCH IN STR TABLE
	AOBJN	T2,.-1		;LOOP
	MOVSI	T3,(1B0)	;SET BIT ZERO
	MOVNI	T1,(T2)		;SET SHIFT ARG
	SKIPL	T2		;IF NO MATCH,
	TDZA	T3,T3		;CLEAR T3
	LSH	T3,(T1)		;SHIFT TO CORRECT BIT
	MOVEM	T3,CSTRFL	;SAVE STR FLAG

GETIN1:	MOVSI	T2,-.FXLND	;START AT UFD LEVEL		[175]
GETPTH:	SAVE$	T2		;SAVE C(T2)
	MOVEI	T1,.FCDIR(T2)	;INDICATE WHICH DIRECTORY
	PUSHJ	P,GETDAT	;GET DIRECTORY NAME
	RSTR$	T2		;RESTORE C(T2)
	MOVEM	T1,PTHBLK+.PTPPN(T2);STORE
	SKIPE	T1		;DONE IF NULL
	AOBJN	T2,GETPTH	;LOOP
	MOVEM	T1,PTHBLK+.PTPPN(T2); ZERO THE REST OF PTHBLK	[177]
	AOBJN	T2,.-1		; DO IT				[177]
GETNAM:	MOVEI	T1,.FCNAM	;INDICATE FILE NAME
	PUSHJ	P,GETDAT	;GET FROM O$NAME BLOCK
	MOVEM	T1,CNAM		;STORE
	MOVEI	T1,.FCEXT	;INDICATE EXTENSION
	PUSHJ	P,GETDAT	;GET EXTENSION
	MOVEM	T1,CEXT		;STORE

;HERE TO CHECK FOR /INITIAL

	SKIPE	S.INTR##	;SEE IF /INTERCHANGE
	JRST	ININAM		;YES, IGNORE ANY INITIAL PATH
	SKIPN	T1,S.INIT+.FXDEV;SEE IF ANY INITIAL DEVICE
	JRST	GOTINI		;NO
	MOVE	T2,CSTRFL	;GET STRUCTURE FLAG
	CAME	T1,CSTR		;SEE IF EXACT MATCH
	TDNE	T2,S.INIT##+FX$STR;OR IF STR FLAGGED
	SKIPA			;YES, CHECK PATH
	JRST	RSTREC		;NO, DROP THIS FILE

	MOVSI	T1,-.FXLND	;CHECK ENTIRE PATH
	SETZ	T2,		;ZILCH
INIPTH:	SKIPN	T3,S.INIT+.FXDIR(T2)	;SEE IF ANY INITIAL DIRECTORY
	JRST	ININAM			;DONE, CHECK FILE NAME
	CAME	T3,PTHBLK+.PTPPN(T1)	;MATCH?
	JRST	RSTREC			;NO, DROP THIS FILE
	ADDI	T2,2			;NEXT
	AOBJN	T1,INIPTH		;LOOP FOR ALL

ININAM:	MOVE	T1,S.INIT+.FXNAM;GET INITIAL FILE NAME, IF ANY
	CAME	T1,CNAM		;MATCH?
	JUMPN	T1,RSTREC	;NO, DROP THIS FILE
	HLLZ	T2,S.INIT+.FXEXT;GET INITIAL EXT, IF ANY
	CAME	T2,CEXT		;MATCH?
	SKIPN	S.INIT+.FXEXT	;NO, OKAY IF NO EXTENSION SET
	SKIPA			;MATCH FOUND
	JRST	RSTREC		;DROP FILE
	SETZM	S.INIT+.FXDEV	;ZILCH
	SETZM	S.INIT+.FXNAM	; ...
	SETZM	S.INIT+.FXEXT	; ...

GOTINI:	MOVE	SP,S.FRST##	;ADDRESS OF SPECS

;HERE TO CHECK IF FILE MATCHES USER SPECS AND SWITCHES

RSTVER:	SKIPE	S.INTR##	;SEE IF /INTERCHANGE
	JRST	RSTVR2		;YES--ONLY FILE NAME AND EXT MUST MATCH
	PUSHJ	P,VER0		;COMPARE			[175]
	  JRST	RSTNOT		;NO GOOD
	AOS	FX$CNT+FX$LEN(SP);INDICATE SPEC DIRECTORY FOUND
RSTVR2:	PUSHJ	P,VER2		;COMPARE
	  JRST	RSTNOT		;NO GOOD

	SKIPE	S.RSUM##	;SEE IF /RESUME
	JRST	RSTYES		; YES, SKIP FOLLOWING
	HLRZ	T1,(P2)		;GET TYPE CODE OF NEXT BLOCK
	CAIE	T1,O$FILE	;CHECK IF O$FILE IS NEXT
	JRST	RSTYES		;NO--ASSUME GOOD
	MOVE	P1,P2		;COPY POINTER TO O$FILE
	MOVEI	T4,1(P1)	;MAKE POINTER TO ATTRIBUTE DATA

	MOVE	T1,A$LENG(T4)	;GET LENGTH IN BYTES
	SETZ	T2,		;ZILCH
	MOVE	T3,A$MODE(T4)	;GET MODE FROM TAPE
	CAIG	T3,.IOASL	;SEE IF ASCII
	IDIVI	T1,5		;CALCULATE LENGTH IN WORDS
	SKIPE	T2		;SEE IF REMAINDER,
	AOS	T1		; YES, ONE MORE WORD
	MOVEM	T1,CWSIZE	;STORE

	MOVE	T1,A$WRIT(T4)	;GET CREATION DATE/TIME
	MOVEM	T1,CCDATI	;STORE
	MOVE	T1,A$REDT(T4)	;GET ACCESS DATE
	MOVEM	T1,CADATI	;STORE
	MOVE	T1,A$MODT(T4)	;GET MONITOR SET DATE/TIME
	MOVEM	T1,CMDATI	;STORE FOR CHECKER

	PUSHJ	P,CHKLIM	;CHECK LIMITS
	  JRST	RSTNOT		;NO GOOD
	  JRST	[TXON  F,FL$D75;INDICATE GOOD ONLY BECAUSE /DATE75
		 MOVEM SP,D75ADR;SAVE POINTER
		 JRST  RSTNOT]	;AND PROCEED, NOT COUNTING MATCH

RSTYES:	TXON	F,FL$MAT	;MATCH?
	MOVEM	SP,SAVADR	;STORE
	AOS	FX$CNT(SP)	;COUNT MATCH

RSTNOT:	ADDI	SP,FX$LEN*2	;NEXT SPEC
	CAMGE	SP,S.LAST##	;SKIP IF DONE
	JRST	RSTVER		;CONTINUE

	TXZN	F,FL$MAT	;MATCH?
	JRST	[TXZN F,FL$D75	;NO--SEE IF DATE75 WIN
		 JRST LSTFNS	;NO--CONTINUE SCANNING TAPE	[172]
		 MOVE SP,D75ADR	;YES--RETRIEVE ADDRESS
		 JRST .+2]	;AND ACCEPT MATCH
	MOVE	SP,SAVADR	;YES. GET COPY OF ADDR

	PUSH	P,.JBFF##	;SAVE JOBFF
	PUSHJ	P,RSTFIL	;RESTORE FILE
	POP	P,.JBFF##	;RESTORE JOBFF

	TXZ	F,FL$OPN	;FILE WAS CLOSED
	SETZM	SUSDF		; CLEAR SUPERSEDING DSK FILE FLAG	[206]
	TXNE	F,FL$KIL	;SEE IF OPERATOR SAID KILL
	JRST	RSTKIL		;YES
	SETZM	CNAM		;INDICATE DONE WITH FILE FOR MASTRX ROUTINE
	JRST	CNTSCN		;CONTINUE SCANNING TAPE		[172]
;HERE TO PRINT FILES ON STRUCTURES NOT IN SYS SEARCH LIST

LSTFNS:	SKIPN	S.PRNT##	;IS THIS A "PRINT" OPERATION?	[172]
	JRST	CNTSCN		;  NO				[172]
	MOVE	T1,MDATA	;GET START OF DATA BLOCK	[172]
	ADDI	T1,200		;POINT TO O$FILE BLOCK		[172]
	PUSHJ	P,LSTFIL	;LIST THE FILE			[172]

CNTSCN:	MOVE	T1,S.SSNM##	;SAVE SET SPECIFIED?
	CAMN	T1,[ASCII/ALL/]	;AND NOT ALL?
	JRST	RSTREC		;NO--CONTINUE SCANNING TAPE FOR FILES

;HERE IF SAVE SET NAME IS NOT "ALL". STOP SCANNING IF SPEC LIST SATISFIED.

	SKIPA	SP,S.FRST##	;START ADDRESS OF SPEC LIST

SPCSAT:	ADDI	SP,FX$LEN*2	;NEXT SPEC PAIR
	CAML	SP,S.LAST##	;END OF SPEC LIST?
	JRST	CPOPJ1		;YES--ALL DONE
	SKIPN	FX$CNT+FX$LEN(SP);THIS DIRECTORY FOUND?
	JRST	RSTREC		;NO--CONTINUE LOOKING
	PUSHJ	P,VER0		;YES--IS IT THE CURRENT ONE?	[175]
	  JUMPE	T1,SPCSAT	;NO--PASSED IT			[204]
	SKIPN	FX$CNT(SP)	;YES--ANY FILES MATCH YET?
	JRST	RSTREC		;NO--KEEP LOOKING
	MOVE	T1,.FXNMM+FX$LEN(SP);GET FILENAME MASK
	CAME	T1,[-1]		;ANY WILD CARDS?
	JRST	RSTREC		;YES--CONTINUE SCAN OF TAPE
	HRRO	T1,.FXEXT+FX$LEN(SP);GET EXTENSION MASK
	CAME	T1,[-1]		;WILD?
	JRST	RSTREC		;YES--CONTINUE SCAN OF TAPE
	MOVSI	T2,-.FXLND+1	; NUMBER OF SFD'S		[213]
	HRRI	T2,.FXDIR+FX$LEN+2(SP) ; ADR OF FIRST ONE	[213]
SPCSA1:	SKIPN	(T2)		; ANY SFD'S?			[213]
	JRST	SPCSAT		; NO - SO DONE			[213]
	SKIPN	1(T2)		; ANY WILD SFD'S?		[213]
	JRST	RSTREC		; YES - KEEP LOOKING		[213]
	ADDI	T2,1		; INDEX BY TWO			[213]
	AOBJN	T2,SPCSA1	; CHECK EM ALL			[213]
	JRST	SPCSAT		;NO--THIS SPEC SATISFIED

RSTKIL:	MOVEI	T1,[ASCIZ/
	% RESTORE ABORTED
/]
	TXNE	F,FL$CHK	;SEE IF /CHECK
	MOVEI	T1,[ASCIZ/
	% CHECK ABORTED
/]
	SKIPE	S.PRNT##	;SEE IF /PRINT			[212]
	MOVEI	T1,[ASCIZ/
	% PRINT ABORTED
/]				;				[212]
	SKIPE	S.LIST		;SKIP IF LISTING NOT NEEDED
	PUSHJ	P,LSTMSG	;SEND MESSAGE TO LISTING FILE
	POPJ	P,		;QUIT NOW--RETURN TO BACKUP
;+
;<RSTFIL IS A ROUTINE TO RESTORE A SINGLE FILE FROM TAPE TO DISK.
;-

RSTFIL:	SETZM	CHKCNT		;CLEAR CHECK COUNT
	TXZ	F,FL$PAO!FL$TPE	;ZERO FLAGS

	SKIPN	S.WRIT##	;SEE IF /NOWRITE
	TXNE	F,FL$CHK	; UNLESS /CHECK
	SKIPA			;NEED TO INITIALIZE DISK CHANNELS
	JRST	TYPOUT		;SKIP UNNECESSARY CODE

;HERE TO COMPUTE ALIAS NAMES AND INITIALIZE CHANNELS

	PUSHJ	P,XALIAS	;DO ALIASING

;NOTE: CODE WHICH WAS HERE PREVIOUSLY TO SCATTER FILES
;OVER FILE STRUCTURE UNITS WAS DELETED SINCE 5.02 AND
;LATER MONITORS PERFORM THIS FUNCTION AUTOMATICALLY

	MOVEI	T1,.IODMP	;DUMP MODE
	MOVE	T2,ACSTR	;LOAD ALIAS STR NAME
	SETZ	T3,		;NO BUFFERS

	OPEN	UFD,T1		;OPEN CHANNEL FOR CREATING UFD
	  JRST	FAIL0		;LOSE

	MOVEI	T1,.IOBIN	;BUFFERED BINARY
	MOVSI	T3,DSKHDR	;OUTPUT BUFFER HEADER ADDDRESS
	TXNE	F,FL$CHK	;IF /CHECK
	MOVSS	T3		; USE FOR INPUT BUFFER

	OPEN	FILE,T1		;OPEN CHANNEL FOR WRITING FILE
	  JRST	FAIL0		;LOSE
	TXO	F,FL$OPN	;NOW DISK OUTPUT FILE IS OPEN

	SETZM	EXLFIL		;CLEAR EXTENDED ENTER BLOCK
	MOVE	T1,[EXLFIL,,EXLFIL+1]; ...
	BLT	T1,EXLFIL+NRIB-1; ...

;HERE TO FILL ENTER BLOCK

	MOVE	T1,ACNAM	;GET ALIAS FILE NAME
	MOVEM	T1,EXLFIL+.RBNAM;STORE IN ENTER BLOCK
	MOVE	T1,ACEXT	;GET ALIAS EXTENSION
	MOVEM	T1,EXLFIL+.RBEXT;STORE
	MOVE	T1,APATH+.PTPPN ;ASSUME UFD LEVEL
	SKIPE	APATH+.PTPPN+1	;SEE IF FILE LOCATED IN SFD,
	MOVEI	T1,APATH	; YES--SET UP PATH POINTER
	MOVEM	T1,EXLFIL+.RBPPN;STORE
	MOVEI	P2,EXLFIL	;SET ADDRESS OF ENTER BLOCK
	SKIPN	S.RSUM##	;SKIP IF RESUMING
	PUSHJ	P,RSTRIB	;FILL IN O$FILE INFO

;HERE TO RESET ENTER VALUES FROM USER OUTPUT SWITCHES

	LDB	T1,[POINTR (.FXMOD(SP),FX.PRO)] ;GET /PROTECTION FROM USER
	LDB	T2,[POINTR (.FXMOM(SP),FX.PRO)] ;SEE IF SET
	SKIPE	T2		;IF SET,
	DPB	T1,[POINTR (EXLFIL+.RBPRV,RB.PRV)] ;SET IN FILE

	SKIPLE	T1,.FXVER(SP)	;GET /VERSION FROM USER, IF SET
	MOVEM	T1,EXLFIL+.RBVER ;SET IN ENTER BLOCK

	SKIPLE	T1,.FXEST(SP)	;IF /ESTIMATE,
	JRST	[IDIVI	T1,200	;CONVERT TO BLOCKS
		 SKIPE	T2	;SEE IF OVERFLOW
		 AOS	T1	; YES, ONE MORE BLOCK
		 MOVEM	T1,EXLFIL+.RBEST; SET IN ENTER BLOCK
		 JRST	.+1]	;PROCEED

	SKIPE	S.RSUM##	;SEE IF /RESUME,
	JRST	TYPOUT		; YES--ASSUME NORMAL HANDLING

	LDB	T1,[POINTR (.FXMOM(SP), FX.SUP)];SEE IF SCAN SUPERSEDE SWITCH
	SKIPE	T1		;IF NOT TYPED,
	TXNE	F,FL$CHK	; OR /CHECK,
	JRST	CHKSUP		; CHECK BACKUP SUPERSEDE SWITCHES

	LDB	T1,[POINTR (.FXMOD(SP), FX.SUP)];TYPED--GET SCAN SETTING
	JUMPN	T1,CLSFL1	;/ERSUPERSEDE
	JRST	TYPOUT		;/OKSUPERSEDE
;HERE TO CHECK WHETHER COPY ON DISK (IF ANY) SHOULD BE SUPERSEDED

CHKSUP:	SETZM	SUSDF		;CLEAR THE SUPERSEDING DSK FILE FLAG [206]
	MOVEI	T1,1		;SEE IF SUPERSEDE ALLOWED
	CAMN	T1,S.SUPR##	;SKIP IF NOT ALWAYS
	TXNE	F,FL$CHK	;OR IF /CHECK
	SKIPA			;YES--NEED LOOKUP
	JRST	TYPOUT		;NO--MUCH FASTER
	MOVE	T1,EXLFIL+.RBNAM;GET FILE NAME
	HLLZ	T2,EXLFIL+.RBEXT;GET EXT
	MOVEI	T3,0		;ZERO PRIV WORD
	MOVE	T4,EXLFIL+.RBPPN ;GET DIRECTORY

	LOOKUP	FILE,T1		;FILE THERE?
	JRST	NOFILE		;NOPE--GOODIE

	TXNE	F,FL$CHK	;IF /CHECK
	JRST	TYPOUT		;ASSUME NORMAL HANDLING

	MOVE	T1,S.SUPR##	;GET SUPERSEDE CODE
	CAIN	T1,3		;SKIP IF NOT SUPERSEDE NEVER
	JRST	CLSFL1		;CLOSE FILE CORRECTLY

	LDB	T1,[POINTR (T3,RB.CRT)] ;GET CREATION TIME
	IMULI	T1,^D60000	;CONVERT TO MILLISECONDS
	LDB	T2,[POINTR (T2,RB.CRX)] ;GET EXTENSION
	LSH	T2,^D12		;SHIFT OVER
	LDB	T3,[POINTR (T3,RB.CRD)] ;GET BASE
	IOR	T2,T3		;UNITE
	PUSHJ	P,CONVDT	;CONVERT TO SMITHSONIAN DATE/TIME
	CAML	T1,CCDATI	;SKIP IF DISK FILE OLDER THAN TAPE FILE	[203]
	JRST	CLSFL1		;DO NOT OVER-WRITE

	SETOM	SUSDF		;SET "SUPERSEDE DSK FILE" FLAG	[206]
	CLOSE	FILE,		;DONE WITH FILE

NOFILE:	TXNN	F,FL$CHK	;NEW FILE--SEE IF /CHECK
	JRST	TYPOUT		;NOT /CHECK
	WARN$N (CNF,Check file not on disk)
	MOVEI	P1,EXLFIL	;ADDRESS OF LOOKUP BLOCK
	PUSHJ	P,GUUO		;TYPE INFO

;HERE TO CLOSE FILE CHANNEL AND NOT DISTURB FILE

CLSFL1:	CLOSE	FILE,CL.ACS	;CLOSE
	POPJ	P,		;RETURN
TYPOUT:	SKIPN	S.TYMS##	;SKIP IF TYPE OUT NEEDED
	JRST	TYPE2		;FORGET IT

	SKIPE	S.INTR##	;SEE IF INTERCHANGE MODE
	JRST	TYPE1		;SKIP TYPING PATH INFO IF SO
	MOVE	T1,CSTR		;GET CURRENT STR
	MOVE	T2,PTHBLK+.PTPPN;GET CURRENT PPN
	CAMN	T1,PRESTR	;SAME AS LAST?
	JRST	STRSAM		;STRUCTURE IS THE SAME
	MOVEM	T1,PRESTR	;STORE NEW LAST STR
	MOVEM	T2,PREPPN	;STORE
	PUSHJ	P,TYLPPN	;TYPE LAST PPN
	OUTCHR	TAB		;TAB OVER
	MOVE	T1,PRESTR	;GET STR NAME
	PUSHJ	P,SIXOUT	;TYPE STR NAME
	JRST	TYPE0		;TYPE <CR><LF> AND RESTORE

STRSAM:	CAMN	T2,PREPPN	;SAME AS LAST?
	JRST	TYPE1		;YES--RESTORE
	MOVEM	T2,PREPPN	;NO--REPLACE
	PUSHJ	P,TYLPPN	;TYPE LAST PPN
TYPE0:	OUTSTR	CRLF		;<CR><LF>

TYPE1:	MOVEI	T1,2		;SEE IF FILE NAMES WANTED
	CAMN	T1,S.TYMS##	;SKIP IF NOT
	PUSHJ	P,TYPFIL	;TYPE FILE NAME

TYPE2:	SKIPE	S.WRIT##	;UNLESS /NOWRITE
	SKIPN	T2,S.RSUM##	; SEE IF RESUMING
	JRST	NEWFIL		;NOT. ASSUME NORMAL HANDLING

	MOVEI	T1,4		;NBR ARGS FOR LOOKUP
	MOVEM	T1,EXLFIL	;STORE
	LOOKUP	FILE,EXLFIL	;FILE SHOULD BE THERE
	  JRST	[SETZM S.RSUM## ;NOT. ZILCH
		 CAIG	T2,1	;IF REALLY NEW FILE,
		 JRST	NEWFIL	;THAT'S OK
		 JRST	ELFIL]	;OTHERWISE DIE

	TXNE	F,FL$CHK	;SEE IF /CHECK,
	JRST	POSITN		;YES, GO POSITION
	ENTER	FILE,EXLFIL	;RE-ENTER TO UPDATE
	  JRST	[SETZM S.RSUM## ;ZILCH
		 JRST	EEFIL]	;ABORT FILE

POSITN:	USETI	FILE,(T2)	;POSITION
	PUSHJ	P,GENDBF	;GENERATE DISK BUFFERS
;HERE TO READ IN THE DISK BLOCK OR DO A DUMMY OUTPUT

	PUSHJ	P,@DSKIO	;EXEC
	  JRST	XFRERR		;DISK I/O ERROR
	  JRST	RSMERR		;EOF--MEANS USER GAVE INVALID CHECKPOINT

	PUSHJ	P,TYPRSM	;TYPE RESUMING MESSAGE
	MOVE	T1,S.RSUM##	;BLOCK NBR WE ARE STARTING AT
	MOVEM	T1,THSRDB	;STORE
	ADDI	T1,CP$INC	;ADD ON CHECKPOINT INCREMENT
	MOVEM	T1,CHKPNT	;SET NEW CHECKPOINT
	MOVE	T1,F$PCHK(MH)	;GET PATH CHECKSUM FROM TAPE RECORD HEADER
	MOVEM	T1,PTHCHK	;SAVE IT
	SETZM	S.RSUM##	;ZILCH
	JRST	CNTFIL		;CONTINUE WITH FILE

NEWFIL:	MOVE	T1,MDATA	;GET START OF DATA AREA
	ADDI	T1,200		;POINT TO O$FILE BLOCK
	PUSHJ	P,LSTFIL	;LIST THIS FILE

	TXNN	F,FL$PSI	;SKIP FOLLOWING IF PSI ENABLED
	JRST	[PUSHJ	P,OPRCMD##;HANDLE ANY TTY INPUT
		  TXO	F,FL$KIL;RETURN HERE IF OPERATOR SAID KILL
		 JRST	.+1]	;CONTINUE

	TXNE	F,FL$CHK	;IF /CHECK,
	JRST	NORMAL		; SKIP ENTER
	SKIPN	S.WRIT##	;IF /NOWRITE,
	POPJ	P,		; QUIT NOW

;HERE TO ENTER TAPE FILE ON DISK

	ADDI	P1,1		;ADJUST TO POINT TO ATTRIBUTE DATA
	MOVE	T1,A$MODE(P1)	;GET CREATION MODE
	SETSTS	FILE,(T1)	;FAKE OUT FILSER

	PUSHJ	P,SETFIL	;SET UP FILE ENTER BLOCK

;	HRRZ	T3,EXLFIL+.RBEXT;SAVE COPY IN CASE OF ERROR	[210]

	ENTER	FILE,EXLFIL	;TRY TO ENTER FILE
	  JRST	CHKWHY		;LOSE--TRY TO RECOVER
;FILE IS ENTERED. HERE TO TRANSFER ACTUAL DATA.

NORMAL:	PUSHJ	P,GENDBF	;GENERATE DISK BUFFERS

	MOVE	P2,MDATA	;GET ADDRESS OF START OF DATA
	ADD	P2,G$LND(MH)	;SKIP NON-DATA SECTION
	MOVE	P1,G$SIZ(MH)	;GET NUMBER OF WORDS OF DATA
	CAILE	P1,400		;SEE IF IN RANGE
	MOVEI	P1,400		;NOT. USE MAX FOR FIRST TAPE BLOCK

	MOVEI	T1,CP$INC	;CHECKPOINT INCREMENT
	MOVEM	T1,CHKPNT	;SET INITIAL CHECKPOINT

	MOVEI	T1,1		;START WITH RELATIVE-DATA-BLOCK 1
	MOVEM	T1,THSRDB	;STORE
	MOVE	T1,F$PCHK(MH)	;GET FILE PATH CHECKSUM
	MOVEM	T1,PTHCHK	;SAVE FOR LATER CHECKING

	PUSHJ	P,@DSKIO	;GET FIRST BUFFER OR DO DUMMY OUTPUT
	  JRST	XFRERR		;ERROR RETURN
	  JRST	DSKEO1		;EOF RETURN--NULL DISK FILE

	JUMPLE	P1,CHKEND	;MAY BE 0 BLOCKS ON TAPE

XFR1:	MOVSI	T1,(P2)		;TAPE BUFFER ADDRESS
	HRRI	T1,(DBUF)	;DISK BUFFER ADDRESS
	MOVEI	T2,177(T1)	;USUALLY 200 WORDS
	CAIL	P1,200		;SEE IF LAST BLOCK IN THIS TAPE BLOCK
	JRST	XFR2		;NO
	MOVEI	T2,-1(T1)	;OFFSET
	ADD	T2,P1		;POINT TO END

XFR2:	XCT	DSKBLT		;COPY OR COMPARE DATA

	TXNN	F,FL$CHK	;SEE IF /CHECK
	CAIL	P1,200		;IS THIS THE LAST BLOCK?
	JRST	NOTLST		;NO--CONTINUE

;HERE IF LAST DISK BLOCK TO BE WRITTEN

	MOVSI	T1,(<OUT FILE,0>) ;WILL DO OUTPUT
	MOVN	T2,P1		;NEGATE WORD COUNT
	ADDM	T2,DSKHDR+.BFCTR;DECREMENT BYTE COUNT
	MOVNS	T2		;NEGATE AGAIN
	PUSHJ	P,ALTDSK	;PERFORM SPECIAL OUTPUT
	  JRST	XFRERR		;ERROR RETURN
	  HALT	.		;***TEMP***
	JRST	ENDBLK		;DONE
;HERE TO CONTINUE TRANSFERING FILE

NOTLST:	PUSHJ	P,@DSKIO	;ADVANCE DISK BUFFER
	  JRST	XFRERR		;ERROR RETURN
	  JRST	DSKEOF		;EOF RETURN
ENDBLK:	ADDI	P2,200		;ADVANCE TO NEXT BLOCK IN RECORD
	SUBI	P1,200		;SUBTRACT BLOCK FROM DATA COUNT
	AOS	T1,THSRDB	;ONE MORE BLOCK
	PUSHJ	P,RSTCKP	;DO CHECKPOINTING, IF NEEDED
	  JRST	XFRERR		;ERROR DURING CHECKPOINTING
	JUMPG	P1,XFR1		;SEE IF ANY MORE TO GO

CHKEND:	MOVX	T1,GF$EOF	;EOF BIT
	TDNN	T1,G$FLAG(MH)	;SKIP IF ON
	JRST	NOTNEW		;GO GET NEXT TAPE RECORD
	TXNN	F,FL$CHK	;SEE IF /CHECK,
	JRST	XFRDON		;NO--TRANSFER DONE

;HERE IF /CHECK AND TAPE EOF

	WARN$N	(CTS,Check tape file shorter)
	PUSHJ	P,DOWHAT	;TYPE FULL FILE PATH
	MOVEI	T1,[ASCIZ/	% Check tape file shorter
/]
	SKIPE	S.LIST		;SEE IF LISTING NEEDED
	PUSHJ	P,LSTMSG	;SEND MESSAGE TO LISTING FILE
	JRST	XFRDON		;DONE

;HERE TO GET ANOTHER TAPE RECORD

NOTNEW:	PUSHJ	P,XMTAIN	;GET NEXT RECORD
	  JRST	XFRERR		;EOF OR KILL--ABORT FILE

	MOVE	T1,G$TYPE(MH)	;GET RECORD TYPE

	CAIE	T1,T$BEG	;START OF SAVE SET?
	CAIN	T1,T$CON	;CONTINUATION OF SAVE SET?
	JRST	[PUSHJ	P,LSTXXX;YES, LIST IT
		 JRST	NOTNEW]	;AND CONTINUE

	CAIN	T1,T$UFD	;SEE IF DIRECTORY RECORD
	JRST	[PUSHJ	P,HAVUFD;CREATE RIB
		 JRST	NOTNEW]	;CONTINUE

	CAIN	T1,T$LBL	;SEE IF LABEL RECORD
	JRST	NOTNEW		;***TEMP***

	CAIE	T1,T$FIL	;SHOULD BE FILE DATA
	JRST	XFRERR		;NO GOOD
;HERE TO CONTINUE WITH FILE SINCE RECORD CONTAINS FILE DATA.

CNTFIL:	SKIPG	P1,G$SIZ(MH)	;ANY SIGNIFICANT DATA?
	JRST	CHKEND		;NO--SHOULD BE END
	CAILE	P1,200*N	;SEE IF IN RANGE
	MOVEI	P1,200*N	;NOT. USE MAX NBR WORDS
	MOVE	P2,MDATA	;START OF DATA

	MOVX	T1,GF$SOF	;SEE IF START OF FILE,
	TDNE	T1,G$FLAG(MH)	;TEST FLAG IN HEADER
	JRST	MISMAT		;YES--MISSED EOF
	MOVE	T1,F$PCHK(MH)	;GET PATH CHECKSUM
	CAME	T1,PTHCHK	;MAKE SURE STILL ON SAME FILE
	JRST	MISMAT		;NOT. BAD NEWS

	MOVE	T1,F$RDW(MH)	;GET TAPE RELATIVE DATA WORD
	ASH	T1,-7		;CALCULATE RELATIVE DATA BLOCK
	AOS	T1		; ...
	CAML	T1,THSRDB	;SEE IF CURRENT OR LATER
	JRST	NEWDAT		;YES
	MOVE	T2,THSRDB	;LOAD NEEDED DISK BLOCK NUMBER
	CAIL	T2,N(T1)	;SEE IF NEEDED BLOCK IS IN THIS TAPE RECORD
	JRST	NOTNEW		;NO--DROP IT

	SUB	T2,T1		;YES, GET DIFFERENCE
	ASH	T2,7		;MULTIPLY BY 200 WORDS
	ADD	P2,T2		;ADD TO DATA ADDRESS POINTER
	SUB	P1,T2		;AND SUBTRACT FROM WORD COUNT
	JUMPG	P1,XFR1		;GO TRANSFER OVER
	JRST	CHKEND		;FOUL UP?

NEWDAT:	TXNN	F,FL$CHK	;SEE IF /CHECK
	CAMG	T1,THSRDB	; OR IF THIS IS THE NEEDED BLOCK
	JRST	XFR1		;YES--GO TRANSFER OVER
	USETO	FILE,(T1)	;NO--POSITION TO FILE BLOCK
	MOVEM	T1,THSRDB	; AND UPDATE FILE INDEX
	JRST	XFR1		;PROCEED

DSKEOF:	SUBI	P1,200		;COUNT LAST DATA XFR
DSKEO1:	MOVX	T1,GF$EOF	;SEE IF LAST TAPE BLOCK
	TDNE	T1,G$FLAG(MH)	;EOF BIT SHOULD BE ON
	JUMPLE	P1,XFRDON	;IF NO TAPE DATA LEFT, OK
	WARN$N (CDS,Check disk file shorter)
	MOVEI	P1,EXLFIL	;ADDRESS OF LOOKUP BLOCK
	PUSHJ	P,GUUO		;TYPE FULL FILE PATH
	MOVEI	T1,[ASCIZ/	% Check disk file shorter
/]
	SKIPE	S.LIST		;SKIP IF LISTING NOT NEEDED
	PUSHJ	P,LSTMSG	;SEND MESSAGE TO LISTING
				;FALL INTO XFRDON
;HERE WHEN RESTORE OR CHECK DONE. CLOSE DISK FILE AND CHECK.

XFRDON:	MOVE	T1,[CLOSE FILE,CL.ACS!CL.DLL] ;LOAD CLOSE UUO
	TXNE	F,FL$PAO	;POA FLAG ON?
	TRZ	T1,CL.DLL	;YES--CLEAR CLOSE BIT
	XCT	T1		;EXEC FUNCTION

	TXNE	F,FL$CHK	;SEE IF /CHECK
	JRST	[SKIPE	T1,CHKCNT;SEE IF ANY DIFFERENCES
		 SKIPN	S.LIST	;AND IF LISTING NEEDED
		 JRST	RLSFIL	;NO, SKIP LISTING COUNT
		 PUSHJ	P,LSTTAB;TAB OVER
		 PUSHJ	P,LSTDEC;LIST COUNT OF DIFFERENCES
		 MOVEI	T1,[ASCIZ \ difference(s) found
\]
		 PUSHJ	P,LSTMSG;SEND TO FILE
		 JRST	RLSFIL]	;SKIP SIZE CHECK

IFN FT$DBG,<
	PUSHJ	P,SETFIL	;RESET LOOKUP/ENTER BLOCK
	LOOKUP	FILE,EXLFIL	;GET IT AGAIN
	  JRST	ELFIL		;OUCH
	MOVE	T1,EXLFIL+.RBSIZ;GET FILE SIZE IN WORDS
	CAMN	T1,CWSIZE	;SAME AS TAPE'S?
	JRST	TAPERR		;YES
	WARN$N	(SCE,Size copy error)
	MOVEI	P1,EXLFIL	;LOAD ADDRESS OF BLOCK
	PUSHJ	P,GUUO		;TYPE NAME
>;END IFN FT$DBG

TAPERR:	TXNN	F,FL$TPE	;TAPE READ ERROR?
	JRST	RLSFIL		;NO, OK
	PUSHJ	P,SETFIL	;RESET LOOKUP/ENTER BLOCK
	MOVX	T1,RP.BFA	;INDICATE BACKUP READ ERROR
	IORM	T1,EXLFIL+.RBSTS;SET FLAG IN FILE STATUS WORD
	RENAME	FILE,EXLFIL	;RENAME TO STORE FLAG
	  JFCL			;NICE TRY

RLSFIL:	RELEAS	FILE,		;RELEASE CHANNEL
	RELEAS	UFD,		; ..
	POPJ	P,		;RETURN

MISMAT:	WARN$	(HSI,Header file spec inconsistency)
	SOS	FX$CNT(SP)	;DON'T COUNT MATCH OF PARTIAL FILE
XFRERR:	CLOSE	FILE,CL.RST	;ABORT FILE
	RELEAS	FILE,		; ..
	RELEAS	UFD,		; ..
	JRST	EAFIL		;TYPE OUT BAD NEWS & RETURN
	SUBTTL	TAPE TO DISK SUBROUTINES

;+
;.CHAPTER TAPE TO DISK SUBROUTINES
;-

;+
;<COMPAR IS A ROUTINE TO COMPARE TWO AREAS.
;^CALLED WITH ^T1 HAVING <BLT POINTER, AND WITH ^T2 POINTING TO END.
;-

COMPAR:	CAIGE	T2,(T1)		;SEE IF DONE YET
	POPJ	P,		;YES--RETURN
	HLRZ	T3,T1		;GET BUFFER 1 ADDRESS
	MOVE	T3,(T3)		;GET NEXT CONTENTS
	CAMN	T3,(T1)		;COMPARE WITH BUFFER 2
	AOBJP	T1,COMPAR	;LOOP UNTIL STOPPED
	SKIPN	CHKCNT		;SEE IF FIRST DIFFERENCE
	PUSHJ	P,CHKDIF	;YES, WARN USER
	AOS	CHKCNT		;STEP COUNT OF DIFFERENCES
	AOBJP	T1,COMPAR	;CONTINUE COMPARING

;+
;<CHKDIF REPORTS THE FIRST DIFFERENCE FOR A FILE ON </CHECK.
;-

CHKDIF:	PUSHJ	P,SAVE1		;SAVE C(P1)
	WARN$N	(CFD,Check files are different)
	MOVE	T4,T1		;COPY T1 POINTERS
	SAVE$	<T1,T2>
	MOVEI	P1,EXLFIL	;ADDRESS OF LOOKUP BLOCK
	PUSHJ	P,GUUO		;TYPE FULL FILE PATH
	SKIPN	S.LIST		;SEE IF LISTING WANTED
	JRST	CHKDF1		;LISTING NOT NEEDED
	MOVEI	T1,[ASCIZ/	% FIRST DIFFERENCE AT WORD /]
	PUSHJ	P,LSTMSG	;SEND MESSAGE
	MOVE	T1,THSRDB	;RELATIVE DATA BLOCK FOR DISK BUFFER
	SOS	T1		;CALCULATE DISK WORD
	ASH	T1,7		; ...
	ADDI	T1,(T4)		;ADD POSITION IN BUFFER
	SUBI	T1,(DBUF)	;SUBTRACT START ADDRESS OF BUFFER
	PUSHJ	P,LSTDEC	;SEND TO FILE
	MOVEI	T1,CRLF		;<CR><LF>
	PUSHJ	P,LSTMSG	;SEND TO FILE
	MOVEI	T1,[ASCIZ/	DISK: /]
	PUSHJ	P,LSTMSG	;SEND TO FILE
	HLRZ	T1,(T4)		;GET LEFT HALF OF DISK WORD
	PUSHJ	P,LSTOCT	;SEND TO FILE
	MOVEI	T1,[ASCIZ/,,/]
	PUSHJ	P,LSTMSG	;HALF WORD FORMAT
	HRRZ	T1,(T4)		;GET RIGHT HALF OF DISK WORD
	PUSHJ	P,LSTOCT	;SEND TO FILE
	MOVEI	T1,[ASCIZ/	TAPE: /]
	PUSHJ	P,LSTMSG	;SEND TO FILE
	MOVSS	T4		;POINT TO TAPE WORD
	HLRZ	T1,(T4)		;GET LEFT HALF OF TAPE WORD
	PUSHJ	P,LSTOCT	;SEND TO FILE
	MOVEI	T1,[ASCIZ/,,/]	;HALF WORD FORMAT
	PUSHJ	P,LSTMSG	;SEND TO FILE
	HRRZ	T1,(T4)		;GET RIGHT HALF OF TAPE WORD
	PUSHJ	P,LSTOCT	;SEND TO FILE
	MOVEI	T1,CRLF		;<CR><LF>
	PUSHJ	P,LSTMSG	;SEND TO FILE
CHKDF1:	RSTR$	<T2,T1>
	POPJ	P,		;RETURN

;+
;<GETDAT IS A SUBROUTINE TO GET FILE PATH DATA FROM THE <O$NAME BLOCK,
;OR FROM THE TAPE RECORD HEADER IF P2 = 0. ^CALL WITH ^T1 = TYPE CODE.
;^IF NEW FILE, ASSUMES ^P1 POINTS TO THE FIRST SUB-BLOCK,
;AND ^P2 POINTS TO THE END OF THE <O$NAME BLOCK.
;^RETURNS FILE DATA IN ^T1 OR ^T1 = 0 IF DATA NOT ON TAPE.
;-

GETDAT:	PUSHJ	P,SAVE2		;SAVE C(P1) & C(P2)
	MOVE	T2,T1		;COPY TYPE
	JUMPN	P2,GETONM	;IF NEW FILE, GET INFO FROM O$NAME BLOCK
	MOVEI	P2,F$PTH(MH)	;POINT TO FILE PATH INFO IN HEADER
GETHDR:	SETZ	T1,		;ZILCH
	MOVSI	T3,440700	;MAKE ASCII BYTE POINTER
	CAIGE	P2,M(MH)	;REACHED END OF HEADER?
	SKIPN	(P2)		; OR NULL WORD?
	POPJ	P,		;YES, RETURN WITHOUT DATA
	HRR	T3,P2		;BP TO NEW STRING
	ILDB	T1,T3		;GET TYPE CODE FROM HEADER
	ILDB	P2,T3		;GET LENGTH OF STRING IN WORDS
	ADDI	P2,(T3)		;SET TO POINT TO NEXT STRING
	CAME	T1,T2		;RIGHT ONE?
	JRST	GETHDR		;NO--TRY NEXT
	CAIE	T1,.FCDIR	;PPN?
	JRST	GETSIX		;NO--CONVERT TO SIXBIT
	JRST	GETPPN		;YES

GETONM:	SETZ	T1,		;ZILCH IN CASE NOT THERE
	HLRZ	T3,(P1)		;GET SUB-BLOCK TYPE 
	CAMN	T2,T3		;COMPARE
	JRST	GOTDAT		;MATCH
	ADD	P1,(P1)		;ADVANCE SUB-BLOCK POINTER
	SKIPE	(P1)		;DONE IF ZERO
	CAIG	P2,(P1)		;OR IF REACHED END OF O$NAME BLOCK
	POPJ	P,		;RETURN
	JRST	GETONM		;TRY NEXT SUB-BLOCK

GOTDAT:	MOVE	T3,[POINT 7,1(P1)];BP TO ASCIZ STRING
	CAIN	T2,.FCDIR	;UFD?
	JRST	GETPPN		;YES--GET PPN
				;FALL INTO GETSIX

GETSIX:	MOVE	T4,[POINT 6,T1];MAKE SIXBIT BP TO T1
	SETZ	T1,		;CLEAR
GETSX1:	CAIG	P2,(T3)		;SEE IF REACCHED END OF BLOCK
	POPJ	P,		;YES, DONE
	ILDB	T2,T3		;GET CHAR
	JUMPE	T2,CPOPJ	;QUIT IF NULL
	SUBI	T2," "-' '	;SIXBITIZE
	IDPB	T2,T4		;SET IN T1
	TLNE	T4,77B23	;SEE IF T1 FULL
	JRST	GETSX1		;BACK FOR NEXT CHAR
	POPJ	P,		;DONE

GETPPN:	SETZ	T1,		;ZILCH
	PUSHJ	P,GETOCT	;GET PROJECT NUMBER
	  POPJ	P,		;RETURN WITH PPN=0 IF JUNK ON TAPE
	HRLZ	T1,T4		;POSITION
	PUSHJ	P,GETOCT	;GET PROGRAMMER NUMBER
	  TDZA	T1,T1		;ZILCH IF JUNK ON TAPE
	HRR	T1,T4		;SET IN T1
	POPJ	P,		;RETURN

GETOCT:	SETZ	T4,		;CLEAR T4
GETOC1:	CAIG	P2,(T3)		;SEE IF REACHED END OF BLOCK
	JRST	CPOPJ1		;YES, RETURN
	ILDB	T2,T3		;GET CHARACTER
	SKIPE	T2		;SKIP IF NULL
	CAIN	T2,"_"		;SEE IF UNDERLINE
	JRST	CPOPJ1		;GIVE SKIP RETURN
	CAIG	T2,"7"		;RANGE CHECK
	CAIGE	T2,"0"		;SHOULD BE OCTAL DIGIT
	POPJ	P,		;NOT. GIVE BAD RETURN
	SUBI	T2,"0"		;DE-ASCIITIZE
	ASH	T4,3		;MULTIPLY BASE BY 8
	ADD	T4,T2		;ADD IN NEW DIGIT
	JRST	GETOC1		;LOOP FOR MORE
;+
;<RSTRIB IS A SUBROUTINE TO FILL AN EXTENDED ENTER BLOCK FROM THE <O$FILE TAPE BLOCK.
;^CALL WITH ^P1 = ADDRESS <O$FILE BLOCK, ^P2 = ADDRESS OF OUTPUT. ^USES ^T1-^T4.
;-

RSTRIB:	PUSHJ	P,SAVE1		;SAVE C(P1)
	ADDI	P1,1		;MAKE POINTER TO ATTRIBUTE DATA
	MOVEI	T1,NRIB-1	;NBR ARGS
	MOVEM	T1,.RBCNT(P2)	;STORE

	MOVE	T1,A$WRIT(P1)	;GET CREATION DATE/TIME
	PUSHJ	P,CONTDT	;CONVERT TO SYSTEM FORMAT
	DPB	T2,[POINTR (.RBPRV(P2),RB.CRD)];LOW ORDER CREATION BITS
	LSH	T2,-^D12	;POSITION HIGH ORDER BITS OF CREATION DATE
	DPB	T2,[POINTR (.RBEXT(P2),RB.CRX)];SET IN ENTER BLOCK
	IDIVI	T1,^D60000	;CONVERT TIME FROM MS TO MINUTES
	SKIPE	T2		;SEE IF OVERFLOW
	AOS	T1		;YES, ONE MORE MINUTE
	DPB	T1,[POINTR (.RBPRV(P2),RB.CRT)];SET CREATION TIME

	MOVE	T1,A$VERS(P1)	;GET VERSION FROM TAPE
	MOVEM	T1,.RBVER(P2)	;SET IN FILE RIB

	MOVE	T1,A$ALLS(P1)	;GET NBR ALLOCATED WORDS
	IDIVI	T1,200		;GET NBR ALLOCATED BLOCKS
	SKIPE	T2		;SEE IF OVERFLOW
	AOS	T1		;YES, ONE MORE BLOCK
	MOVEM	T1,.RBEST(P2)	;SET AS ESTIMATE 
	SKIPE	S.INTR##	;SEE  IF /INTERCHANGE
	POPJ	P,		;YES, IGNORE REST OF O$FILE BLOCK

;HERE TO FILL REST OF ENTER BLOCK FOR NON-INTERCHANGE MODE

	SKIPE	A$RADR(P1)	;SEE IF ADDRESS REQUESTED
	MOVEM	T1,.RBALC(P2)	;YES--SET AS ALLOCATED ALSO
	SKIPN	T1,A$ESTS(P1)	;SEE IF FILE ESTIMATE SET,
	JRST	RSTADT		;NO, CONTINUE
	IDIVI	T1,200		;YES--USE IT TO CALCULATE .RBEST
	SKIPE	T2		;SEE IF OVERFLOW
	AOS	T1		;ONE MORE BLOCK
	MOVEM	T1,.RBEST(P2)	;UPDATE .RBEST

RSTADT:	MOVE	T1,A$REDT(P1)	;GET ACCESS DATE/TIME
	PUSHJ	P,CONTDT	;CONVERT TO SYSTEM STANDARD
	DPB	T2,[POINTR (.RBEXT(P2), RB.ACD)];SET IN ENTER BLOCK

	SKIPE	T1,A$PROT(P1)	;SEE IF PROTECTION SET,
	PUSHJ	P,RSTPRO	; GET PROTECTION & CONVERT
	DPB	T1,[POINTR (.RBPRV(P2), RB.PRV)];STORE
	PUSH	P,P2		;SAVE OUTPUT ADDRESS
	HRRZ	P2,-1(P1)	;GET LENGTH OF O$FILE BLOCK
	ADDI	P2,-1(P1)	;ADD IN START ADDRESS
	MOVE	T3,A$NOTE(P1)	;GET BP TO ASCIZ STRING (.RBSPL)
	JUMPE	T3,RSTMTI	;NONE
	ADD	T3,P1		;ADD START ADDRESS
	PUSHJ	P,GETSIX	;CONVERT TO SIXBIT
	MOVE	T2,(P)		;WHERE TO STORE
	MOVEM	T1,.RBSPL(T2)	;STORE
RSTMTI:	MOVE	T3,A$BKID(P1)	;GET RELATIVE BP TO SAVE NAME
	JUMPE	T3,RSTAUT	;NONE
	ADD	T3,P1		;ADD START ADDRESS
	PUSHJ	P,GETSIX	;CONVERT TO SIXBIT
	MOVE	T2,(P)		;WHERE TO STORE
	MOVEM	T1,.RBMTA(T2)	;STORE
RSTAUT:	MOVE	T3,A$CUSR(P1)	;GET RELATIVE BP TO AUTHOR
	JUMPE	T3,RSTUSR	;NONE
	ADD	T3,P1		;ADD START ADDRESS
	PUSHJ	P,GETPPN	;CONVERT TO PPN
	MOVE	T2,(P)		;WHERE TO STORE
	MOVEM	T1,.RBAUT(T2)	;STORE
RSTUSR:	POP	P,P2		;RESTORE P2
	MOVE	T1,A$USRW(P1)	;GET CUSTOMER WORDS FROM TAPE
	MOVEM	T1,.RBNCA(P2)	; ...
	MOVE	T1,A$PCAW(P1)	; ...
	MOVEM	T1,.RBPCA(P2)	; ...

	MOVEI	T1,0		;ZILCH
	MOVE	T2,A$FLGS(P1)	;GET BACKUP FLAGS FROM TAPE
	MOVSI	T3,-LN$FLG	;LENGTH OF FLAG TABLES
RSTFLG:	TDNE	T2,BKPFLG(T3)	;IF BACKUP FLAG SET,
	IOR	T1,RIBFLG(T3)	; SET CORRESPONDING RIB FLAG
	AOBJN	T3,RSTFLG	;LOOP
	MOVEM	T1,.RBSTS(P2)	;STORE FLAGS

	MOVE	T1,A$RADR(P1)	;GET REQUESTED DISK ADDRESS
	IDIVI	T1,200		;CONVERT TO LOGICAL BLOCK NBR
	MOVEM	T1,.RBPOS(P2)	;STORE
	POPJ	P,		;RETURN
;+
;<RSTPRO IS A SUBROUTINE TO RETURN THE <RIB PROTECTION FOR A FILE
;FROM THE <BACKUP PROTECTION WORD. ^CALLED WITH ^P1 = ADDRESS OF
;ATTRIBUTE DATA, RETURNS PROTECTION IN ^T1. ^USES ^T1-^T4.
;-

RSTPRO:	LDB	T1,[POINTR (A$PROT(P1), AC$OWN)];GET OWNER ACCESS FIELD
	PUSHJ	P,RSTPRT	;CONVERT
	MOVEM	T1,T4		;SAVE PROGRAMMER PROTECTION
	LDB	T1,[POINTR (A$PROT(P1), AC$GRP)];GET GROUP ACCESS FIELD
	PUSHJ	P,RSTPRT	;CONVERT
	LSH	T4,3		;POSITION
	IORM	T1,T4		;UNITE AND SAVE
	LDB	T1,[POINTR (A$PROT(P1), AC$WLD)];GET WORLD ACCESS FIELD
	PUSHJ	P,RSTPRT	;CONVERT
	LSH	T4,3		;POSITION
	IOR	T1,T4		;UNITE
	POPJ	P,		;RETURN WITH PROTECTION IN T1

;+
;<RSTPRT IS A SUBROUTINE TO CONVERT A <BACKUP ACCESS FIELD
;TO A <TOPS-10 PROTECTION VALUE. ^CALLED WITH ACCESS FIELD IN ^T1,
;RETURNS <RIB PROTECTION IN ^T1. ^USES ^T1-^T3.
;-

RSTPRT:	MOVEI	T3,7		;START WITH MAX PROTECTION
	LDB	T2,[POINTR (T1,PR$RED)];GET READ ACCESS BITS
	SUB	T3,T2		;ADJUST PROTECTION
	CAIGE	T3,5		; ...
	MOVEI	T3,5		; ...
	LDB	T2,[POINTR (T1, PR$WRT)];GET WRITE ACCESS BITS
	JUMPN	T2,[MOVEI T3,5	;USE MAX OF 5
		    SUB   T3,T2	;ADJUST
		    JRST  .+1]	;PROCEED
	LDB	T2,[POINTR (T1, PR$ATR)];GET ATTRIBUTE FIELD
	CAIN	T2,7		;SEE IF = 7
	MOVEI	T3,1		; RESET PROTECTION TO 1
	CAIN	T2,6		;SEE IF = 6
	MOVEI	T3,0		; RESET
	MOVE	T1,T3		;COPY PROTECTION
	POPJ	P,		;RETURN
;+
;<RSTCKP IS A SUBROUTINE TO PRESERVE THE DISK OUTPUT FILE ON A
;RESTORE AT CHECKPOINTS. ^CALLED WITH ^T1 = CURRENT DISK BLOCK.
;^GIVES NON-SKIP RETURN IF PROBLEM WITH LOOKUP OR ENTER.
;-

RSTCKP:	SKIPE	S.CKPT##	;SEE IF /CPOINT
	CAME	T1,CHKPNT	; AND CHECKPOINT REACHED
	JRST	CPOPJ1		;NO--SKIP BACK
RSTCK1:	TXNE	F,FL$CHK	;IF /CHECK,
	JRST	RSTCK2		;DO TYPEOUT ONLY
	CLOSE	FILE,CL.ACS	;CLOSE TO PRESERVE FILE
	LOOKUP	FILE,EXLFIL	;DO LOOKUP
	  JRST	ELFIL		;NOT THERE!!
	ENTER	FILE,EXLFIL	;RE-ENTER TO UPDATE
	  JRST	EEFIL		;GIVE ERROR RETURN
	USETI	FILE,-1		;POSITION TO END TO APPEND
	PUSHJ	P,GENDBF	;GENERATE DISK BUFFERS
	PUSHJ	P,DSKOUT	;DO DUMMY OUTPUT
	  POPJ	P,		;ERROR!
	  HALT	RSTCKP		;EOF RETURN--SHOULD NEVER HAPPEN ON OUTPUT
	MOVE	T1,CHKPNT	;GET CHECKPOINT BACK

RSTCK2:	TXNN	F,FL$EOV	;IF EOV, NO TYPEOUT
	PUSHJ	P,TYPCKP	;TYPE CHECKPOINT
	JRST	CPOPJ1		;SKIP RETURN

GENDBF:	SETSTS	FILE,.IOBIN	;BACK TO BUFFERED BINARY
	MOVE	T1,[OUTBUF FILE,NDSKBF]	;SET UP BUFFERS
	TXNE	F,FL$CHK		;IF /CHECK,
	MOVE	T1,[INBUF FILE,NDSKBF]	; DO INBUF
	XCT	T1			;GENERATE BUFFERS
	POPJ	P,		;RETURN
;+
;^A BRANCH TO <CHKWHY IS TAKEN IF THE <ENTER <UUO FOR RESTORING A TAPE
;FILE FAILS. ^IF A MISSING DIRECTORY IN THE RESTORATION PATH CAUSED THE
;FAILURE, THE NEEDED DIRECTORY IS CREATED, AND THE <ENTER RETRIED.
;-

CHKWHY:	HRRZ	T1,EXLFIL+.RBEXT;GET ERROR CODE

	CAIN	T1,ERPOA%	;PARTIAL ALLOCATION?
	JRST	POACOD		;YES--FIX

	CAIE	T1,ERIPP%	;SKIP IF NO UFD
	CAIN	T1,ERSNF%	;SFD NOT FOUND?
	SKIPA			; YES--CAN TRY FIX UP
	JRST	EEFIL		;FATAL ERROR

	SETZ	LVL,		;START AT UFD LEVEL

MAKSFD:	SKIPN	T1,APATH+.PTPPN(LVL) ;SEE IF LEVEL EXISTS
	JRST	PATHOK		;NOPE. TRY ENTER AGAIN

	MOVE	T2,LVL		;WHAT LEVEL WE'RE AT
	IMULI	T2,NRIB		;HOW MANY WORDS PER RIB
	ADD	T2,ADRLST	;ADD IN BASE ADDRESS
	HRLZ	T3,T2		;LH
	HRRI	T3,EXLUFD	;BLOCK
	BLT	T3,EXLUFD+NRIB-1;TRANSFER

	MOVEM	T1,EXLUFD+.RBNAM;STORE NAME
	MOVE	T1,MFDPPN	;GET MFD PPN
	MOVEM	T1,EXLUFD+.RBPPN;SET PPN
	MOVSI	T1,'UFD'	;INSURE CORRECT EXTENSION

	JUMPLE	LVL,LEVEL0	;SKIP FOLLOWING IF UFD

	MOVE	T1,APATH+.PTPPN-1(LVL) ;GET ONE HIGHER SFD
	MOVEM	T1,UPTBLK+.PTPPN-1(LVL) ;STORE
	SETZM	UPTBLK+.PTPPN(LVL) ;INSURE TRAILING ZERO

	MOVEI	T1,UPTBLK	;WHERE TO FIND PATH
	MOVEM	T1,EXLUFD+.RBPPN;STORE
	MOVSI	T1,'SFD'	;LOAD EXTENSION 

LEVEL0:	HLLM	T1,EXLUFD+.RBEXT;STORE EXTENSION
	MOVEI	T1,3		;JUST .RBPPN,NAM,EXT
	MOVEM	T1,EXLUFD+.RBCNT;STORE

	LOOKUP	UFD,EXLUFD	;IS IT THERE?
	  JRST	ENTSFD		;MUST DO ENTER
	JRST	NXTSFD		;THAT GUY'S THERE
ENTSFD:	MOVEI	T1,NRIB-1	;WHOLE RIB
	MOVEM	T1,EXLUFD+.RBCNT;STORE
	HRRZ	T1,.RBEXT(T2)	;GET RH BACK
	HRRM	T1,EXLUFD+.RBEXT;CLEAR ERROR CODE AND RESET
	MOVEI	T1,RP.DIR	;DIRECTORY BIT
	MOVEM	T1,EXLUFD+.RBSTS;SET IT
	SETZM	EXLUFD+.RBDEV	;ZILCH
	SETZM	EXLUFD+.RBELB	; ..
	SETZM	EXLUFD+.RBEUN	; ..
	SETZM	EXLUFD+.RBUSD	; ..
	SETZM	EXLUFD+.RBNXT	; ..
	SETZM	EXLUFD+.RBPRD	; ..
	SETZM	EXLUFD+.RBUFD	; ..
	SETZM	EXLUFD+.RBFLR	; ..
	SETZM	EXLUFD+.RBXRA	; ..
	SKIPLE	T1,S.UPRT##	;SEE IF /UPROTECT
	DPB	T1,[POINTR (EXLUFD+.RBPRV, RB.PRV)];SET IT

	HRLOI	T1,377777	;PLUS INFINITY AS DEFAULT QUOTA
	HRLOI	T2,001777	; PLUS INFINITY IN WORDS	[214]
	CAMN	T2,EXLUFD+.RBQTF; IS IT?			[214]
	MOVEM	T1,EXLUFD+.RBQTF; YES - BACK TO BLOCKS		[214]
	CAMN	T2,EXLUFD+.RBQTO; PLUS INFINITY IN WORDS?	[214]
	MOVEM	T1,EXLUFD+.RBQTO; YES - BACK TO BLOCKS		[214]
	SKIPN	S.INTR##	; DOES 0 DENOTE +INFINITY?	[215]
	JRST	ENTSF2		; NO - NOT INTERCHANGE MODE	[215]
	SKIPG	EXLUFD+.RBQTF	;QUOTA SET?
	MOVEM	T1,EXLUFD+.RBQTF;USE DEFAULT
	SKIPG	EXLUFD+.RBQTO	;QUOTA SET?
	MOVEM	T1,EXLUFD+.RBQTO;USE DEFAULT

ENTSF2:	ENTER	UFD,EXLUFD	;ATTEMPT TO CREATE UFD		[215]
	  JRST	EEUFD		;ERROR RETURN
	USETO	UFD,2		;INSURE 1 BLOCK

NXTSFD:	CLOSE	UFD,CL.ACS	;CLOSE UFD
	AOJA	LVL,MAKSFD	;LOOP

PATHOK:	PUSHJ	P,SETFIL	;RESET EXLFIL BLOCK
	MOVE	T1,A$WRIT(P1)	;GET CREATION DATE/TIME		[210]
	PUSHJ	P,CONTDT	;CONVERT TO SYSTEM FORMAT	[210]
	LSH	T2,-^D12	;GET JUST HI-ORDER BITS		[210]
	DPB	T2,[POINTR (.RBEXT(P2),RB.CRX)];RESTORE DATE	[210]

	ENTER	FILE,EXLFIL	;TRY TO ENTER FILE
	  SKIPA			;CHECK FOR ERPOA%
	JRST	NORMAL		;OK

	HRRZ	T1,EXLFIL+.RBEXT;GET ERROR CODE
	CAIE	T1,ERPOA%	;POA?
	JRST	EEFIL		;NO--QUIT

POACOD:	TXO	F,FL$PAO	;FLAG AS SUCH
	JRST	NORMAL		;PROCEED

SETFIL:	MOVEI	T1,NRIB-1	;ARG COUNT
	MOVEM	T1,EXLFIL+.RBCNT;STORE
	SETZM	EXLFIL+.RBPOS	; ..
	SETZM	EXLFIL+.RBDEV	; ..
	SETZM	EXLFIL+.RBSTS	; ..
	SETZM	EXLFIL+.RBELB	; ..
	SETZM	EXLFIL+.RBEUN	; ..
	SETZM	EXLFIL+.RBUSD	; ..
	SETZM	EXLFIL+.RBNXT	; ..
	SETZM	EXLFIL+.RBPRD	; ..
	SETZM	EXLFIL+.RBUFD	; ..
	SETZM	EXLFIL+.RBFLR	; ..
	SETZM	EXLFIL+.RBXRA	; ..
	POPJ	P,		;RETURN
	SUBTTL	TAPE INPUT/OUTPUT SUBROUTINES

;+
;.CHAPTER TAPE I/O ROUTINES
;
;<MTAOUT IS THE SUBROUTINE TO OUTPUT A TAPE RECORD. ^ALL WRITE PROBLEMS
;(INCLUDING WRITE LOCK) ARE CORRECTED WITHIN THIS SUBROUTINE.
;^WRITE ERRORS ARE CORRECTED FOR BY REWRITING THE DATA IN A
;REPEATER RECORD. (^THIS DEPENDS ON THE SYNCRONIZE-IF-ERROR FEATURE
;OF 6.02 AND LATER MONITORS.) ^CALL WITH <MH = ADDRESS OF OUTPUT BLOCK HEADER.
;^IT IS ASSUMED THAT THE DATA FOLLOWS THE HEADER IMMEDIATELY.
;-

;HERE FOR ENTRY POINT AND ENCRIPTION CODE

MTAOUT:	TXNE	F,FL$KIL	;IF KILL ALREADY, DON'T WRITE MORE
	POPJ	P,		;RETURN
	PUSHJ	P,SAVE3		;PRESERVE ACS

	MOVE	T1,G$TYPE(MH)	;GET RECORD CODE
	CAIN	T1,T$FIL	;FILE DATA?
	SKIPN	S.CRYP##	;PASSWORD TYPED?
	JRST	MTAOU1		;LOSE--NO SCRAMBLING

	MOVEM	7,SAVACS+7	;SAVE AC0 THRU AC7
	MOVEI	7,SAVACS	; ..
	BLT	7,SAVACS+6	; ..
	MOVE	7,SAVACS+7	;RESTORE IF NEEDED

	TXOE	F,FL$INI	;INITIALIZED?
	JRST	CLSCRM		;YES--SKIP THIS
IFLE F-7,<
	MOVEM	F,SAVACS+F	;STORE NEWLY SET BIT
>;END IFLE F-7
	MOVEI	7,S.CRYP##	;LOC OF PASSWORD
	PUSHJ	P,CRASZ.##	;CALL CODER
	MOVEM	5,SVCODE	;SAVE SEED

CLSCRM:	MOVSI	7,-200*N	;HOW MANY WORDS
	HRRI	7,M(MH)		;WHERE IT'S AT
	MOVE	1,G$LND(MH)	;GET LENGTH OF NON-DATA SECTION
	HRLS	1		;PUT IN LH ALSO
	ADD	7,1		;DON'T ENCRYPT NON-DATA 
	MOVE	6,F$RDW(MH)	;GET RELATIVE WORD
	ADDI	6,200		;FORCE OVERFLOW
	ASH	6,-7		;GET RELATIVE BLOCK
	MOVE	5,SVCODE	;GET SEED BACK
	PUSHJ	P,CRYPT.##	;CALL ENCRIPTER

	MOVSI	7,SAVACS	;RESTORE REGISTERS
	BLT	7,7		; ..
MTAOU1:	AOS	T1,NSEQ		;GET SEQUENCE NUMBER
	MOVEM	T1,G$SEQ(MH)	;STORE
	MOVE	T1,NTPE		;GET TAPE NUMBER
	MOVEM	T1,G$RTNM(MH)	;STORE

IFE FT$CHK <
	MOVX	T1,GF$NCH	;INDICATE NO CHECKSUM
	IORM	T1,G$FLAG(MH)	;SET FLAG IN RECORD HEADER
>;END IFE FT$CHK

IFN FT$CHK <
	PUSHJ	P,CHKSUM	;COMPUTE CHECKSUM
>;END IFN FT$CHK

DUMOUT:	SETZB	P3,S.MBPT##+.BFCTR;ZERO COUNT AND ERROR POSITION POINTER
	MOVEI	T1,MTBBKP	;LOAD OUTPUT BLOCK SIZE
	ADDM	T1,S.MBPT##+.BFPTR;INCREMENT BYTE POINTER
	OUT	F.MTAP,		;EXECUTE OUTPUT UUO
	  JRST	MTASET		;SUCCESSFUL OUTPUT

OUTERR:	WAIT	F.MTAP,		;WAIT FOR I/O TO FINISH
	GETSTS	F.MTAP,P1	;GET ERROR STATUS BITS

	TRNN	P1,IO.IMP	;CHECK WRITE LOCK BIT
	JRST	NOTLOK		;NO--CHECK OTHERS

	SETSTS	F.MTAP,.IOBIN	;CLEAR STATUS
	OPER$	(TWL,Tape write locked--add write ring then type "GO")
	PUSHJ	P,TYI		;WAIT FOR GO
	JRST	MTASET		;ALL OK

NOTLOK:	TRNN	P1,IO.EOT	;CHECK END OF TAPE BIT
	JRST	NOTEOT		;NO--CHECK OTHERS

	TXNE	F,FL$EOV	;SEE IF EOV SENT
	JRST	MTASET		;IT HAS. FINISH THIS TAPE UP
	TXO	F,FL$END	;INDICATE END OF SAVE
	PUSHJ	P,MTASET	;FORCE OUTPUT OF REMAINING BUFFERS
	MOVEI	T1,T$EOV	;FORM EOV RECORD
	MOVEM	T1,G$TYPE(MH)	;STORE
	TXO	F,FL$END!FL$EOV ;WILL FORCE OUT EOV RECORD
	PUSHJ	P,MTAOU1	;SEND EOV
				;FALL INTO MULTIR
;	HERE TO HANDLE REEL SWITCHING

MULTIR:	TXZ	F,FL$EOV	;CLEAR EOV FLAG
	TXNN	F,FL$RCV	;SEE IF RECOVERY CODE AVAILABLE
	JRST	[CLOSE	F.MTAP,	;NO--WRITE THE REST OF THE BLOCKS
		 PUSHJ	P,DUMOUT;DO A DUMMY OUTPUT
		 JRST	MULTR2]	;PROCEED
	MTEOF.	F.MTAP,		;WRITE 2 EOFS
	MTEOF.	F.MTAP,		; ..

MULTR2:	SKIPE	S.MULT##	;SEE IF /NOMULTIREEL
	JRST	NEWTAP		;NO, GO ASK FOR NEW TAPE
	OUTSTR	[ASCIZ/
?BKPRES Reached EOT on single reel save
/]
	MONRT.			;.CONTINUE WILL WORK


NEWTAP:	AOS	NTPE		;INCREMENT TAPE NUMBER
	PUSHJ	P,NEXTAP	;GET NEXT TAPE
	SETZM	ERRCNT		;INITIALIZE COUNT FOR NEW REEL
	TXNE	F,FL$KIL	; WAS KILL TYPED?		[200]
	POPJ	P,		; YEP - SO EXIT			[200]
	MOVEI	T1,T$CON	;CONTINUATION OF SAVE SET
	PUSHJ	P,GENSAV	;WRITE T$CON ON NEW TAPE
	SKIPE	S.INTR##	;SEE IF /INTERCHANGE
	POPJ	P,		;YES, DON'T WRITE T$UFD RECORDS
	MOVSI	T1,-.FXLND	;HOW MANY LEVELS
	HRRZS	ADRLST(T1)	;CLEAR LH(ADRLST)
	AOBJN	T1,.-1		; ...
	PUSHJ	P,WRTUFD	;WRITE T$UFD RECORDS
	POPJ	P,		;RETURN

NEXTAP:	SKIPE	CNAM		;FILE SPLIT ACCROSS REELS?
	PUSHJ	P,TYEFIL	;YES, TYPE FILE SPEC AND BLOCK NBR
	MTUNL.	F.MTAP,		;START UNLOADING THE TAPE
	OPER$	(EOT,Reached EOT--mount new tape then type "GO")
	PUSHJ	P,TYI		;WAIT FOR GO
	POPJ	P,		;RETURN
;HERE TO SAVE THE RING HEADER'S POSITION AFTER THE FIRST ERROR

NOTEOT:	SKIPN	P3		;SEE IF FIRST TIME THRU
	HRRZ	P3,S.MBPT##	;YES--SAVE CURRENT POSITION IN RING

;HERE TO FIND THE BUFFER WHICH HAD THE OUTPUT PROBLEM

	PUSHJ	P,FNDBUF	;FIND THE BUFFER
	  JRST	NOFIND		;LOSE

;HERE WHEN PROBLEM BUFFER FOUND

FOUND:	ANDCAM	P1,-1(P2)	;CLEAR ERROR BITS IN BUFFER STATUS WORD
	TXNE	P1,IO.DER!IO.DTE!IO.BKT ;DATA ERRORS?
	JRST	DATERR		;YES
NOREPT:	SETSTS	F.MTAP,.IOBIN	;NO--ONLY EOT, CLEAR STATUS
	HRRZ	P2,(P2)		;FORCE OUT FOLLOWING BUFFER
	CAME	P2,P3		; UNLESS DONE WITH RING
	JRST	FRCOUT		;FORCE OUT NEXT BUFFER
	TXNN	F,FL$EOV	;WROTE EOV ALREADY?
	JRST	MTASET		;NO
	JRST	NORCOV		;YES

DATERR:	MOVEI	MH,2(P2)	;SET POINTER
	PUSHJ	P,MASTER	;REPORT ERROR

	MOVE	T1,ERRCNT	;GET COUNT OF TAPE ERRORS
	TXNE	P1,IO.EOT	;PASSED EOT?
	CAIGE	T1,EOTEMX	;YES--TIME TO GIVE UP ON REPEATERS?
	SKIPA			;NO, PROCEED
	JRST	NOREPT		;YES


IFN FT$EMX,<
	CAIGE	T1,EMAX		;SEE IF MAXIMUM REACHED
	JRST	CNTOUT		;NO--CONTINUE OUTPUTTING
	OUTSTR	[ASCIZ /
?BKPRTE Reached Tape error maximum
/]
	MONRT.			;EXIT TO MONITOR
	SETZM	ERRCNT		;.CONTINUE WILL KEEP TRYING
>;END IFN FT$EMX

;READY TO WRITE REPEATER RECORD--WRITE 3 INCHES BLANK TAPE FIRST
;TO PASS BAD SPOT ON TAPE.

CNTOUT:	MTBLK.	F.MTAP,		;WRITE 3 IN. BLANK TAPE
	SETSTS	F.MTAP,.IOBIN	;CLEAR STATUS AFTER WRITING BLANK TAPE

;SEE IF REALLY CAN USE RECOVERY CODE

	SKIPE	(MH)		;SEE IF MONITOR ZEROED BUFFER IN SPITE OF UU.IBC
	TXNN	F,FL$RCV	;OR IF MONITOR DOESN'T SUPPORT UU.SIE
	JRST	MTARST		;NO RECOVERY POSSIBLE
;TO PREVENT RUNNING OFF THE END OF TAPE, WRITE ONLY ONE REPEATER
;OF A BAD RECORD AFTER IO.EOT IS SEEN

IFN FT$RCV,<
	MOVX	T1,GF$RPT	;REPEATER FLAG
	TDNE	T1,G$FLAG(MH)	;SEE IF THIS IS A REPEATER
	TXNN	P1,IO.EOT	; AND NEAR END OF TAPE
	SKIPA			;NO--WRITE A REPEATER RECORD
	JRST	NOREPT		;YES--GIVE UP ON THIS RECORD
	IORM	T1,G$FLAG(MH)	;SET REPEATER FLAG IN RECORD HEADER

IFN FT$CHK <
	PUSHJ	P,CHKSUM	;CORRECT CHECKSUM FOR REPEATER RECORD
>;END IFN FT$CHK

;CLEAR ALL USE BITS TO INSURE THAT THE REPEATER RECORD IS THE NEXT
;RECORD ACTUALLY OUTPUT TO TAPE

FRCOUT:	MOVSI	T1,(1B0)	;USE BIT
	MOVE	T2,P2		;WHERE TO START

CLRUSE:	ANDCAM	T1,(T2)		;CLEAR USE BIT
	HRR	T2,(T2)		;GO AROUND RING
	CAME	T2,P2		;DONE?
	JRST	CLRUSE		;NO

;READY TO DO OUTPUT.  RESET RING HEADER BYTE POINTER TO FAKE OUT MONITOR

	HRRM	P2,S.MBPT##	;POINT RING HEADER TO ERROR BUFFER
	MOVEI	T1,1(P2)	;PRETEND JUST FINISHED FILLING
	ADDI	T1,MTBBKP	;THIS BUFFER
	HRRM	T1,S.MBPT##+.BFPTR;SET BYTE POINTER
	SETZM	S.MBPT##+.BFCTR	;ZILCH COUNT

;IF THIS OUTPUT WINS, MAKE SURE ALL CURRENTLY FILLED BUFFERS
;IN RING ARE OUTPUT BEFORE FILLING ANY NEW BUFFER.

	OUT	F.MTAP,(P2)	;WRITE REPEATER RECORD
	  JRST	BUFOUT		;WON--SEE IF MONITOR HAS CAUGHT UP YET

CHKERR:	WAIT	F.MTAP,		;WAIT FOR I/O
	PUSHJ	P,FNDBUF	;FIND ERROR BUFFER
	  SKIPA			;LOSE--JUST RESET STATUS AND CONTINUE
	JRST	FOUND		;GO TAKE CARE OF IT

	SETSTS	F.MTAP,.IOBIN	;CLEAR ERROR STATUS
				;FALL INTO BUFOUT
BUFOUT:	HRRZ	T2,S.MBPT##	;GET CURRENT BUFFER ADDRESS
	CAMN	T2,P3		;CAUGHT UP YET TO ORIGINAL POSITION?
	JRST	MTASET		;YES--CAN CONTINUE FILLING BUFFERS

;HERE TO CONTINUE DOING OUTPUT UNTIL MONITOR ADVANCES RING HEADER
;POINTER TO ITS POSITION AFTER THE FIRST ERROR.

	SETZM	S.MBPT##+.BFCTR	;ZERO COUNT
	MOVEI	T1,MTBBKP	;LOAD OUTPUT BLOCK SIZE
	ADDM	T1,S.MBPT##+.BFPTR;INCREMENT BYTE POINTER
	OUT	F.MTAP,		;DO OUTPUT UNTIL CAUGHT UP
	  JRST	BUFOUT		;SUCCESSFUL OUTPUT
	JRST	CHKERR		;CHECK ERROR
>;END IFN FT$RCV

NOFIND:	SETSTS	.IOBIN		;CLEAR STATUS & REPORT STRANGE ERROR
	WARN$	(UOE,Untraceable output error)
;IF END OF SAVE, FORCE OUTPUT OF REMAINING BUFFERS BEFORE CLOSING
;THE CHANNEL TO TAKE ADVANTAGE OF TAPE ERROR RECOVERY CODE.

MTASET:	TXNN	F,FL$END	;SEE IF END OF SAVE SET
	JRST	MTARST		;NO, GO CLEAR RECORD HEADER

IFN FT$RCV,<
	TXNN	F,FL$RCV	;SEE IF RECOVERY CODE AVAILABLE
	JRST	NORCOV		;NO

	WAIT	F.MTAP,		;WAIT FOR ANY I/O IN PROGRESS
	GETSTS	F.MTAP,T1	;GET STATUS
	TRNE	T1,IO.DER!IO.DTE!IO.BKT ;IF DATA ERRORS,
	JRST	NOTEOT		;GO WRITE A REPEATER RECORD
	TRNE	T1,IO.EOT	;IF EOT,
	SETSTS	F.MTAP,.IOBIN	; MUST CLEAR EOT BEFORE DOING OUTPUT

	MOVSI	T1,(1B0)	;USE BIT
	SKIPN	P3		;FIRST TIME THRU?
	HRRZ	P3,S.MBPT##	;YES--GET CURRENT POSITION
	MOVE	P2,P3		;WHERE TO START

FINRNG:	TDNE	T1,(P2)		;RECORD OUTPUT TO TAPE YET?
	JRST	FRCOUT		;NO--FORCE OUT
	HRRZ	P2,(P2)		;GO AROUND RING
	CAME	P2,P3		;DONE?
	JRST	FINRNG		;NO--CONTINUE
>;END IFN FT$RCV

NORCOV:	TXZ	F,FL$END	;CLEAR
;HERE TO CLEAR RECORD HEADER OF NEW RECORD

MTARST:	HRRZ	MH,S.MBPT##+.BFPTR;GET NEW BUFFER POINTER ADDRESS
	ADDI	MH,1		;ADJUST ADDRESS
	SETZM	(MH)		;CLEAR RECORD HEADER
	MOVSI	T1,(MH)		;MAKE BLT POINTER
	HRRI	T1,1(MH)	; ...
	BLT	T1,M-1(MH)	;ZILCH HEADER
	POPJ	P,		;RETURN

;+
;<FNDBUF IS A SUBROUTINE TO FIND WHICH BUFFER IN THE RING HAD A WRITE
;PROBLEM. ^ON EXIT, ^P2 = ADDRESS OF PROBLEM BUFFER AND ^P1 = ERROR
;BITS FOUND. ^NON-SKIP RETURN IF CAN'T FIND IT.
;-

FNDBUF:	MOVE	P2,S.MBPT##	;START AT CURRENT POSITION
FNDBF1:	MOVE	P1,-1(P2)	;GET BUFFER STATUS WORD
	ANDI	P1,IO.DER!IO.DTE!IO.BKT!IO.EOT	;SAVE ONLY ERROR BITS
	JUMPN	P1,CPOPJ1	;IF ANY SET, GIVE SKIP RETURN
	HRR	P2,(P2)		;GET TO NEXT BUFFER
	CAME	P2,S.MBPT##	;FOUL UP?
	JRST	FNDBF1		;NO--KEEP CHECKING
	POPJ	P,		;YES--LOSE
;+
;<XMTAIN IS THE TAPE INPUT SUBROUTINE. ^IT GIVES A NON-SKIP RETURN
;ON END OF FILE OR IF THE <KILL COMMAND IS DETECTED. (^THESE CONDITIONS
;ARE FLAGGED IN <AC ^F.) ^IF THE RECORD'S CHECKSUM AGREES WITH THAT SAVED
;IN THE RECORD HEADER, IT IS SIMPLY PASSED TO THE MAIN PROGRAM. ^IF NOT,
;LOOK FOR A REPEATER RECORD. ^IF NO REPEATER IS NEXT, THERE IS NO
;BETTER COPY OF THE DATA ON TAPE, SO THE CURRENT RECORD IS USED
;ANYWAY. ^OTHERWISE IT IS DROPPED IN FAVOR OF THE REPEATER RECORD,
;AND THE SAME ALGORITHM IS APPLIED TO THE REPEATER RECORD.
;^IF THE RECORD WAS NEVER CHECKSUMED (<GF$NCH BIT IN <G$FLAG), THE
;ABOVE ALGORITHM IS APPLIED BASED ON WHETHER THE MONITOR SET DATA
;ERROR BITS IN THE BUFFER FILE STATUS WORD FOR THE RECORD.
;-

XMTAIN:	TXNE	F,FL$KIL	;IF /KILL ALREADY,
	POPJ	P,		;DON'T DO ANY MORE TAPE INPUT

	PUSHJ	P,SAVE2		;SAVE C(P1) AND C(P2)
	TXZ	F,FL$NBF!FL$FRS	;CLEAR NBF MESSAGE THIS BLOCK & FRS CONVERSION

DOINPT:	TXZE	F,FL$INP	;INPUT DONE ALREADY?
	JRST	BUFSTS		;YES

IFN FT$EMX,<
	SKIPLE	T1,ERRCNT	;GET CURRENT ERROR COUNT
	CAIGE	T1,EMAX		;SEE IF MAXIMUM REACHED
	JRST	CNTINP		;NO, CONTINUE INPUT
	OUTSTR	[ASCIZ /
?BKPRTE Reached tape error maximum
/]
	MONRT.			;EXIT TO MONITOR
	SETZM	ERRCNT		;.CONTINUE WILL KEEP TRYING
>;END IFN FT$EMX

CNTINP:	SETZM	S.MBPT##+.BFCTR	;ZERO HEADER
	MOVEI	T1,MTBFSZ	;LOAD BUFFER SIZE
	ADDM	T1,S.MBPT##+.BFPTR;INCREMENT BYTE POINTER

	INPUT	F.MTAP,		;EXECUTE INPUT UUO

BUFSTS:	HRRZ	P2,S.MBPT##	;GET BUFFER ADDRESS
	MOVE	P1,-1(P2)	;GET STATUS FROM BUFFER HEADER

	TLNN	P1,IO.END	;END OF FILE?
	JRST	NIEOF		;NO--SKIP

	CLOSE	F.MTAP,		;YES--CLEAR STATUS
	TXOE	F,FL$EF1	;ADJUST FLAGS
	TXO	F,FL$EF2	; ...
	TXNE	F,FL$EF2	;IF SECOND EOF,
	MTBSF.	F.MTAP,		; BACKSPACE OVER IT
	POPJ	P,		;EOF RETURN
NIEOF:	MOVEI	MH,2(P2)	;SET BUFFER POINTER
	MOVEI	T1,M(MH)	;POINT TO DATA AREA
	MOVEM	T1,MDATA	;STORE FOR LATER USERS

	MOVE	T1,G$TYPE(MH)	;GET RECORD TYPE
	CAIE	T1,T$EOV	;SEE IF END-OF-VOLUME
	JRST	NOTEOV		;NO, CONTINUE
	TXO	F,FL$EOV	;FLAG EOV
	TXNE	F,FL$OPN	;SKIP IF NOT WRITING ON DISK
	PUSHJ	P,RSTCK1	;PRESERVE DISK FILE
	  JFCL			;LOSE (WARNING ISSUED)

	CLOSE	F.MTAP,		;RESET STATUS
	TXZ	F,FL$EF1!FL$EF2!FL$EOV	;RESET EOF BITS
	PUSHJ	P,NEXTAP	;GET NEXT TAPE
	SETZM	PREPPN		;WILL CAUSE PPN TO  BE RETYPED
	SETZM	ERRCNT		;CLEAR COUNT OF TAPE ERRORS FOR NEW TAPE
	TXNE	F,FL$KIL	; WAS KILL TYPED?		[200]
	POPJ	P,		; YEP - SO EXIT			[200]
	JRST	DOINPT		;GO GET NEXT RECORD

NOTEOV:	TXZ	F,FL$EF1!FL$EF2	;ZERO EOF BITS
	TRNE	P1,IO.DER!IO.DTE!IO.BKT ;SEE IF DATA ERRORS
	SETSTS	F.MTAP,.IOBIN	;CLEAR ERROR STATUS

	TXNN	F,FL$PSI	;SEE IF PSI ENABLED
	JRST	[PUSHJ	P,OPRCMD##;NO--HANDLE ANY TTY INPUT
		 TXO	F,FL$KIL;HERE IF OPERATOR SAID KILL
		 JRST	.+1]	;CONTINUE
	TXNE	F,FL$KIL	;SEE IF OPERATOR SAID KILL
	POPJ	P,		;YES--GIVE ERROR RETURN

	MOVEI	T1,MTBBKP	;INDICATE BACKUP TAPE BLOCK LENGTH
	MOVE	T2,0(MH)	;GET FIRST WORK OF TAPE BLOCK
	TLNN	T2,777770	;SEE IF FRS OR BACKUP
	JRST	TSTIBL		;OK--CHECK FOR IBL
	TXOE	 F,FL$NBF	;WARNING ISSUED ALREADY?
	JRST	DOINPT		;YES, JUST SKIP THE RECORD
	WARN$N (NBF,Not BACKUP format)
	PUSHJ	P,MASTRX	;TYPE FILE SPEC
	JRST	 DOINPT		;LOOP UNTIL ONE FOUND

TSTIBL:	TXZ	F,FL$NBF	;GOOD--CLEAR FLAG
	TLNE	T2,-1		;IF FRS,
	PUSHJ	P,CNVFRS	; GO CONVERT TO BACKUP HEADER
	CAMN	T1,S.MBPT##+.BFCTR ;SEE IF CORRECT BLOCK LENGTH
	JRST	TSTCHK		;OK--GO TEST CHECKSUMMING
	AOS	ERRCNT		;STEP COUNT OF TAPE ERRORS
	WARN$N (IBL,Incorrect block length)
	PUSHJ	P,MASTRX	;TYPE FILE SPEC
	SKIPN	SUSDF		;DOES OLDER FILE EXIST?		[206]
	JRST	 DOINPT		;NO - SKIP OVER FLAKY DATA	[206]
	POPJ	P,		;DONT SUPERSEDE OLD FILE WITH BAD FILE [206]

TSTCHK:	MOVX	T1,GF$NCH	;NO CHECKSUM FLAG
	TDNN	T1,G$FLAG(MH)	;WAS IS CHECKSUMED?
	JRST	CMPCKS		;YES--GO COMPARE CHECKSUMS

IFN FT$RCV,<
	TRNN	P1,IO.DER!IO.DTE!IO.BKT ;ANY DATA ERRORS?
	JRST	USEREC		;NO, USE THE RECORD
	PUSHJ	P,RPTNXT	;IS THERE A REPEATER NEXT?
	  SKIPA			; NO				[206]
	JRST	DOINPT		;YES--CAN DROP THIS RECORD
	SKIPN	SUSDF		;IS THERE AN OLDER FILE?	[206]
	JRST	USEREC		;NO - USE THIS RECORD		[206]
	POPJ	P,		;YES - SO DONT SUPERSEDE	[206]
>;END IFN FT$RCV

CMPCKS:	MOVE	T3,G$CHK(MH)	;GET TAPE CHECKSUM FOR COMPARISON

IFN FT$CHK,<
	PUSHJ	P,CHKSUM	;RECOMPUTE CHECKSUM
>;END IFN FT$CHK

	CAMN	T3,G$CHK(MH)	;COMPARE
	JRST	USEREC		;MATCH--USE IT

IFN FT$RCV,<
	PUSHJ	P,RPTNXT	;REPEATER NEXT?
	  SKIPA			;NO
	JRST	DOINPT		;YES--CAN DROP THIS RECORD
>;END IFN FT$RCV

	WARN$N	(CHK,Checksum inconsistency)
	PUSHJ	P,MASTER+1	;TELL WHERE
	SKIPE	SUSDF		; SUPERSEDING NOW?		[206]
	POPJ	P,		; YES - ABORT TO SAVE OLD FILE	[206]
				;FALL INTO USEREC
;HERE TO USE THE RECORD POINTED TO BY MH.

USEREC:	TRNE	P1,IO.DER!IO.DTE!IO.BKT;IF WORD ERRORS,
	PUSHJ	P,MASTER	;REPORT THEM

;HERE TO TEST FOR ENCRYPTION AND DO UNSCRAMBLING.

	MOVE	T1,G$TYPE(MH)	;GET RECORD TYPE
	CAIN	T1,T$FIL	;FILE DATA?
	SKIPN	S.CRYP##	;PASSWORD TYPED?
	JRST	CPOPJ1		;RETURN NOW

	MOVEM	7,SAVACS+7	;SAVE REGISTERS
	MOVEI	7,SAVACS	; ..
	BLT	7,SAVACS+6	; ..
	MOVE	7,SAVACS+7	;RESTORE IF NEEDED

	TXOE	F,FL$INI	;INITIALIZED?
	JRST	UNSCRM		;CALL UNSCRAMBLER
IFLE F-7,<
	MOVEM	F,SAVACS+F	;STORE NEWLY SET FLAG
>;END IFLE F-7
	MOVEI	7,S.CRYP##	;ARGS
	PUSHJ	P,CRASZ.##	; ..
	MOVEM	5,SVCODE	;STORE

UNSCRM:	MOVSI	7,-200*N	;GET NEGATIVE NBR WORDS
	HRR	7,MDATA		;WHERE TO FIND THEM
	MOVE	1,G$LND(MH)	;GET LENGTH OF NON-DATA SECTION
	HRLS	1		;PUT IN LEFT HALF ALSO
	ADD	7,1		;ONLY DATA IS ENCRYPTED
	MOVE	6,F$RDW(MH)	;GET RELATIVE DATA WORD
	ADDI	6,200		;FORCE OVERFLOW
	ASH	6,-7		;GET RELATIVE BLOCK
	MOVE	5,SVCODE	;GET SEED BACK
	PUSHJ	P,CRYPT.##	;GO TRANSLATE

	MOVSI	7,SAVACS	;RESTORE REGISTERS
	BLT	7,7		; ..
	JRST	CPOPJ1		;SKIP RETURN
;ROUTINE TO CONVERT FRS TAPES TO BACKUP

CNVFRS:	WARN$	(FRS,FRS tapes not supported) ;***TEMP***
	POPJ	P,		;***TEMP***

	PUSHJ	P,SAVE2		;MAKE SOME EXTRA ROOM
	TXO	F,FL$FRS	;FOR MINOR AFFECTS HANDLED ELSEWHERE
	STORE	T1,FRSHDR,FRSHDE,0 ;CLEAR CONVERSION AREA

	TRO	T2,(GF$NCH)	;SET NO CHECKSUM FLAG
	HRLZM	T2,FRSHDR+G$FLAG;RH(WORD 0) ARE LH FLAGS
	HLRZM	T2,FRSHDR+G$TYPE ;LH(WORD 0) IS RECORD TYPE
	MOVE	T1,1(MH)	;WORD 1 IS
	MOVEM	T1,FRSHDR+G$RTNM ; TAPE COUNTER
	MOVEI	T2,2(MH)	;POINT TO TYPE SPECIFIC REGION
	MOVE	T4,FRSHDR+G$TYPE ;GET TYPE
	MOVE	T4,FRSTBL-1(T4) ;GET POINTER OF WORK TO DO
CNVFR1:	MOVE	T3,(T4)		;GET POINTER FOR TRANSFERS
CNVFR2:	MOVE	T1,(T2)		;GET NEXT INPUT
	MOVEM	T1,FRSHDR(T3)	;STORE IN NEXT OUTPUT
	AOS	T2		;INCREMENT INPUT
	AOBJN	T3,CNVFR2	;LOOP OVER CONSECUTIVE STORES
	AOBJN	T4,CNVFR1	;LOOP OVER ALL STORES

	MOVSI	P2,-FRSDTL	;GET LOOP OF DATES TO CONVERT
CNVFR3:	MOVE	P1,FRSDTM(P2)	;GET NEXT INSTRUCTION
	HLRZ	T2,P1		;GET ADDRESS OF DATE
	TRZE	T2,1B18		;CLEAR FLAG
	TDZA	T1,T1		;CLEAR TIME IF SET
	MOVE	T1,-1(T2)	; ELSE, GET TIME
	IMULI	T1,^D60000	;CONVERT TIME TO MILLISECONDS
	SKIPN	T2,(T2)		;GET DATE
	JRST	CNVFR4		;NOT SET--IGNORE
	PUSHJ	P,CONVDT	;CONVERT IT
	MOVEM	T1,FRSHDR(P1)	;STORE RESULT
CNVFR4:	AOBJN	P2,CNVFR3	;LOOP OVER DATES

	SKIPE	T1,FRSSTK	;GET 7-TRACK FLAG
	MOVX	T1,MT.7TR	;SET FOR MTCHR.
	LDB	T2,[POINTR (FRSSMD,IO.DEN)] ;GET DENSITY
	DPB	T2,[POINTR (T1,MT.DEN)] ;SET FOR MTCHR.
	MOVEM	T1,FRSHDR+S$MTCH ;SET WHERE BACKUP DOES IT

	MOVE	T2,FRSHDR+G$TYPE;GET TYPE
	CAIE	T2,T$FIL	;SEE IF FILE,
	JRST	CNVFR5		;NO
	MOVX	T1,GF$SOF	;SET START OF FILE FLAG
	SKIPN	FRSRDB		;SEE IF FIRST DATA BLOCK
	IORM	T1,FRSHDR+G$FLAG;SET FLAG IF SO
	MOVE	T1,FRSSDB	;GET NBR SDB
	JUMPE	T1,CNVFIL	;SKIP IF NULL
	SUBI	T1,1		;CALCULATE G$SIZ
	IMULI	T1,200		; ..
	ADD	T1,FRSSIZ	;ADD ON SIZE OF LAST BLOCK
CNVFIL:	MOVEM	T1,FRSHDR+G$SIZ	;STORE
	SKIPE	T1,FRSRDB	;GET RELATIVE DATA BLOCK
	SUBI	T1,1		;CALCULATE RELATIVE DATA WORD
	IMULI	T1,200		; ...
	MOVEM	T1,FRSHDR+F$RDW;STORE
	MOVEI	T1,177+24(MH)	;POINT TO UFD
	SUB	T1,FRSLVL	;SUBTRACT LEVEL
	SETZM	-1(T1)		;ZILCH ONE HIGHER
 
	;***TEMP*** CREATE ASCIZ NAME

CNVFR5:	SKIPN	T1,FRSSTR	;LOAD FS NAME
	JRST	CNVFR6		;IF NONE, NOT FILE OR UFD TYPE
	MOVE	T3,[POINT 7,FRSHDR+F$PTH];INITIAL PATH POINTER
	CAIN	T2,T$UFD	;SEE IF UFD TYPE
	MOVE	T3,[POINT 7,FRSHDR+D$STR];CORRECT POINTER
	MOVEI	T2,.FCDEV	;INDICATE DATA TYPE
	PUSHJ	P,SETPTH	;SET IN PATH BLOCK
	SKIPN	T1,FRSPPN	;GET FRS PPN
	JRST	CNVFR6		;MUST BE UFD TYPE
	MOVEI	T2,.FCDIR	;INDICATE DATA TYPE
	PUSHJ	P,SETPTH	;SET IN PATH BLOCK
	MOVE	T1,FRSNAM	;GET FILE NAME
	MOVEI	T2,.FCNAM	;DAT TYPE
	PUSHJ	P,SETPTH	;STORE
	MOVE	T1,FRSEXT	;EXTENSION
	MOVEI	T2,.FCEXT	;DATA TYPE
	PUSHJ	P,SETPTH	;STORE

CNVFR6:	MOVEI	T1,24(MH)	;SET DATA POINTER
	MOVEM	T1,MDATA	; FOR ALL USERS
	MOVEI	MH,FRSHDR	;POINT TO CONVERTED HEADER
	MOVEI	T1,MTBFRS	;INDICATE FRS BLOCK SIZE
	POPJ	P,		;RETURN
;TABLE OF TRANSLATIONS BY RECORD TYPE

FRSTBL:	-FRSLLB,,FRSTLB		;1=LABEL
	-FRSLSS,,FRSTSS		;2=START SAVE SET
	-FRSLSS,,FRSTSS		;3=END SAVE SET
	-FRSLFL,,FRSTFL		;4=FILE
	-FRSLDR,,FRSTDR		;5=DIRECTORY
	-FRSLJK,,FRSTJK		;6=JUNK
	-FRSLJK,,FRSTJK		;7=JUNK

;TABLES CONTAINING -NO WORDS (0=1),,ADDRESS TO STORE

FRSTLB:				;LABEL
	    L$RLNM		;TAPE REEL NAME
	-3,,FRSTIM-FRSHDR	;TIME, DATE, DESTROY DATE
	;-16 CONTAIN NOTHING
FRSLLB==.-FRSTLB

FRSTSS:				;START/END SAVE SET
	-5,,S$BVER+2		;SYSTEM NAME***TEMP***
	    S$SVER		;VERSION
	-2,,S$FMT		;FORMAT VERSION, FRS VERSION
	-4,,FRSSTM-FRSHDR	;TIME, DATE, MODE, TRACKS
	    S$BVER+1		;SAVE SET NAME***TEMP***
	    S$DEV		;DEVICE
	;-4 CONTAIN NOTHING
FRSLSS==.-FRSTSS

FRSTFL:				;FILE
	-5,,FRSSTR-FRSHDR	;STR, NAME, EXT, PPN, REL DATA BLK
	    G$CHK		;CHECKSUM
	-3,,FRSSDB-FRSHDR	;BLKS IN REC, WRDS IN L.BLK, LVL
	;-11 CONTAIN NOTHING
FRSLFL==.-FRSTFL

FRSTDR:				;DIRECTORY
	    FRSSTR-FRSHDR	;UFD STRUCTURE
	    D$LVL		;DIRECTORY LEVEL
	;-20 CONTAIN NOTHING
FRSLDR==.-FRSTDR

FRSTJK:				;UNKNOWN TYPE
	-22,,G$FLAG+1		;STRAIGHT TRANSLATION
FRSLJK==.-FRSTJK

;TABLE OF DATE CONVERSIONS
;FORMAT: BYTE (1)NO TIME (17)SOURCE DATE (18) RESULT

FRSDTM:	BYTE (1)0 (17)FRSDAT (18)L$DATE	;LABEL CREATION
	BYTE (1)1 (17)FRSDSD (18)L$DSTR	;DESTROY DATE
	BYTE (1)0 (17)FRSSDT (18)S$DATE	;SAVE SET DATE
FRSDTL==.-FRSDTM
;+
;<MASTER IS A SUBROUTINE TO REPORT TAPE <I/O PROBLEMS. ^THE
;SPECIFIC <I/O ERROR IS TYPED AND IF THE TAPE RECORD CONTAINED FILE DATA,
;THE FILE SPECIFICATION AND BLOCK NUMBER ARE ALSO TYPED.
;-

MASTER:	PUSHJ	P,ERRBIT	;TYPE ERROR BIT INFO
	AOS	ERRCNT		;STEP TAPE ERROR COUNT
	SKIPGE	S.OPER##	;WRITE OPERATION?
	OUTSTR	[ASCIZ /writing /] ;MESSAGE
	SKIPL	S.OPER##	;ACTUALLY A READ OPERATION?
	OUTSTR	[ASCIZ /reading /] ;MESSAGE
	MOVE	T1,G$TYPE(MH)	;GET RECORD TYPE
	CAIE	T1,T$FIL	;FILE DATA?
	JRST	NONFIL		;NO--NOTE
	TXO	F,FL$TPE	;SET TAPE READ ERROR FLAG

	MOVE	T3,[POINT 7,F$PTH(MH)];POINTER TO FILE INFO
	ILDB	T1,T3		;GET FIRST BYTE
	CAIE	T1,.FCDEV	;SEE IF DEVICE
	JRST	MSTDIR		;NO
	PUSHJ	P,TYPID		;TYPE FS NAME
	OUTCHR	COLON		; ..
MSTDIR:	CAIE	T1,.FCDIR	;SEE IF DIRECTORY NEXT
	JRST	MSTFIL		;JUMP IF NOT
	OUTCHR	LBR		; ..
MSTSFD:	PUSHJ	P,TYPID		;TYPE DIRECTORY
	CAIGE	T1,.FCSF1	;SFD NEXT?
	JRST	MSTRBR		;NO
	OUTCHR	COMMA		;YES, TYPE COMMA
	JRST	MSTSFD		;LOOP TO TYPE SFD
MSTRBR:	OUTCHR	RBR		;RIGHT BRACKET
MSTFIL:	CAIE	T1,.FCNAM	;FILE NAME NEXT?
	JRST	MSTBLK		;NO
	PUSHJ	P,TYPID		;TYPE FILE NAME
	CAIE	T1,.FCEXT	;EXTENSION NEXT?
	JRST	MSTBLK		;NO
	OUTCHR	DOT		; ..
	PUSHJ	P,TYPID		;TYPE EXTENSION
MSTBLK:	OUTSTR	[ASCIZ /(BLOCK=/]
	MOVE	T1,F$RDW(MH)	;GET RELATIVE DATA WORD
	ADDI	T1,200		;FORCE OVERFLOW
	ASH	T1,-7		;GET RELATIVE BLOCK NBR
	PUSHJ	P,DECOUT	;TYPE
	OUTSTR	[ASCIZ /)
/]
	POPJ	P,		;DONE

MASTRX:	OUTSTR	[ASCIZ /reading /];MESSAGE
	SKIPN	CNAM		;DURING FILE DATA?
	JRST	NONFIL		;NO
	TXO	F,FL$TPE	;SET TAPE READ ERROR FLAG
	JRST	DOWHAT		;TYPE FILE SPEC AND RETURN

NONFIL:	OUTSTR	[ASCIZ /non-file data
/]
	POPJ	P,		;RETURN
;+
;<ERRBIT IS A SUBROUTINE TO DECODE THE TAPE ERROR STATUS BITS AND
;TYPE APPROPRIATE WARNING MESSAGES.
;-

ERRBIT:	TRNE	P1,IO.DER
	WARN$N	(THE,Tape hardware error)
	TRNE	P1,IO.DTE
	WARN$N	(TPE,Tape parity error)
	TRNE	P1,IO.BKT
	WARN$N	(BTL,Block too large)
	POPJ	P,		;RETURN

;+
;<CHKSUM COMPUTES THE CHECKSUM FOR A TAPE RECORD AND STORES THE VALUE
;IN THE RECORD HEADER AT <G$CHK. ^CALL WITH <MH POINTING TO THE TAPE
;BUFFER. ^USES ^T1 _& ^T2.
;-

IFN FT$CHK,<
CHKSUM:	SETZB	T1,G$CHK(MH)	;START WITH ZERO
	MOVSI	T2,-MTBBKP	;AOBJN WORD FOR TAPE BUFFER
	HRR	T2,MH		;GET START ADDRESS OF BUFFER
CHKSM1:	ADD	T1,(T2)		;DO CHECKSUMMING
	ROT	T1,1		; ...
	AOBJN	T2,CHKSM1	;NEXT WORD
	MOVEM	T1,G$CHK(MH)	;STORE IN HEADER
	POPJ	P,		;RETURN
>;END IFN FT$CHK
;+
;<RPTNXT IS A ROUTINE TO DETERMINE IF THE FOLLOWING RECORD ON TAPE
;IS A REPEATER RECORD. ^CALLED WITH ^P2 = POINTER TO  SECOND WORD
;OF CURRENT BUFFER HEADER. ^A SKIP RETURN IS GIVEN IF A REPEATER
;RECORD IS NEXT. ^THE <FL$INP FLAG IS SET IF INPUT WAS FORCED IN
;ORDER TO LOOK AHEAD.
;-

IFN FT$RCV,<
RPTNXT:	PUSHJ	P,SAVE1		;SAVE C(P1)
	WAIT	F.MTAP,		;WAIT FOR I/O TO FINISH
	HRRZ	P1,(P2)		;ADDRESS OF NEXT BUFFER
	MOVSI	T1,(1B0)	;USE BIT
	TDNE	T1,(P1)		;SEE IF FILLED YET
	JRST	TSTRPT		;YES--GO CHECK REPEATER BIT

;HERE TO FORCE INPUT OF NEXT TAPE RECORD TO SEE IF IT IS A REPEATER.
;FIRST, REMOVE CURRENT BUFFER FROM RING TO PREVENT IT FROM BEING
;OVERWRITTEN WITH NEW DATA. NEED TO FIND PREVIOUS BUFFER TO UPDATE
;IT'S POINTER.

	PUSHJ	P,FNDPRV	;GET ADDRESS OF PREVIOUS IN T1

;HERE WITH T1 = ADDRESS OF PREVIOUS BUFFER. IF XMTABF = 0 REMOVE
;CURRENT BUFFER FROM RING AND SAVE IT'S ADDRESS IN XMTABF. IF
;XMTABF IS NON-ZERO, THERE ALREADY IS A BUFFER OUT OF THE RING,
;SO SWITCH THEM.

	SKIPN	T2,XMTABF	;GET REMOVED BUFFER, IF ANY
	MOVE	T2,P1		;USE NEXT BUFFER INSTEAD
	HRRM	T2,(T1)		;STUFF INTO PREVIOUS BUFFER
	SKIPE	XMTABF		;SKIP IF NOT SWITCHING
	HRRM	P1,@XMTABF	;UPDATE POINTER OF INSERTED BUFFER
	MOVEM	P2,XMTABF	;SAVE ADDRESS OF REMOVED BUFFER

	MOVSI	T1,(1B0)	;CLEAR USE BIT OF REMOVED BUFFER
	ANDCAM	T1,(P2)		; SO IT WONT CAUSE TROUBLE LATER

;NOW CAN FORCE INPUT SAFELY

	SETZM	S.MBPT##+.BFCTR	;ZILCH
	MOVEI	T1,MTBFSZ	;LOAD BUFFER SIZE
	ADDM	T1,S.MBPT##+.BFPTR;SET POINTER
	INPUT	F.MTAP,(P1)	;FORCE INPUT ON THIS BUFFER
	TXO	F,FL$INP	;FLAG INPUT DONE
;HERE TO SEE IF NEXT TAPE RECORD IS A REPEATER RECORD
;ALSO REJECT RECORD IF BAD BUFFER SIZE OR NOT BACKUP FORMAT

TSTRPT:	ADDI	P1,2		;POINT TO DATA
	MOVE	T2,(P1)		;FIRST DATA WORD
	TLNE	T2,777770	;SEE IF JUNK
	POPJ	P,		;NO GOOD--GIVE BAD RETURN

	MOVEI	T1,MTBBKP	;BACKUP BUFFER SIZE
	TLNE	T2,-1		;SEE IF FRS
	MOVEI	T1,MTBFRS	;LOAD FRS BUFFER SIZE
	CAME	T1,-1(P1)	;CHECK BUFFER COUNT
	POPJ	P,		;NO GOOD--GIVE BAD RETURN

	MOVX	T1,GF$RPT	;REPEATER FLAG
	TDNE	T1,G$FLAG(P1)	;SEE IF ON
	AOS	(P)		;YES--ADVANCE RETURN
	POPJ	P,		;RETURN
>;END IFN FT$RCV

;+
;<FNDPRV IS A ROUTINE TO FIND THE PREDECESSOR BUFFER IN A RING.
;^CALL WITH ^P2 = ADDRESS OF "CURRENT" BUFFER (<LH MUST BE ZERO).
;^RETURNS WITH ^T1 = ADDRESS OF PREDECESSOR BUFFER. ^CLOBBERS ^T2.
;-

FNDPRV:	MOVE	T1,P2		;START WITH CURRENT BUFFER
FNDPR1:	HRRZ	T2,(T1)		;LOAD THIS BUFFER'S POINTER
	CAMN	T2,P2		;DOES IT POINT TO THE CURRENT BUFFER?
	POPJ	P,		;YES--RETURN WITH PREVIOUS ADR IN T1
	HRRZ	T1,(T1)		;GO AROUND RING
	JRST	FNDPR1		;FIND PREVIOUS
	SUBTTL	DISK INPUT/OUTPUT ROUTINE

;+
;.CHAPTER DISK INPUT/OUTPUT ROUTINE
;-

;+
;<DSKOUT AND <DSKIN ARE THE USUAL ENTRY POINTS TO THE DISK <I/O
;ROUTINE. ^EITHER AN <OUT OR AN <IN <UUO IS EXECUTED AND A DOUBLE
;SKIP RETURN IS GIVEN IF NO PROBLEM IS ENCOUNTERED. ^ON EXIT, <DBUF
;IS SET TO POINT TO THE "NEW" DISK BUFFER. ^A SINGLE SKIP RETURN
;INDICATES END OF FILE. ^ON  AN ERROR RETURN FROM THE <UUO,
;THE SUBROUTINE ISSUES A WARNING AND GIVES A NON-SKIP RETURN.
;
;<ALTDSK IS AN ALTERNATE ENTRY POINT TO THE DISK <I/O ROUTINE WHICH
;IS USED WHEN WRITING THE LAST DISK BLOCK FOR A FILE ON A <RESTORE.
;^IT IS CALLED TO ADJUST THE DISK RING HEADER BYTE POINTER FOR THE ACTUAL
;NUMBER OF DATA WORDS IN THE BUFFER. ^THIS CAUSES THE MONITOR TO RECORD
;THE FILE SIZE IN <.RBSIZ CORRECTLY.
;-

DSKOUT:	SKIPA	T1,[OUT FILE,0]	;OUTPUT CALL
DSKIN:	MOVSI	T1,(<IN FILE,0>) ;INPUT CALL
	SETZ	T2,		;ZERO C(T2)
	EXCH	T2,DSKHDR+.BFCTR;ZERO BYTE COUNT
ALTDSK:	ADDM	T2,DSKHDR+.BFPTR;INCREMENT BYTE POINTER
	XCT	T1		;XCT I/O UUO
	  JRST	DSKSET		;OK
	WAIT	FILE,		;WAIT FOR I/O TO CEASE
	GETSTS	FILE,T1		;GET ERROR STS
	TRNE	T1,IO.EOF	;SKIP IF NOT EOF
	JRST	CPOPJ1		;RETURN
	WARN$N	(DIO,Disk I/O error)
	PUSHJ	P,OCTOUT	;TYPE STATUS 
	OUTSTR	[ASCIZ / during/] ;TELL WHEN
	SAVE$	P1		;SAVE C(P1)
	MOVEI	P1,EXLFIL	;ADDRESS OF LOOKUP/ENTER BLOCK
	PUSHJ	P,GUUO		;TYPE OUT
	RSTR$	P1		;RESTORE C(P1)
	POPJ	P,		;RETURN
DSKSET:	HRRZ	DBUF,DSKHDR+.BFPTR;FIRST DATA WORD MINUS ONE
	AOJA	DBUF,CPOPJ2	;RETURN
	SUBTTL	LIST OUTPUT SUBROUTINES

;+
;.CHAPTER LIST OUTPUT SUBROUTINES
;-

;+
;<LSTTAB INSERTS A TAB INTO THE LISTING FILE.
;-

LSTTAB:	MOVEI	CH,.CHTAB	;LOAD HORIZONTAL TAB

;+
;<LSTOUT IS THE SUBROUTINE CALLED TO HANDLE FILLING AND OUTPUTING
;THE LISTING BUFFERS.
;-

LSTOUT:	SOSG	S.LBPT##+.BFCTR	;SEE IF ANY ROOM LEFT
	OUTPUT	F.LIST,		;NONE. ADVANCE BUFFERS
	IDPB	CH,S.LBPT##+.BFPTR;STORE CHARACTER
	POPJ	P,		;RETURN

;+
;<LSTMSG OUTPUTS AN <ASCIZ STRING TO THE LISTING FILE. ^CALL
;WITH ADDRESS OF STRING IN ^T1.
;-

LSTMSG:	HRLI	T1,440700	;BYTE POINTER
LSTMSA:	ILDB	CH,T1		;GET CHARACTER
	JUMPE	CH,CPOPJ	;RETURN IF NULL
	PUSHJ	P,LSTOUT	;SEND TO FILE
	JRST	LSTMSA		;LOOP FOR NEXT CHAR

;+
;<LST6 CONVERTS THE <SIXBIT WORD IN ^T1 TO <ASCII AND LISTS IT.
;-

LST6:	MOVE	T2,T1		;COPY C(T1)
LST6A:	JUMPE	T2,CPOPJ	;RETURN IF NULL
	MOVEI	T1,0		;FIRST ZILCH
	LSHC	T1,6		;CAPTURE A CH
	MOVEI	CH," "-' '(T1)	;FORM ASCII EQUIV IN CH
	PUSHJ	P,LSTOUT	;SEND TO FILE
	JRST	LST6A		;CONTINUE
;+
;<LSTOCT LISTS THE OCTAL NUMBER IN ^T1.
;<LSTDEC LISTS THE DECIMAL NUMBER IN ^T1.
;-

LSTOCT:	TDZA	T3,T3		;OCTAL RADIX
LSTDEC:	MOVEI	T3,2		;DECIMAL RADIX
	MOVEI	CH,"-"		;MINUS SIGN
	SKIPGE	T1		;SEE IF POSITIVE
	PUSHJ	P,LSTOUT	;SEND MINUS SIGN TO FILE
LSTNBR:	IDIVI	T1,8(T3)	;SPLIT DIGITS
	MOVMS	T2		;CLEAR MINUS SIGN
	HRLM	T2,(P)		;STORE DIGIT ON STACK
	SKIPE	T1		;SKIP IF DONE
	PUSHJ	P,LSTNBR	;RECURSE
	HLRZ	CH,(P)		;FETCH CH OFF STACK
	ADDI	CH,"0"		;CONVERT TO ASCII
	JRST	LSTOUT		;SEND TO FILE

;+
;<LSTBTH LISTS TWO DIGITS OF THE DECIMAL NUMBER IN ^T1, WITH A 
;LEADING ZERO IF LESS THAN TEN.
;
;<LSTTWO LISTS TWO DIGITS OF THE DECIMAL NUMBER IN ^T1, WITH A
;LEADING SPACE IF LESS THAN TEN.
;-

LSTBTH:	MOVEI	CH,"0"		;SET LEADING ZERO
	SKIPA			;  ...
LSTTWO:	MOVEI	CH," "		;SET LEADING SPACE
	IDIVI	T1,^D10		;SPLIT DIGITS
	SKIPE	T1		;SKIP IF CORRECT
	MOVEI	CH,"0"(T1)	;WRONG. GET ASCII DIGIT
	PUSHJ	P,LSTOUT	;SEND TO FILE
	MOVEI	CH,"0"(T2)	;GET SECOND DIGIT
	JRST	LSTOUT		;SEND TO FILE
;+
;<LSTDAT LISTS A DATE IN <DD-MMM-YY FORMAT.
;^CALL WITH ^T1 = DATE IN SYSTEM FORMAT.
;-

LSTDAT:	IDIVI	T1,^D31		;GET DAYS
	SAVE$	T1		;STORE QUOTIENT ON STACK
	MOVEI	T1,1(T2)	;GET DAYS IN T1
	PUSHJ	P,LSTTWO	;SEND TO FILE
	RSTR$	T1		;RETRIEVE QUOTIENT
	IDIVI	T1,^D12		;GET MONTHS
	SAVE$	T1		;STORE QUOTIENT ON STACK
	MOVEI	T1,MONTBL(T2)	;GET MONTH
	PUSHJ	P,LSTMSG	;SEND TO FILE
	MOVEI	CH,"-"		;SECOND DASH
	PUSHJ	P,LSTOUT	;TO FILE
	RSTR$	T1		;RETRIEVE YEARS
	ADDI	T1,^D64		;64 IS BASE YEAR
	JRST	LSTDEC		;SEND TO FILE

;+
;<LSTTIM LISTS THE TIME IN <HH:MM:SS FORMAT WITH LEADING ZEROS.
;^CALL WITH ^T1 = TIME IN MILLISECONDS.
;-

LSTTIM:	IDIV	T1,[^D3600000]	;CALCULATE HOURS
	IDIVI	T2,^D60000	;CALCULATE MINUTES
	IDIVI	T3,^D1000	;CALCULATE SECONDS
	PUSH	P,T3		;SAVE SECONDS FOR LATER
	PUSH	P,T2		;SAVE MINUTES FOR LATER
	PUSHJ	P,LSTBTH	;LIST HOURS
	MOVEI	CH,":"		;SET COLON
	PUSHJ	P,LSTOUT	;LIST COLON
	POP	P,T1		;GET MINUTES BACK
	PUSHJ	P,LSTBTH	;LIST MINUTES
	MOVEI	CH,":"		;SET COLON
	PUSHJ	P,LSTOUT	;LIST COLON
	POP	P,T1		;GET SECONDS BACK
	JRST	LSTBTH		;LIST SECONDS AND RETURN
;+
;<LSTXXX IS A SUBROUTINE TO LIST THE START/END OF SAVE SET INFORMATION.
;-

LSTXXX:	SKIPN	S.LIST##	;SKIP IF LISTING ORDERED
	POPJ	P,		;RETURN

	PUSHJ	P,SAVE1		;SAVE C(P1)
	SETZM	LSTSTR		;CLEAR LAST LIST STR

	MOVE	T2,G$TYPE(MH)	;GET RECORD TYPE		[211]
	CAIE	T2,T$CON	;IF CONTINUATION,		[211]
	JRST	LSTXX1		;NOT CONTINUATION		[211]
	MOVEI	CH,14		;GET A FORM-FEED		[211]
	MOVEI	T1,F.LIST	;LISTING CHANNEL		[211]
	DEVCHR	T1,		;GET CHARACTERISTICS		[211]
	TXNN	T1,DV.TTY	;IS DEV A TTY?			[211]
	PUSHJ	P,LSTOUT	;NO - START A NEW PAGE		[211]

LSTXX1:	MOVEI	T1,[ASCIZ /Start/] ;ASSUME START OF SAVE	[211]
	CAIN	T2,T$CON	;IF CONTINUATION,
	MOVEI	T1,[ASCIZ /

**********************************************************************

Continuation/]
	CAIN	T2,T$END	;SKIP IF NOT END OF SAVE
	MOVEI	T1,[ASCIZ /
End/]
	PUSHJ	P,LSTMSG	;SEND TO FILE

	MOVEI	T1,[ASCIZ / of save set /] ;COMMON CODE
	PUSHJ	P,LSTMSG	; ..
	MOVEI	T3,M(MH)	;START OF DATA AREA
	ADD	T3,G$LND(MH)	;END OF NON-DATA PORTION
	MOVEI	T1,M+1(MH)	;ADDRESS OF ASCII STRING
LSTSSN:	HLRZ	T2,-1(T1)	;GET BLOCK TYPE CODE
	CAIN	T2,O$SSNM	;SEE IF SAVE SET BLOCK
	PUSHJ	P,LSTMSG	;LIST SAVE SET NAME
	HRRZ	T2,-1(T1)	;GET LENGTH OF BLOCK
	ADD	T1,T2		;ADVANCE POINTER
	CAIGE	T1,(T3)		;SEE IF MORE BLOCKS
	JRST	LSTSSN		;YES, CIRCLE
	MOVEI	T1,[ASCIZ / on /] ;TELL WHERE
	PUSHJ	P,LSTMSG	;SEND TO FILE
	MOVE	T1,S$DEV(MH)	;GET PHYSICAL DEVICE NAME
	PUSHJ	P,LST6		;SEND TO FILE
	MOVEI	CH," "		;SPACE
	PUSHJ	P,LSTOUT	;SEND
	MOVE	T1,S$RLNM(MH)	;GET REELID
	PUSHJ	P,LST6		;SEND
;HERE TO LIST THE SECOND LINE OF THE SAVE SET HEADER

	MOVEI	T1,[ASCIZ /
System /]
	PUSHJ	P,LSTMSG	; ..
	MOVEI	T3,M(MH)	;START OF DATA AREA
	ADD	T3,G$LND(MH)	;END OF NON-DATA PORTION
	MOVEI	T1,M+1(MH)	;ADDRESS OF ASCII STRING
LSTSYS:	HLRZ	T2,-1(T1)	;GET BLOCK TYPE CODE
	CAIN	T2,O$SYSN	;SEE IF SYSEM HEADER
	PUSHJ	P,LSTMSG	;YES, LIST
	HRRZ	T2,-1(T1)	;GET LENGTH OF BLOCK
	ADD	T1,T2		;ADD TO POINTER
	CAIGE	T1,(T3)		;SEE IF REACHED END
	JRST	LSTSYS		;CIRCLE
	LDB	T1,[POINTR (S$MON(MH),CN%MNT)];GET MONITOR TYPE BYTE
	CAIL	T1,LN$MTP	;SEE IF DEFINED
	SETZ	T1,		;NO, UNKNOWN
	MOVE	T1,MTPTBL(T1)	;GET ADDRESS OF MONITOR TYPE STRING
	PUSHJ	P,LSTMSG	;SEND TO FILE
	MOVEI	T1,[ASCIZ / monitor /] ; ..
	PUSHJ	P,LSTMSG	; ..
	MOVE	P1,S$SVER(MH)	;GET MONITOR VERSION
	PUSHJ	P,LSTVER	;SEND TO FILE
	MOVEI	T1,[ASCIZ / APR#/] ; ..
	PUSHJ	P,LSTMSG	; ..
	MOVE	T1,S$APR(MH)	;GET APR SERIAL NUMBER
	PUSHJ	P,LSTDEC	;SEND TO FILE
	MOVEI	T1,CRLF		;<CR><LF>
	PUSHJ	P,LSTMSG	;SEND TO FILE
;HERE TO LIST THE THIRD LINE OF THE SAVE SET HEADER

	LDB	T1,[POINTR (S$MTCH(MH),MT.DEN)] ;GET DENSITY BYTE
	MOVE	T1,DNSTBL(T1)	;GET ADDRESS OF DENSITY STRING
	PUSHJ	P,LSTMSG	;SEND TO FILE
	MOVEI	CH,"9"		;ASSUME 9 TRACK
	MOVEI	T1,MT.7TR	;SEE IF SEVEN TRACK
	TDNE	T1,S$MTCH(MH)	;SKIP IF OFF
	MOVEI	CH,"7"		;LOAD ASCII SEVEN
	PUSHJ	P,LSTOUT	;SEND
	MOVEI	T1,[ASCIZ / track /]
	PUSHJ	P,LSTMSG	;SEND
	MOVE	T1,S$DATE(MH)	;GET DATE/TIME IN UNIVERSAL FORMAT
	PUSHJ	P,CONTDT	;CONVERT TO SYSTEM FORMAT
	PUSH	P,T1		;SAVE TIME FOR LATER
	MOVE	T1,T2		;GET DATE
	PUSHJ	P,LSTDAT	;LIST DATE
	MOVEI	CH," "		;SPACE
	PUSHJ	P,LSTOUT	;SEND
	POP	P,T1		;GET TIME BACK
	PUSHJ	P,LSTTIM	;LIST TIME
	MOVEI	T1,[ASCIZ / BACKUP /]
	PUSHJ	P,LSTMSG	;SEND TO FILE
	MOVE	P1,S$BVER(MH)	;GET VERSION
	PUSHJ	P,LSTVER	;TYPE VERSION
	MOVEI	T1,[ASCIZ / tape format /] ; ..
	PUSHJ	P,LSTMSG	; ..
	MOVE	T1,S$FMT(MH)	;GET FORMAT
	PUSHJ	P,LSTDEC	;TYPE DECIMAL
	MOVEI	T1,CRLF		;SEND CR-LF
	PUSHJ	P,LSTMSG	;SEND TO FILE

;HERE TO LIST THE FOURTH LINE OF THE SAVE SET HEADER

	MOVEI	T1,[ASCIZ /Tape number  /]
	PUSHJ	P,LSTMSG	;SEND
	MOVE	T1,NTPE		;GET TAPE NUMBER
	PUSHJ	P,LSTDEC	;SEND
	MOVEI	T1,[ASCIZ /

**********************************************************************

/]
	MOVEI	T2,T$CON	;ASTERISK OFFSET FOR CONTINUATION HEADER
	CAMN	T2,G$TYPE(MH)	; ...
	PUSHJ	P,LSTMSG	;SEND ASTERISK LINE
	MOVEI	T1,CRLF		;SEND ONE CR-LF
	PUSHJ	P,LSTMSG	;SEND TO FILE
	MOVEI	T1,CRLF		;FINISH WITH SECOND CR-LF
	JRST	LSTMSG		;SEND TO FILE
;+
;<LSTVER IS A SUBROUTINE TO DECODE AND LIST THE VERSION IN
;<.JBVER FORMAT IN ^P1.
;-

LSTVER:	LDB	T1,[POINTR (P1,VR.MAJ)] ;GET MAJOR VERSION
	PUSHJ	P,LSTOCT	;SEND TO FILE
	LDB	T1,[POINTR (P1,VR.MIN)] ;GET MINOR VERSION
	JUMPE	T1,NMINOR	;BRANCH IF NO MINOR
	MOVEI	CH,"A"-1(T1)	;GET UPDATE LETTER
	PUSHJ	P,LSTOUT	;SEND TO FILE
NMINOR:	LDB	T1,[POINTR (P1,VR.EDT)] ;GET EDIT VERSION
	JUMPE	T1,NEDIT	;BRANCH IF NO EDIT
	MOVEI	CH,"("		;OPEN PARENS
	PUSHJ	P,LSTOUT	; ..
	PUSHJ	P,LSTOCT	;SEND EDIT NUMBER TO FILE
	MOVEI	CH,")"		;CLOSE PARENS
	PUSHJ	P,LSTOUT	;SEND TO FILE
NEDIT:	LDB	T1,[POINTR (P1,VR.CUS)] ;GET CUSTOMER VERSION
	JUMPE	T1,CPOPJ	;RETURN IF DONE
	MOVEI	CH,"-"		;DASH
	PUSHJ	P,LSTOUT	;TO FILE
	JRST	LSTOCT		;SEND CUSTOMER VERSION TO FILE

DNSTBL:	EXP	[ASCIZ /Unknown BPI /]
	EXP	[ASCIZ /200 BPI /]
	EXP	[ASCIZ /556 BPI /]
	EXP	[ASCIZ /800 BPI /]
	EXP	[ASCIZ /1600 BPI /]
	EXP	[ASCIZ /6250 BPI /]
	EXP	[ASCIZ /(6) BPI /]
	EXP	[ASCIZ /(7) BPI /]

MTPTBL:	EXP	[ASCIZ / Unknown/]
	EXP	[ASCIZ / TOPS-10/]
	EXP	[ASCIZ / ITS/]
	EXP	[ASCIZ / TENEX/]
LN$MTP==.-MTPTBL		;LENGTH OF MONITOR TYPE TABLE
;+
;<LSTFIL LISTS THE FILE DATA INFORMATION.
;^CALL WITH ^T1 = ADDRESS OF <O$FILE BLOCK.
;-

LSTFIL:	SKIPN	S.LIST##	;SKIP IF LISTING ORDERED
	POPJ	P,		;RETURN

	PUSHJ	P,SAVE2		;SAVE C(P1), C(P2)
	MOVEI	P1,1(T1)	;POINT TO O$FILE DATA

;HERE TO COMPARE THIS FILE STR-PATH WITH LAST ONES

	SETZ	P2,		;ZERO INDICATES NO CHANGE

	MOVE	T1,ACSTR	;GET ALIAS FS NAME
	SKIPL	S.OPER##	;SEE IF /SAVE
	MOVE	T1,CSTR		;NOT. USE CURRENT FS NAME
	CAME	T1,LSTSTR	;COMPARE
	JRST	DIFF		;DIFFERENT

	SETZ	T2,		;START AT UFD LEVEL AT LSTPTH
	MOVEI	T3,APATH+.PTPPN	;COMPARE WITH ALIAS PATH
	SKIPL	S.OPER##	;SEE IF /SAVE
	MOVEI	T3,PTHBLK+.PTPPN;NOT. USE PATH BLOCK

CMPPTH:	MOVE	T4,LSTPTH(T2)	;GET ENTRY FROM BLOCK
	CAME	T4,(T3)		;COMPARE WITH TAPE BLOCK
	JRST	DIFF		;DIFFERENT
	JUMPE	T4,LSTFID	;BRANCH IF DONE
	ADDI	T3,1		;NEXT WORD IN BLOCK
	AOJA	T2,CMPPTH	;COMPARE NEXT

DIFF:	SETO	P2,		;MINUS 1 INDICATE CHANGE

	MOVEM	T1,LSTSTR	;STORE

	MOVSI	T1,APATH+.PTPPN;ALIAS PATH
	SKIPL	S.OPER##	;SEE IF /SAVE
	MOVSI	T1,PTHBLK+.PTPPN;USE PATH BLOCK
	HRRI	T1,LSTPTH	;TRANSFER TO LISTING PATH BLOCK
	BLT	T1,LSTPTH+.FXLND;XFR

	MOVEI	T1,CRLF		;CR-LF
	PUSHJ	P,LSTMSG	;SEND TO FILE
;HERE TO LIST INDIVIDUAL FILE IDENTIFIERS

LSTFID:	MOVE	T1,ACNAM	;GET ALIAS NAME
	SKIPL	S.OPER##	;SEE IF /SAVE
	MOVE	T1,CNAM		;NOT. USE CURRENT FILE NAME
	PUSHJ	P,LST6		;SEND TO FILE
	PUSHJ	P,LSTTAB	;TAB OVER

	MOVE	T1,ACEXT	;GET ALIAS EXTENSION
	SKIPL	S.OPER##	;SEE IF /SAVE
	MOVE	T1,CEXT		;NOT. USE CURRENT EXT
	PUSHJ	P,LST6		;SEND TO FILE
	PUSHJ	P,LSTTAB	;TAB OVER

	MOVE	T1,A$LENG(P1)	;GET SIZE IN BYTES
	MOVE	T2,A$MODE(P1)	;GET FILE MODE
	CAIG	T2,.IOASL	;SEE IF ASCII
	IDIVI	T1,5		;GET SIZE IN WORDS
	ADDI	T1,177		;FORCE OVERFLOW
	ASH	T1,-7		;COMPUTE SIZE IN BLOCKS
	PUSHJ	P,LSTDEC	;SEND TO FILE
	PUSHJ	P,LSTTAB	;TAB OVER

	SKIPE	A$PROT(P1)	;SEE IF NO PROTECTION ON TAPE,
	SKIPE	S.INTR##	; OR IF INTERCHANGE MODE
	JRST	LSTFCD		;YES--NO PROTECTION TO LIST
	MOVEI	CH,"<"		;PROTECTION
	PUSHJ	P,LSTOUT	; ..
	PUSHJ	P,RSTPRO	;GET PROTECTION AND CONVERT
	IDIVI	T1,100		;SPLIT DIGITS
	IDIVI	T2,10		;T1-T2-T3
	MOVEI	CH,"0"(T1)	;FIRST
	PUSHJ	P,LSTOUT	; ..
	MOVEI	CH,"0"(T2)	;SECOND
	PUSHJ	P,LSTOUT	; ..
	MOVEI	CH,"0"(T3)	;THIRD
	PUSHJ	P,LSTOUT	; ..
	MOVEI	CH,">"		; ..
	PUSHJ	P,LSTOUT	; ..

LSTFCD:	PUSHJ	P,LSTTAB	;TAB OVER
	MOVE	T1,A$WRIT(P1)	;GET DATE/TIME
	PUSHJ	P,CONTDT	;CONVERT TO SYSTEM FORMAT
	MOVE	T1,T2		;GET DATE
	PUSHJ	P,LSTDAT	;LIST DATE
	JUMPE	P2,LSTFLX	;BRANCH IF NO STR-PATH CHANGE
	SKIPE	S.INTR##	;SEE IF /INTERCHANGE
	JRST	LSTFLX		;SKIP PATH INFO IF SO

;HERE TO LIST THE FULL FILE PATH

	PUSHJ	P,LSTTAB	;TAB OVER
	MOVE	T1,LSTSTR	;GET STR NAME
	PUSHJ	P,LST6		;SEND TO FILE
	MOVEI	CH,":"		;END OF STR
	PUSHJ	P,LSTOUT	;SEND TO FILE
	PUSHJ	P,LSTTAB	;TAB OVER
	MOVEI	CH,"["		;START OF PATH
	PUSHJ	P,LSTOUT	;SEND TO FILE
	HLRZ	T1,LSTPTH	;GET PROJECT
	PUSHJ	P,LSTOCT	;SEND TO FILE
	MOVEI	CH,","		;COMMA
	PUSHJ	P,LSTOUT	;SEND TO FILE
	HRRZ	T1,LSTPTH	;GET PROGRAMMER
	PUSHJ	P,LSTOCT	;SEND TO FILE
	MOVEI	P2,LSTPTH+1	;GET ADDRESS OF SFD NAMES
SFDLST:	SKIPN	T1,(P2)		;SEE IF ONE IS THERE
	JRST	CLSPTH		;BRANCH IF DONE
	MOVEI	CH,","		;LOAD COMMA
	PUSHJ	P,LSTOUT	;SEND TO FILE
	PUSHJ	P,LST6		;SEND SFD NAME TO FILE
	AOJA	P2,SFDLST	;CONTINUE
CLSPTH:	MOVEI	CH,"]"		;END OF PATH
	PUSHJ	P,LSTOUT	;SEND TO FILE

LSTFLX:	MOVEI	T1,CRLF		;<CR><LF>
	JRST	LSTMSG		;SEND TO FILE
	SUBTTL	DATE CONVERSION SUBROUTINES

;+.CHAPTER DATE CONVERSION SUBROUTINES
;-

RADIX	10	;***NOTE WELL***

;+
;<CONVDT CONVERTS DATE IN OLD FORMAT AND TIME IN MINUTES TO SMITHSONIAN DATE/TIME.
;^CALLED WITH ^T1 = TIME IN MINUTES SINCE MIDNIGHT, ^T2 = DATE IN OLD FORMAT.
;^ON EXIT ^T1 = SMITHSONIAN DATE/TIME.
;-

CONVDT:	PUSHJ	P,SAVE1		;PRESERVE P1
	SAVE$	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

	RSTR$	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
	POPJ	P,		;RETURN
;+
;<CONTDT CONVERTS DATE FROM SMITHSONIAN DATE/TIME TO OLD SYSTEM FORMAT.
;^CALL WITH ^T1 = DATE/TIME, RETURN WITH ^T1=TIME IN MILLISECONDS,
;^T2=DATE IN SYSTEM FORMAT (.<LT. 0 IF ARG .<LT. 0). ^USES ^T1-^T4.
;-

CONTDT:	PUSH	P,T1		;SAVE TIME FOR LATER
	JUMPL	T1,CNTDT6	;DEFEND AGAINST JUNK INPUT
	HLRZ	T1,T1		;GET DATE PORTION (DAYS SINCE 1858)

	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

	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

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

RADIX	8	;***NOTE WELL***
	SUBTTL	FILE VERIFICATION SUBROUTINES
;+
;.CHAPTER FILE VERIFICATION ROUTINES
;-

;+
;<VER0 VERIFIES THAT THE INPUT DEVICE NAME MATCHES THE NAME FROM
;THE <O$NAME BLOCK ON TAPE. ^SKIP RETURN IF MATCH.
;-

VER0:	MOVE	T1,FX$LEN+.FXDEV(SP); GET INPUT DEVICE NAME	[175]
	CAME	T1,CSTR		; SAME AS TAPE DEVICE NAME?	[175]
	CAMN	T1,[SIXBIT/ALL/]; NO, "ALL" MATCHES ANY STR	[175]
	JRST	VER001		; A MATCH			[175]
	CAME	T1,[SIXBIT/DSK/]; "DSK" MATCHES ANY STR		[175]
	POPJ	P,		; DIFFERENT			[175]
VER001:	CAME	T1,.FXDEV(SP)	; SKIP STR-FLAG TEST IF 	[175]
	JRST	VER101		; OUTPUT DEV NEQ INPUT DEV	[175]

;+
;<VER1 VERIFIES THAT THE PATH OF THE CURRENT FILE MATCHES THE
;USER'S INPUT SPEC (ADDRESS IN <SP). ^IF THE FILE IS AN <SFD, IT
;MUST MATCH DOWN TO THE CURRENT LEVEL IN <LVL. ^NON-^^SFD\\S MUST
;MATCH AT ALL LEVELS. ^SKIP RETURN IF MATCH.
;^ON THE NON-MATCH RETURN T1 CONTAINS ZERO IF DIFFERENCE WAS
;DUE TO PPN AND NON-ZERO IF DUE TO SFD DIFFERENCE.
;-

VER1:	MOVE	T1,CSTRFL	;GET CURRENT STR FLAG
	TDNN	T1,FX$LEN+FX$STR(SP);CHECK INPUT STR WORD
	POPJ	P,		;STR NO GOOD--RETURN NOW

VER101:	MOVNI	T1,1(LVL)	;GET NEGATIVE LEVEL COUNT	[175]

	HRLZS	T1		;FORM AOBJN WORD FOR SFD
	MOVSI	T2,'SFD'	;SEE IF CURRENT FILE IS AN SFD,
	CAME	T2,CEXT		; IF NOT,
	MOVSI	T1,-.FXLND	; USE AOBJN WORD FOR FILES
	MOVE	T2,SP		;ANOTHER INDEX

SFDCHK:	MOVE	T3,PTHBLK+.PTPPN(T1) ;GET SFD NAME
	XOR	T3,FX$LEN+.FXDIR(T2) ;GET DIFFERENCES
	AND	T3,FX$LEN+.FXDIM(T2) ;BLOT OUT DIFFERENCES
	JUMPN	T3,SFDCH1	;RETURN IF NO GOOD		[204]
	ADDI	T2,2		;INCREMENT
	AOBJN	T1,SFDCHK	;LOOP
	JRST	CPOPJ1		;SKIP BACK
SFDCH1:	HRRZ	T1,T1		; ZERO THE LEFT HALF		[204]
	POPJ	P,		; NON-MATCH RETURN		[204]

;+
;<VER2 VERIFIES THAT THE FILE NAME AND EXTENSION OF THE CURRENT FILE
;MATCH THE USER'S INPUT SPEC (ADDRESS IN <SP). ^A SKIP RETURN IS GIVEN
;ON A MATCH.
;-

VER2:	MOVE	T1,CNAM		;GET CURRENT NAME
	XOR	T1,FX$LEN+.FXNAM(SP) ; ..
	AND	T1,FX$LEN+.FXNMM(SP) ; ..
	JUMPN	T1,CPOPJ	; ..

	MOVE	T1,CEXT		;GET CURRENT EXT
	XOR	T1,FX$LEN+.FXEXT(SP) ; ..
	HRLZ	T2,FX$LEN+.FXEXT(SP) ; ..
	AND	T1,T2		; ..
	JUMPE	T1,CPOPJ1	;GOOD RETURN
	POPJ	P,		;BAD RETURN
;+
;<CHKLIM IS A SUBROUTINE TO CHECK A FILE SPEC AGAINST THE USER'S
;SELECTIVE  SWITCHES. ^CALL WITH <SP = ADDRESS OF FILE SPEC BLOCK.
;^NON-SKIP RETURN IF FILE DOES NOT MEET TIME AND SIZE SPECIFICATIONS.
;^SKIP RETURN IF FILE WILL LOSE EXCEPT FOR </DATE75 DEFENSE.
;^DOUBLE SKIP INDICATES FILE MEETS TIME AND SIZE SPECIFICATIONS.
;^NOTE THAT ON AN INTERCHANGE RESTORE, ACCESS AND MONITOR-SET
;DATE/TIME SWITCHES DO NOT APPLY. ^ALSO, SELECTION SWITCHES ARE
;IGNORED FOR CERTAIN ^^PPN\\S AND IF THE <RP.ABU BIT IS
;SET FOR A FILE. (SEE <CHKABU FOR MORE INFO ON THIS).
;-

CHKLIM:	MOVEI	T4,2		;SET WINNING INCREMENT

	PUSHJ	P,CHKABU	;SEE IF ALWAYS BACKUP
	  JRST	CHKLMX		;YES--GIVE NORMAL RETURN

	MOVE	T1,CWSIZE	;GET SIZE
	MOVE	T2,FX$LEN+.FXFLI(SP) ;GET LOWER LIMIT
	MOVE	T3,FX$LEN+.FXFLM(SP) ;GET UPPER LIMIT
	PUSHJ	P,CHKRNG	;CHECK RANGE
	  POPJ	P,		;COMPLETE LOSAGE

	MOVE	T1,CCDATI	;GET CREATION DATE/TIME
	MOVE	T2,FX$LEN+.FXSNC(SP) ;GET LOWER LIMIT
	MOVE	T3,FX$LEN+.FXBFR(SP) ;GET UPPER LIMIT
	PUSHJ	P,CHKRNG	;CHECK RANGE
	  MOVEI	T4,1		;INDICATE LOSE

	SKIPE	S.INTR##	;SEE IF /INTERCHANGE
	SKIPG	S.OPER##	;AND /RESTORE,
	SKIPA			; NO, CONTINUE
	JRST	CHKD75		; YES, IGNORE OTHER DATES

	MOVE	T1,CADATI	;GET ACCESS DATE/TIME
	MOVE	T2,FX$LEN+.FXASN(SP) ;GET LOWER LIMIT
	MOVE	T3,FX$LEN+.FXABF(SP) ;GET UPPER LIMIT
	PUSHJ	P,CHKRNG	;CHECK RANGE
	  MOVEI	T4,1		;INDICATE LOSE

	MOVE	T1,CMDATI	;GET MODIFY DATE/TIME
	MOVE	T2,FX$LEN+FX$MSN(SP) ;GET LOWER LIMIT
	MOVE	T3,FX$LEN+FX$MBF(SP) ;GET UPPER LIMIT
	PUSHJ	P,CHKRNG	;CHECK RANGE
	  MOVEI	T4,1		;INDICATE LOSE

CHKD75:	SKIPG	S.DT75##	;SEE IF /DATE75
	CAIE	T4,1		;NO--IF 1,
	SKIPA			;ELSE
	MOVEI	T4,0		;IF NOT /DATE75 AND LOST, SET 0

	CAIE	T4,1		;UNLESS JUST DATE LOSAGE,
	JRST	CHKLMX		; GO RETURN
	MOVEI	T4,0		;POSSIBLE DATE75, SET FOR FAILURE
	HLRZ	T1,CCDATI	;GET CREATION DATE
	CAIL	T1,115103	;IF BEFORE 1-JAN-67
	CAIN	T1,122661	; OR = 5-JAN-75
	MOVEI	T4,1		;INDICATE DATE75

	HLRZ	T1,CADATI	;GET ACCESS DATE
	CAIL	T1,115103	;IF BEFORE 1-JAN-67
	CAIN	T1,122661	; OR = 5-JAN-75
	MOVEI	T4,1		;INDICATE DATE75

CHKLMX:	ADDM	T4,(P)		;ADVANCE RETURN
	POPJ	P,		;RETURN

;INTERNAL ROUTINE TO CHECK C(T1) WITHIN RANGE C(T2)-C(T3)

CHKRNG:	JUMPLE	T2,CHKRG1	;IS LOWER LIMIT NOT SET, SKIP ON
	CAMGE	T1,T2		;IF BELOW LOWER LIMIT,
	POPJ	P,		; GIVE ERROR RETURN

CHKRG1:	JUMPLE	T3,CPOPJ1	;IF UPPER LIMIT NOT SET, WIN
	CAMLE	T1,T3		;IF ABOVE UPPER LIMIT,
	POPJ	P,		; GIVE ERROR RETURN
	JRST	CPOPJ1		;GIVE OK RETURN

;+
;<CHKABU IS A SUBROUTINE TO CHECK THE <RP.ABU BIT FOR A FILE. ^ALSO CHECKS
;IF <PPN = [^A,*] OR [10,^B] FOR ^A _& ^B <.LE. 7 IN ORDER TO SAVE/RESTORE
;ALL LIBRARIES, ETC.(UNLESS </NOEXEMPT WAS TYPED).
;^SKIP RETURN IF SHOULD CONTINUE CHECKING USER SWITCHES.
;-

CHKABU:	SKIPE	S.INTR##	;IF /INTERCHANGE,
	JRST	CPOPJ1		; ALWAYS CONTINUE
	MOVX	T1,RP.ABU	;ALWAYS BACKUP BIT
	MOVEI	T2,EXLFIL+.RBSTS ;POINT TO FILE STATUS WORD
	SKIPL	S.OPER##	;SEE IF /SAVE
	JRST	[MOVX	T1,B$DLRA;CORRESPONDING BACKUP FLAG
		 MOVEI	T2,A$FLGS+1(P1);POINT TO BACKUP FLAGS
		 JRST	.+1]	;PROCEED
	TDNE	T1,(T2)		;SEE IF FLAG ON
	POPJ	P,		;YES--ALWAYS ACCEPT
	SKIPN	S.XMPT##	;/NOEXEMPT?
	JRST	CPOPJ1		;YES--DONT CHECK PPNS
	HLRZ	T1,PTHBLK+.PTPPN;GET PROGET NUMBER
	CAIG	T1,7		;SEE IF PRJ <  OR = 7
	POPJ	P,		;YES--ALWAYS ACCEPT
	CAIE	T1,10		;SEE IF [10,B]
	JRST	CPOPJ1		;NO--CHECK SWITCHES
	HRRZ	T1,PTHBLK+.PTPPN;YES--GET PROGRAMMER NUMBER
	CAILE	T1,7		;SEE IF PRG < OR = 7
	AOS	(P)		;NO--ADVANCE RETURN
	POPJ	P,		;RETURN
	SUBTTL	SORT SUBROUTINES

;+
;.CHAPTER SORT SUBROUTINES
;-

;+
;<LOCSRT HANDLES THE SORT BY LOCATION (COMPRESSED FILE POINTER).
;^USES A BUBBLE SORT. ^CALL WITH ^P1 = START ADDRESS OF <MFD OR DIRECTORY.
;-

LOCSRT:	MOVE	T1,P1		;COPY POINTER
	ADD	T1,[2,,0]	;SKIP FIRST
	JUMPGE	T1,CPOPJ	;RETURN

LOC1:	HRRZ	T2,2(T1)	;GET CFP OF FIRST
	HRRZ	T3,4(T1)	;GET CFP OF SECOND
	CAMLE	T2,T3		;SKIP IF LE
	JRST	LOCINV		;INVERSION
LOC2:	AOBJN	T1,.+1		;ADVANCE 1
	AOBJN	T1,LOC1		;CONTINUE IF MORE

	TXZE	F,FL$FLP	;ZILCH & SKIP IF NO INVERSIONS
	JRST	LOCSRT		;SCAN AGAIN
	POPJ	P,		;RETURN

LOCINV:	MOVE	T2,1(T1)	;GET FIRST FILE NAME
	EXCH	T2,3(T1)	;EXCHANGE
	MOVEM	T2,1(T1)	; ..
	MOVE	T2,2(T1)	;GET FIRST EXT
	EXCH	T2,4(T1)	;EXCHANGE
	MOVEM	T2,2(T1)	; ..
	TXO	F,FL$FLP	; ..
	JRST	LOC2		; ..
;+
;<ALPSRT HANDLES THE ALPHABETIC SORT. ^USES A BUBBLE SORT.
;^CALL WITH ^P1 = START ADDRESS OF <MFD OR DIRECTORY.
;-

ALPSRT:	MOVE	T1,P1		;COPY POINTER
	ADD	T1,[2,,0]	;SKIP FIRST
	JUMPGE	T1,CPOPJ	;RETURN

ALP1:	MOVE	T2,1(T1)	;GET FIRST FILE NAME
	TLC	T2,(1B0)	;COMPLEMENT SIGN BIT
	MOVE	T3,3(T1)	;GET SECOND FILE NAME
	TLC	T3,(1B0)	;COMPLEMENT SIGN BIT
	CAMLE	T2,T3		;TEST
	JRST	INVERT		;INVERSION
	CAME	T2,T3		;SKIP IF EQUAL
	JRST	ALP2		;FINISHED
	HLRZ	T2,2(T1)	;GET FIRST EXT
	HLRZ	T3,4(T1)	;GET SECOND EXT
	CAMLE	T2,T3		;TEST FOR INVERSION
	JRST	INVERT		;INVERSION
ALP2:	AOBJN	T1,.+1		;ADVANCE 1
	AOBJN	T1,ALP1		;ADVANCE 2

	TXZE	F,FL$FLP	;ZERO & TEST IF ANY INVERSIONS
	JRST	ALPSRT		;THERE WERE SOME--CONTINUE
	POPJ	P,		;NONE--SKIP BACK

INVERT:	MOVE	T2,1(T1)	;GET FIRST
	EXCH	T2,3(T1)	;EXCHANGE FIRST WITH SECOND
	MOVEM	T2,1(T1)	;PUT SECOND IN FIRST
	MOVE	T2,2(T1)	;GET FIRST
	EXCH	T2,4(T1)	;EXCHANGE FIRST WITH SECOND
	MOVEM	T2,2(T1)	;PUT SECOND IN FIRST
	TXO	F,FL$FLP	;SET BIT
	JRST	ALP2		;CONTINUE
	SUBTTL	CORE ALLOCATION SUBROUTINES

;+
;.CHAPTER	CORE ALLOCATION SUBROUTINES
;-

;+
;<UCORE IS A SUBROUTINE TO ALLOCATE CORE. ^CALL WITH ^T1 = NUMBER OF WORDS
;TO ALLOCATE. ^NON-SKIP RETURN IF NO CORE AVAILABLE (WILL ISSUE WARNING).
;^ON A SKIP RETURN ^P1 = ADDRESS OF ZEROED BLOCK.
;^PRESERVES ^T1, CLOBBERS ^T2.
;-

UCORE:	MOVE	P1,T1		;COPY NUMBER OF WORDS
	CAILE	T1,377777	;SEE IF REASONABLE
	JRST	NOCORE		;TAKE ERROR RETURN IF NOT
	ADD	P1,.JBFF##	;INCREMENT TO FORM NEW JOBFF
	MOVE	T2,P1		;COPY AGAIN
	CAMG	T2,.JBREL##	;SKIP IF TOO BIG
	JRST	UCORE1		;IT FITS--GOOD
	CAIG	T2,377777	;TOO LARGE?
	CORE	T2,		;EXPAND IF NECESSARY
	  JRST	NOCORE		;LOSE
UCORE1:	MOVE	T2,.JBFF##	;GET OLD JOBFF
	SETZM	(T2)		;ZILCH FIRST WORD
	HRLS	T2		;PUT IN LH
	ADDI	T2,1		;FORM BLT POINTER
	BLT	T2,-1(P1)	;ZERO NEW CORE
	EXCH	P1,.JBFF##	;GET BASE ADDR
	JRST	CPOPJ1		;SKIP BACK

;+
;<DRPCOR DROPS CORE TO ^C(^T1) IF THIS WILL SAVE 2^K OR MORE.
;^THIS AVOIDS UNNECESSARY SWAPPING AND SYSTEM OVERHEAD OF
;REPEATED UP/DOWNS.
;-

DRPCOR:	MOVEI	T2,2000(T1)	;ADD ON 2K
	CAMGE	T2,.JBREL##	;SEE IF UNDER JOBREL
	CORE	T1,		;DROP CORE
	  JFCL			;NICE TRY
	POPJ	P,		;RETURN
	SUBTTL	TELETYPE I/O SUBROUTINES

;+
;.CHAPTER TELETYPE I/O SUBROUTINES
;
;<TYI HANDLES OPERATOR INTERFACE AT <EOT AND ON TAPE WRITE LOCK. ^IT
;DISABLES <PSI, SIMULATES /<STOP AND CALLS THE RUN-TIME COMMAND HANDLER,
;<OPRCMD, TO PROCESS THE <TTY INPUT.
;-

TYI:	MOVX	T1,PS.FOF	;TURN OFF PSI
	PISYS.	T1,		;EXEC
	  JFCL			;PROBABLY NEVER TURNED ON
	OUTSTR	[ASCIZ \/\]	;DISPLAY PROMPT
	MOVEI	T1,1		;SET STOP
	MOVEM	T1,S.STOP##	; ...
	INCHWL	T1		;WAIT TILL LINE INPUT
	PUSHJ	P,OPRCMD##+2	;CALL RUN TIME COMMAND HANDLER (CHAR IN T1)
	  TXO	F,FL$KIL	;HERE IF COMMAND IS KILL
	SETZM	S.STOP##	;CLEAR STOP
	MOVX	T1,PS.FON	;TURN PSI BACK ON
	PISYS.	T1,		;EXEC
	  TXZ	F,FL$PSI	;ERROR--ZILCH FLAG
	POPJ	P,		;CONTINUE

;+
;<SIXOUT TYPES OUT THE <SIXBIT WORD IN ^T1.
;-

SIXOUT:	MOVE	T2,T1		;COPY C(T1)
SIXOU1:	JUMPE	T2,CPOPJ	;RETURN IF DONE
	MOVEI	T1,0		;ZILCH T1
	LSHC	T1,6		;CAPTURE CH
	MOVEI	CH," "-' '(T1)	;CONVERT TO ASCII
	OUTCHR	CH		;OUTPUT TO TTY
	JRST	SIXOU1		;GET NEXT ONE

;+
;<OCTOUT TYPES THE OCTAL NUMBER IN ^T1.
;<DECOUT TYPES THE DECIMAL NUMBER IN ^T1.
;-

OCTOUT:	TDZA	T3,T3		;INDICATE BASE 8
DECOUT:	MOVEI	T3,2		;INDICATE BASE 10
	SKIPGE	T1		;IF NEGATIVE,
	OUTSTR	[ASCIZ /-/]	; INDICATE
NBROUT:	IDIVI	T1,8(T3)	;START SPLITTING NUMBER
	MOVMS	T2		;FORCE POSITIVE
	HRLM	T2,(P)		;STORE DIGIT ON STACK
	SKIPE	T1		;SEE IF DONE
	PUSHJ	P,NBROUT	;KEEP GOING
	HLRZ	T1,(P)		;GET DIGIT OFF STACK
	ADDI	T1,"0"		;CONVERT BINARY TO ASCII
	OUTCHR	T1		;OUTPUT TO TTY
	POPJ	P,		;RETURN
;+
;<DOWHAT IS CALLED BY THE RUN-TIME COMMAND HANDLER, <OPRCMD, IF THE
;COMMAND IS <WHAT. ^IT REPORTS THE FULL PATH IDENTIFICATION OF
;THE CURRENT FILE BEING PROCESSED.
;-

DOWHAT::PUSHJ	P,TYSPEC	;TYPE FULL PATH SPEC
	OUTSTR	CRLF		;<CR><LF>
	POPJ	P,		;AND RETURN

;+
;<TYSPEC TYPES THE FULL PATH SPEC OF THE CURRENT FILE (NO CARIAGE RETURN).
;-

TYSPEC:	SKIPN	T1,CSTR		;GET STR NAME, IF ANY
	POPJ	P,		;NOTHING TO TYPE
	PUSHJ	P,SIXOUT	;TYPE DEVICE
	OUTCHR COLON		;COLON
	SKIPE	S.INTR##	;SEE IF /INTERCHANGE
	JRST	TYPNAM		;YES--SKIP PATH INFO
	OUTCHR	LBR		;LEFT BRACKET
	HLRZ	T1,PTHBLK+.PTPPN;PRJ NBR
	PUSHJ	P,OCTOUT	;TYPE
	OUTCHR	COMMA		;...
	HRRZ	T1,PTHBLK+.PTPPN;PROGRAMMER NMR
	PUSHJ	P,OCTOUT	;TYPE
	MOVSI	T3,-.FXLND+1	;HOW MANY SFD LEVELS
TYPSFD:	SKIPN	T1,PTHBLK+.PTPPN+1(T3);GET SFD NAME IF ANY
	JRST	TYPRBR		;NULL--CLOSE BRACKETS
	OUTCHR	COMMA		;TYPE COMMA
	PUSHJ	P,SIXOUT	;TYPE SFD
	AOBJN	T3,TYPSFD	;LOOP
TYPRBR:	OUTCHR	RBR		;RIGHT BRACKET
TYPNAM:	MOVE	T1,CNAM		;GET FILE NAME
	PUSHJ	P,SIXOUT	;PRINT
	SKIPN	T1,CEXT		;GET EXTENSION
	POPJ	P,		;DONE
	OUTCHR	DOT		;PERIOD
	JRST	SIXOUT		;TYPE EXTENSION

;+
;<TYEFIL TYPES THE CURRENT FILE'S FULL PATH SPEC AND BLOCK NUMBER. ^CALLED AT
;END OF TAPE SO FIRST REEL NEVER NEEDS TO BE REMOUNTED IN CASE OF CRASH.
;-

TYEFIL:	SKIPE	S.LIST##	;SEE IF LISTING FILE
	OUTPUT	F.LIST,		; OUTPUT LISTING BUFFER FIRST
	PUSHJ	P,TYSPEC	;TYPE FULL PATH SPEC
	OUTSTR	[ASCIZ\(BLOCK=\];MESSAGE
	MOVE	T1,THSRDB	;GET CURRENT BLOCK NUMBER
	PUSHJ	P,DECOUT	;TYPE
	OUTSTR	[ASCIZ\)
\]
	POPJ	P,		;RETURN
;+
;<TYPFIL TYPES THE FILE NAME AND EXTENSION OF THE CURRENT FILE
;BEING PROCESSED.
;-

TYPFIL:	MOVE	T1,CNAM		;FILE NAME
	PUSHJ	P,SIXOUT	;TYPE
	SKIPN	T1,CEXT		;EXTENSION
	JRST	NOEXT		;GO AROUND
	OUTCHR	TAB		;TAB OVER
	PUSHJ	P,SIXOUT	;TYPE EXTENSION
NOEXT:	OUTSTR	CRLF		;<CR><LF>
	POPJ	P,		;RETURN

;+
;<TYLPPN TYPES THE <PPN IN <PREPPN.
;-

TYLPPN:	HLRZ	T1,PREPPN	;GET PROJ
	PUSHJ	P,OCTOUT	;TYPE
	OUTCHR	COMMA		;COMMA
	HRRZ	T1,PREPPN	;GET PROG
	JRST	OCTOUT		;TYPE

;+
;<TYPID IS CALLED BY <MASTER TO TYPE SUCCESSIVE PATH FIELD
;COMPONENTS. ^AN <ASCII BYTE POINTER TO THE <F$PTH SECTION
;OF THE TAPE RECORD HEADER IS SET UP BY <MASTER. <TYPID TYPES
;THE FIELD AND RETURNS WITH THE TYPE CODE OF THE NEXT FIELD IN ^T1.
;-

TYPID:	ILDB	T2,T3		;GET # OF WORDS
	CAILE	T2,M-F$PTH	;SEE IF IN RANGE
	MOVEI	T2,M-F$PTH	;NOT. USE MAX
	ADDI	T2,(T3)		;ADD START ADDRESS
TYPID1:	ILDB	T1,T3		;GET CHARACTER
	CAIN	T2,(T3)		;SEE IF DONE
	POPJ	P,		;RETURN WITH T1=TYPE BYTE OF NEXT PATH NAME
	JUMPE	T1,TYPID1	;IGNORE NULLS
	CAIN	T1,"_"		;SEE IF UNDERLINE,
	MOVEI	T1,","		;CONVERT TO COMMA
	OUTCHR	T1		;SEND TO TTY
	JRST	TYPID1		;GET NEXT CHARACTER
	POPJ	P,		;RETURN

;+
;<TYPRSM TYPES THE RESUME MESSAGE.
;-

TYPRSM:	OUTSTR	[ASCIZ \Resuming at checkpoint \]
	MOVE	T1,S.RSUM##	;LOAD BLOCK NBR
	PUSHJ	P,DECOUT	;TYPE IT
	OUTSTR	CRLF		;<CR><LF>
	POPJ	P,		;THAT'S ALL
;+
;<TYPCKP TYPES THE CHECKPOINT IF IT HAS BEEN REACHED AND SETS THE NEXT
;CHECKPOINT. ^CALLED WITH ^T1 = CURRENT DISK BLOCK NUMBER.
;-

TYPCKP:	CAME	T1,CHKPNT	;HIT CHECKPOINT YET?
	POPJ	P,		;NO, RETURN
	MOVEI	T2,CP$INC	;LOAD CHECKPOINT INCREMENT
	ADDM	T2,CHKPNT	;SET NEXT CHECKPOINT
	SKIPG	S.OPER##	;IF /SAVE,
	SUBI	T1,CP$MRG	;SUBTRACT THE MARGIN
	PUSHJ	P,DECOUT	;DISPLAY CHECKPOINT
	OUTSTR	CRLF		;FOLLOWED BY <CR><LF>
	POPJ	P,		;RETURN

;+
;<TTYSER IS THE SERVICE ROUTINE FOR <PSI INTERUPT ON <TTY INPUT.
;^IT SAVES ALL TEMPOARY ^^AC\\S, AND CALLS THE RUN-TIME COMMAND
;HANDLER, <OPRCMD, TO PROCESS THE COMMAND. ^THEN THE ^^AC\\S ARE
;RESTORED AND THE INTERUPT DISMISSED.
;-

TTYSER:	SAVE$	<T1,T2,T3,T4>	;SAVE ALL TEMP ACS
	PUSHJ	P,OPRCMD##	;SERVICE TTY INPUT
	  TXO	F,FL$KIL	;RETURN HERE IF OPERATOR SAID KILL
	RSTR$	<T4,T3,T2,T1>	;RESTORE ALL TEMP ACS
	DEBRK.			;DISMISS INTERUPT
	  HALT	TTYSER		;ERROR RETURN
	  HALT	TTYSER		;UNIMPLEMENTED RETURN

;+
;<WRNMSG IS A SUBROUTINE CALLED BY THE <WARN$ AND <WARN$N MACROS.
;^IT HANDLES OUTPUTING THE LISTING BUFFER AND </MESSAGE:NOPREFIX.
;-

WRNMSG:	SKIPE	S.LIST		;SEE IF LISTING CHANNEL OPENED
	OUTPUT	F.LIST,		;YES, OUTPUT BUFFER BEFORE MESSAGE
	OUTSTR	[ASCIZ \
%\]
	AOS	(P)		;SKIP RETURN
	PUSH	P,T1		;SAVE T1
	MOVX	T1,JWW.PR	;SEE IF /MESSAGE:NOPREFIX
	TDNN	T1,S.VRBO##	;PREFIX NEEDED?
	AOS	-1(P)		;NO--GIVE DOUBLE SKIP RETURN
	POP	P,T1		;RESTORE T1
	POPJ	P,		;RETURN
	SUBTTL	ERROR MESSAGES


NOCORE:	WARN$	(NEC,Not enough core)
	POPJ	P,0

FAIL0:	SKIPA	T1,T2
DVFAIL:	MOVE	T1,CSTR
	WARN$N	(COD,Cannot OPEN ")
	PUSHJ	P,SIXOUT
	OUTSTR	[ASCIZ \"
\]
	POPJ	P,0

IFN FT$IND,<
NOHOME:	WARN$N	(CRH,Cannot read HOME block for structure ")
	MOVE	T1,CSTR
	PUSHJ	P,SIXOUT
	OUTSTR	[ASCIZ \"
\]
	POPJ	P,0
>;END IFN FT$IND

RSMERR:	WARN$	(RIC,Resume at invalid checkpoint attempted)
	SETZM	S.RSUM##	;ZILCH
				;FALL INTO EAFIL
EAFIL:	PUSHJ	P,SAVE1
	MOVEI	P1,EXLFIL

	WARN$N	(ABT,Abort)
	JRST	GUUO

ELUFD:	PUSHJ	P,SAVE1
	MOVEI	P1,EXLUFD
	JRST	LMSG

ELFIL:	PUSHJ	P,SAVE1
	MOVEI	P1,EXLFIL

LMSG:	HRRZ	T1,.RBEXT(P1)	;LOAD ERROR CODE
	LDB	T2,[POINTR (.FXMOD(SP), FX.PRT)]
	CAIN	T1,2		;PROTECTION FAILURE?
	JUMPN	T2,CPOPJ	;IF /OKPROTECTION DON'T MUMBLE
	WARN$N	(FLE,File LOOKUP error)
	JRST	EGUUO

EEUFD:	PUSHJ	P,SAVE1
	MOVEI	P1,EXLUFD
	JRST	EMSG

EEFIL:	PUSHJ	P,SAVE1
	MOVEI	P1,EXLFIL

EMSG:	HRRZ	T1,.RBEXT(P1)	;LOAD ERROR CODE
	LDB	T2,[POINTR (.FXMOD(SP), FX.PRT)]
	CAIN	T1,2		;PROTECTION FAILURE?
	JUMPN	T2,CPOPJ	;IF /OKPROTECTION DON'T MUMBLE
	WARN$N	(FEE,File ENTER error)

EGUUO:	HRRZ	T1,.RBEXT(P1)	;GET ERROR CODE
	PUSHJ	P,OCTOUT	;TYPE IT

	HRRZ	T2,.RBEXT(P1)	;GET ERROR CODE AGAIN
	CAIL	T2,ERRLTH	;RANGE CHECK
	JRST	GUUO		;OUT OF RANGE, SKIP ABREV
	OUTCHR	LPAREN
	ROT	T2,-1		;GET ABREVIATION FROM TABLE
	MOVE	T1,ERRTBL(T2)	; ..

	TLNE	T2,(1B0)
	MOVSS	T1
	HLLZS	T1
	PUSHJ	P,SIXOUT
	OUTCHR	RPAREN

GUUO:	OUTCHR	SPACE

	MOVE	T1,CSTR
	SKIPL	S.OPER##
	MOVE	T1,ACSTR
	PUSHJ	P,SIXOUT
	OUTCHR	COLON
	HLRZ	T1,.RBEXT(P1)
	CAIE	T1,'UFD'
	JRST	NOTUFD
	HLRZ	T1,.RBNAM(P1)
	PUSHJ	P,OCTOUT
	OUTCHR	COMMA
	HRRZ	T1,.RBNAM(P1)
	PUSHJ	P,OCTOUT
	JRST	JOIN1
NOTUFD:	MOVE	T1,.RBNAM(P1)
	PUSHJ	P,SIXOUT
JOIN1:	HLLZ	T1,.RBEXT(P1)
	JUMPE	T1,JOIN2
	OUTCHR	DOT
	PUSHJ	P,SIXOUT
JOIN2:	SKIPE	S.INTR##
	JRST	EDONE+1
	HLRZ	T1,.RBPPN(P1)
	JUMPE	T1,JOIN3
	OUTCHR	LBR
	PUSHJ	P,OCTOUT
	OUTCHR	COMMA
	HRRZ	T1,.RBPPN(P1)
	PUSHJ	P,OCTOUT
EDONE:	OUTCHR	RBR
	OUTSTR	CRLF
	POPJ	P,0

JOIN3:	HRRZ	P1,.RBPPN(P1)
	HLRZ	T1,2(P1)
	PUSHJ	P,OCTOUT
	OUTCHR	COMMA
	HRRZ	T1,2(P1)
	PUSHJ	P,OCTOUT

JOIN4:	SKIPN	T1,3(P1)
	JRST	EDONE
	OUTCHR	COMMA
	PUSHJ	P,SIXOUT
	AOJA	P1,JOIN4
SAVE1:	EXCH	P1,(P)
	PUSH	P,.+3
	HRLI	P1,-1(P)
	JRA	P1,(P1)
	  CAIA	.
	AOS	-1(P)
	JRST	POP1

SAVE2:	EXCH	P1,(P)
	PUSH	P,P2
	PUSH	P,.+3
	HRLI	P1,-2(P)
	JRA	P1,(P1)
	  CAIA	.
	AOS	-2(P)
	JRST	POP2

SAVE3:	EXCH	P1,(P)
	PUSH	P,P2
	PUSH	P,P3
	PUSH	P,.+3
	HRLI	P1,-3(P)
	JRA	P1,(P1)
	  CAIA	.
	AOS	-3(P)
	JRST	POP3

SAVE4:	EXCH	P1,(P)
	PUSH	P,P2
	PUSH	P,P3
	PUSH	P,P4
	PUSH	P,.+3
	HRLI	P1,-4(P)
	JRA	P1,(P1)
	  CAIA	.
	AOS	-4(P)
POP4:	POP	P,P4
POP3:	POP	P,P3
POP2:	POP	P,P2
POP1:	POP	P,P1
	POPJ	P,0
CPOPJ2:	AOS	(P)
CPOPJ1:	AOS	(P)
CPOPJ:	POPJ	P,0

ERRTBL:	SIXBIT	/FNFIPP/
	SIXBIT	/PRTFBM/
	SIXBIT	/AEFISU/
	SIXBIT	/TRNNSF/
	SIXBIT	/NECDNA/
	SIXBIT	/NSDILU/
	SIXBIT	/NRMWLK/
	SIXBIT	/NETPOA/
	SIXBIT	/BNFNSD/
	SIXBIT	/DNESNF/
	SIXBIT	/SLELVL/
	SIXBIT	/NCESNS/
	SIXBIT	/FCULOH/
ERRLTH==<.-ERRTBL>*2

MONTBL:	ASCIZ	/-Jan/
	ASCIZ	/-Feb/
	ASCIZ	/-Mar/
	ASCIZ	/-Apr/
	ASCIZ	/-May/
	ASCIZ	/-Jun/
	ASCIZ	/-Jul/
	ASCIZ	/-Aug/
	ASCIZ	/-Sep/
	ASCIZ	/-Oct/
	ASCIZ	/-Nov/
	ASCIZ	/-Dec/

DOT:	"."
COLON:	":"
COMMA:	","
LPAREN:	"("
RPAREN:	")"
LBR:	"["
RBR:	"]"
TAB:	EXP	.CHTAB
SPACE:	EXP	" "

CRLF:	BYTE(7).CHCRT,.CHLFD,0


;&.DO INDEX


	END		;&.SKIP2;[^END OF <BACKRS.PLM]