Trailing-Edge
-
PDP-10 Archives
-
bb-bt99h-bb
-
backrs.x14
There are 3 other files named backrs.x14 in the archive. Click here to see a list.
TITLE BACKRS -- MODULE TO DO THE WORK FOR BACKUP -- %5A(620)
SUBTTL FRANK NATOLI/FJN/PFC/KCM/JEF/MEB/CLRH/VLR/CGN/WMG/DC/BPK/MS/BAH/EDS 16-JUN-86
DECVER==5 ;MAJOR VERSION
DECMVR==1 ;MINOR VERSION
DECEVR==620 ;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.
;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
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,1986. 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 <N*200+M+1> ;[257] AREA FOR CURRENT TAPE RECORD
;[257] AND ITS STATUS BITS
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
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$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]
;-.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$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
;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
MOVEI T1,F.MTAP ;POINT TO TAPE CHANNEL
DEVNAM T1, ;GET PHYSICAL UNIT NAME
MOVE T1,S.MOPN##+.OPDEV ; (LOGICAL IF UUO FAILS)
MOVEM T1,UPHYN ;STORE FOR LATER
MOVEI T2,.TFDEN ;INDICATE DENSITY
MOVEI T3,F.MTAP ;TAPE CHANNEL
MOVE T1,[XWD 2,T2] ;ARG FOR TAPEOP
TAPOP. T1, ;READ DENSITY
SETZ T1, ;LOSE (NO INFO)
DPB T1,[POINTR (UMTCHR, MT.DEN)];STORE
MOVEI T2,.TFTRK ;TRACK
MOVE T1,[XWD 2,T2] ;RESET ARG
TAPOP. T1, ;GET TRACK
SETZ T1, ;LOSE
DPB T1,[POINTR (UMTCHR, MT.7TR)];STORE TRACK
SKIPN UMTCHR ;SEE IF TAPOP. LOST
JRST [MOVEI T1,F.MTAP ;CHANNEL
MTCHR. T1, ;TRY MTCHR. FOR TAPE CHARACTERISTICS
SETZ T1 ;LOSE
ANDX T1,MT.DEN!MT.7TR ;CLEAR JUNK
MOVEM T1,UMTCHR;SAVE
JRST .+1] ;PROCEED
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
MOVEI T2,M(MH) ;LOC FOR SYSTEM NAME BLOCK
MOVEI T1,LN$SYS+2 ;TOTAL LENGTH
HRLI T1,O$SYSN ;TYPE CODE
MOVEM T1,(T2) ;STORE
MOVEI T1,1(T2) ;LOC FOR SYSTEM NAME
HRLI T1,USYSNM ;WHERE I HAVE IT
BLT T1,LN$SYS(T2) ;XFR
SETZM LN$SYS+1(T2) ;INSURE TRAILING NULL FOR ASCIZ
ADDI T2,LN$SYS+2 ;UPDATE POINTER
SKIPN S.SSNM## ;SEE IF SAVE SET NAME SUPPLIED
JRST LSTSAV ;NO, OMIT O$SSNM BLOCK
HRLI T1,O$SSNM ;TYPE CODE FOR SAVE SET NAME
HRRI T1,LN$SSN+2 ;NUMBER OF WORDS
MOVEM T1,(T2) ;STORE CONTROL WORD
MOVEI T1,1(T2) ;LOC FOR SAVE SET NAME
HRLI T1,S.SSNM## ;WHERE IT IS
BLT T1,LN$SSN(T2) ;XFR
SETZM LN$SSN+1(T2) ;INSURE TRAILING NULL
ADDI T2,LN$SSN+2 ;UPDATE
LSTSAV: SETZM (T2) ;FIRST CLEAR REST OF TAPE BUFFER
MOVSI T1,(T2) ;MAKE BLT POINTER
HRRI T1,1(T2) ; ...
BLT T1,MTBBKP-1(MH) ;ZILCH
SUBI T2,M(MH) ;SUBTRACT START ADDRESS
MOVEM T2,G$LND(MH) ;STORE TOTAL LENGTH NON-DATA
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) ; ...
BLT T1,MTBBKP-1(MH);CLEAR BUFFER
MOVEI T1,T$UFD ;LOAD UFD TYPE
MOVEM T1,G$TYPE(MH) ;STORE IN HEADER
HRRZM P1,D$LVL(MH) ;STORE LEVEL
MOVEI T3,D$STR(MH) ;MAKE BP TO D$STR IN HEADER
HRLI T3,440700 ;...
MOVE T1,ACSTR ;GET ALIAS STRUCTURE NAME
MOVEI T2,.FCDEV ;INDICATE DATA TYPE
PUSHJ P,SETPTH ;STORE IN HEADER
MOVE T1,D$LVL(MH) ;INDICATE LEVEL
PUSHJ P,SETASC ;STORE O$NAME FULL PATH OF DIRECTORY
MOVEM T1,D$PCHK(MH) ;SAVE CHECKSUM OF PATH IN HEADER
PUSHJ P,SAVATR ;SAVE O$FILE ATTRIBUTE BLOCK ON TAPE
;HERE TO WRITE O$DIRT NON-DATA BLOCK IN T$UFD RECORD. OUTPUT PLACED AT M+400(MH)
MOVEI T1,200 ;LENGTH OF BLOCK
ADDM T1,G$LND(MH) ;ADD TO NON-DATA LENGTH
HRLI T1,O$DIRT ;POSITION CONTROL CODE
MOVEM T1,400+M(MH) ;STORE CONTROL WORD
MOVEI T1,401+M(MH) ;MAKE POINTER TO DIRECTORY ATTRIBUTES
MOVEI T2,LN$DFH ;FIXED HEADER LENGTH
MOVEM T2,D$FHLN(T1) ;STORE
MOVEI T2,201+M(MH) ;MAKE POINTER TO O$FILE
MOVE T3,A$WRIT(T2) ;GET CREATION DATE/TIME FROM O$FILE BLOCK
MOVEM T3,D$LOGT(T1) ;SAVE FOR LOGIN TIME
SETZB T3,A$PROT(T2) ;ZILCH FILE PROTECTION WORD
LDB T4,[POINTR (.RBPRV(P2), RB.PRV)];GET RIB PROTECTION
LSHC T3,^D30 ;POSITION PROGRAMMER PROTECTION IN T3
DPB T3,[POINTR (D$PROT(T1), AC$OWN)];SET OWNER ACCESS
SETZ T3, ;CLEAR
LSHC T3,3 ;POSITION PROJECT PROTECTION IN T3
DPB T3,[POINTR (D$PROT(T1), AC$GRP)];SET AFFINITY GROUP PROT.
LSH T4,-^D33 ;POSITION WORLD PROTECTION IN T4
TLO T4,(5B2) ;SET "5"
IORM T4,D$PROT(T1) ;STORE DIRECTORY PROTECTION
MOVE T2,.RBQTF(P2) ;GET QUOTA IN BLOCKS FROM RIB
ASH T2,7 ;MULTIPLY BY 200 FOR QUOTA IN WORDS
MOVEM T2,D$QTF(T1) ;STORE
MOVE T2,.RBQTO(P2) ;GET LOGGED OUT QUOTA FROM RIB
ASH T2,7 ;MULTIPLY BY 200 FOR QUOTA IN WORDS
MOVEM T2,D$QTO(T1) ;STORE
PUSHJ P,MTAOUT ;EXEC I/O
NORIB: AOBJN P1,WRIB ;CIRCLE
POPJ P, ;RETURN
;+
;<SAVFIL IS A ROUTINE TO MOVE AN INDIVIDUAL FILE FROM DISK TO TAPE.
;-
SAVFIL: 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) ; ...
BLT T1,MTBBKP-1(MH) ;ZILCH ENTIRE BUFFER
MOVEI T1,.FXLND ;INDICATE FILE
MOVEI P2,EXLFIL ;SET ADDRESS OF LOOKUP BLOCK
PUSHJ P,SETASC ;SAVE O$NAME BLOCK
MOVEM T1,F$PCHK(MH) ;SAVE CHECKSUM IN HEADER
MOVEM T1,PTHCHK ;AND FOR LATER USE
PUSHJ P,SAVATR ;SAVE FILE ATTRIBUTES
MOVEI T1,M+200(MH) ;SET POINTER TO O$FILE BLOCK
SKIPN S.RSUM## ;UNLESS RESUMING,
PUSHJ P,LSTFIL ;LIST THIS FILE
PUSHJ P,DSKIN ;GET FIRST DISK BLOCK
JRST CLSFIL ;ERROR -- QUIT
JRST [SKIPE S.RSUM## ;EOF RETURN
JRST RSMERR ;IF RESUMING MEANS USER GAVE BAD CHECKPOINT
JRST SNDLST] ;IF NOT, MEANS ZERO LENGTH FILE -- DONE
SKIPN T1,S.RSUM## ;IF RESUMING, GET BLOCK NUMBER
MOVEI T1,1 ;FIRST BLOCK
MOVEM T1,THSRDB ;STORE RELATIVE BLOCK NUMBER
SKIPE S.RSUM## ;IF RESUMING,
PUSHJ P,TYPRSM ;TYPE RESUME MESSAGE
SETZM S.RSUM## ; AND ZILCH
MOVE T1,EXLFIL+.RBSIZ;GET SIZE OF FILE
CAILE T1,400 ;SEE IF OVER 2 BLOCKS
JRST SNDREC ;YES, START FILE IN 2ND TAPE RECORD
MOVEI P2,M+400(MH) ;WHERE TO START
MOVEI P1,N-2 ;MAX OF 2 BLOCKS FOR FIRST RECORD
CAIG T1,200 ;IF ONLY ONE BLOCK,
MOVEI P1,1 ;ADJUST P1
;HERE TO TRANSFER A DISK BLOCK TO THE TAPE BUFFER
STBLK: MOVSI T1,(DBUF) ;ADDRESS OF DATA
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,MTAOUT ;SEND TAPE RECORD
MOVEI P1,N ;HOW MANY BLOCKS
MOVEI P2,M(MH) ;WHERE TO WRITE
TXNN F,FL$KIL ;SEE IF OPERATOR SAID KILL
JRST STREC ;NO--GO START AGAIN
PUSHJ P,EAFIL ;YES--ABORT FILE
MOVEI T1,[ASCIZ/
% SAVE ABORTED
/]
SKIPE S.LIST ;SKIP IF NO LISTING NEEDED
PUSHJ P,LSTMSG ;SEND TO LISTING FILE
JRST CLSFIL ;CLOSE FILE
; HERE ON DISK EOF
FINFIL: ADDM P3,G$SIZ(MH) ;TO USE ACTUAL WORD SIZE OF LAST DISK BLOCK
SOJLE P1,SNDLST ;IF BUFFER FULL, SEND LAST RECORD
SETZM (P2) ;CLEAR REMAINDER OF BUFFER
MOVSI T1,(P2) ;MAKE BLT POINTER
HRRI T1,1(P2) ; ...
BLT T1,MTBBKP-1(MH) ;ZILCH TO END OF TAPE BUFFER
SNDLST: MOVX T1,GF$EOF ;MARK AS LAST BLOCK
IORM T1,G$FLAG(MH) ;SET FLAG
PUSHJ P,MTAOUT ;SEND LAST BUFFER
SKIPN S.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
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
CAILE P1,400 ;SEE IF IN RANGE
MOVEI P1,400 ;NOT. USE MAX FOR FIRST TAPE BLOCK
MOVEI T1,CP$INC ;CHECKPOINT INCREMENT
MOVEM T1,CHKPNT ;SET INITIAL CHECKPOINT
MOVEI T1,1 ;START WITH RELATIVE-DATA-BLOCK 1
MOVEM T1,THSRDB ;STORE
MOVE T1,F$PCHK(MH) ;GET FILE PATH CHECKSUM
MOVEM T1,PTHCHK ;SAVE FOR LATER CHECKING
PUSHJ P,@DSKIO ;GET FIRST BUFFER OR DO DUMMY OUTPUT
JRST XFRERR ;ERROR RETURN
JRST DSKEO1 ;EOF RETURN--NULL DISK FILE
JUMPLE P1,CHKEND ;MAY BE 0 BLOCKS ON TAPE
XFR1: MOVSI T1,(P2) ;TAPE BUFFER ADDRESS
HRRI T1,(DBUF) ;DISK BUFFER ADDRESS
MOVEI T2,177(T1) ;USUALLY 200 WORDS
CAIL P1,200 ;SEE IF LAST BLOCK IN THIS TAPE BLOCK
JRST XFR2 ;NO
MOVEI T2,-1(T1) ;OFFSET
ADD T2,P1 ;POINT TO END
XFR2: XCT DSKBLT ;COPY OR COMPARE DATA
TXNN F,FL$CHK ;SEE IF /CHECK
CAIL P1,200 ;IS THIS THE LAST BLOCK?
JRST NOTLST ;NO--CONTINUE
;HERE IF LAST DISK BLOCK TO BE WRITTEN
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
CAILE P1,200*N ;SEE IF IN RANGE
MOVEI P1,200*N ;NOT. USE MAX NBR WORDS
MOVE P2,MDATA ;START OF DATA
MOVX T1,GF$SOF ;SEE IF START OF FILE,
TDNE T1,G$FLAG(MH) ;TEST FLAG IN HEADER
JRST MISMAT ;YES--MISSED EOF
MOVE T1,F$PCHK(MH) ;GET PATH CHECKSUM
CAME T1,PTHCHK ;MAKE SURE STILL ON SAME FILE
JRST MISMAT ;NOT. BAD NEWS
MOVE T1,F$RDW(MH) ;GET TAPE RELATIVE DATA WORD
ASH T1,-7 ;CALCULATE RELATIVE DATA BLOCK
AOS T1 ; ...
CAMN T1,THSRDB ;[321] BLOCK EXPECTED?
JRST XFR1 ;[321] YES - GO USE IT
MOVE T2,THSRDB ;LOAD NEEDED DISK BLOCK NUMBER
CAML T2,T1 ;[321] NEEDED BLOCK GE FIRST BLOCK IN RECORD?
CAIL T2,N(T1) ;[321] 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
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
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: MOVSI 7,-200*N ;HOW MANY WORDS
HRRI 7,M(MH) ;WHERE IT'S AT
MOVE 1,G$LND(MH) ;GET LENGTH OF NON-DATA SECTION
HRLS 1 ;PUT IN LH ALSO
ADD 7,1 ;DON'T ENCRYPT NON-DATA
MOVE 6,F$RDW(MH) ;GET RELATIVE WORD
ADDI 6,200 ;FORCE OVERFLOW
ASH 6,-7 ;GET RELATIVE BLOCK
MOVE 5,SVCODE ;GET SEED BACK
PUSHJ P,CRYPT.## ;CALL ENCRIPTER
MOVSI 7,SAVACS ;RESTORE REGISTERS
BLT 7,7 ; ..
MTAOU1: AOS T1,NSEQ ;GET SEQUENCE NUMBER
MOVEM T1,G$SEQ(MH) ;STORE
MOVE T1,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
MOVEI T1,MTBBKP ;LOAD OUTPUT BLOCK SIZE
ADDM T1,S.MBPT##+.BFPTR ;INCREMENT BYTE POINTER
OUT F.MTAP, ;EXECUTE OUTPUT UUO
JRST MTASET ;SUCCESSFUL OUTPUT
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
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
SKIPA ;[345] CAN'T... SEE WHY
POPJ P, ;[345] GOT IT, CHARGE ON
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 ;YES
DATERR: MOVEI MH,2(P2) ;SET POINTER
PUSHJ P,MASTER ;REPORT ERROR
MOVE T1,ERRCNT ;GET COUNT OF TAPE ERRORS
TXNE P1,IO.EOT ;PASSED EOT?
CAIGE T1,EOTEMX ;YES--TIME TO GIVE UP ON REPEATERS?
SKIPA ;NO, PROCEED
JRST NOREPT ;YES
IFN FT$EMX,<
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,1(P2) ;PRETEND JUST FINISHED FILLING
ADDI T1,MTBBKP ;THIS BUFFER
HRRM T1,S.MBPT##+.BFPTR;SET BYTE POINTER
SETZM S.MBPT##+.BFCTR ;ZILCH COUNT
;IF THIS OUTPUT WINS, MAKE SURE ALL CURRENTLY FILLED BUFFERS
;IN RING ARE OUTPUT BEFORE FILLING ANY NEW BUFFER.
OUT F.MTAP,(P2) ;WRITE REPEATER RECORD
JRST BUFOUT ;WON--SEE IF MONITOR HAS CAUGHT UP YET
CHKERR: 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.
SETZM S.MBPT##+.BFCTR ;ZERO COUNT
MOVEI T1,MTBBKP ;LOAD OUTPUT BLOCK SIZE
ADDM T1,S.MBPT##+.BFPTR;INCREMENT BYTE POINTER
OUT F.MTAP, ;DO OUTPUT UNTIL CAUGHT UP
JRST BUFOUT ;SUCCESSFUL OUTPUT
JRST CHKERR ;CHECK ERROR
>;END IFN FT$RCV
NOFIND: SETSTS 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
MOVEI T1,MTBFSZ ;LOAD BUFFER SIZE
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
HRRI T1,TAPHLD+1 ;[257] AREA FOR SAFEKEEPING
BLT T1,<TAPHLD+N*200+M> ;[257] MOVE DATA
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: MOVEI MH,TAPHLD+1 ;[257] 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]
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
MOVEI T1,MTBBKP ;INDICATE BACKUP TAPE BLOCK LENGTH
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: MOVSI 7,-200*N ;GET NEGATIVE NBR WORDS
HRR 7,MDATA ;WHERE TO FIND THEM
MOVE 1,G$LND(MH) ;GET LENGTH OF NON-DATA SECTION
HRLS 1 ;PUT IN LEFT HALF ALSO
ADD 7,1 ;ONLY DATA IS ENCRYPTED
MOVE 6,F$RDW(MH) ;GET RELATIVE DATA WORD
ADDI 6,200 ;FORCE OVERFLOW
ASH 6,-7 ;GET RELATIVE BLOCK
MOVE 5,SVCODE ;GET SEED BACK
PUSHJ P,CRYPT.## ;GO TRANSLATE
MOVSI 7,SAVACS ;RESTORE REGISTERS
BLT 7,7 ; ..
JRST CPOPJ1 ;SKIP RETURN
;
;
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
MOVSI T2,-MTBBKP ;AOBJN WORD FOR TAPE BUFFER
HRR T2,MH ;GET START ADDRESS OF BUFFER
CHKSM1: ADD T1,(T2) ;DO CHECKSUMMING
ROT T1,1 ; ...
AOBJN T2,CHKSM1 ;NEXT WORD
MOVEM T1,G$CHK(MH) ;STORE IN HEADER
POPJ P, ;RETURN
>;END IFN FT$CHK
;+
;<RPTNXT IS A ROUTINE TO DETERMINE IF THE FOLLOWING RECORD ON TAPE
;IS A REPEATER RECORD. ^CALLED WITH ^P2 = POINTER TO SECOND WORD
;OF CURRENT BUFFER HEADER. ^A SKIP RETURN IS GIVEN IF A REPEATER
;RECORD 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
MOVEI T1,MTBBKP ;BACKUP BUFFER SIZE
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
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
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 CH," " ;SPACE
PUSHJ P,LSTOUT ;SEND
MOVE T1,S$RLNM(MH) ;GET REELID
PUSHJ P,LST6 ;SEND
;HERE TO LIST THE SECOND LINE OF THE SAVE SET HEADER
MOVEI T1,[ASCIZ /
System /]
PUSHJ P,LSTMSG ; ..
MOVEI T3,M(MH) ;START OF DATA AREA
ADD T3,G$LND(MH) ;END OF NON-DATA PORTION
MOVEI T1,M+1(MH) ;ADDRESS OF ASCII STRING
LSTSYS: HLRZ T2,-1(T1) ;GET BLOCK TYPE CODE
CAIN T2,O$SYSN ;SEE IF SYSEM HEADER
PUSHJ P,LSTMSG ;YES, LIST
HRRZ T2,-1(T1) ;GET LENGTH OF BLOCK
ADD T1,T2 ;ADD TO POINTER
CAIGE T1,(T3) ;SEE IF REACHED END
JRST LSTSYS ;CIRCLE
LDB T1,[POINTR (S$MON(MH),CN%MNT)];GET MONITOR TYPE BYTE
CAIL T1,LN$MTP ;SEE IF DEFINED
SETZ T1, ;NO, UNKNOWN
MOVE T1,MTPTBL(T1) ;GET ADDRESS OF MONITOR TYPE STRING
PUSHJ P,LSTMSG ;SEND TO FILE
MOVEI T1,[ASCIZ / monitor /] ; ..
PUSHJ P,LSTMSG ; ..
MOVE P1,S$SVER(MH) ;GET MONITOR VERSION
PUSHJ P,LSTVER ;SEND TO FILE
MOVEI T1,[ASCIZ / APR#/] ; ..
PUSHJ P,LSTMSG ; ..
MOVE T1,S$APR(MH) ;GET APR SERIAL NUMBER
PUSHJ P,LSTDEC ;SEND TO FILE
MOVEI T1,CRLF ;<CR><LF>
PUSHJ P,LSTMSG ;SEND TO FILE
;HERE TO LIST THE THIRD LINE OF THE SAVE SET HEADER
LDB T1,[POINTR (S$MTCH(MH),MT.DEN)] ;GET DENSITY BYTE
MOVE T1,DNSTBL(T1) ;GET ADDRESS OF DENSITY STRING
PUSHJ P,LSTMSG ;SEND TO FILE
MOVEI CH,"9" ;ASSUME 9 TRACK
MOVEI T1,MT.7TR ;SEE IF SEVEN TRACK
TDNE T1,S$MTCH(MH) ;SKIP IF OFF
MOVEI CH,"7" ;LOAD ASCII SEVEN
PUSHJ P,LSTOUT ;SEND
MOVEI T1,[ASCIZ / track /]
PUSHJ P,LSTMSG ;SEND
MOVE T1,S$DATE(MH) ;GET DATE/TIME IN UNIVERSAL FORMAT
PUSHJ P,CONTDT ;CONVERT TO SYSTEM FORMAT
PUSH P,T1 ;SAVE TIME FOR LATER
MOVE T1,T2 ;GET DATE
PUSHJ P,LSTDAT ;LIST DATE
MOVEI CH," " ;SPACE
PUSHJ P,LSTOUT ;SEND
POP P,T1 ;GET TIME BACK
PUSHJ P,LSTTIM ;LIST TIME
MOVEI T1,[ASCIZ / BACKUP /]
PUSHJ P,LSTMSG ;SEND TO FILE
MOVE P1,S$BVER(MH) ;GET VERSION
PUSHJ P,LSTVER ;TYPE VERSION
MOVEI T1,[ASCIZ / tape format /] ; ..
PUSHJ P,LSTMSG ; ..
MOVE T1,S$FMT(MH) ;GET FORMAT
PUSHJ P,LSTDEC ;TYPE DECIMAL
MOVEI T1,CRLF ;SEND CR-LF
PUSHJ P,LSTMSG ;SEND TO FILE
;HERE TO LIST THE FOURTH LINE OF THE SAVE SET HEADER
MOVEI T1,[ASCIZ /Tape number /]
PUSHJ P,LSTMSG ;SEND
MOVE T1,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 /]
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]