Google
 

Trailing-Edge - PDP-10 Archives - BB-BT99V-BB_1990 - 10,7/backup/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 -- %6(704)
	SUBTTL	FRANK NATOLI/FJN/PFC/KCM/JEF/MEB/CLRH/VLR/CGN/WMG/DC/BPK/MS/BAH/EDS	7-FEB-90

DECVER==6		;MAJOR VERSION
DECMVR==0		;MINOR VERSION
DECEVR==703		;EDIT NUMBER
CUSTVR==0		;CUSTOMER VERSION


;+
;.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 5A
;.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 (c) DIGITAL EQUIPMENT CORPORATION 1974,1977,1978,1979,1980,1981,1982,1984,1986,1988,1989,1990.
;ALL RIGHT RESERVED.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;\\
;-\\

;               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 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

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

;.CHAPTER GENERAL INFORMATION
;-

	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

COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1974,1990.  ALL RIGHTS RESERVED.
\;END COPYRIGHT MACRO

	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 FT$FRS,0		;[335] CODE TO SUPPORT FRS **DUPLICATED IN BACKUP**
ND FT$USG,1		;CODE TO SUPPORT USAGE ACCOUNTING **DUPLICATED IN BACKUP**

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-17,<PRINTX ? SFD LEVEL TOO DEEP
			PASS2
			END>

HOLD==UFD+.FXLND	;[337] UFD-HOLDING CHANNEL.
;+
;.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

IFNDEF	PS.RSW,<PS.RSW==1B31>	;INCASE NOT IN UUOSYM YET

MTBBKP==M+<200*N>	;SIZE OF BACKUP RECORD ON TAPE
MTBFSZ==MTBBKP		;SIZE OF INPUT READ
IFN FT$FRS,<		;[335]
MTBFRS==24+5*200	;SIZE OF FRS BLOCK ON TAPE
IFG MTBFRS-MTBFSZ,<MTBFSZ==MTBFRS> ;[300]	**DUPLICATED IN BACKUP**
>; END IFN FT$FRS	;[335]
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
IFN FT$USG,<
NRIB==.RBAC8+1		;READ ACCOUNT STRINGS FROM RIB
>
NDCH==.DCBSC+1		;[601] 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
IFN FT$FRS,<		;[335]
FL$FRS==1B14	;DOING FRS CONVERSION
>; END IFN FT$FRS	;[335]
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
FL$PRN==1B22	;PROTECTION RENAME BIT
FL$FN==1B23	;[231] PRINTING FILENAME FLAG
FL$EST==1B24	;[232] .RBEST RENAME FLAG
FL$SKP==1B25	;[232] SKIP .RBEST RENAME KLUDGE
FL$DFE==1B26	;[254] DISK FILE HAD ERROR ON SAVE
FL$SV1==1B27	;[310] TO WRITE BLANK TAPE ON FIRST OUTPUT
FL$EPR==1B28	;[322] IF FL$PRN IS SET BECAUSE OF EOV
FL$HUF==1B29	;[337] UFD PPB IS BEING HELD
FL$ABS==1B30	;[522] ABORT STRUCTURE SINCE /INITIAL NOT FOUND

				;&

;+.HL1 /INITIAL BIT MASK DEFINITIONS
;.NOFILL.FLAG CONTROL #
;#END SELECT
;-

IB$STR==1	;[522] LOOKING FOR SPECIFIC /INITIAL FILE STRUCTURE
IB$NAM==2	;[522] LOOKING FOR /INITIAL FILENAME AND EXTENSION
IB$UFD==4	;[522] LOOKING FOR /INITIAL UFD
IB$SF1==10	;[522] LOOKING FOR /INITIAL SFD LEVEL 1
IB$SF2==20	;[522] LOOKING FOR /INITIAL SFD LEVEL 2
IB$SF3==40	;[522] LOOKING FOR /INITIAL SFD LEVEL 3
IB$SF4==100	;[522] LOOKING FOR /INITIAL SFD LEVEL 4
IB$SF5==200	;[522] LOOKING FOR /INITIAL SFD LEVEL 5

			;&#FLAG CONTROL

;+.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

TSTBLK::	BLOCK	1	; FLAG WORD FOR LOWSEG PASSAGE.		[344]


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
REELID:	BLOCK	1	;CURRENT REELID
PSIVCT:!		;BASE ADDRESS OF PSI VECTORS
PSITTY::BLOCK	4	;PSI VECTOR FOR TTY
PSIMTA::BLOCK	4	;PSI VECTOR FOR MTA

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]

LSTFOP:	BLOCK	.FOMAX	;[520] FILOP. BLOCK FOR LISTING FILE

IFN FT$FRS,<		;[335]
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
>; END IFN FT$FRS	;[335]
HCSTR:	BLOCK 	1	;[342] HELD STRUCTURE
HCPPN:	BLOCK	1	;[342] HELD PPN
CSTR:	BLOCK	1	;STRUCTURE
CSTRFL:	BLOCK	1	;STRUCTURE FLAGS
ACSTR:	BLOCK	1	;ALIAS STRUCTURE
CNAM:	BLOCK	1	;FILE
CNAMSW:	BLOCK	1	;[416] FILE NAME SWITCH
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
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

CURTAP:	BLOCK	1	;[355] CURRENT TAPE NUMBER
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
DCHARG:	BLOCK	5	;[503] FOR DSKCHR UUO

PRNAME:	BLOCK	1	;[227] RENAME PROTECTION STORAGE
EST:	BLOCK	1	;[232] .RBEST STORAGE
NRPS:	BLOCK	1	;[240] STORAGE TO INSURE ONE REPETITION WITH /<REPEAT
UNIQUE:	BLOCK	1	;UNIQUE EXTENSION NUMBER
IFE FT$USG,<
EXLFIL:	BLOCK	NRIB	;EXTENDED LOOKUPS/ENTERS/RENAMES
>
IFN FT$USG,<
EXLFIL:	BLOCK	200	;EXTENDED LOOKUPS/ENTERS/RENAMES (200 WORDS FOR /USETI)
>
EXLUFD:	BLOCK	NRIB	; ..
EXLUF1:	BLOCK	NRIB	;[530] PRESERVE UFD LOOKUP BLOCK FOR USAGE

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
TAPHLD:	BLOCK	2		;FIRST WORD FOR STATUS BITS
				;SECOND WORD IS ADDRESS OF DYNAMIC BUFFER

IFN FT$DBG,<			;[323]
FSZWDS:	BLOCK	1		;[323] SAVE AREA FOR FILE SIZE IN WORDS
>;END IFN FT$DBG		;[323]
NWPBLK:	BLOCK	1		;NUMBER OF WORDS/DISK BUFFER
NDBPMR:	BLOCK	1		;NUMBER OF DISK BUFFERS/MAGTAPE RECORD
NDBLIB:	BLOCK	1		;NUMBER OF DISK BLOCKS LEFT IN THIS DISK BUFFER
INIBTS::BLOCK	1		;[522] BIT MASK FOR /INITIAL FILESPEC
SAVBTS:	BLOCK	1		;[522] SAVED COPY OF ABOVE
BBSN:	BLOCK	1		;NUMBER OF DISK BLOCKS/TAPE FOR
				; CURRENT RECORD
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.

;.LE;<GF$DFE -- ONE OF THESE FLAGS IS SET IF ONE OF THESE DISK RECORDS
;HAD AN ERROR.
;-.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
GF$DF0==1B4	;[254] DISK FILE HAD ERROR (FIRST BLOCK ON TAPE)
GF$DF1==1B5	;[254] DISK FILE HAD ERROR (SECOND BLOCK ON TAPE)
GF$DF2==1B6	;[254] DISK FILE HAD ERROR (THIRD BLOCK ON TAPE)
GF$DF3==1B7	;[254] DISK FILE HAD ERROR (FOURTH BLOCK ON TAPE)
GF$DFE==GF$DF0!GF$DF1!GF$DF2!GF$DF3	;[254] DISK FILE HAD ERROR

;+.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$TBS==7	;TAPE BLOCK SIZE
   GC$BSZ==777777B17 ;SIZE OF THE TAPE BLOCK
   GC$N==777B35	;NUMBER OF DISK BLOCKS/TAPE BLOCK
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]

;.LE;<A$FTYP (*) -- FILE TYPE AND FLAGS WORD [<.RBTYP]

;.LE;<A$FBSZ (*) -- BYTE SIZES [<.RBBSZ]

;.LE;<A$FRSZ (*) -- RECORD AND BLOCK SIZES [<.RBRSZ]

;.LE;<A$FFFB (*) -- APPLICATION/CUSTOMER WORD [<.RBFFB]

;-.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

A$FTYP==32	;FILE TYPE AND FLAGS
A$FBSZ==33	;BYTE SIZES
A$FRSZ==34	;RECORD AND BLOCK SIZES
A$FFFB==35	;APPLICATION/CUSTOMER WORD

LN$AFH==36	;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.

;.LE;<S$LBLT -- <LABEL TYPE IN OCTAL.	[426]

;.LE;<S$BLKF -- BLOCKING FACTOR.

;-.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$LBLT==25	;[426] LABEL TYPE
S$BLKF==26	;BLOCKING FACTOR (DISK BLOCKS PER TAPE BLOCK)
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
	MOVE	T1,S.TPFG##	; GET FLAG BITS FOR TEST.	[347]
	JUMPN	T1,BACKB	; IF = THEN /TPNUM WASN'T SET.	[347]
	SKIPE	TSTBLK		; HAVE WE BEEN HERE BEFORE?	[344]
	SKIPN	S.MULT##	; MULTI-REEL SET?		[344]
	SKIPA			;[371] NO SO GO ON AS PLANNED.
	JRST	BACKB		; SKIP TAPE NUMBER INITIALIZING [344]
	MOVEI	T1,1		;[371] INITIALIZE TAPE COUNTER
	MOVEM	T1,S.NTPE##	; STORE

;HERE TO COPY SYSTEM NAME INTO MY CORE AREA

BACKB:	SETOM	TSTBLK		; TURN ALL BITS ON.		[344]
	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 ESTABLISH BIG BUFFERS

	MOVE	T1,[.STDEF,,T2]	;SET DEFAULT
	MOVE	T2,[2,,.STDSB]	; BIGBUF NUMBER OF BLOCKS
	MOVEI	T3,N		;NUMBER OF DISK BLOCKS IN A MAGTAPE RECORD
	MOVEI	T4,200*N	;NUMBER OF WORDS IF THIS SUCCEEDS
	SETUUO	T1,		;SET PROGRAM DEFAULT
	  MOVEI	T4,200		;SIGH, NO BIG BUFFERS
	MOVEM	T4,NWPBLK	;SAVE NUMBER OF WORDS PER DISK BUFFER
	IDIVI	T4,200		;NUMBER OF BLOCKS PER DISK BUFFER
	MOVEM	T4,NDBPMR	;SAVE FOR DSKIN
	SETZ	P1,		;INIT TAPHLD BLOCK ADDRESS
	SKIPG	S.OPER##	;READING THE TAPE?
	JRST	NOHOLD		;NO, NO NEED FOR HOLD BUFFER
	MOVE	T1,S.BFSZ##	;GET MAXIMUM TAPE BUFFER SIZE
	PUSHJ	P,UCORE		;GRAB THE CORE
	  SKIPA			;NO CORE AVAILABLE, SKIP
	JRST	NOHOLD		;PROCEED
	WARN$	(NCH,Not enough core for tape buffer)
	POPJ	P,		;RETURN

NOHOLD:	HRRZM	P1,TAPHLD+1	;STORE ADDRESS OF TAPHLD BLOCK
	MOVEI	T1,N		;INITIALIZE BLOCK SIZE
	MOVEM	T1,BBSN		;TO BACKUP DEFAULT VALUE

;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	;TTY SERVICE ROUTINE ADDRESS
	MOVEM	T1,PSITTY+.PSVNP;STORE NEW PC IN PSI VECTOR
	MOVEI	T1,MTASER	;MTA SERVICE ROUTINE
	MOVEM	T1,PSIMTA+.PSVNP;STORE NEW PC IN PSI VECTOR
	MOVX	T1,PS.VTO	;DISABLE WITH DEBRK. UUO
	MOVEM	T1,PSITTY+.PSVFL;STORE
	MOVEM	T1,PSIMTA+.PSVFL;STORE
	MOVEI	T1,PSIVCT	;BASE ADDRESS
	PIINI.	T1,		;INITIALIZE PSI
	  JRST	SETERR		;ERROR--CLEAR PSI FLAG
	MOVE	T1,[PS.FON!PS.FAC+[EXP <'TTY   '>,<<PSITTY-PSIVCT>,,PS.RID>,0]]
	PISYS.	T1,		;TURN PSI ON FOR TTY
	  JRST	SETERR		;FAILED--CLEAR PSI FLAG
	MOVE	T1,[PS.FON!PS.FAC+[EXP F.MTAP,<<PSIMTA-PSIVCT>,,PS.RSW>,0]]
	PISYS.	T1,		;TURN PSI ON FOR MTA
	  JFCL			;MAYBE RUNNING UNDER A PRE-7.03 MONITOR
	SKIPA			;IN ANY CASE DON'T COUNT THIS AS NO PSI
SETERR:	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


SETDEN:	SKIPL	S.OPER##	;WRITING?
	JRST	SETDE1		;NO
	MOVEI	T2,.TFSTS	;FUNCTION CODE
	MOVEI	T3,F.MTAP	;TAPE CHANNEL
	MOVE	T1,[2,,T2]	;SET UP UUO AC
	TAPOP.	T1,		;READ STATUS
	  JRST	SETDE1		;TAKE A GUESS
	TRNN	T1,TF.BOT	;SITTING AT BOT?
	JRST	SETDE1		;NO--DENSITY CAN EASILY BE READ
	MTBLK.	F.MTAP,		;ELSE WRITE A LONG GAP
	MTWAT.	F.MTAP,		;WAIT FOR THE DRIVE TO SETTLE DOWN
	MTREW.	F.MTAP,		;AND PUT US BACK AT THE LOAD POINT
SETDE1:	MOVEI	T2,.TFDEN	;INDICATE DENSITY
	MOVEI	T3,F.MTAP	;TAPE CHANNEL
	MOVE	T1,[XWD 2,T2]	;ARG FOR UUO
	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

	PUSHJ	P,MTADEV	;READ PHYSICAL DEVICE NAME
	PUSHJ	P,MTARID	;READ REELID
	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,APHSRT,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

;FIRST INITIALIZE THE USAGE ACCOUNTING PACKAGE

IFN FT$USG,<
	SKIPN	S.USG##		;USAGE ACCOUNTING REQUESTED
	JRST	.+3		;NO, DON'T BOTHER INITIALIZING IT
	PUSHJ	P,USGINI##	;INITIALIZE IT
	  JRST	[WARN$ (NCU,Not enough Core for Usage accounting)
		 POPJ P,]	;CAN'T DON'T DO SAVE
>

;HERE TO SETUP THE INITIAL FILESPEC BIT MASK BEFORE THE SAVE

	SETZB	T1,INIBTS	;[522] CLEAR THE WORKING BITS
	MOVEM	T1,SAVBTS	;[522] AND THE SAVED COPY
	SKIPE	S.INIT##+.FXDEV	;[522] ANY DEVICE SPECIFIED?
	  TXO	T1,IB$STR	;[522] YES, REMEMBER
	SKIPN	S.INIT##+.FXNAM	;[522] ANY FILENAME SPECIFIED?
	 SKIPE	S.INIT##+.FXEXT	;[522] NO, ANY EXTENSION?
	  TXO	T1,IB$NAM	;[522] YES, FLAG THAT
	MOVEI	T2,.FXDIR+S.INIT## ;[522] POINT AT THE FIRST DIRECTORY WORD
	MOVEI	T3,6		;[522] GET THE NUMBER OF DIRECTORY WORDS
	MOVX	T4,IB$UFD	;[522] GET THE FIRST BIT

SETINT:	SKIPN	(T2)		;[522] DIRECTORY SPECIFIED AT THIS LEVEL?
	  JRST	SETI01		;[522] NO, EXIT THIS LOOP
	TDO	T1,T4		;[522] YES, LITE THE CORRESPONDING BIT
	ADDI	T2,2		;[522] POINT TO THE NEXT DIRECTORY LEVEL
	LSH	T4,1		;[522] SHIFT THE BIT FOR THE NEXT LEVEL
	SOJG	T3,SETINT	;[522] LOOP FOR ALL SPECIFIED LEVELS

SETI01:	MOVEM	T1,SAVBTS	;[522] STORE THE INITIAL FILESPEC BITS
	MOVEM	T1,INIBTS	;[522] IN BOTH PLACES.

;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
	SKIPE	INIBTS		;[522] ANY /INITIAL SPECIFIER?
	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
	MOVX	T4,IB$STR	;[522] YES, GET THE DIRECTORY SPECIFIER
	ANDCAM	T4,INIBTS	;[522] CLEAR THE DEPENDENCY

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

	MOVE	T1,SAVBTS	;[522] GET THE SAVED INITIAL BITS
	SKIPE	INIBTS		;[522] DID WE FIND THE INITIAL FILE?
	  MOVEM	T1,INIBTS	;[522] NO, RESET THE SEARCH BITS
	TXZ	F,FL$ABS	;[522] CLEAR STRUCTURE ABORT FLAG
	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
	SKIPE	INIBTS		;[522] DID WE EVER FIND THE /INITIAL FILE?
	  JRST	CPOPJ1		;[522] YES, RETURN TO BACKUP WITH OPERATION DONE
	SETZM	S.INIT##	;[522] CLEAR THE
	MOVE	T1,[S.INIT##,,S.INIT##+1] ;[522] INITIAL
	BLT	T1,S.INIT##+FX$LEN-1	;[522] FILESPEC
	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,REELID	;GET REELID
	MOVEM	T1,S$RLNM(MH)	;STORE
	MOVE	T1,TAPLBL##	;[426] GET THE LABEL TYPE
	MOVEM	T1,S$LBLT(MH)	;[426] SAVE FOR LATER
	MOVE	T1,S.BFCT##	;GET BLOCKING FACTOR
	MOVEM	T1,S$BLKF(MH)	;SAVE IN SAVE-SET HEADER
	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)	; ...
	PUSHJ	P,BIGBLT	;DO THE BLT
	SUBI	T2,M(MH)	;SUBTRACT START ADDRESS
	MOVEM	T2,G$LND(MH)	;STORE TOTAL LENGTH NON-DATA
	SKIPE	S.NLDV		;[375] NULL TAPE DEVICE?
	JRST	LSTXXX		;[375] YES, LIST AND RETURN
	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

IFN FT$USG,<			;IF USAGE ACCOUNTING
	MOVE	T1,DCHBLK	;GET STRUCTURE WE ARE SAVING
	SKIPE	S.USG##		;ARE WE DOING USAGE ACCOUNTING
	PUSHJ	P,USGNST##	;YES, TELL PACKAGE OF NEW 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
	SKIPE	T1,DCHBLK+.DCBSC;[601] BLOCKS/SUPERCLUSTER
	SKIPA			;[601] 
	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
	OPEN	HOLD,T1		;[337] OPEN CHANNEL FOR HOLDING ONTO PPB
	  JRST	DVFAIL		;[337] 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

	MOVX	T1,UU.PHS+UU.LBF+.IOBIN ;LARGE BUFFERS + BUFFERED BINARY MODE
	MOVE	T2,CSTR		;CURRENT STRUCTURE
	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
	SKIPE	INIBTS		;[522] ANY /INITIAL SPECIFIER?
	SKIPN	S.INIT##+.FXDIR	;ANY INITIAL PPN?
	JRST	GETUF1		;NO
	CAME	T1,S.INIT##+.FXDIR;MATCH?
	JRST	NXTUFD		;NO--DROP PPN
	MOVX	T4,IB$UFD	;[522] YES, GET THE UFD SPECIFIER BIT
	ANDCAM	T4,INIBTS	;[522] CLEAR THE DEPENDENCY
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
	TXZ	F,FL$HUF	;[337] TURN OFF UFD-PPB-HELD FLAG
	PUSHJ	P,SAVUFD	;SAVE FILES
IFN FT$USG,<
	SKIPN	S.USG##		;USAGE ACCOUNTING WANTED?
	JRST	GOTUF1		;[413] NO
	PUSHJ	P,USGEND##	;YES, TELL WE ARE AT END OF A UFD
	RENAME	UFD,EXLUF1	;[530][413] RENAME FOR ACCOUNTING PURPOSES
	JFCL			;[413] RENAME FAILED
>
GOTUF1:	TXZE	F,FL$HUF	;[413] TURN OFF UFD-PPB-HELD. WAS IT HELD?
	CLOSE	HOLD,CL.ACS	;[337] YES - CLOSE THE FILE
	POP	P,T1		;RESTORE JOBREL
	PUSHJ	P,DRPCOR	;DROP CORE USED FOR THIS UFD
	POP	P,.JBFF##	;RESTORE JOBFF
	SKIPE	INIBTS		;[522] DID WE FIND THE /INITIAL FILE?
	  TXO	F,FL$ABS	;[522] ONLY GOT PART OF IT - BLOW THIS STR OFF

	TXNE	F,FL$KIL!FL$ABS	;[522] SEE IF OPERATOR SAID KILL OR ABORT SET
	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,		; ..
	RELEAS	HOLD,		;[376][337] ..
	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
IFE FT$USG,<
	  JRST	ELUFD		;LOSE
>
IFN FT$USG,<
	  JRST	[SKIPN S.USG##	;DOING USAGE ACCOUNTING
		 JRST ELUFD	;NO, JUST REPORT ERROR
		 MOVEI T1,EXLUFD ;POINT TO LOOKUP BLOCK THAT FAILED
		 PUSHJ P,USGNDI## ;FIRST SAY IT IS A NEW DIRECTORY
		 SKIPN	LVL	;[530] IS THIS A UFD LOOKUP?
		 PUSHJ	P,UFDCOP;[530] YES. SAVE EXLUFD FOR RENAME IN GOTUFD
		 PUSHJ P,USGDIP## ;THEN SAY DIRECTORY PROTECTION FAILURE
		 JRST ELUFD]	;THEN REPORT IT TO THE OPERATOR
	MOVEI	T1,EXLUFD	;POINT TO THE EXTENDED LOOKUP BLOCK
	SKIPN	S.USG##		;[530] WANT USAGE ENTRIES
	JRST	SETFI1		;[530] NO.
	PUSHJ	P,USGNDI##	;YES, CALL ACCOUNTING PACKAGE
	SKIPN	LVL		;[530] IS THIS A UFD LOOKUP?
	PUSHJ	P,UFDCOP	;[530] YES. SAVE EXLUFD FOR RENAME IN GOTUFD
SETFI1:
>
;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)
UFDERR:	MOVEI	P1,EXLUFD	;INDICATE WHICH
	PUSHJ	P,GUUO		;TYPE SPEC
IFN FT$USG,<
	MOVEI	T1,EXLUFD	;POINT TO LOOKUP BLOCK WE CAN'T COPY
	SKIPE	S.USG##		;DOING USAGE ACCOUNTING
	PUSHJ	P,USGDIP##	;YES, TELL DOWNSTREAM BILLING OF PROBLEM
>
	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)
	JRST	UFDERR		;TAKE COMMON ERROR EXIT

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
	SETOM	CNAMSW		;[416] STORE 
	SETZM	THSRDB		;[421] SET BLOCK SIZE TO ZERO
	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	INIBTS		;[524][522] ANY /INITIAL SPECIFIER?
	JRST	SAFE2		;[524] NO
	SKIPN	T3,S.INIT+.FXDIR(T2) ;ANY INITIAL SFD?
	JRST	NXTFIL		;[524] NO
	CAME	T3,CNAM		;SEE IF MATCH
	SOJA	LVL,NXTFIL	;NO, DROP IT
	MOVX	T4,IB$UFD	;[522] YES, GET THE DIRECTORY SEEN BIT
	LSH	T4,(LVL)	;[522] SHIFT TO THE RIGHT SFD LEVEL
	ANDCAM	T4,INIBTS	;[522] CLEAR THE BIT FOR THIS LEVEL

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)
	SKIPE	INIBTS		;[522] DID WE FIND THE /INITIAL FILE?
	  TXO	F,FL$ABS	;[522] NO, YES - ABORT THIS STRUCTURE

	SETZM	PTHBLK+.PTPPN(LVL) ;ZERO
	TXNE	F,FL$KIL!FL$ABS	;[522] SEE IF OPERATOR SAID KILL OR ABORT SET
	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:	SKIPN	T4,INIBTS	;[522] LOOKING FOR /INITIAL FILE?
	  JRST	SETEXT		;[522] NO, GO AHEAD WITH THIS FILE
	CAXE	T4,IB$NAM	;[522] YES, JUST LOOKING FOR FILENAME?
	  JRST	NXTFIL		;[522] NO, DROP THIS FILE
	HLRZ	T3,S.INIT+.FXEXT;GET INITIAL EXTENSION
	MOVE	T2,S.INIT+.FXNAM;[522] GET THE /INITIAL FILENAME
	CAMN	T2,CNAM		;MATCH?
	CAME	T3,T1		;EXTENSION MUST MATCH TOO
	JRST	NXTFIL		;NO, DROP IT
	SETZM	INIBTS		;[522] YES, NO MORE /INITIAL SPEC

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

IFE FT$USG,<
	MOVE	T1,[IOWD NRIB,EXLFIL] ;MAKE COMMAND WORD
>
IFN FT$USG,<
	MOVE	T1,[IOWD 200,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; ..
IFE FT$USG,<
	CAMN	T1,CEXT		; ..
	JRST	DECODE		;GO DECODE RIB
>
IFN FT$USG,<
	CAME	T1,CEXT		; ..
	JRST	STNCHK		; ..
	MOVE	T2,EXLFIL+.RBACT ;GET AOBJN POINTER TO ACCOUNT STRING
	SETZM	EXLFIL+.RBACT	;CLEAR OUT WORDS FOR IT IN RIB
	MOVE	T1,[EXLFIL+.RBACT,,EXLFIL+.RBACT+1]
	BLT	T1,EXLFIL+.RBACT+7 ;CLEAR IT
	JUMPGE	T2,DECODE	;IF NO POINTER, PROCEED, ACCT STR = 0
	HLRZ	T3,T2		;[417] GET NEG. WORD LENGTH
	HRRZ	T1,T2		;[417] GET OFFSET FROM RIB START
	CAIGE	T1,200		;[417] GREATER THAN MAX. RIB SIZE?
	CAIGE	T3,-10		;[417] GREATER THAN MAX. ACCT. STRING LENGTH?
	JRST	DECODE		;[417] YES, IGNORE POINTER
	SETZ	T3,		;CLEAR INDEX
CHKFI2:	MOVE	T1,EXLFIL(T2)	;PICK UP WORD OF ACCOUNT STRING
	MOVEM	T1,EXLFIL+.RBACT(T3) ;STORE WHERE LOOKUP WOULD HAVE PUT IT
	AOS	T3		;BUMP INDEX
	AOBJN	T2,CHKFI2	;MOVE ALL THE WORDS
	JRST	DECODE		;AND PROCEED
>
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	; ..
IFE FT$USG,<
	  JRST	GOTFIL		;ASSUME FILE IS GOOD
>
IFN FT$USG,<
	  JRST	[MOVEI T1,EXLFIL ;POINT TO FAILING LOOKUP BLOCK
		 SKIPE S.USG##	;DOING USAGE ACCOUNTING
		 PUSHJ P,USGFIP## ;YES, TELL DOWNSTREAM BILLING OF LOOKUP FAILURES
		 JRST GOTFIL]	;AND ASSUME FILE IS GOOD
>
	CLOSE	STR,CL.ACS	; ..

;HERE TO CHECK IF FILE SATISFIES USER SWITCH RESTRICTIONS

DECODE:
IFN FT$USG,<
	MOVEI	T1,EXLFIL	;POINT TO RIB OF FILE
	SKIPE	S.USG##		;WANT DISK SPACE ACCOUNTING
	PUSHJ	P,USGFIL##	;YES, TELL ACCOUNTING PACKAGE OF NEW FILE
>
	MOVEI	T1,RP.NFS	;CHECK NO SAVE BIT
	MOVEI	T2,1		;[241] PRIME THE PUMP FOR NFS CHECK
	TDNE	T1,EXLFIL+.RBSTS;ON?
	CAMN	T2,S.NFS##	;[241] NFS SET?
		SKIPA		;[241] YES-- CONTINUE WITH FILE
	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:	SETOM	NRPS		;[240] INITIALIZE ONE REPETITION SWITCH
GOTFL2:	SKIPE	S.TYMS##	;[240] 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

	MOVE	T1,S.NTPE##	;[355] SAVE CURRENT TAPE NUMBER
	MOVEM	T1,CURTAP	;[355]
	PUSHJ	P,SAVFIL	;SAVE THE FILE
	MOVE	T1,CURTAP	;[355] GET TAPE NUMBER BACK

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

	CAMN	T1,S.NTPE##	;SEE IF TAPE NUMBER CHANGED
	JRST	NXTFIL		;NO, PROCEED
	TXZ	F,FL$UFD	;ZILCH SO PPN WILL BE TYPED

	SKIPN	S.REPT##	;[240] /REPEAT?
	JRST	NXTFIL		;[240] YES--SAVE THIS FILE AGAIN
	SETZM	THSRDB		;[432] Init block for WHAT and routine CONREC
	AOSG	NRPS		;[240] DEFENSE AGAINST ENDLESS REPETITION
	JRST	GOTFL2		;[240] REPEAT ONLY ONCE
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]

	MOVEI	T1,F.LIST		;MUST USE CHANNEL 1	[217]
	DEVTYP	T1,		; GET DEVICE TYPE BITS		[176]
	 JRST	CLSUF2		; ERROR RET - IGNORE		[176]
	JUMPE	T1,CLSUF2	; NOT A DEVICE OR NOT INITED	[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:	HRLI	T1,F.LIST	;[520] CHANNEL NUMBER OF LISTING FILE
	HRRI	T1,.FOURB	;[520] CHECKPOINT FUNCTION
	MOVEM	T1,LSTFOP+.FOFNC;[520] FIRST WORD OF FILOP BLOCK
	MOVEI	T1,S.LENT##	;[520] LOOKUP/ENTER BLOCK ADDRESS
	MOVEM	T1,LSTFOP+.FOLEB;[520]
	MOVE	T1,[.FOMAX,,LSTFOP] ;[520]
	FILOP.	T1,
	  JRST	LSTERR		;[520] REPORT THE ERROR
	POPJ	P,		;[520] RETURN

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


;UFDCOP - Routine to preserve the LOOKUP block of the UFD if doing /USAGE
;	accounting so that the RENAME in GOTUFD does the correct thing instead
;	of renaming the last SFD looked up.

UFDCOP:	MOVE	T1,[EXLUFD,,EXLUF1];[530] SET UP THE BLT
	BLT	T1,EXLUF1+NRIB-1;[530]
	POPJ	P,		;[530]

;+
;<WRTUFD IS A ROUTINE TO WRITE A <T$UFD RECORD ON TAPE FOR EACH DIRECTORY IN 
;THE FILE PATH.
;-

WRTUFD:	SKIPE	S.NLDV##	;[375] IF NUL TAPE DEVICE THEN
	POPJ	P,		;[375]  DON'T NEED THIS
	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)	; ...
	PUSHJ	P,BIGBLT	;DO THE BLT

	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:	SKIPE	S.NLDV		;[400] ARE WE WRITING TO A NUL TAPE DEVICE?
	JRST	[		;[400] YES,
		MOVE	T1,S.LIST##	;[400] LET'S SEE IF THERE'S ANY
		IOR	T1,S.SDEL##	;[400] REASON TO DO A LOOKUP
		IOR	T1,S.DELT##	;[400] (I.E. LIST, SDELETE OR DELETE)
		JUMPN	T1,.+1		;[400] JUMP IF THERE'S A REASON
		POPJ	P,]		;[400] NOPE, JUST EXIT
	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

	SKIPE	S.NLDV##	;[375] IF NUL TAPE DEVICE THEN
	JRST	[			;[375] WE CAN SKIP LOTS OF STUFF
		SKIPN	S.LIST##	;[375] SKIP IF LISTING ORDERED
		JRST	CHKDEL		;[375] NO, DON'T NEED THE REST
		MOVEI	P2,EXLFIL	;[375] SET ADDR OF LOOKUP BLOCK
		PUSHJ	P,SAVATR	;[375] SETUP O$FILE BLOCK
		MOVEI	T1,M+200(MH)	;[375] POINT TO O$FILE BLOCK
		PUSHJ	P,LSTFIL	;[375] DO THE LISTING
		JRST	CHKDEL]		;[375] FINISH OFF

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

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

	PUSHJ	P,.USETI	;[357] POSITION USING FILOP
	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)	; ...
	PUSHJ	P,BIGBLT	;DO THE BLT

	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
	CAIL	T1,<N*2*200>	;WOULD A BIG BLOCK BE USEFUL?
	SKIPA	T2,S.BFCT##	;YES, GET BLOCKING FACTOR
	MOVEI	T2,N		;ELSE USE STANDARD VALUE
	MOVEM	T2,BBSN		;SAVE DISK BLOCKS/TAPE BLOCK
	SUBI	T2,2		;ACCOUNT FOR STUFF USED BY HEADER
	IMULI	T2,200		;TIMES SIZE OF A DISK BLOCK
	CAMLE	T1,T2		;SEE IF SHOULD START IN SECOND TAPE BLOCK
	JRST	SNDREC		;YES, START FILE IN 2ND TAPE RECORD

	MOVEI	P2,M+400(MH)	;WHERE TO START
	MOVE	P1,BBSN		;MAXIMUM NUMBER OF BLOCKS FOR FIRST RECORD
	SUBI	P1,2		;MINUS 2 USED BY HEADER STUFF
	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
	ADDI	DBUF,200	;NEXT BLOCK IN DISK BUFFER
	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
	MOVNI	P3,200		;WORDS IN THIS BLT
	ADDB	P3,DSKHDR+.BFCTR;SAVE ACTUAL NUMBER OF WORDS
	ADDI	P2,200		;NEXT BLOCK SLOT
	SOSE	NDBLIB		;MORE DATA IN THIS DISK BUFFER?
	JRST	STBLK1		;YES, JUST MOVE IT TO THE TAPE BUFFER
	PUSHJ	P,DSKIN		;GET NEXT DATA BLOCK
	 JRST	[MOVX	T2,GF$DF0	;[254] SET DISK FILE ERROR BIT
		HRRZ	T3,S.MBPT	;[254] TAPE BUFFER POINTER
		ADDI	T3,M+2		;[254] TO START OF DATA
		SUB	T3,P2		;[254] SUBTRACT CURRENT ADDRESS
		IDIVI	T3,200		;[254] TO NEGATIVE BLOCKS
		LSH	T2,(T3)		;[254] SHIFT BIT TO POSITION
		IORM	T2,G$FLAG(MH)	;[254] INTO RECORD FLAG WORD
		JRST	.+2]		;[254] AND CONTINUE
	  JRST	FINFIL		;EOF--DONE
STBLK1:	AOS	T1,THSRDB	;ANOTHER BLOCK READ
	SKIPE	S.CKPT##	;CHECKPOINTING?
	PUSHJ	P,TYPCKP	;YES
	SOJG	P1,STBLK	;GO XFR NEXT ONE

SNDREC:	PUSHJ	P,GETFCT	;GET BLOCKING FACTOR IN T1
	MOVEM	T1,G$TBS(MH)	;STORE IN HEADER
	PUSHJ	P,MTAOUT	;SEND TAPE RECORD

	MOVE	P1,BBSN		;GET NUMBER OF DISK BLOCKS/TAPE BLOCK
	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:	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)	; ...
	PUSHJ	P,BIGBLT	;DO THE BLT

SNDLST:	MOVX	T1,GF$EOF	;MARK AS LAST BLOCK
	IORM	T1,G$FLAG(MH)	;SET FLAG
	PUSHJ	P,GETFCT	;GET BLOCKING FACTOR IN T1
	MOVEM	T1,G$TBS(MH)	;STORE IN HEADER
	PUSHJ	P,MTAOUT	;SEND LAST BUFFER
	MOVEI	T1,N		;RESET BLOCK SIZE
	MOVEM	T1,BBSN		;...
	SKIPN	S.REPT##	;[355] /REPEAT?
	JRST	CHKDEL		;[355] NO, SAFE TO DELETE IF NECESSARY
	MOVE	T1,CURTAP	;[355] SEE IF TAPE NUMBERS HAVE CHANGED
	CAMN	T1,S.NTPE##	;[355]
	JRST	CHKDEL		;[355] SAME TAPE
	SKIPE	NRPS		;[355] HAS A REPEAT ALREADY BEEN DONE?
	JRST	CLSFIL		;[355] NO, SO DON'T TRY DELETING
CHKDEL:	SKIPN	S.SDEL##	;[230] /SDELETE?
	JRST	DELSWT		;[230] NO, CHECK /DELETE
	MOVEI	T1,T2		;[230] YES,SET UP CHKACC
	LDB	T2,[POINTR(EXLFIL+.RBPRV,RB.PRV)] ;[230] GET PROTECTION
	MOVE	T3,EXLFIL+.RBPPN	;[230] GET POINTER OR PPN
	TLNN	T3,-1		;[230] IS IT S POINTER?
	MOVE	T3,.PTPPN(T3)	;[230][317] YES, GO GET PPN
	MOVE	T4,.MYPPN##	;[230] GET USER PPN
	HRLI	T2,.ACREN	;[230] SET UP CHKACC FOR RENAME
	CHKACC	T1,		;[230] SEE IF DELETION VIA RENAME WILL WORK
	JFCL			;[230] IGNORE ERROR
	JUMPE	T1,DELFIL	;[230] YES,GO DELETE
	MOVSI	T1,700000	;[230] NO,MUST LOWER OWNER PROTECTION
	ANDCAM	T1,EXLFIL+.RBPRV	;[230] CLEAR OWNER PROTECTION
	RENAME 	FILE,EXLFIL	;[230] RENAME FILE PROTECTION
	JFCL			;[230] IGNORE ERROR
	JRST	DELFIL		;[230] GO DELETE FILE
DELSWT:	SKIPN	S.DELT##	;[230] /DELETE?
	JRST	CLSFIL		;NO, FINISH FILE
DELFIL:	TXNN	F,FL$HUF	;[342] SKIP IF HOLDING FILE ALREADY
	PUSHJ	P,HOLDIT	;[337] GO HOLD FILE IF NECESSARY
	MOVE	T1,EXLFIL+.RBNAM ;[230] 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:	TXNN	F,FL$HUF	;[342] SKIP IF ALREADY HELD.
	PUSHJ	P,HOLDIT	;[337] HOLD IF NECESSARY.
	CLOSE	FILE,CL.ACS	;INHIBIT ACCESS DATE UPDATING
	 POPJ	P,		;RETURN



;HOLDIT -- Routine to LOOKUP the file (information at EXLFIL) so that the
;	monitor will not do extra disk accesses for the UFD. Uses P1-P4,
;	carefully saving and restoring them.  Do the test of FL$HUF here,
;	just to be safe.

HOLDIT:	TXNE	F,FL$HUF	;[436] ARE WE HOLDING THE UFD PPB?
	POPJ	P,		;[436] YES. JUST RETURN
	PUSHJ	P,SAVE4		;[436] PRESERVE P1-P4
	MOVE	P1,EXLFIL+.RBNAM;[436] FILENAME
	HLLZ	P2,EXLFIL+.RBEXT;[436] EXTENSION
	MOVEI	P3,0		;[436] ZERO THIRD WORD
	MOVE	P4,EXLFIL+.RBPPN;[436] PPN OR PATH POINTER
	LOOKUP	HOLD,P1		;[436] LOOKUP FILE ON HOLD CHANNEL
	  POPJ	P,		;[436] JUST CONTINUE IF ERROR.
	TXO	F,FL$HUF	;[436] SUCCESSFUL LOOKUP - FLAG IT
	POPJ	P,		;[436] RESTORE P1-P4 AND RETURN
HOLDRL:	TXZE	F,FL$HUF	;[342] HOLDING UFD?
	CLOSE	HOLD,CL.ACS	;[342] YES - CLOSE THE FILE
	RELEAS	HOLD,		;[376][342] IN ANY CASE, RELEASE CHANNEL
	SETZM	HCSTR		;[342] ZERO CURRENTLY HELD STRUCTURE
	SETZM	HCPPN		;[342] AND PPN
	POPJ	P,		;[342] 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
	SKIPE	T1,.FXVER(SP)	;[316] GET VERSION NUMBER, IF NULL
	CAMN	T1,[-1]		;[316] OR DEFAULT, USER .RBVER
	MOVE	T1,.RBVER(P2)	;IF NOT, USE VERSION FROM FILE
	MOVEM	T1,A$VERS(P1)	;STORE VERSION ON TAPE
	MOVE	T1,.RBTYP(P2)	;GET FILE TYPE
	MOVEM	T1,A$FTYP(P1)	;STORE
	MOVE	T1,.RBBSZ(P2)	;GET BYTE SIZES
	MOVEM	T1,A$FBSZ(P1)	;STORE
	MOVE	T1,.RBRSZ(P2)	;RECORD AND BLOCK SIZES
	MOVEM	T1,A$FRSZ(P1)	;STORE
	MOVE	T1,.RBFFB(P2)	;GET APPLICATION/CUSTOMER WORD
	MOVEM	T1,A$FFFB(P1)	;STORE
	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
IFN FT$USG,<
	SKIPN	.RBACT(P2)	;ANY ACCOUNT STRING GIVEN
	JRST	SETANT		;NO, SKIP THIS
	HRLI	T1,.RBACT(P2)	;POINT TO ACCOUNT STRING
	HRRI	T1,M+201+LN$AFH(MH) ;POINT TO PHYSICAL PLACE FOR IT
	BLT	T1,M+201+LN$AFH+7(MH) ;MOVE THE ACCOUNT STRING
	MOVEM	T3,A$ACCT(P1)	;STORE WHERE YOU CAN FIND IT
	ADDI	T3,10		;INCREMENT ABSOLUTE BYTE POINTER
>
SETANT:	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
	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
;+
;<BIGBLT IS A SUBROUTINE TO BLT USING THE SIZE OF A LARGE BLOCK.
;^IT REPLACES ALL "<BLT <T1,<MTBBKP-1(MH)" INSTRUCTIONS.  ^THIS
;ROUTINE COMPUTES THE LENGTH OF THE RECORD USING <BBSN.
;-

BIGBLT:	PUSH	P,T2		;SAVE AN AC
	MOVE	T2,B.BBKP##	;ADD IN SIZE OF A BACKUP BLOCK ON TAPE
				;$ (CONSTANT INITIALIZED BY INIBBS IN BACKUP)
	ADDI	T2,-1(MH)	;COMPUTE END ADDRESS
	BLT	T1,(T2)		;DO THE BLT
	POP	P,T2		;RESTORE THE AC
	POPJ	P,		;RETURN

;+
;<GETFCT RETURNS THE BLOCKING FACTOR IN <T1.  ^IF NOT WRITING BIG
;BLOCKS, ZERO IS RETURNED.
;-

GETFCT:	MOVE	T1,BBSN		;GET BLOCKING FACTOR
	SKIPE	S.INTR##	;BUT WAS /INTERCHANGE SPECIFIED?
	MOVEI	T1,N		;YES, THEN DON'T USE BIG BUFFERS
	CAILE	T1,N		;IS THIS A BIG BLOCK?
	JRST	GETFC1		;YES
	SETZ	T1,		;NO, RETURN ZERO
	POPJ	P,		;RETURN

GETFC1:	PUSH	P,T2		;SAVE AN AC
	MOVE	T2,T1		;GET A COPY
	IMULI	T2,200		;CONVERT TO WORDS
	ADDI	T2,M		;ADD IN HEADER
	DPB	T2,[POINTR T1,GC$BSZ] ;STORE IN T1
	POP	P,T2		;RESTORE AN AC
	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

	MOVE	P2,S.SSNM##	;[237] SAVE SET SPECIFIED?
	JUMPE	P2,RSTREC	;[237] PUNT, IF NOT SPECIFIED
	CAME	P2,[ASCII/all/]	;[237] SEE IF LOWER CASE ALL
	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
	SETZM	S.SSNM##	;[265] DON"T LOOK FOR THIS ONE AGAIN
;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?
		 PJRST	HOLDRL	;[342] RELEASE HOLD CHANNEL AND RETURN
		 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	;[515] YES, LIST IT AND
		 JRST  RSTREC]  ;[515] 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?
	CAME	T1,[ASCII/all/]	;[237] NOT "all"
	CAMN	T1,[ASCII/ALL/]	; AND NOT "ALL"
	JRST	RSTREC		;NO--KEEP GOING
	PUSHJ	P,HOLDRL	;[342] RELEASE ANYTHING ON HOLD CHANNEL
	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]
	TXO	F,FL$SKP	;[232] SKIP .RBEST RENAME IF UFD
	PUSHJ	P,RSTRIB	;CONVERT TO RIB
	TXZ	F,FL$SKP	;[232] RESET .RBEST SKIP
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
	TXNE	F,FL$CHK	;[403] UNLESS /CHECK
	MOVSI	T1,'ALL'	;[403] THEN USE ALL
	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]
	PUSHJ	P,SETSTR	;[262] GET FLAG WORD
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
	SETOM	CNAMSW		;[416] 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:	PUSHJ	P,SETSTR	;[503][262] SET UP STRUCTURE MASK
	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	CNAMSW		;[416] 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?
	CAME	T1,[ASCII/all/]	; lower case ALL?		[350]
	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
	SKIPE	S.INTR		;[273] DON'T CHECK SFD IF /INTER
	JRST	SPCSA2		;[273]
	MOVSI	T2,-.FXLND+1	;[270] NUMBER OF SFD'S
	HRRI	T2,.FXDIR+FX$LEN+2(SP)	;[270] CHECK FIRST FOR WILD SFD
SPCSA4:	SETCM	T1,1(T2)		;[270] ANY WILD SFD"S
	JUMPN	T1,RSTREC		;[270]YES, GO BACK
	ADDI	T2,1			;[270] INDEX BY TWO
	AOBJN	T2,SPCSA4		;[270] TO CHECK THEM ALL
	PUSHJ	P,SETSTR	;[262] SET UP STRUCTURE MASK
	SKIPN	FX$CNT+FX$LEN(SP);THIS DIRECTORY FOUND?
	JRST	RSTREC		;NO--CONTINUE LOOKING
	MOVE	T1,.FXDEV+FX$LEN(SP)	;[352] YES--IF INPUT DEVICE IS
	CAME	T1,[SIXBIT/ALL/]	;[352] ALL OR DSK, MAYBE ANOTHER
	CAMN	T1,[SIXBIT/DSK/]	;[352] STRUCTURE LATER.
	JRST	SPCSA2		;[352] YES--DONE ONLY IF FILE FOUND
	PUSHJ	P,VER0		;[352][175] NO--IS IT THE CURRENT ONE?
	  JUMPE	T1,SPCSAT	;NO--PASSED IT			[204]
SPCSA2:	SKIPN	FX$CNT(SP)	;[273] 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
	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
	PJRST	HOLDRL		;[342] RELEASE HOLD CHANNEL AND RETURN
;+
;<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!FL$DFE	;[254] ZERO FLAGS
	MOVE	T1,G$FLAG(MH)	;[254] GET FLAG WORD
	TXNE	T1,GF$DFE	;[254] DFE BIT ON?
	 PUSHJ	P,DSKDFE	;[254] YES, PRINT MESSAGE

	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
	SKIPN	T2,ACSTR	;[406] LOAD ALIAS STR NAME
	MOVSI	T2,'DSK'	;[406] DEFAULT TO DSK:
	SETZ	T3,		;NO BUFFERS

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

	MOVX	T1,.IOBIN+UU.LBF;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

	CAMN	T2,HCSTR	;[342] ALIAS STRUCTURE SAME AS HELD STR?
	JRST	RSTFL2		;[342] YES - JUMP TO CHECK PPN
	PUSHJ	P,HOLDRL	;[342] NO - RELEASE THIS STR
	OPEN	HOLD,T1		;[342] OPEN ALIAS STR ON HOLD CHANNEL
	  JRST	FAIL0		;[342] LOSE
	MOVEM	T2,HCSTR	;[342] REMEMBER HOLD STRUCTURE
RSTFL2:	MOVE	T1,APATH+.PTPPN	;[342] GET ALIAS PPN
	CAMN	T1,HCPPN	;[342] SAME AS CURRENTLY HELD PPN?
	JRST	RSTFL3		;[342] YES - JUMP TO FILL ENTER BLOCK
	MOVEM	T1,HCPPN	;[342] NO - REMEMBER THE PPN CHANGE
	TXZE	F,FL$HUF	;[342] ZERO THE HELD-FLAG
	CLOSE	HOLD,CL.ACS	;[342] AND CLOSE PREVIOUS FILE IF ANY
RSTFL3:				;[342]
	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
	SKIPN	T2		;[356] IF NOT SET,
	LDB	T1,[POINTR (EXLFIL+.RBPRV,RB.PRV)] ;[356] GET FILE PROT.
	MOVEM	T1,PRNAME	;[356] AND REMEMBER FOR LATER
	SKIPN	S.FFA		;[356] AM I [1,2]
	JRST	LBL1		;[356] NO, ALWAYS DO PROT. RENAME
	TRZN	T1,400		;[356] FILDAE PROTECTED?
	JUMPN	T1,LBL		;[356] NO, DON'T NEED RENAME UNLESS PROT <000>
	TROA	T1,377		;[356] YES, NEED PROT. RENAME
LBL1:	MOVEI	T1,100		;[356] NON-OPR RENAMED PROTECTION
	TXO	F,FL$PRN	;[356] FLAG RENAME NEEDED
LBL:	DPB	T1,[POINTR (EXLFIL+.RBPRV,RB.PRV)] ;[356] SET IN FILE
	SKIPE	T1,.FXVER(SP)	;[316] GET /VERSION FROM USER, IF SET
	CAMN	T1,[-1]		;[316]
	  SKIPA			;[316]
	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
;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

	MOVX	T1,.PTSCN	;[501] NO SCAN
	MOVEM	T1,APATH+.PTSWT	;[501] SET PATH SWITCH

	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

	TXNN	F,FL$HUF	;[436][342] IF NOT ALREADY HELD,
	PUSHJ	P,HOLDIT	;[436][342] HOLD THIS PPN

	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	T1,S.RSUM##	;[357] SEE IF RESUMING
	JRST	NEWFIL		;NOT. ASSUME NORMAL HANDLING

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

	TXNN	F,FL$HUF	;[342] IF NOT ALREADY HELD,
	PUSHJ	P,HOLDIT	;[342] HOLD THIS PPN
	TXNE	F,FL$CHK	;SEE IF /CHECK,
	JRST	POSITN		;YES, GO POSITION
	ENTER	FILE,EXLFIL	;RE-ENTER TO UPDATE
	 JRST	[MOVEM	T2,EXLFIL+.RBPPN	;[357][261] RESTORE PATH
		SETZM	S.RSUM##	;[261] ZILCH
		 JRST	EEFIL]	;ABORT FILE
	MOVEM	T2,EXLFIL+.RBPPN	;[261] RESTORE PATH

POSITN:	PUSHJ	P,.USETI	;[357] POSITON USING FILOP
	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
	MOVEI	T2,FILE		;[510] CHANNEL
	DEVCHR	T2,		;[510] GET LEGAL DATA MODES FOR THIS DEVICE
	MOVEI	T3,1		;[510] ADJUST TO THE BIT POSITION OF THE GIVEN
	LSH	T3,(T1)		;[510]  DATA MODE TO COMPARE WITH BITS RETURNED
	TDNE	T2,T3		;[510]  BY THE DEVCHR.  IS THE DATA MODE KNOWN?
	JRST	NEWFL1		;[510] YES
	WARN$N	(IDM,Illegal data mode)	;[510] NO. REPORT IT
	PUSHJ	P,OCTOUT	;[510] DISPLAY ILLEGAL DATA MODE
	OUTSTR	[ASCIZ / for file /]	;[510]

	PUSHJ	P,TYSPEC	;[510] DISPLAY FILE SPEC
	OUTSTR	[ASCIZ/, assuming image mode.
/]
	MOVEI	T1,.IOIMG	;[510] USE BINARY MODE INSTEAD
NEWFL1:	SETSTS	FILE,(T1)	;FAKE OUT FILSER
	PUSHJ	P,SETFIL	;SET UP FILE ENTER BLOCK
	SETOM	UNIQUE		;RESET UNIQUE EXTENSION NUMBER
NEWFL2:	MOVX	T1,RB.NSE	;NON-SUPERSEDING ENTER BIT
	MOVX	T2,FX.SUP	;SCAN SUPERSEDE BIT
	SKIPG	S.UNIQ##	;UNIQUE EXTENSIONS?
	TDNE	T2,.FXMOD(SP)	;/ERSUPERSEDE?
	IORM	T1,EXLFIL+.RBCNT ;YES
	MOVE	T1,EXLFIL+.RBPPN	;[261] SAVE PATH
	ENTER	FILE,EXLFIL	;TRY TO ENTER FILE
	 JRST	[MOVEM	T1,EXLFIL+.RBPPN	;[261] RESTORE PATH
		JRST	CHKWHY	]	;[261] LOSE--TRY TO RECOVER
	MOVEM	T1,EXLFIL+.RBPPN	;[261] RESTORE PATH
	SKIPGE	UNIQUE		;WAS A UNIQUE EXTENSION GENERATED?
	JRST	NORMAL		;NO
	WARN$N	(UEG,<Unique extension generated>)
	PUSH	P,P1		;SAVE P1
	MOVEI	P1,EXLFIL	;POINT TO ENTER BLOCK
	PUSHJ	P,GUUO		;TYPE FILESPEC
	POP	P,P1		;RESTORE P1
;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
	MOVE	T1,BBSN		;GET NUMBER OF DISK BLOCKS/TAPE BLOCK
	SUBI	T1,2		;SKIP OVERHEAD STUFF
	IMULI	T1,200		;CONVERT TO WORDS
	CAMLE	P1,T1		;IS IT IN RANGE?
	MOVE	P1,T1		;NO, USE DEFAULT

	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
	MOVE	T1,[CLOSE FILE,CL.ACS!CL.DAT] ;[304]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:	MOVEI	T1,200		;ADJUST BYTE POINTER
	ADDM	T1,DSKHDR+.BFPTR
	MOVE	T1,DSKHDR+.BFCTR;ADJUST BYTE COUNT
	SUBI	T1,200
	MOVEM	T1,DSKHDR+.BFCTR
	ADDI	DBUF,200	;NEXT BLOCK IN DISK BUFFER
	SOSE	NDBLIB		;IS THIS THE LAST BLOCK OF THE DISK BUFFER?
	JRST	ENDBLK		;NO. CONTINUE TRANSFERRING
	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	;COUNT OF BLOCKS+1 SO FAR
	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:	MOVE	T1,G$FLAG(MH)	;[254] GET FLAG WORD
	TXNE	T1,GF$DFE	;[254] DFE BIT ON?
	 PUSHJ	P,DSKDFE	;[254] YES, PRINT MESSAGE
	SKIPG	P1,G$SIZ(MH)	;[254] ANY SIGNIFICANT DATA?
	JRST	CHKEND		;NO--SHOULD BE END
	MOVE	P2,BBSN		;GET NUMBER OF DISK BLOCKS/TAPE BLOCK
	IMULI	P2,200		;CONVERT TO WORDS
	CAMLE	P1,P2		;SEE IF IN RANGE
	MOVE	P1,P2		;NO, USE MAXIMUM
	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		; ...
	CAMN	T1,THSRDB	;[321] BLOCK EXPECTED?
	JRST	XFR1		;[321] YES - GO USE IT
	MOVE	T2,THSRDB	;LOAD NEEDED DISK BLOCK NUMBER
	MOVE	T3,BBSN		;GET NUMBER OF DISK BLOCKS/TAPE BLOCK
	ADDI	T3,(T1)		;COMPUTE END OF RANGE
	CAML	T2,T1		;NEEDED BLOCK GE FIRST BLOCK IN RECORD?
	CAML	T2,T3		;AND ALSO LT FIRST BLOCK IN NEXT RECORD?
	JRST	NOTINB		;[321] NO - GO RESET DISK POINTERS

	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?


NOTINB:	CAML	T1,THSRDB	;[321] PREVIOUS BLOCK?
	JRST	RSTMSD		;[321] NO - WE MISSED A BLOCK
	MOVEM	T1,THSRDB	;[321] YES - RESET FILE INDEX
	WARN$N	(PBR,Prior block repeated) ;[321] WARN USER
	MOVEI	T2,[ASCIZ/rewriting from /] ;[321] MESSAGE
	TXNE	F,FL$CHK	;[321] CHECKING?
	MOVEI	T2,[ASCIZ/rereading from /] ;[321] YES - OTHER MSG
	OUTSTR	@T2		;[321]
	PUSHJ	P,TYEFIL	;[321] TELL USER FILE AND BLOCK
	JRST	RSTUST		;[321] GO USE IT
RSTMSD:	PUSH	P,T1		;[321] SAVE THIS RDB
	WARN$N	(BMT,Block missed on tape, expected) ;[321] WARN
	PUSHJ	P,TYEFIL	;[321] DISPLAY FILE AND BLOCK
	POP	P,THSRDB	;[321] UPDATE FILE INDEX
	WARN$N	(FLC,File continuing with) ;[321] SHOW WHAT'S HAPPENING
	PUSHJ	P,TYEFIL	;[321] DITTO
RSTUST:	MOVE	T1,THSRDB	;[321] GET BLOCK NUMBER
	TXNN	F,FL$CHK	;[321] CHECKING?
	JRST	[PUSHJ	P,.USETO	;[357] NO, USETO DISK FILE (USE FILOP)
		 JRST	XFR1]		;[321] GO USE THE BLOCK
	WAIT	FILE,		;[521] WAIT FOR DISK ACTIVITY TO SETTLE DOWN
	MOVSI	T2,400000	;[321] CHECKING - MUST RESET INPUT BUFFERS
	IORB	T2,DSKHDR	;[321] FLAG BUFFER RING AS EMPTY
	MOVEI	T3,NDSKBF	;[321] PREPARE TO INVALIDATE ALL BUFFERS
RSTUS1:	SOJL	T3,RSTUS2	;[321] ANY MORE BUFFERS?
	MOVE	T4,(T2)		;[321] YES - GET NEXT .BFHDR
	TXZ	T4,BF.IOU	;[321] CLEAR THE USE BIT
	MOVEM	T4,(T2)		;[321] PUT IT BACK
	MOVE	T2,T4		;[321] POINT TO NEXT BUFFER IN RING
	JRST	RSTUS1		;[321] GO CHECK FOR MORE
RSTUS2:	PUSHJ	P,.USETI	;[357] RING INVALIDATED, USETI DISK FILE
	PUSHJ	P,@DSKIO	;[321] READ THE NEEDED DISK BLOCK
	  JRST	XFRERR		;[321] PROBLEM WITH DISK
	  JRST	DSKEO1		;[321] NO MORE DISK FILE
	JRST	XFR1		;[321] GO COMPARE

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:	SKIPLE	.FXEST(SP)	;[232] /ESTIMATE SET?
	SKIPA	T1,[CLOSE FILE,CL.ACS!CL.DLL!CL.DAT]; [236] YES,LOAD PROPER CLOSE
	MOVE	T1,[CLOSE FILE,CL.ACS!CL.DAT]	;[236] NO,LOAD PROPER CLOSE
	TXNE	F,FL$PAO		;[232] PAO FLAG ON?
	TRZ	T1,CL.DLL		;[232] YES,CLEAR CL.DLL
	XCT	T1			;[232] EXECUTE UUO
	TXNE	F,FL$HUF	;[342] PPN HELD ALREADY?
	JRST	XFRDO2		;[342] YES - SKIP HOLDING STUFF
	PUSHJ	P,SETFIL	;[342] NO - RESET LOOKUP BLOCK
	PUSHJ	P,HOLDIT	;[342] AND CALL PPN HOLDER

XFRDO2:				;[342]
IFN FT$DBG,<			;[323]
	SETOM	FSZWDS		;[323] FLAG # WORDS UNDETERMINED
>;END IFN FT$DBG		;[323]
	TXNN	F,FL$CHK	;[260] SKIP IF /CHECK
	TXNN	F,FL$PRN!FL$EST		;[232] EITHER PROT. OR .RBEST TO BE RENAMED?
	JRST 	CONT			;[232] NO,SKIP AROUND RENAME LOGIC
	PUSHJ	P,SETFIL		;[232] YES,RESET ENTER BLOCK
	MOVE	T2,EXLFIL+.RBPRV	;[315] SAVE REAL CREATION DATE
	MOVE	T1,EXLFIL+.RBPPN	;[324] SAVE PATH
	MOVE	T3,EXLFIL+.RBEXT	;[354] SAVE HIGH ORDER CREATION BITS
	LOOKUP	FILE,EXLFIL		;[232] LOOKUP FILE
		JRST ELFIL		;[232] TELL USER BAD NEWS
	MOVEM	T3,EXLFIL+.RBEXT	;[354] REPLACE HIGH ORDER CREATION BITS
	MOVEM	T1,EXLFIL+.RBPPN	;[324] RESTORE PATH
	MOVEM	T2,EXLFIL+.RBPRV	;[315] REPLACE REAL CREATION DATE
IFN FT$DBG,<				;[323]
	MOVE	T2,EXLFIL+.RBSIZ	;[323] GET FILE SIZE IN WORDS
	MOVEM	T2,FSZWDS		;[323] SAVE IT
>;END IFN FT$DBG			;[323]
	TXNN	F,FL$PRN		;[354][232] PROTECTION TO BE RENAMED?
	JRST	XFRDO3			;[354] NO...
	SKIPE	T2,PRNAME		;[354] YES, GET ORIGINAL PROTECTION
	JRST	STPROT			;[354] JUMP IF NOT ZERO
	TXZE	F,FL$EPR		;[354] EOV?
	JRST	XFRDO3			;[354] YES
	SKIPN	S.INTR			;[354] INTERCHANGE MODE?
STPROT:	DPB	T2,[POINTR(EXLFIL+.RBPRV,RB.PRV)] ;[354][232] NO, SET IN BLOCK
XFRDO3:	TXNE	F,FL$EST		;[232] .RBEST TO BE RENAMED?
	JRST	[MOVE	T2,EST		;[232] YES,GET ORIGINAL .RBEST
		 SKIPG	.FXEST(SP)	;[232] IF /ESTIMATE SET RETURN
		 MOVEM	T2,EXLFIL+.RBEST ;[232] SET IN ENTER BLOCK
		 JRST	.+1]	;[232] RETURN
	MOVEI	T2,12			;[232] SHORTEN ENTE BLOCK
	MOVEM	T2,EXLFIL		;[232] SET IN BLOCK 
	RENAME	FILE,EXLFIL		;[232] RENAME THE FILE
	 PUSHJ	P,ERFIL		;[260] [232] GIVE WARNING MESSAGE
	MOVEM	T1,EXLFIL+.RBPPN	;[324] RESTORE PATH
	TXZ	F,FL$PRN!FL$EST		;[232] RESET RENAME FLAGS

CONT:	TXZE	F,FL$DFE	;[254] ANY DISK ERRORS WHEN SAVED?
	PUSHJ	P,DFETST	;[424][254] YES, PRINT ERROR MESSAGE
	TXNE	F,FL$CHK	;[254] 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,<
	SKIPE	S.INTR		;[323] INTERCHANGE MODE?
	  JRST	TAPERR		;[323] YES - SKIP SIZE CHECK IN CASE DUMPER
	MOVE	T1,FSZWDS	;[323] NO - GET FILE SIZE IN WORDS
	CAME	T1,[-1,,-1]	;[323] DO WE REALLY HAVE IT?
	  JRST	SIZCHK		;[323] YES - GO COMPARE SIZES.
				;[323] NO - MUST DO A LOOKUP
	PUSHJ	P,SETFIL	;RESET LOOKUP/ENTER BLOCK
	MOVE	T1,EXLFIL+.RBPPN	;[324] SAVE PATH
	LOOKUP	FILE,EXLFIL	;GET IT AGAIN
	  JRST	ELFIL		;OUCH
	MOVEM	T1,EXLFIL+.RBPPN	;[324] RESTORE PATH
	MOVE	T1,EXLFIL+.RBSIZ;GET FILE SIZE IN WORDS
SIZCHK:	CAMN	T1,CWSIZE	;SAME AS TAPE'S?
	JRST	TAPERR		;YES
	MOVEI	T1,FILE		;GET CHANNEL
	DEVCHR	T1,		;AND THE DEVMOD BITS
	TXNE	T1,DV.DSK	;A DISK?
	TXNN	T1,DV.TTY	;AND A TTY?
	CAIA			;NO--REAL ERROR
	JRST	TAPERR		;DEVICE IS NUL
	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

DFETST:	WARN$N	(DFE,Disk file had errors when SAVEd)	;[254]
	MOVEI	P1,EXLFIL	;[254] LOAD ADDRESS OF BLOCK
	PUSHJ	P,GUUO		;[254] TYPE NAME
	POPJ	P,		;[424] 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
	SUBI	T2," "-' '	;[340] SIXBITIZE
	JUMPL	T2,CPOPJ	;[340] QUIT IF NULL OR FUNNY CHARACTER
	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 
	MOVE	T1,A$FHLN(P1)	;GET LENGTH OF HEADER
	CAIGE	T1,LN$AFH	;IS THIS TAPE THE OLD FORMAT?
	JRST	RSTRI1		;YES. SKIP THE FILE ATTRIBUTE INFO
	MOVE	T1,G$TYPE(MH)	;GET THE RECORD TYPE
	CAIE	T1,T$FIL	;IS THIS FILE DATA?
	JRST	RSTRI1		;NO. SKIP THE NEXT PART. FILE ATTRIBUTES ARE
				; FOR FILES, NOT UFDS
	MOVE	T1,A$FTYP(P1)	;GET FILE TYPE
	MOVEM	T1,.RBTYP(P2)	;STORE
	MOVE	T1,A$FBSZ(P1)	;GET BYTE SIZES
	MOVEM	T1,.RBBSZ(P2)	;STORE
	MOVE	T1,A$FRSZ(P1)	;GET RECORD AND BLOCK SIZES
	MOVEM	T1,.RBRSZ(P2)	;STORE
	MOVE	T1,A$FFFB(P1)	;GET APPLICATION/CUSTOMER WORD
	MOVEM	T1,.RBFFB(P2)	;STORE
RSTRI1:	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
	TXNE	F,FL$SKP	;[232] SKIP .RBEST RENAME IF UFD
	JRST	RSTADT		;CONTINUE
	TXO	F,FL$EST	;[232] SET .RBEST RENAME FLAG
	MOVEM	T1,EST		;[232] SAVE ORIGINAL .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
IFN FT$USG,<
	MOVE	T3,A$ACCT(P1)	;GET ADDRESS OF ACCOUNT STRING
	JUMPE	T3,RSTANT	;NONE, SKIP THIS
	ADD	T3,P1		;MAKE PHYSICAL ADDRESS
	HRLI	T3,(T3)		;SOURCE FOR BLT
	MOVE	T2,(P)		;ADDRESS OF RIB TO CREATE
	HRRI	T3,.RBACT(T2)	;DESTINATION
	BLT	T3,.RBACT+7(T2)	;MOVE THE ACCOUNT STRING
>
RSTANT:	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
	TXNE	T1,RP.BFA	;[427] DID SAVE HAD BAD FILE?
	TXO	F,FL$TPE	;[427] YES, SET UP TAPE ERROR

	TXNE	T1,RP.BFA	;[427] DID SAVE HAD BAD FILE
	TXO	F,FL$TPE	;[427] YES, SET UP TAPE ERROR
	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
	MOVE	T1,EXLFIL+.RBPPN	;[324] SAVE PATH
	MOVE	T2,EXLFIL+.RBPRV	;[354] SAVE LOW ORDER CREATE BITS
	MOVE	T3,EXLFIL+.RBEXT	;[354] SAVE HI ORDER CREATE BITS
	LOOKUP	FILE,EXLFIL	;DO LOOKUP
	  JRST	ELFIL		;NOT THERE!!
	MOVEM	T1,EXLFIL+.RBPPN	;[324] RESTORE PATH
	ENTER	FILE,EXLFIL	;RE-ENTER TO UPDATE
	  JRST	EEFIL		;GIVE ERROR RETURN
	MOVEM	T3,EXLFIL+.RBEXT	;[354] RESTORE HI ORDER CREATE BITS
	MOVEM	T2,EXLFIL+.RBPRV	;[354] RESTORE LOW ORDER CREATE BITS
	MOVEM	T1,EXLFIL+.RBPPN	;[324] RESTORE PATH
	TXO	F,FL$PRN	;[354] MAKE SURE WE RENAME FILE
	USETI	FILE,-1		;POSITION TO END TO APPEND
	MOVE	T1,.JBFF	;[242] GET JOBFF
	MOVE	T2,NWPBLK	;NUMBER OF WORDS/BUFFER
	IMULI	T2,NDSKBF+3	;CORE FOR DISK BUFFERS
	SUBI	T1,T2		;[242] SUBTRACT OFF OLD BUFFER AREA
	MOVEM	T1,.JBFF	;[242] PUT BACK JOBFF
	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

	CAIE	T1,ERAEF%	;ALREADY EXISTING FILE?
	JRST	CHKWH2		;NO
	AOS	T1,UNIQUE	;GET UNIQUE NUMBER
	SKIPLE	S.UNIQ##	;WANT UNIQUE EXTENSION?
	CAILE	T1,^D999	;OVERFLOW?
	JRST	EEFIL		;GIVE UP
	MOVEI	T4,3		;COUNTER
CHKWH1:	IDIVI	T1,^D10		;CONVERT
	ADDI	T2,'0'		; NUMBER
	LSHC	T2,-6		;  TO SIXBIT
	SOJG	T4,CHKWH1	;LOOP
	HLLZM	T3,EXLFIL+.RBEXT ;STUFF RESULT IN ENTER BLOCK
	JRST	NEWFL2		;GO RETRY ENTER

CHKWH2:	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

	MOVX	T1,.PTSCN	;[425] SET NO SCAN
	MOVEM	T1,UPTBLK+.PTSWT;[501][425] STORE
	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,RB.NLB+NRIB-1 ;[423] 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]

	MOVE	T1,A$REDT(P1)	;[223] GET ACCESS DATE/TIME
	PUSHJ	P,CONTDT	;[223] CONVERT TO SYSTEM FORMAT
	DPB	T2,[POINTR (.RBEXT(P2),RB.ACD)] ;[223] RESTORE IT
	MOVE	T2,EXLFIL+.RBPPN	;[324] SAVE PATH
	ENTER	FILE,EXLFIL	;TRY TO ENTER FILE
	  SKIPA			;CHECK FOR ERPOA%
	JRST	[MOVEM	T2,EXLFIL+.RBPPN	;[324] RESTORE PATH
		 JRST NORMAL			;OK
		]				;[324]

	MOVEM	T2,EXLFIL+.RBPPN	;[324] RESTORE PATH
	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,RB.NLB+NRIB-1 ;[423] 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

;+
;<DSKDFE IS A SUBROUTINE WHICH IS CALLED WHEN A DISK BLOCK WHICH
;CONTAINED AN ERROR IS TO BE RESTORED OR CHECKED FROM A TAPE. ^THESE
;RECORDS HAVE A <GF$DFE BIT ON IN THE <G$FLAG WORD. ^THIS ROUTINE
;USES ^T1 AND ^T2.
;-

DSKDFE:	TXO	F,FL$DFE	;[254] TURN ON ERROR FLAG
	WARN$N	(DSE,Disk save error)	;[254] PRINT WARNING
	OUTSTR	[ASCIZ	/(block=/]	;[254] GIVE BLOCK
	MOVE	T1,F$RDW(MH)	;[254] GET WORD NUMBER
	ADDI	T1,400		;[254] TO BLOCK
	ASH	T1,-7		;[254] CONVERT TO BLOCK NUMBER
	MOVE	T2,G$FLAG(MH)	;[254] GET FLAG BITS
	TXZE	T2,GF$DF0	;[254] FIRST BLOCK?
	 JRST	DSKDF1		;[254] YES, CONTINUE
	TXZE	T2,GF$DF1	;[254] SECOND BLOCK?
	 JRST	[ADDI	T1,1		;[254] ADJUST BLOCK NUMBER
		JRST	DSKDF1	]	;[254] AND CONTINUE
	TXZE	T2,GF$DF2	;[254] THIRD BLOCK?
	 JRST	[ADDI	T1,2		;[254] AJUST BLOCK NUMBER
		JRST	DSKDF1	]	;[254] CONTINUE
	TXZN	T2,GF$DF3	;[254] FOURTH BLOCK?
	 JRST	DSKDF1		;[254] NO, ASSUME FIRST BLOCK
	ADDI	T1,3		;[254] YES, ADJUST BLOCK NUMBER
DSKDF1:	MOVEM	T2,G$FLAG(MH)	;[254] PUT BACK FLAG WORD
	PUSHJ	P,DECOUT	;[254] PRINT IT
	OUTCHR	[")"]		;[254] PRINT CLOSING PARENTHESIS
	SAVE$	P1		;[254] SAVE C(P1)
	MOVEI	P1,EXLFIL	;[254] GET FILE SPECS
	PUSHJ	P,GUUO		;[254] AND PRINT THEM
	RSTR$	P1		;[254] RESTORE C(P1)
	POPJ	P,		;[254] 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:	MOVE	7,BBSN		;GET NUMBER OF DISK BLOCKS/TAPE BLOCK
	IMULI	7,-200		;CONVERT TO WORDS AND NEGATE
	HRLZS	7		;MOVE TO LEFT HALF
	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,S.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:	TXOE	F,FL$SV1	;[310] FIRST OUTPUT?
	JRST	DUMOU1		;[310] NO, GO DO REGULAR OUT
	MTBLK.	F.MTAP,		;[310] YES, WRITE BLANK TAPE FIRST
	MTWAT.	F.MTAP,		;[310] AND WAIT
	GETSTS	F.MTAP,P1	;[310] SEE IF WE HAVE ANY ERRORS
	TXC	P1,IO.ERR	;[612][402] REMOVE ALL BUT ERROR BITS
	TXCN	P1,IO.ERR	;[612][402] SEE IF A TAPE LABEL ERROR OCCURED
	JRST	LABERR		;[402] YES, GO AWAY NEVER TO RETURN...

;No error was detected by the tape labeling process.  Now
;make sure the tape is not write-locked, then continue.
;
WLOCK:	TRNN	P1,IO.IMP	;[402][310] TO CHECK IF TAPE WRITE-LOCKED
	JRST	DUMOU2		;[310] NO, GO DO REGULAR OUTPUT
	SETSTS	F.MTAP,.IOBIN	;[310] CLEAR STATUS
	OPER$	(TWL,tape write locked--add write ring then type "GO") ;[310]
	PUSHJ	P,TYI		;[310] WAIT FOR GO
DUMOU2:	SETSTS	F.MTAP,.IOBIN	;[310] CLEAR STATUS AFTER WRITING BLANK TAPE
DUMOU1:	SETZB	P3,S.MBPT##+.BFCTR ;[310] ZERO COUNT AND ERROR POSITION POINTER
	SKIPN	T1,G$TBS(MH)	;WRITING BIG BLOCKS?
	MOVSI	T1,MTBBKP	;NO, LOAD REGULAR SIZE
	HLRZS	T1		;MOVE TO RIGHT HALF
	HRRZ	T2,S.MBPT##	;GET BUFFER ADDRESS PLUS ONE
	HRRM	T1,1(T2)	;STORE IN USER WORD COUNT FIELD FOR UUOCON
	ADDM	T1,S.MBPT##+.BFPTR ;INCREMENT BYTE POINTER
	OUT	F.MTAP,		;EXECUTE OUTPUT UUO
	  JRST	MTASET		;SUCCESSFUL OUTPUT

	GETSTS	F.MTAP,P1	;[440] GET ERROR STATUS BITS
	WAIT	F.MTAP,		;[440] WAIT FOR I/O TO FINISH
	TRNN	P1,IO.EOT	;CHECK END OF TAPE BIT
	JRST	[			;[407]
		TXC	P1,IO.ERR	;[612][407] REMOVE ALL BUT ERROR BITS
		TXCN	P1,IO.ERR	;[612][407] TAPE LABEL ERROR?
		JRST	LABERR		;[407] YES, GO AWAY NEVER TO RETURN...
		JRST	NOTEOT]		;[407] 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

;HERE TO HANDLE REEL SWITCHING

	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
		 SETSTS F.MTAP,.IOBIN	;[221] CLEAR STATUS
		 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	S.NTPE##	;INCREMENT TAPE NUMBER
	MOVE 	T1,S.NTPE##	;[266][311] GET TAPE NO. FOR HEADER
	MOVEM	T1,G$RTNM(MH)	;[266][311] PUT IT IN HEADER
	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
	TXZ	F,FL$SV1	;[310] ZERO FIRST-WRITE FLAG
	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	CNAMSW		;[416] FILE SPLIT ACCROSS REELS?
	PUSHJ	P,TYEFIL	;YES, TYPE FILE SPEC AND BLOCK NBR
	MOVE	T1,TAPLBL##	;[426] GET THE LABEL TYPE
	CAXN	T1,.TFLNV	;[345] IS IT SPECIAL UNLABELED TAPE?
	JRST	NXTMDA		;[345] YES, ASK THE MDA
NXTT.1:	MTUNL.	F.MTAP,		;START UNLOADING THE TAPE
	OPER$	(EOT,Reached EOT--mount new tape then type "GO")
	PUSHJ	P,TYI		;WAIT FOR GO
	MTREW.	F.MTAP,		;MAKE SURE TAPE AT LOAD POINT
NXTT.2:	MOVE	T1,[3,,T2]	;SET UP UUO AC
	MOVEI	T2,.TFDEN+.TFSET ;FUNCTION CODE + SET
	MOVEI	T3,F.MTAP	;CHANNEL
	LDB	T4,[POINTR (UMTCHR,MT.DEN)];GET VALUE FROM PREVIOUS TAPE
	SKIPGE	S.OPER##	;WRITING?
	TAPOP.	T1,		;THEN SET DENSITY
	  JFCL			;SHOULD NOT FAIL
	SETSTS	F.MTAP,.IOBIN	;CLEAR ERRORS
	POPJ	P,		;RETURN

;Here to get the next volume via the correct fashion
NXTMDA:	OUTSTR	[ASCIZ/
[BKPAMD Asking MDA for next volume]
/]
	MOVE	T1,[XWD	2,T2]	;[345] AIM AT THE ARG BLOCK
	MOVEI	T2,.TFFEV	;[345] FORCE END-OF-VOLUME PROCESSING
	MOVEI	T3,F.MTAP	;[345] ON THIS OPEN CHANNEL
	TAPOP.	T1,		;[345] GET THE NEXT VOLUME
	  JRST	NXTMD1		;CAN'T--SEE WHY
	JRST	NXTT.2		;GO FINISH UP

NXTMD1:	OUTSTR	CRLF		;[405] SOME TYPE OF ERROR
	OUTSTR	[ASCIZ\?BKPCGT Can't get next tape\] ;[405] GENERAL ERROR
	OUTSTR	CRLF		;[405] MESSAGE
	GETSTS	F.MTAP,P1	;[405] SEE IF  LABERR CAN HANDLE IT
	TXC	P1,IO.ERR	;[612][405] REMOVE ALL BUT ERROR BITS
	TXCN	P1,IO.ERR	;[612][405] CAN WE GIVE IT TO LABERR?
	JRST	LABER2		;[405] YES, GO AWAY NEVER TO RETURN...
				;[405] ONLY ONE OTHER POSSIBILITY
	OUTSTR	[ASCIZ\?BKPINS Insufficient number of reels specified\] ;[405]
	OUTSTR	CRLF		;[405]
	MONRT.			;[345] CAN'T SO COMPLAIN
	JRST	NXTT.1		;[345] ADVENTUROUS USER.. TRY THE OLD WAY

;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		;S

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,<
	CAMGE	T1,S.EMAX##	;[506] 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.SOE
	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
	MOVSI	T1,(BF.VBR)	;[420] SET VIRGIN BUFFER BIT
	IORM	T1,S.MBPT##	;[420] PUT IT INTO BUFFER CONTROL BLOCK
	OUTPUT	F.MTAP,		;[420] INFORM THE MONITOR

;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,2(P2)	;POINT TO START OF DATA
	SKIPN	T2,G$TBS(T1)	;WRITING BIG BLOCKS?
	MOVSI	T2,MTBBKP	;NO, LOAD REGULAR SIZE
	HLRZS	T2		;MOVE TO RIGHT HALF
	HRRZ	T3,S.MBPT##	;GET BUFFER ADDRESS PLUS ONE
	HRRM	T2,1(T3)	;STORE IN USER WORD COUNT FIELD FOR UUOCON
	ADDI	T1,-1(T2)	;ADD IN SIZE OF 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:	GETSTS	F.MTAP,P1	;[440][407] GET DEVICE STATUS
	WAIT	F.MTAP,		;[440] WAIT FOR I/O
	TXC	P1,IO.ERR	;[612][407] REMOVE ALL BUT ERROR BITS
	TXCN	P1,IO.ERR	;[612][407] SEE IF A TAPE LABEL ERROR OCCURED
	JRST	LABERR		;[407] YES, GO AWAY NEVER TO RETURN...
	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.

	ADDI	T2,2		;POINT TO START OF DATA
	SETZM	S.MBPT##+.BFCTR	;ZERO COUNT
	SKIPN	T1,G$TBS(T2)	;WRITING BIG BLOCKS?
	MOVSI	T1,MTBBKP	;NO, LOAD REGULAR SIZE
	HLRZS	T1		;MOVE TO RIGHT HALF
	HRRZ	T3,S.MBPT##	;GET BUFFER ADDRESS PLUS ONE
	HRRM	T1,1(T3)	;STORE IN USER WORD COUNT FIELD FOR UUOCON
	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	F.MTAP,.IOBIN	;[220] 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

	GETSTS	F.MTAP,T1	;[440] GET STATUS
	WAIT	F.MTAP,		;[440] WAIT FOR ANY I/O IN PROGRESS
	TRNE	T1,IO.DER!IO.DTE!IO.BKT ;IF DATA ERRORS,
	JRST	NOTEOT		;GO WRITE A REPEATER RECORD
	TRNN	T1,IO.EOT	;[525] EOT?
	JRST	MTAST1		;[525] NO.
	PUSHJ	P,FNDBUF	;[525] FIND THE BUFFER MARKED WITH EOT
	SKIPA			;[525] PUZZLING. CAN'T FIND EOT
	ANDCAM	P1,-1(P2)	;[525] CLEAR THE EOT BIT IN BUFFER STATUS WORD
	SETSTS	F.MTAP,.IOBIN	; MUST CLEAR EOT BEFORE DOING OUTPUT

MTAST1:	MOVSI	T1,(1B0)	;[525] 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	;[335] CLEAR NBF MESSAGE THIS BLOCK
IFN FT$FRS,<			;[335]
	TXZ	F,FL$FRS	;[335] CLEAR FRS CONVERSION
>; END IFN FT$FRS		;[335]

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

IFN FT$EMX,<
	SKIPLE	T1,ERRCNT	;GET CURRENT ERROR COUNT
	CAMGE	T1,S.EMAX##	;[506] 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
	MOVE	T1,S.MBPT##	;GET BUFFER ADDRESS PLUS ONE
	HLLZS	1(T1)		;CLEAR WORD COUNT FIELD
	MOVE	T1,S.BFSZ##	;GET SIZE OF TAPE BUFFER
	ADDM	T1,S.MBPT##+.BFPTR;INCREMENT BYTE POINTER

	IN	F.MTAP,		;[402] EXECUTE IN UUO
	  JRST	BUFSTS		;[402] ALL IS OK
	GETSTS	F.MTAP,P1	;[402] GET FILE STATUS WORD
	WAIT	F.MTAP,		;[612] WAIT UNTIL MOVEMENT HAS SETTLED DOWN
	TXC	P1,IO.ERR	;[612][402] REMOVE ALL BUT ERROR BITS
	TXCN	P1,IO.ERR	;[612][402] SEE IF A TAPE LABEL ERROR
	JRST	LABERR		;[402] YES, GO AWAY NEVER TO RETURN...

BUFSTS:	MOVE	T1,S.MBPT##	;[257] CURRENT BUFFER ADDRESS
	HRLZI	T1,2(T1)	;[257] PLUS TWO
	HRR	T1,TAPHLD+1	;GET ADDRESS OF TAPE BUFFER
	HRRZ	P1,T1		;GET A COPY
	ADD	P1,S.BFSZ##	;SIZE OF BUFFER
	BLT	T1,(P1)		;MOVE THE BUFFER
	HRRZ	P2,S.MBPT##	;[257] GET BUFFER ADDRESS
	MOVE	P1,-1(P2)	;GET STATUS FROM BUFFER HEADER
	MOVEM	P1,TAPHLD	;[257] SAVE STATUS BITS

	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:	HRRZ	MH,TAPHLD+1	;SET BUFFER POINTER
	MOVEI	T1,M(MH)	;POINT TO DATA AREA
	MOVEM	T1,MDATA	;STORE FOR LATER USERS
	MOVE	T1,G$RTNM(MH)	;[311]
	MOVEM	T1,S.NTPE##	;[311]
	SKIPN	T1,G$TBS(MH)	;BLOCKING FACTOR SET?
	MOVEI	T1,N		;NO, USE DEFAULT
	ANDI	T1,GC$N		;MASK TO JUST NUMBER OF BLOCKS
	MOVEM	T1,BBSN		;STORE FOR THOSE INTERESTED

	MOVE	T1,G$TYPE(MH)	;GET RECORD TYPE
	CAIE	T1,T$EOV	;SEE IF END-OF-VOLUME
	JRST	NOTEOV		;NO, CONTINUE
	TXNN	F,FL$PRN	;[322] FL$PRN SET ALREADY?
	TXO	F,FL$EPR	;[322] NO - FLAG FL$PRN-BY-EOV
	TXO	F,FL$PRN	;[227] FLAG RENAME
	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

	SKIPN	T1,G$TBS(MH)	;$[3] SEE IF A BIG BLOCK
	MOVEI	T1,N		;$[3] NO, USE DEFAULT
	ANDX	T1,GC$N		;$[3] MASK TO JUST NUMBER OF BLOCKS
	IMULI	T1,200		;CONVERT TO WORDS
	ADDI	T1,M		;ADD IN THE HEADER
	MOVE	T2,0(MH)	;GET FIRST WORD OF TAPE BLOCK
IFE FT$FRS,<			;[335]
	TDNN	T2,[-1,,777760]	;[335] SEE IF BACKUP
	TRNN	T2,000017	;[335]
	SKIPA			;[335]
>; END IFE FT$FRS		;[335]
IFN FT$FRS,<			;[335]
	TLNN	T2,777770	;SEE IF FRS OR BACKUP
>; END IFN FT$FRS		;[335]
	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
IFN FT$FRS,<			;[335]
	TLNE	T2,-1		;IF FRS,
	PUSHJ	P,CNVFRS	; GO CONVERT TO BACKUP HEADER
>; END IFN FT$FRS		;[335]
	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,MASCHK	;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:				;[257]
USERC1:	TRNE	P1,IO.DER!IO.DTE!IO.BKT;[257] 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:	MOVE	7,BBSN		;GET NUMBER OF DISK BLOCKS/TAPE BLOCK
	IMULI	7,-200		;CONVERT TO WORDS AND NEGATE
	HRLZS	7		;MOVE TO LEFT HALF
	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
;
;
IFN FT$FRS,<			;[335]


;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

	FRDUM1==0B18+FRSDAT		;[330]
	FRDUM2==1B18+FRSDSD		;[330]
	FRDUM3==0B18+FRSSDT		;[330]
FRSDTM:	BYTE (18)FRDUM1 (18)L$DATE	;[330]LABEL CREATION
	BYTE (18)FRDUM2 (18)L$DSTR	;[330]DESTROY DATE
	BYTE (18)FRDUM3 (18)S$DATE	;[330]SAVE SET DATE
FRSDTL==.-FRSDTM
>; END IFN FT$FRS		;[335]
;+
;<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

;CALLED HERE IF CHECKSUM INCONSISTENCY BY ROUTINE CMPCKS
MASCHK:	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

MASTR1:	MOVE	T3,[POINT 7,F$PTH(MH)];[302] POINTER TO FILE INFO
				;[302] HERE TO REPORT ERROR
				;[302] AND NOT PUT ERROR FLAG IN RIB
				;[302] FOR UNEXPECTED REPEATER RECORDS
	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
	TXO	F,FL$FN		;[231] SET FILENAME TYPE OUT FLAG
	PUSHJ	P,TYPID		;TYPE FILE NAME
	TXZ	F,FL$FN		;[231] RESET FILENAME TYPE OUT FLAG
	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	CNAMSW		;[416] 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
	SKIPN	T2,G$TBS(MH)	;SEE IF A BIG BLOCK
	MOVSI	T2,MTBBKP	;NO, USE REGULAR SIZE
	ANDX	T2,GC$BSZ	;KEEP JUST THE BLOCK SIZE
	MOVNS	T2		;NEGATE
	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 WITH THE PROPER <RDW 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)
	TXOE	F,FL$INP	;[402][321] FLAG INPUT DONE
	  JRST	TSTRPT		;[402]
	IN	F.MTAP,		;[402] AND INPUT IF NEEDED
	  JRST	TSTRPT		;[402] ALL IS OK
	GETSTS	F.MTAP,P1	;[402] GET FILE STATUS WORD
	TXC	P1,IO.ERR	;[612][402] REMOVE ALL BUT ERROR BITS
	TXCN	P1,IO.ERR	;[612][402] SEE IF A TAPE LABEL ERROR
	JRST	LABERR		;[402] YES, GO AWAY NEVER TO RETURN...

;HERE TO SEE IF NEXT TAPE RECORD IS A REPEATER RECORD
;ALSO REJECT RECORD IF BAD BUFFER SIZE OR NOT BACKUP FORMAT
;OR NOT THE EXPECTED RELATIVE DATA WORD.

TSTRPT:	MOVE	P1,S.MBPT	;[257] BUFFER ADDRESS
	ADDI	P1,2		;[257] POINT TO DATA
	MOVE	T2,(P1)		;FIRST DATA WORD
IFN FT$FRS,<			;[335]
	TLNE	T2,777770	;SEE IF JUNK
>; END IFN FT$FRS		;[335]
IFE FT$FRS,<			;[335]
	TDNN	T2,[-1,,777760]	;[335] SEE IF BACKUP
	TRNN	T2,000017	;[335]
>; END IFE FT$FRS		;[335]
	POPJ	P,		;NO GOOD--GIVE BAD RETURN

	SKIPN	T1,G$TBS(P1)	;BLOCKING FACTOR SET?
	MOVSI	T1,MTBBKP	;NO, LOAD REGULAR SIZE
	HLRZS	T1		;MOVE TO RIGHT HALF
IFN FT$FRS,<			;[335]
	TLNE	T2,-1		;SEE IF FRS
	MOVEI	T1,MTBFRS	;LOAD FRS BUFFER SIZE
>; END IFN FT$FRS		;[335]
	HRRZ	T2,-1(P1)	;[353] LEFT HALF IS BOOKKEEPING STUFF
	CAME	T1,T2		;[353] CHECK BUFFER COUNT
	POPJ	P,		;NO GOOD--GIVE BAD RETURN

	MOVX	T1,GF$RPT	;REPEATER FLAG
	TDNN	T1,G$FLAG(P1)	;[321] SEE IF ON
	POPJ	P,		;RETURN
	MOVE	T1,F$RDW(P1)	;[321] GET REPEATER'S RDW
	CAMN	T1,F$RDW(MH)	;[321] MATCHES THE OTHER BUFFER?
	AOS	(P)		;[321] YES - ADVANCE RETURN
	POPJ	P,		;[321] 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
	SUBTTL	TAPE PSI INTERRUPT HANDLING

;+
;.CHAPTER TAPE PSI INTERRUPT HANDLING
;-


;+
;<MTASER IS THE ROUTINE THAT TAKES REEL SWITCH INTERRUPTS.
;-

MTASER:	PUSH	P,T1		;SAVE T1
	PUSH	P,T2		;SAVE T2
	PUSH	P,T3		;SAVE T3
	PUSHJ	P,MTARID	;READ REELID
	PUSHJ	P,MTADEV	;READ PHYSICAL DEVICE NAME
	MOVE	T1,TAPLBL##	;GET LABEL TYPE
	CAIE	T1,.TFLBP	;BYPASS?
	CAIN	T1,.TFLNV	;USER-EOT?
	JRST	MTASE1		;YES TO EITHER--DO THINGS THE OLD WAY
	AOS	S.NTPE##	;INCREMENT TAPE NUMBER
	PUSH	P,CH		;SAVE CH
	PUSHJ	P,LSTRSW	;DO LISTING STUFF
	POP	P,CH		;RESTORE CH
MTASE1:	POP	P,T3		;RESTORE T3
	POP	P,T2		;RESTORE T2
	POP	P,T1		;RESTORE T1
	DEBRK.			;RETURN
	  JFCL			;???
	  POPJ	P,		;HOPE WE GOT HERE VIA PUSHJ


;+
;<MTARID IS THE ROUTINE THAT READS REELIDS
;-

MTARID:	MOVE	T1,[2,,T2]	;SET UP UUO AC
	MOVEI	T2,.TFRID	;FUNCTION CODE TO READ REELID
	MOVEI	T3,F.MTAP	;CHANNEL NUMBER
	TAPOP.	T1,		;READ REELID
	  SKIPA			;???
	MOVEM	T1,REELID	;SAVE
	POPJ	P,		;RETURN

;+
;<MTADEV IS THE ROUTINE THAT READS THE PHYSICAL MAGTAPE DEVICE NAME
;-

MTADEV:	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
	POPJ	P,

	SUBTTL	DISK INPUT/OUTPUT ROUTINES

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

;+
;<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:	MOVSI	T1,(<OUT FILE,0>)	;[254] OUTPUT UUO
	SETZ	T2,		;[254] ZERO C(T2)
	EXCH	T2,DSKHDR+.BFCTR;ZERO BYTE COUNT
ALTDSK:	ADDM	T2,DSKHDR+.BFPTR;INCREMENT BYTE POINTER
	XCT	T1		;[254] DO OUT UUO
	  JRST	DSKSET		;OK
	GETSTS	FILE,T1		;[440] GET ERROR STS
	WAIT	FILE,		;[440] WAIT FOR I/O TO CEASE
	TRNE	T1,IO.DER!IO.BKT!IO.DTE	;[276] DATA ERRORS?
	JRST	DSKOU1			;[276] YES
	TRNE	T1,IO.EOF	;SKIP IF NOT EOF
	JRST	CPOPJ1		;RETURN
DSKOU1:	WARN$N	(DOE,Disk output error)	;[254] [276]
	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:	PUSHJ	P,DSKBLK	;CALCULATE # OF BLOCKS IN THIS BUFFER (NDBLIB)
	HRRZ	DBUF,DSKHDR+.BFPTR;FIRST DATA WORD MINUS ONE
	AOJA	DBUF,CPOPJ2	;RETURN

DSKIN:	SETZ	T2,		;[254] ZERO C(T2)
	EXCH	T2,DSKHDR+.BFCTR	;[254] ZERO BYTE COUNT
	ADDM	T2,DSKHDR+.BFPTR	;[254] INCREMENT BYTE POINTER
	IN	FILE,0		;[254] DO IN UUO
	 JRST	DSKSE1		;[254] OK
	GETSTS	FILE,T1		;[440][254] GET ERROR STATUS
	WAIT	FILE,		;[440][254] WAIT FOR I/O TO CEASE
	TRNE	T1,IO.EOF	;[254] SKIP IF NOT EOF
	 JRST	CPOPJ1		;[254] RETURN
	MOVE	T2,DSKHDR+.BFADR	;[254] GET CURRENT BUFFER
	MOVE	T3,-1(T2)	;[254] GET ITS STATUS BITS
	ANDI	T3,IO.ERR	;[254] ANY ERRORS HERE?
	 JUMPN	T3,DSKSE2	;[254] YES
	TRO	T1,IO.SYN	;[254] NO, SET IO.SYN--ERROR FURTHER ON
	SETSTS	FILE,(T1)	;[254] SET IN STATUS BITS
	JRST	DSKSE1		;[254] CONTINUE AS IF OK
DSKSE2:	SAVE$	T1		;[254] SAVE STATUS FOR ERROR MSG
	TRZ	T1,(T3)		;[254] IN STS, TURN OFF ERROR FOR THIS BUF
	TRNN	T1,IO.ERR	;[254] ANY ERRORS LEFT?
	 TRZA	T1,IO.SYN	;[254] ALL CLEAR--CLEAR IO.SYN
	 TRO	T1,IO.SYN	;[254] NOT ALL CLEAR, SET IO.SYN
	SETSTS	FILE,(T1)	;[254] SETSTS TO CLEAR

;[254] SPECIAL CASE FOR IO.IMP:
;[254] ALL OTHER ERRORS ARE IN ONLY ONE BUFFER, BECAUSE DEVICE STOPS
;[254] AFTER ERROR, BUT IO.IMP PROPOGATES INTO ALL OTHER BUFFERS
;[254] READ BY THE MONITOR AT THIS READ. (THESE HAVE THE USE BITS ON.)
;[254] IO.IMP IS THE ERROR FOR CHECKSUM ERRORS.

	TRNN	T3,IO.IMP	;[254] WAS IT IO.IMP?
	 JRST	DSKSE3		;[254] NO - CONTINUE
DSKSE4:	SKIPL	T2,(T2)		;[254] TO NEXT BUFFER
	 JRST	DSKSE3		;[254] NOT IN USE--CONTINUE
	MOVE	T1,-1(T2)	;[254] GET STATUS WORD
	TRZN	T1,IO.IMP	;[254] IO.IMP ON?
	 JRST	DSKSE3		;[254] NO--DONE
	MOVEM	T1,-1(T2)	;[254] YES, TURN IT OFF
	JRST	DSKSE4		;[254] LOOP THROUGH BUFFER RING

DSKSE3:	WARN$N	(DIE,Disk input error)	;[254]
	RSTR$	T1		;[254] GET ORIGINAL STATUS WORD BACK
	PUSHJ	P,OCTOUT	;[254] PRINT IT
	OUTSTR	[ASCIZ / (block=/]	;[254]
	MOVE	T1,THSRDB	;[254] GET BLOCK NUMBER
	ADDI	T1,2		;[254] PLUS TWO TO CURRENT BLOCK
	PUSHJ	P,DECOUT	;[254] PRINT IT
	OUTCHR	[")"]		;[254] CLOSE PARENTHESIS
	OUTSTR	[ASCIZ / during/]	;[254]
	SAVE$	P1		;[254] SAVE C(P1)
	MOVEI	P1,EXLFIL	;[254] GET FILE SPEC
	PUSHJ	P,GUUO		;[254] PRINT IT
	RSTR$	P1		;[254] RESTORE C(P1)
	HRRZ	DBUF,DSKHDR+.BFPTR	;[254]
	PUSHJ	P,DSKBLK	;[613] CALCULATE NUMBER OF BLOCKS IN THIS BUFFER
	AOS	DBUF		;[254]
	POPJ	P,		;[254] RETURN

DSKSE1:	PUSHJ	P,DSKBLK	;CALCULATE # OF BLOCKS IN THIS BUFFER (NDBLIB)
	HRRZ	DBUF,DSKHDR+.BFPTR	;[254]
	AOJA	DBUF,CPOPJ2	;[254] RETURN

;+
;<DSKBLK CALCULATES NUMBER OF BLOCK IN THIS BUFFER AND STORES IN NDBLIB.
;^USES T1
;-
DSKBLK:	MOVE	T1,DSKHDR+.BFCTR;GET WORD COUNT
	IDIVI	T1,200		;CALCULATE BLOCKS
	SKIPE	T2		;OVERFLOW?
	AOS	T1		;YES. ACCOUNT FOR PARTIAL BLOCK
	MOVEM	T1,NDBLIB	;STORE NUMBER OF BLOCK/THIS BUFFER
	POPJ	P,
;+
;<SETSTR SETS UP THE STRUCTURE MASK IN <CSTRFL.
;-

SETSTR:	SAVE$	T1		;[262] SAVE SCRATCH REGISTERS
	SAVE$	T2		;[262]
	SAVE$	T3		;[262]
	MOVE	T1,.FXDEV(SP)	;[262] OUTPUT DEVICE NAME
	CAMN	T1,[SIXBIT/ALL/];[503] SPECIAL CHECK FOR "ALL"
	JRST	SETST2		;[503] NO TRANSLATION NEEDED
	MOVEM	T1,DCHARG	;[503] STORE IT
	MOVE	T1,[5,,DCHARG]	;[503] SETUP FOR DSKCHR UUO
	DSKCHR	T1,		;[503] GET DISK CHARACTERISTICS
	 SKIPA	T1,[SIXBIT/ALL/];[503] NONE--PRETEND IT WAS "ALL"
	MOVE	T1,DCHARG+.DCSNM;[503] GET PHYSICAL STRUCTURE NAME
SETST2:	SETOM	CSTRFL		;[503][262] SET FLAG FOR "ALL"
	CAMN	T1,[SIXBIT/ALL/]	;[262] SKIP IF NOT "ALL"
	 JRST	SETST1		;[262] "ALL" -- DONE
	MOVSI	T2,777700	;[262] SET FLAG FOR "DSK"
	MOVEM	T2,CSTRFL	;[262] SAVE IT
	CAMN	T1,[SIXBIT/DSK/]	;[262] SKIP IF NOT "DSK"
	 JRST	SETST1		;[262] "DSK" -- DONE
	MOVE	T2,S.NGST	;[262] LOAD AOBJN WORD TO STR TABLE
	CAME	T1,S.STRS##(T2)	;[262] FIND MATCH IN TABLE
	AOBJN	T2,.-1		;[262] LOOP
	MOVSI	T3,(1B0)	;[262] SET BIT ZERO
	MOVNI	T1,(T2)		;[262] SET SHIFT ARGUMENT
	SKIPL	T2		;[262] IF NO MATCH,
	 TDZA	T3,T3		;[262] CLEAR T3
	 LSH	T3,(T1)		;[262] SHIFT TO CORRECT BIT
	MOVEM	T3,CSTRFL	;[262] SAVE STR FLAG
SETST1:	RSTR$	T3		;[262] RESTORE REGISTERS
	RSTR$	T2		;[262]
	RSTR$	T1		;[262]
	POPJ	P,		;[262] RETURN

;+
;<.USETI AND <.USETO DO <USETI AND <USETO BY MEANS OF THE <FILOP.
;MONITOR CALL.  ^THIS ALLOWS DISK FILES GREATER THAN 262144(10)
;BLOCKS TO BE PROCESSED PROPERLY.
;-

;  CALLING SEQUENCE:
;
;	MOVE	T1,[BLOCK #]
;	PUSHJ	P,.USETI	OR	PUSHJ	P,.USETO
;	RETURN HERE

.USETI:	PUSHJ	P,SAVE3		;[357] SAVE SOME ACS
	MOVEI	P1,.FOUSI	;[357] GET USETI FUNCTION CODE
	JRST	USTCOM		;[357] AND FALL INTO COMMON CODE

.USETO:	PUSHJ	P,SAVE3		;[357] SAVE ACS
	MOVEI	P1,.FOUSO	;[357] GET USETO FUNCTION CODE

USTCOM:	HRLI	P1,FILE		;[357] GET DISK I/O CHANNEL
	MOVE	P2,T1		;[357] GET BLOCK NUMBER SUPPLIED
	MOVE	P3,[XWD 2,P1]	;[357] SET UP ARGUMENT POINTER
	FILOP.	P3,		;[357] DO IT
	  HALT	.		;[357] ***TEMP***
	POPJ	P,		;[357] RETURN TO CALLER

	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
;+
;<LSTRSW IS A SUBROUTINE TO LIST DATA AFTER REEL SWITCHES ON LABELED TAPES.
;-

LSTRSW:	SKIPN	S.LIST##	;WANT LISTINGS?
	POPJ	P,		;NO
	MOVEI	CH,14		;GET A FORM-FEED
	MOVEI	T1,F.LIST	;LISTING CHANNEL
	DEVCHR	T1,		;GET CHARACTERISTICS
	TXNN	T1,DV.TTY	;IS DEV A TTY?
	PUSHJ	P,LSTOUT	;NO - START A NEW PAGE
	MOVEI	T1,[ASCIZ /

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

Continuation on drive /]
	PUSHJ	P,LSTMSG	;SEND TO FILE
	MOVEI	T1,F.MTAP	;GET CHANNEL
	DEVNAM	T1,		;AND NAME
	  MOVSI	T1,'???'
	PUSHJ	P,LST6		;TYPE
	MOVEI	T1,[ASCIZ /, reelid /]
	PUSHJ	P,LSTMSG	;SEND TO FILE
	MOVE	T1,REELID	;GET NEW REELID
	PUSHJ	P,LST6		;TYPE IT
	MOVEI	T1,[ASCIZ /, tape number /]
	PUSHJ	P,LSTMSG	;TYPE TEXT
	MOVE	T1,S.NTPE##	;GET NEW TAPE NUMBER
	PUSHJ	P,LSTDEC	;TYPE IT
	MOVEI	T1,[ASCIZ /

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

/]
	PUSHJ	P,LSTMSG	;SEND TO FILE
	POPJ	P,		;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	T1,[ASCIZ /, reel /]
	PUSHJ	P,LSTMSG	;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 /Blocking factor /] ;$[1]
	PUSHJ	P,LSTMSG	;PRINT TEXT
	SKIPN	T1,S$BLKF(MH)	;GET BLOCKING FACTOR
	MOVEI	T1,1		;OLD TAPE
	PUSHJ	P,LSTDEC	;PRINT IT
	MOVEI	T1,[ASCIZ / Tape number  /]
	PUSHJ	P,LSTMSG	;SEND
	MOVE	T1,S.NTPE##	;[311]
	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
	SKIPE	T1		;[277] DON'T OUTPUT ZERO
	PUSHJ	P,LSTOCT	;SEND TO FILE
	LDB	T1,[POINTR (P1,VR.MIN)] ;GET MINOR VERSION
	JUMPE	T1,NMINOR	;BRANCH IF NO MINOR
	SOS	T1		;[505] PRINT IN MODIFIED
	IDIVI	T1,^D26		;[505] RADIX 26 ALPHA
	JUMPE	T1,LSTVE1	;[505] JUMP IF ONE CHARACTER
	MOVEI	CH,"A"-1(T1)	;GET UPDATE LETTER
	PUSHJ	P,LSTOUT	;SEND TO FILE
LSTVE1:	MOVEI	CH,"A"(T2)	;[505] ISSUE "UNITS"
	PUSHJ	P,LSTOUT	;[505] CHARACTER
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 /]

DNSTLS:	EXP	[ASCIZ /UNKN/]
	EXP	[ASCIZ / 200/]
	EXP	[ASCIZ / 556/]
	EXP	[ASCIZ / 800/]
	EXP	[ASCIZ /1600/]
	EXP	[ASCIZ /6250/]
	EXP	[ASCIZ / (6)/]
	EXP	[ASCIZ / (7)/]

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

	HRLZI	T2,-.FXLND	;[366] 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
	AOBJN	T2,CMPPTH	;[366] COMPARE NEXT
	JRST	LSTFID		;[366] WE'RE DONE

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
	MOVE	CH,SPACE	;[252] PRINT A SPACE
	PUSHJ	P,LSTOUT	;[252]
	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

	MOVEI	T2,^D36		;[513] WIDTH OF WORD IN BITS
	IDIV	T2,A$BSIZ(P1)	;[513] GET BYTES PER WORD
	SKIPGE	T1,A$LENG(P1)	;[513] LENGTH OF FILE IN BYTES
	MOVEI	T2,1		;[513] IF OVERFLOW, KILL DIVISOR
	IDIV	T1,T2		;[513] FILE LENGTH IN WORDS
	SKIPE	T2		;[513] EXTRA BYTES?
	AOS	T1		;[513] YES. ONE MORE WORD
	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
	PUSHJ	P,LSTTAB	;[512] ADJUST LISTING
	PUSH	P,P1		;[512] SAVE P1
	SKIPE	P1,A$VERS(P1)	;[512] IS THERE A VERSION NUMBER?
	PUSHJ	P,LSTVER	;[512] YES. GO LIST IT
	POP	P,P1		;[512] RESTORE P1
	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
	MOVE	P2,[XWD -.FXLND+1,LSTPTH+1] ;[366] GET ADDRESS OF SFD NAMES
				;[366] AND LENGTH
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
	AOBJN	P2,SFDLST	;[366] CONTINUE UNLESS HIT MAX
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]
	 JRST	[SETZ	T1,		;[264] CLEAR T1 FOR SPCSAT CODE
		POPJ	P,	]	;[264] AND RETURN--DIFFERENT
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
	 JRST	[SETZ	T1,		;[264] CLEAR T1 FOR SPCSAT CODE
		POPJ	P,	]	;[264] AND RETURN--STR BAD

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		; ..
;+
;<APHSRT PERFORMS AN ALPHABETIC "SHELL" SORT. ^CALL WITH <P1
;CONTAINING AN IOWD TO THE <MFD OR DIRECTORY.
;-

APHSRT:	PUSHJ	P,SAVE4		;SAVE P1-P4
	PUSH	P,SP		;SAVE SP
	HLRE	P3,P1		;GET MAGNITUDE
	MOVMS	P3		;...
	MOVEI	P1,1(P1)	;POINT AT START OF DIRECTORY
	IDIVI	P3,2		;CALCULATE NUMBER OF ENTRIES
	MOVEI	SP,(P3)		;SET FRAME
APHSR1:	LSH	SP,-1		;CUT BY TWO
	JUMPE	SP,APHSR6	;JUMP IF ZERO FRAME
	MOVEI	P4,(SP)		;WORK OUT FRAME-ENTRIES
	IMULI	P4,2		;...
	MOVEI	P2,(SP)		;MAKE AN AOBJN WORD
	SUBI	P2,(P3)		;...
	HRLZS	P2		;...
	HRRI	P2,(P1)		;...
APHSR2:	MOVEI	T3,(P2)		;SET UPPER POINTER
APHSR3:	MOVEI	T4,(T3)		;SET LOWER POINTER
	ADDI	T4,(P4)		;...

	HLRZ	T1,0(T3)	;GET LH OF UPPER NAME
	HLRZ	T2,0(T4)	;GET LH OF LOWER NAME
	CAIE	T1,(T2)		;SAME?
	JRST	APHSR4		;NO
	HRRZ	T1,0(T3)	;GET RH OF UPPER NAME
	HRRZ	T2,0(T4)	;GET RH OF LOWER NAME
	CAIE	T1,(T2)		;STILL SAME?
	JRST	APHSR4		;NO
	HLRZ	T1,1(T3)	;YES, GET UPPER EXTENSION
	HLRZ	T2,1(T4)	;GET LOWER EXTENSION

APHSR4:	CAIG	T1,(T2)		;RIGHT ORDER?
	JRST	APHSR5		;YES, OK
	MOVE	T1,0(T3)	;NO, EXCHANGE
	EXCH	T1,0(T4)	;...
	MOVEM	T1,0(T3)	;...
	MOVE	T1,1(T3)	;...
	EXCH	T1,1(T4)	;...
	MOVEM	T1,1(T3)	;...
	SUBI	T3,(P4)		;CAN WE SPIDER BACK?
	CAIL	T3,(P1)		;...
	JRST	APHSR3		;YES
APHSR5:	ADDI	P2,1		;ADVANCE POINTER
	AOBJN	P2,APHSR2	;LOOP
	JRST	APHSR1		;NEXT CUT

APHSR6:	POP	P,SP		;RESTORE AC
	POPJ	P,		;RETURN
	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:	SKIPN	T1,CNAM		;[251] GET FILE NAME
	 POPJ	P,		;[251] NONE, RETURN
	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
TYEFL2::PUSHJ	P,TYSPEC	;[334] TYPE FULL PATH SPEC
	MOVE	T1,THSRDB	;[334] GET DATA BLOCK
	JUMPLE	T1,TYEFL3	;[334] DON'T SHOW INDETERMINATE BLOCKS
	OUTSTR	[ASCIZ\ (BLOCK=\];MESSAGE
	PUSHJ	P,DECOUT	;TYPE
	OUTSTR	[ASCIZ\)\]	;[334]
TYEFL3:	OUTSTR	[ASCIZ\
\]				;[334]
	POPJ	P,		;RETURN
;+
;<TYPFIL TYPES THE FILE NAME AND EXTENSION OF THE CURRENT FILE
;BEING PROCESSED.
;-

TYPFIL:	SKIPN	T1,CNAM		;[251] FILE NAME
	 POPJ	P,		;[251] NONE, SO RETURN
	OUTCHR	SPACE		;[252] PRINT A SPACE FIRST
	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
	TXNE	F,FL$FN		;[231] TYPING OUT FILENAME?
	JRST	TYPID2		;[231] YES,DON'T CONVERT BACK ARROWS
	CAIN	T1,"_"		;SEE IF UNDERLINE,
	MOVEI	T1,","		;CONVERT TO COMMA
TYPID2:	OUTCHR	T1		;[231] 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


;LABERR is called if an error is detected by the tape label handler
;on an attempt by BACKUP to perform a tape input or output operation.
;The user has probably mounted the wrong tape.  Output a general error
;message, then output a specific error message using the error code
;returned by the DEVOP. monitor call.  Abort the job.
;
LABERR:	OUTSTR	CRLF		;[402] OUTPUT GENERAL ERROR MESSAGE (FATAL)
	OUTSTR	[ASCIZ /?BKPTLE Error detected by tape label handler/] ;[402]
	OUTSTR	CRLF		;[405][402]
LABER2:	MOVE	P1,[XWD 2,[EXP .DFRES,F.MTAP]] ;[402] SET UP ARG BLOCK
	DEVOP.	P1,		;[402] AND GET THE ERROR CODE
	JRST	[			;[402] DEVOP SHOULDN'T FAIL
		OUTSTR	@DEVTAB		;[402] PRINT OUT ERROR MESSAGE
		MOVE	T1,P1		;[402] GET DEVOP ERROR
		PUSHJ	P,OCTOUT	;[402] PRINT IT
		JRST	SAVABT]		;[402] AND FINISH OFF

	OUTSTR	[ASCIZ/?BKPOPA /] ;[402] PRINT SPECIFIC ERROR
	OUTSTR	@DEVTAB(P1)	;[402] USE ERROR CODE FOR INDEX
SAVABT:	OUTSTR	[ASCIZ/, operation aborted/] ;[402] AND ABORT MESSAGE
	OUTSTR	CRLF		;[402]
	OUTSTR	CRLF		;[402]
	MONRT.			;[402] DONE FOR
	JRST	.-1		;[402] NO CONTINUES ALLOWED
	
;The following table contains all possible errors returned by
;the DEVOP. monitor call (.DFRES function) as of version 7.01.
;Not all of these errors are applicable to tape devices, but the
;table has been reproduced in full for completeness sake.  The
;DEVOP. is performed and the resultant error code is used as an
;index into this table.  If the the DEVOP. fails, the first error
;in the table is issued along with the octal error code.
;
DEVTAB:	EXP	[ASCIZ/?BKPDVF DEVOP. failed with error code /] ;[402]
	EXP	[ASCIZ/No operation performed by PULSAR/] ;[410] (MTA) nonfatal
	EXP	[ASCIZ/End of file reached/]		;[410] (MTA) nonfatal
	EXP	[ASCIZ/Label type error/]		;[402] (MTA)
	EXP	[ASCIZ/Header label error/]		;[402] (MTA)
	EXP	[ASCIZ/Trailer label error/]		;[402] (MTA)
	EXP	[ASCIZ/Volume label error/]		;[402] (MTA)
	EXP	[ASCIZ/Hard device error/]		;[402]
	EXP	[ASCIZ/Parity error/]			;[402]
	EXP	[ASCIZ/Write-lock error/]		;[402]
	EXP	[ASCIZ/Illegal position operation/]	;[402] (MTA)
	EXP	[ASCIZ/Beginning of tape/]		;[402] (MTA) nonfatal
	EXP	[ASCIZ/Illegal operation/]		;[402] (MTA)
	EXP	[ASCIZ/File not found/]			;[402] (MTA)
	EXP	[ASCIZ/Volume switch canceled by OPR/]	;[405] (MTA)
	EXP	[ASCIZ/Too many volumes in volume set/]	;[405] (MTA)
	EXP	[ASCIZ/Network node down/]		;[402]
	EXP	[ASCIZ/Undefined character interrupt/]	;[402] (LP20)
	EXP	[ASCIZ/RAM parity error/]		;[402] (LP20)


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

ERFIL:	PUSHJ	P,SAVE1		;[260] SAVE P1
	MOVEI	P1,EXLFIL	;[260] GET FILE SPECS
	WARN$N	(FRE,File RENAME error)	;[260] GIVE MESSAGE
	JRST	EGUUO		;[260] PRINT OTHER INFO

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
	CAIN	P1,S.LENT##		;[307] LIST-FILE ERROR?
	MOVE	T1,S.LIST+.FXDEV	;[307] YES, USE LIST DEVICE
	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
	OUTCHR	LBR		;[244]
	HLRZ	T1,.RBPPN(P1)	;[244]
	JUMPE	T1,JOIN3	;[244]
	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]