github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-01-30 21:31:53 +00:00
Code Issues Projects Releases Wiki Activity
Files
6e18f5ebefd9acb0d718ef31a08f33a60fc9fca2
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/backup/backrs.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

6846 lines
216 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
TITLE BACKRS -- MODULE TO DO THE WORK FOR BACKUP -- %5A(625)
SUBTTL FRANK NATOLI/FJN/PFC/KCM/JEF/MEB/CLRH/VLR/CGN/WMG/DC/BPK/MS/BAH/EDS 18-FEB-88
DECVER==5 ;MAJOR VERSION
DECMVR==1 ;MINOR VERSION
DECEVR==624 ;EDIT NUMBER
CUSTVR==0 ;CUSTOMER VERSION
;+
;.AUTOPARAGRAPH.FLAG INDEX.FLAG CAPITAL.LOWER CASE
;.TITLE ^PROGRAM ^LOGIC ^MANUAL FOR ^^BACKRS\\
;.SKIP 10.CENTER;^^BACKRS\\
;.SKIP 1.CENTER;^PROGRAM ^LOGIC ^MANUAL
;.SKIP 1.CENTER;^VERSION 5A
;.SKIP -20.CENTER;<ABSTRACT
;.SKIP 1
;<BACKUP IS A PROGRAM WHICH BACKS UP THE DISK FILE SYSTEM
;ONTO MAG TAPE AND RESTORES FROM THIS TAPE. <BACKRS IS A
;SEPARATE MODULE (ACTUALLY THE SECOND MODULE) OF THE
;PROGRAM AND HANDLES ALL THE WORK.
;^THE FIRST MODULE IS THE COMMAND SCANNER AND SETUP.
;^THIS WORKER MODULE LIVES IN THE LOW SEGMENT
;AND RELEASES AND RESTORES THE HIGH SEGMENT TO ELIMINATE MOST
;OF THE CORE WHEN RUNNING.
;.PAGE;^^
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1974,1977,1978,1979,1980,1981,1982,1984,1986,1988.
;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,1988. 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
SETDEN: SKIPL S.OPER## ;WRITING?
JRST SETDE1 ;NO
MOVEI T2,.TFSTS ;FUNCTION CODE
MOVEI T3,F.MTAP ;TAPE CHANNEL
MOVE T1,[2,,T2] ;SET UP UUO AC
TAPOP. T1, ;READ STATUS
JRST SETDE1 ;TAKE A GUESS
TRNN T1,TF.BOT ;SITTING AT BOT?
JRST SETDE1 ;NO--DENSITY CAN EASILY BE READ
MTBLK. F.MTAP, ;ELSE WRITE A LONG GAP
MTWAT. F.MTAP, ;WAIT FOR THE DRIVE TO SETTLE DOWN
MTREW. F.MTAP, ;AND PUT US BACK AT THE LOAD POINT
SETDE1: MOVEI T2,.TFDEN ;INDICATE DENSITY
MOVEI T3,F.MTAP ;TAPE CHANNEL
MOVE T1,[XWD 2,T2] ;ARG FOR UUO
TAPOP. T1, ;READ DENSITY
SETZ T1, ;LOSE (NO INFO)
DPB T1,[POINTR (UMTCHR, MT.DEN)];STORE
MOVEI T2,.TFTRK ;TRACK
MOVE T1,[XWD 2,T2] ;RESET ARG
TAPOP. T1, ;GET TRACK
SETZ T1, ;LOSE
DPB T1,[POINTR (UMTCHR, MT.7TR)];STORE TRACK
SKIPN UMTCHR ;SEE IF TAPOP. LOST
JRST [MOVEI T1,F.MTAP ;CHANNEL
MTCHR. T1, ;TRY MTCHR. FOR TAPE CHARACTERISTICS
SETZ T1 ;LOSE
ANDX T1,MT.DEN!MT.7TR ;CLEAR JUNK
MOVEM T1,UMTCHR;SAVE
JRST .+1] ;PROCEED
PUSHJ P,MTADEV ;READ PHYSICAL DEVICE NAME
PUSHJ P,MTARID ;READ REELID
SKIPGE S.OPER## ;IF WRITE OPERATION,
PUSHJ P,DUMOUT ; ISSUE DUMMY OUTPUT
MOVE T1,S.OPER## ;RETRIEVE FUNCTION
PJRST @CMDTBL-1(T1) ;DISPATCH AND RETURN
CMDTBL: XWD ZERO5,CHKALL
XWD ZERO5,RSTALL
XWD ZERO5,SAVALL
SRTDSP: EXP CPOPJ,APHSRT,LOCSRT
SUBTTL DISK TO TAPE MAIN ROUTINES
;+
;.CHAPTER DISK TO TAPE MAIN ROUTINES
;-
;+
;<SAVALL IS THE ROUTINE CALLED TO EXECUTE THE SAVE OPERATION. ^IT FIRST WRITES
;A START-OF-SAVE-SET (<T$BEG) RECORD ON TAPE. ^NEXT, IT SELECTS FROM THE SYSTEM'S
;STRUCTURE LIST, FOR FURTHER PROCESSING, THE FILE STRUCTURES INDICATED BY THE USER
;SPEC LIST PASSED FROM THE <BACKUP MODULE. ^WHEN THE SAVE IS COMPLETED
;AN END-OF-SAVE-SET RECORD (<T$END) IS WRITTEN ON TAPE.
;-
SAVALL: PUSHJ P,SAVE1 ;SAVE 1 PERMANENT
;FIRST INITIALIZE THE USAGE ACCOUNTING PACKAGE
IFN FT$USG,<
SKIPN S.USG## ;USAGE ACCOUNTING REQUESTED
JRST .+3 ;NO, DON'T BOTHER INITIALIZING IT
PUSHJ P,USGINI## ;INITIALIZE IT
JRST [WARN$ (NCU,Not enough Core for Usage accounting)
POPJ P,] ;CAN'T DON'T DO SAVE
>
;HERE TO SETUP THE INITIAL FILESPEC BIT MASK BEFORE THE SAVE
SETZB T1,INIBTS ;[522] CLEAR THE WORKING BITS
MOVEM T1,SAVBTS ;[522] AND THE SAVED COPY
SKIPE S.INIT##+.FXDEV ;[522] ANY DEVICE SPECIFIED?
TXO T1,IB$STR ;[522] YES, REMEMBER
SKIPN S.INIT##+.FXNAM ;[522] ANY FILENAME SPECIFIED?
SKIPE S.INIT##+.FXEXT ;[522] NO, ANY EXTENSION?
TXO T1,IB$NAM ;[522] YES, FLAG THAT
MOVEI T2,.FXDIR+S.INIT## ;[522] POINT AT THE FIRST DIRECTORY WORD
MOVEI T3,6 ;[522] GET THE NUMBER OF DIRECTORY WORDS
MOVX T4,IB$UFD ;[522] GET THE FIRST BIT
SETINT: SKIPN (T2) ;[522] DIRECTORY SPECIFIED AT THIS LEVEL?
JRST SETI01 ;[522] NO, EXIT THIS LOOP
TDO T1,T4 ;[522] YES, LITE THE CORRESPONDING BIT
ADDI T2,2 ;[522] POINT TO THE NEXT DIRECTORY LEVEL
LSH T4,1 ;[522] SHIFT THE BIT FOR THE NEXT LEVEL
SOJG T3,SETINT ;[522] LOOP FOR ALL SPECIFIED LEVELS
SETI01: MOVEM T1,SAVBTS ;[522] STORE THE INITIAL FILESPEC BITS
MOVEM T1,INIBTS ;[522] IN BOTH PLACES.
;HERE TO WRITE BEGINNING-OF-SAVE RECORD ON TAPE
MOVEI T1,T$BEG ;INDICATE START OF SAVE
SKIPE S.RSUM## ;SEE IF /RESUME
JRST [MTBSR. F.MTAP, ;BACKSPACE IN CASE CRASH WROTE
MTBSR. F.MTAP, ;JUNK ON TAPE
JRST .+2] ;NO T$BEG RECORD IF RESUMING
PUSHJ P,GENSAV ;FILL IN REST OF CHARS
MOVE P1,S.NGST## ;AOBJN WORD FOR STRUCTURE LIST
;HERE TO SELECT A STRUCTURE
GETSTR: SKIPN T1,S.STRS##(P1) ;GET STRUCTURE NAME
JRST FINSTR ;NULL--LIST FINISHED
MOVSI T2,(1B0) ;START WITH BIT 0
MOVNI T3,(P1) ;SET ARG FOR SHIFTING RIGHT
LSH T2,(T3) ;SHIFT TO CORRECT BIT FOR THIS STR
SKIPE INIBTS ;[522] ANY /INITIAL SPECIFIER?
SKIPN S.INIT+.FXDEV ;ANY INITIAL DEVICE?
JRST GETST1 ;NO
CAME T1,S.INIT##+.FXDEV;SEE IF EXACT MATCH
TDNE T2,S.INIT##+FX$STR;OR IF THIS STR INDICATED BY FLAG
SKIPA ;YES
JRST NXTSTR ;NO. DROP THIS STRUCTURE
MOVX T4,IB$STR ;[522] YES, GET THE DIRECTORY SPECIFIER
ANDCAM T4,INIBTS ;[522] CLEAR THE DEPENDENCY
GETST1: MOVEM T1,CSTR ;STORE
MOVEM T1,DCHBLK ; ..
MOVEM T2,CSTRFL ; ..
;HERE TO CHECK IF ANY FILE SPEC ASKS FOR STRUCTURE
MOVE SP,S.FRST## ;LOAD ADDRESS OF SPECS
CHKSTR: CAME T1,FX$LEN+.FXDEV(SP);CHECK FOR EXACT MATCH
TDNE T2,FX$LEN+FX$STR(SP); OR IF THIS STR FLAGGED BY SPEC DEVICE
JRST GOTSTR ;OK. USE THIS STRUCTURE
ADDI SP,FX$LEN*2 ;NEXT FILE SPEC
CAMGE SP,S.LAST## ;SKIP IF DONE
JRST CHKSTR ;CONTINUE
JRST NXTSTR ;CHECK NEXT STRUCTURE
;HERE IF AT LEAST ONE FILE SPEC NEEDS THIS STRUCTURE
GOTSTR: PUSH P,.JBFF## ;SAVE JOBFF
PUSH P,.JBREL## ;SAVE JOBREL
PUSHJ P,SAVSTR ;SAVE STRUCTURE
POP P,T1 ;RESTORE JOBREL
PUSHJ P,DRPCOR ;DROP CORE USED FOR THIS STR
POP P,.JBFF## ;RESTORE JOBFF
MOVE T1,SAVBTS ;[522] GET THE SAVED INITIAL BITS
SKIPE INIBTS ;[522] DID WE FIND THE INITIAL FILE?
MOVEM T1,INIBTS ;[522] NO, RESET THE SEARCH BITS
TXZ F,FL$ABS ;[522] CLEAR STRUCTURE ABORT FLAG
TXNE F,FL$KIL ;SEE IF OPERATOR SAID KILL
POPJ P, ; YES--QUIT NOW
NXTSTR: AOBJN P1,GETSTR ;LOOP FOR ALL STRUCTURES
;HERE TO WRITE END-OF-SAVE RECORD ON TAPE
FINSTR: TXO F,FL$END ;WILL FORCE OUTPUT OF ALL BUFFERS
MOVEI T1,T$END ;INDICATE END OF SAVE
PUSHJ P,GENSAV ;WRITE REST OF RECORDS
CLOSE F.MTAP, ;CLOSE CHANNEL
SKIPE INIBTS ;[522] DID WE EVER FIND THE /INITIAL FILE?
JRST CPOPJ1 ;[522] YES, RETURN TO BACKUP WITH OPERATION DONE
SETZM S.INIT## ;[522] CLEAR THE
MOVE T1,[S.INIT##,,S.INIT##+1] ;[522] INITIAL
BLT T1,S.INIT##+FX$LEN-1 ;[522] FILESPEC
JRST CPOPJ1 ;RETURN TO BACKUP WITH OPERATION DONE
;+
;<GENSAV IS A SUBROUTINE TO GENERATE THE SAVE SET RECORDS.
;^IT IS CALLED WITH ^T1 = RECORD TYPE (<T$BEG, <T$CON, <T$END).
;-
GENSAV: MOVEM T1,G$TYPE(MH) ;STORE
MOVE T1,UMONTP ;GET MONITOR TYPE
MOVEM T1,S$MON(MH) ;STORE
MOVE T1,UMONVR ;GET MONITOR VERSION
MOVEM T1,S$SVER(MH) ;STORE
MOVEI T1,FORMAT ;CURRENT BACKUP FORMAT
MOVEM T1,S$FMT(MH) ;STORE
MOVE T1,.JBVER## ;BACKUP VERSION
MOVEM T1,S$BVER(MH) ;STORE
MOVX T1,%CNDTM ;GET DATE/TIME
GETTAB T1, ;ACCESS O/S
SETZ T1, ;SUBSTITUTE ZERO
MOVEM T1,S$DATE(MH) ;STORE
MOVE T1,UPHYN ;GET PHYSICAL DEVICE NAME
MOVEM T1,S$DEV(MH) ;STORE
MOVE T1,UAPRSN ;GET SERIAL NUMBER
MOVEM T1,S$APR(MH) ;STORE
MOVE T1,UMTCHR ;GET CHARACTERISTICS
MOVEM T1,S$MTCH(MH) ;STORE
MOVE T2,UPHYN ;PHYSICAL TAPE NAME
MOVE T1,REELID ;GET REELID
MOVEM T1,S$RLNM(MH) ;STORE
MOVE T1,TAPLBL## ;[426] GET THE LABEL TYPE
MOVEM T1,S$LBLT(MH) ;[426] SAVE FOR LATER
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
MTREW. F.MTAP, ;MAKE SURE TAPE AT LOAD POINT
NXTT.2: SETSTS F.MTAP,.IOBIN ;CLEAR ERRORS
POPJ P, ;RETURN
;Here to get the next volume via the correct fashion
NXTMDA: OUTSTR [ASCIZ/
[BKPAMD Asking MDA for next volume]
/]
MOVE T1,[XWD 2,T2] ;[345] AIM AT THE ARG BLOCK
MOVEI T2,.TFFEV ;[345] FORCE END-OF-VOLUME PROCESSING
MOVEI T3,F.MTAP ;[345] ON THIS OPEN CHANNEL
TAPOP. T1, ;[345] GET THE NEXT VOLUME
SKIPA ;[345] CAN'T... SEE WHY
JRST NXTT.2 ;GO FINISH UP
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
PUSHJ P,MTADEV ;READ PHYSICAL DEVICE NAME
MOVE T1,TAPLBL## ;GET LABEL TYPE
CAIE T1,.TFLBP ;BYPASS?
CAIN T1,.TFLNV ;USER-EOT?
JRST MTASE1 ;YES TO EITHER--DO THINGS THE OLD WAY
AOS S.NTPE## ;INCREMENT TAPE NUMBER
PUSH P,CH ;SAVE CH
PUSHJ P,LSTRSW ;DO LISTING STUFF
POP P,CH ;RESTORE CH
MTASE1: POP P,T3 ;RESTORE T3
POP P,T2 ;RESTORE T2
POP P,T1 ;RESTORE T1
DEBRK. ;RETURN
JFCL ;???
POPJ P, ;HOPE WE GOT HERE VIA PUSHJ
;+
;<MTARID IS THE ROUTINE THAT READS REELIDS
;-
MTARID: MOVE T1,[2,,T2] ;SET UP UUO AC
MOVEI T2,.TFRID ;FUNCTION CODE TO READ REELID
MOVEI T3,F.MTAP ;CHANNEL NUMBER
TAPOP. T1, ;READ REELID
SKIPA ;???
MOVEM T1,REELID ;SAVE
POPJ P, ;RETURN
;+
;<MTADEV IS THE ROUTINE THAT READS THE PHYSICAL MAGTAPE DEVICE NAME
;-
MTADEV: MOVEI T1,F.MTAP ;POINT TO TAPE CHANNEL
DEVNAM T1, ;GET PHYSICAL UNIT NAME
MOVE T1,S.MOPN##+.OPDEV ; (LOGICAL IF UUO FAILS)
MOVEM T1,UPHYN ;STORE FOR LATER
POPJ P,
SUBTTL DISK INPUT/OUTPUT ROUTINES
;+
;.CHAPTER DISK INPUT/OUTPUT ROUTINES
;-
;+
;<DSKOUT AND <DSKIN ARE THE USUAL ENTRY POINTS TO THE DISK <I/O
;ROUTINE. ^EITHER AN <OUT OR AN <IN <UUO IS EXECUTED AND A DOUBLE
;SKIP RETURN IS GIVEN IF NO PROBLEM IS ENCOUNTERED. ^ON EXIT, <DBUF
;IS SET TO POINT TO THE "NEW" DISK BUFFER. ^A SINGLE SKIP RETURN
;INDICATES END OF FILE. ^ON AN ERROR RETURN FROM THE <UUO,
;THE SUBROUTINE ISSUES A WARNING AND GIVES A NON-SKIP RETURN.
;
;<ALTDSK IS AN ALTERNATE ENTRY POINT TO THE DISK <I/O ROUTINE WHICH
;IS USED WHEN WRITING THE LAST DISK BLOCK FOR A FILE ON A <RESTORE.
;^IT IS CALLED TO ADJUST THE DISK RING HEADER BYTE POINTER FOR THE ACTUAL
;NUMBER OF DATA WORDS IN THE BUFFER. ^THIS CAUSES THE MONITOR TO RECORD
;THE FILE SIZE IN <.RBSIZ CORRECTLY.
;-
DSKOUT: MOVSI T1,(<OUT FILE,0>) ;[254] OUTPUT UUO
SETZ T2, ;[254] ZERO C(T2)
EXCH T2,DSKHDR+.BFCTR;ZERO BYTE COUNT
ALTDSK: ADDM T2,DSKHDR+.BFPTR;INCREMENT BYTE POINTER
XCT T1 ;[254] DO OUT UUO
JRST DSKSET ;OK
GETSTS FILE,T1 ;[440] GET ERROR STS
WAIT FILE, ;[440] WAIT FOR I/O TO CEASE
TRNE T1,IO.DER!IO.BKT!IO.DTE ;[276] DATA ERRORS?
JRST DSKOU1 ;[276] YES
TRNE T1,IO.EOF ;SKIP IF NOT EOF
JRST CPOPJ1 ;RETURN
DSKOU1: WARN$N (DOE,Disk output error) ;[254] [276]
PUSHJ P,OCTOUT ;TYPE STATUS
OUTSTR [ASCIZ / during/] ;TELL WHEN
SAVE$ P1 ;SAVE C(P1)
MOVEI P1,EXLFIL ;ADDRESS OF LOOKUP/ENTER BLOCK
PUSHJ P,GUUO ;TYPE OUT
RSTR$ P1 ;RESTORE C(P1)
POPJ P, ;RETURN
DSKSET: PUSHJ P,DSKBLK ;CALCULATE # OF BLOCKS IN THIS BUFFER (NDBLIB)
HRRZ DBUF,DSKHDR+.BFPTR;FIRST DATA WORD MINUS ONE
AOJA DBUF,CPOPJ2 ;RETURN
DSKIN: SETZ T2, ;[254] ZERO C(T2)
EXCH T2,DSKHDR+.BFCTR ;[254] ZERO BYTE COUNT
ADDM T2,DSKHDR+.BFPTR ;[254] INCREMENT BYTE POINTER
IN FILE,0 ;[254] DO IN UUO
JRST DSKSE1 ;[254] OK
GETSTS FILE,T1 ;[440][254] GET ERROR STATUS
WAIT FILE, ;[440][254] WAIT FOR I/O TO CEASE
TRNE T1,IO.EOF ;[254] SKIP IF NOT EOF
JRST CPOPJ1 ;[254] RETURN
MOVE T2,DSKHDR+.BFADR ;[254] GET CURRENT BUFFER
MOVE T3,-1(T2) ;[254] GET ITS STATUS BITS
ANDI T3,IO.ERR ;[254] ANY ERRORS HERE?
JUMPN T3,DSKSE2 ;[254] YES
TRO T1,IO.SYN ;[254] NO, SET IO.SYN--ERROR FURTHER ON
SETSTS FILE,(T1) ;[254] SET IN STATUS BITS
JRST DSKSE1 ;[254] CONTINUE AS IF OK
DSKSE2: SAVE$ T1 ;[254] SAVE STATUS FOR ERROR MSG
TRZ T1,(T3) ;[254] IN STS, TURN OFF ERROR FOR THIS BUF
TRNN T1,IO.ERR ;[254] ANY ERRORS LEFT?
TRZA T1,IO.SYN ;[254] ALL CLEAR--CLEAR IO.SYN
TRO T1,IO.SYN ;[254] NOT ALL CLEAR, SET IO.SYN
SETSTS FILE,(T1) ;[254] SETSTS TO CLEAR
;[254] SPECIAL CASE FOR IO.IMP:
;[254] ALL OTHER ERRORS ARE IN ONLY ONE BUFFER, BECAUSE DEVICE STOPS
;[254] AFTER ERROR, BUT IO.IMP PROPOGATES INTO ALL OTHER BUFFERS
;[254] READ BY THE MONITOR AT THIS READ. (THESE HAVE THE USE BITS ON.)
;[254] IO.IMP IS THE ERROR FOR CHECKSUM ERRORS.
TRNN T3,IO.IMP ;[254] WAS IT IO.IMP?
JRST DSKSE3 ;[254] NO - CONTINUE
DSKSE4: SKIPL T2,(T2) ;[254] TO NEXT BUFFER
JRST DSKSE3 ;[254] NOT IN USE--CONTINUE
MOVE T1,-1(T2) ;[254] GET STATUS WORD
TRZN T1,IO.IMP ;[254] IO.IMP ON?
JRST DSKSE3 ;[254] NO--DONE
MOVEM T1,-1(T2) ;[254] YES, TURN IT OFF
JRST DSKSE4 ;[254] LOOP THROUGH BUFFER RING
DSKSE3: WARN$N (DIE,Disk input error) ;[254]
RSTR$ T1 ;[254] GET ORIGINAL STATUS WORD BACK
PUSHJ P,OCTOUT ;[254] PRINT IT
OUTSTR [ASCIZ / (block=/] ;[254]
MOVE T1,THSRDB ;[254] GET BLOCK NUMBER
ADDI T1,2 ;[254] PLUS TWO TO CURRENT BLOCK
PUSHJ P,DECOUT ;[254] PRINT IT
OUTCHR [")"] ;[254] CLOSE PARENTHESIS
OUTSTR [ASCIZ / during/] ;[254]
SAVE$ P1 ;[254] SAVE C(P1)
MOVEI P1,EXLFIL ;[254] GET FILE SPEC
PUSHJ P,GUUO ;[254] PRINT IT
RSTR$ P1 ;[254] RESTORE C(P1)
HRRZ DBUF,DSKHDR+.BFPTR ;[254]
PUSHJ P,DSKBLK ;[613] CALCULATE NUMBER OF BLOCKS IN THIS BUFFER
AOS DBUF ;[254]
POPJ P, ;[254] RETURN
DSKSE1: PUSHJ P,DSKBLK ;CALCULATE # OF BLOCKS IN THIS BUFFER (NDBLIB)
HRRZ DBUF,DSKHDR+.BFPTR ;[254]
AOJA DBUF,CPOPJ2 ;[254] RETURN
;+
;<DSKBLK CALCULATES NUMBER OF BLOCK IN THIS BUFFER AND STORES IN NDBLIB.
;^USES T1
;-
DSKBLK: MOVE T1,DSKHDR+.BFCTR;GET WORD COUNT
IDIVI T1,200 ;CALCULATE BLOCKS
SKIPE T2 ;OVERFLOW?
AOS T1 ;YES. ACCOUNT FOR PARTIAL BLOCK
MOVEM T1,NDBLIB ;STORE NUMBER OF BLOCK/THIS BUFFER
POPJ P,
;+
;<SETSTR SETS UP THE STRUCTURE MASK IN <CSTRFL.
;-
SETSTR: SAVE$ T1 ;[262] SAVE SCRATCH REGISTERS
SAVE$ T2 ;[262]
SAVE$ T3 ;[262]
MOVE T1,.FXDEV(SP) ;[262] OUTPUT DEVICE NAME
CAMN T1,[SIXBIT/ALL/];[503] SPECIAL CHECK FOR "ALL"
JRST SETST2 ;[503] NO TRANSLATION NEEDED
MOVEM T1,DCHARG ;[503] STORE IT
MOVE T1,[5,,DCHARG] ;[503] SETUP FOR DSKCHR UUO
DSKCHR T1, ;[503] GET DISK CHARACTERISTICS
SKIPA T1,[SIXBIT/ALL/];[503] NONE--PRETEND IT WAS "ALL"
MOVE T1,DCHARG+.DCSNM;[503] GET PHYSICAL STRUCTURE NAME
SETST2: SETOM CSTRFL ;[503][262] SET FLAG FOR "ALL"
CAMN T1,[SIXBIT/ALL/] ;[262] SKIP IF NOT "ALL"
JRST SETST1 ;[262] "ALL" -- DONE
MOVSI T2,777700 ;[262] SET FLAG FOR "DSK"
MOVEM T2,CSTRFL ;[262] SAVE IT
CAMN T1,[SIXBIT/DSK/] ;[262] SKIP IF NOT "DSK"
JRST SETST1 ;[262] "DSK" -- DONE
MOVE T2,S.NGST ;[262] LOAD AOBJN WORD TO STR TABLE
CAME T1,S.STRS##(T2) ;[262] FIND MATCH IN TABLE
AOBJN T2,.-1 ;[262] LOOP
MOVSI T3,(1B0) ;[262] SET BIT ZERO
MOVNI T1,(T2) ;[262] SET SHIFT ARGUMENT
SKIPL T2 ;[262] IF NO MATCH,
TDZA T3,T3 ;[262] CLEAR T3
LSH T3,(T1) ;[262] SHIFT TO CORRECT BIT
MOVEM T3,CSTRFL ;[262] SAVE STR FLAG
SETST1: RSTR$ T3 ;[262] RESTORE REGISTERS
RSTR$ T2 ;[262]
RSTR$ T1 ;[262]
POPJ P, ;[262] RETURN
;+
;<.USETI AND <.USETO DO <USETI AND <USETO BY MEANS OF THE <FILOP.
;MONITOR CALL. ^THIS ALLOWS DISK FILES GREATER THAN 262144(10)
;BLOCKS TO BE PROCESSED PROPERLY.
;-
; CALLING SEQUENCE:
;
; MOVE T1,[BLOCK #]
; PUSHJ P,.USETI OR PUSHJ P,.USETO
; RETURN HERE
.USETI: PUSHJ P,SAVE3 ;[357] SAVE SOME ACS
MOVEI P1,.FOUSI ;[357] GET USETI FUNCTION CODE
JRST USTCOM ;[357] AND FALL INTO COMMON CODE
.USETO: PUSHJ P,SAVE3 ;[357] SAVE ACS
MOVEI P1,.FOUSO ;[357] GET USETO FUNCTION CODE
USTCOM: HRLI P1,FILE ;[357] GET DISK I/O CHANNEL
MOVE P2,T1 ;[357] GET BLOCK NUMBER SUPPLIED
MOVE P3,[XWD 2,P1] ;[357] SET UP ARGUMENT POINTER
FILOP. P3, ;[357] DO IT
HALT . ;[357] ***TEMP***
POPJ P, ;[357] RETURN TO CALLER
SUBTTL LIST OUTPUT SUBROUTINES
;+
;.CHAPTER LIST OUTPUT SUBROUTINES
;-
;+
;<LSTTAB INSERTS A TAB INTO THE LISTING FILE.
;-
LSTTAB: MOVEI CH,.CHTAB ;LOAD HORIZONTAL TAB
;+
;<LSTOUT IS THE SUBROUTINE CALLED TO HANDLE FILLING AND OUTPUTING
;THE LISTING BUFFERS.
;-
LSTOUT: SOSG S.LBPT##+.BFCTR ;SEE IF ANY ROOM LEFT
OUTPUT F.LIST, ;NONE. ADVANCE BUFFERS
IDPB CH,S.LBPT##+.BFPTR;STORE CHARACTER
POPJ P, ;RETURN
;+
;<LSTMSG OUTPUTS AN <ASCIZ STRING TO THE LISTING FILE. ^CALL
;WITH ADDRESS OF STRING IN ^T1.
;-
LSTMSG: HRLI T1,440700 ;BYTE POINTER
LSTMSA: ILDB CH,T1 ;GET CHARACTER
JUMPE CH,CPOPJ ;RETURN IF NULL
PUSHJ P,LSTOUT ;SEND TO FILE
JRST LSTMSA ;LOOP FOR NEXT CHAR
;+
;<LST6 CONVERTS THE <SIXBIT WORD IN ^T1 TO <ASCII AND LISTS IT.
;-
LST6: MOVE T2,T1 ;COPY C(T1)
LST6A: JUMPE T2,CPOPJ ;RETURN IF NULL
MOVEI T1,0 ;FIRST ZILCH
LSHC T1,6 ;CAPTURE A CH
MOVEI CH," "-' '(T1) ;FORM ASCII EQUIV IN CH
PUSHJ P,LSTOUT ;SEND TO FILE
JRST LST6A ;CONTINUE
;+
;<LSTOCT LISTS THE OCTAL NUMBER IN ^T1.
;<LSTDEC LISTS THE DECIMAL NUMBER IN ^T1.
;-
LSTOCT: TDZA T3,T3 ;OCTAL RADIX
LSTDEC: MOVEI T3,2 ;DECIMAL RADIX
MOVEI CH,"-" ;MINUS SIGN
SKIPGE T1 ;SEE IF POSITIVE
PUSHJ P,LSTOUT ;SEND MINUS SIGN TO FILE
LSTNBR: IDIVI T1,8(T3) ;SPLIT DIGITS
MOVMS T2 ;CLEAR MINUS SIGN
HRLM T2,(P) ;STORE DIGIT ON STACK
SKIPE T1 ;SKIP IF DONE
PUSHJ P,LSTNBR ;RECURSE
HLRZ CH,(P) ;FETCH CH OFF STACK
ADDI CH,"0" ;CONVERT TO ASCII
JRST LSTOUT ;SEND TO FILE
;+
;<LSTBTH LISTS TWO DIGITS OF THE DECIMAL NUMBER IN ^T1, WITH A
;LEADING ZERO IF LESS THAN TEN.
;
;<LSTTWO LISTS TWO DIGITS OF THE DECIMAL NUMBER IN ^T1, WITH A
;LEADING SPACE IF LESS THAN TEN.
;-
LSTBTH: MOVEI CH,"0" ;SET LEADING ZERO
SKIPA ; ...
LSTTWO: MOVEI CH," " ;SET LEADING SPACE
IDIVI T1,^D10 ;SPLIT DIGITS
SKIPE T1 ;SKIP IF CORRECT
MOVEI CH,"0"(T1) ;WRONG. GET ASCII DIGIT
PUSHJ P,LSTOUT ;SEND TO FILE
MOVEI CH,"0"(T2) ;GET SECOND DIGIT
JRST LSTOUT ;SEND TO FILE
;+
;<LSTDAT LISTS A DATE IN <DD-MMM-YY FORMAT.
;^CALL WITH ^T1 = DATE IN SYSTEM FORMAT.
;-
LSTDAT: IDIVI T1,^D31 ;GET DAYS
SAVE$ T1 ;STORE QUOTIENT ON STACK
MOVEI T1,1(T2) ;GET DAYS IN T1
PUSHJ P,LSTTWO ;SEND TO FILE
RSTR$ T1 ;RETRIEVE QUOTIENT
IDIVI T1,^D12 ;GET MONTHS
SAVE$ T1 ;STORE QUOTIENT ON STACK
MOVEI T1,MONTBL(T2) ;GET MONTH
PUSHJ P,LSTMSG ;SEND TO FILE
MOVEI CH,"-" ;SECOND DASH
PUSHJ P,LSTOUT ;TO FILE
RSTR$ T1 ;RETRIEVE YEARS
ADDI T1,^D64 ;64 IS BASE YEAR
JRST LSTDEC ;SEND TO FILE
;+
;<LSTTIM LISTS THE TIME IN <HH:MM:SS FORMAT WITH LEADING ZEROS.
;^CALL WITH ^T1 = TIME IN MILLISECONDS.
;-
LSTTIM: IDIV T1,[^D3600000] ;CALCULATE HOURS
IDIVI T2,^D60000 ;CALCULATE MINUTES
IDIVI T3,^D1000 ;CALCULATE SECONDS
PUSH P,T3 ;SAVE SECONDS FOR LATER
PUSH P,T2 ;SAVE MINUTES FOR LATER
PUSHJ P,LSTBTH ;LIST HOURS
MOVEI CH,":" ;SET COLON
PUSHJ P,LSTOUT ;LIST COLON
POP P,T1 ;GET MINUTES BACK
PUSHJ P,LSTBTH ;LIST MINUTES
MOVEI CH,":" ;SET COLON
PUSHJ P,LSTOUT ;LIST COLON
POP P,T1 ;GET SECONDS BACK
JRST LSTBTH ;LIST SECONDS AND RETURN
;+
;<LSTRSW IS A SUBROUTINE TO LIST DATA AFTER REEL SWITCHES ON LABELED TAPES.
;-
LSTRSW: SKIPN S.LIST## ;WANT LISTINGS?
POPJ P, ;NO
MOVEI CH,14 ;GET A FORM-FEED
MOVEI T1,F.LIST ;LISTING CHANNEL
DEVCHR T1, ;GET CHARACTERISTICS
TXNN T1,DV.TTY ;IS DEV A TTY?
PUSHJ P,LSTOUT ;NO - START A NEW PAGE
MOVEI T1,[ASCIZ /
**********************************************************************
Continuation on drive /]
PUSHJ P,LSTMSG ;SEND TO FILE
MOVEI T1,F.MTAP ;GET CHANNEL
DEVNAM T1, ;AND NAME
MOVSI T1,'???'
PUSHJ P,LST6 ;TYPE
MOVEI T1,[ASCIZ /, reelid /]
PUSHJ P,LSTMSG ;SEND TO FILE
MOVE T1,REELID ;GET NEW REELID
PUSHJ P,LST6 ;TYPE IT
MOVEI T1,[ASCIZ /, tape number /]
PUSHJ P,LSTMSG ;TYPE TEXT
MOVE T1,S.NTPE## ;GET NEW TAPE NUMBER
PUSHJ P,LSTDEC ;TYPE IT
MOVEI T1,[ASCIZ /
**********************************************************************
/]
PUSHJ P,LSTMSG ;SEND TO FILE
POPJ P, ;RETURN
;+
;<LSTXXX IS A SUBROUTINE TO LIST THE START/END OF SAVE SET INFORMATION.
;-
LSTXXX: SKIPN S.LIST## ;SKIP IF LISTING ORDERED
POPJ P, ;RETURN
PUSHJ P,SAVE1 ;SAVE C(P1)
SETZM LSTSTR ;CLEAR LAST LIST STR
MOVE T2,G$TYPE(MH) ;GET RECORD TYPE [211]
CAIE T2,T$CON ;IF CONTINUATION, [211]
JRST LSTXX1 ;NOT CONTINUATION [211]
MOVEI CH,14 ;GET A FORM-FEED [211]
MOVEI T1,F.LIST ;LISTING CHANNEL [211]
DEVCHR T1, ;GET CHARACTERISTICS [211]
TXNN T1,DV.TTY ;IS DEV A TTY? [211]
PUSHJ P,LSTOUT ;NO - START A NEW PAGE [211]
LSTXX1: MOVEI T1,[ASCIZ /Start/] ;ASSUME START OF SAVE [211]
CAIN T2,T$CON ;IF CONTINUATION,
MOVEI T1,[ASCIZ /
**********************************************************************
Continuation/]
CAIN T2,T$END ;SKIP IF NOT END OF SAVE
MOVEI T1,[ASCIZ /
End/]
PUSHJ P,LSTMSG ;SEND TO FILE
MOVEI T1,[ASCIZ / of save set /] ;COMMON CODE
PUSHJ P,LSTMSG ; ..
MOVEI T3,M(MH) ;START OF DATA AREA
ADD T3,G$LND(MH) ;END OF NON-DATA PORTION
MOVEI T1,M+1(MH) ;ADDRESS OF ASCII STRING
LSTSSN: HLRZ T2,-1(T1) ;GET BLOCK TYPE CODE
CAIN T2,O$SSNM ;SEE IF SAVE SET BLOCK
PUSHJ P,LSTMSG ;LIST SAVE SET NAME
HRRZ T2,-1(T1) ;GET LENGTH OF BLOCK
ADD T1,T2 ;ADVANCE POINTER
CAIGE T1,(T3) ;SEE IF MORE BLOCKS
JRST LSTSSN ;YES, CIRCLE
MOVEI T1,[ASCIZ /on /] ;TELL WHERE
PUSHJ P,LSTMSG ;SEND TO FILE
MOVE T1,S$DEV(MH) ;GET PHYSICAL DEVICE NAME
PUSHJ P,LST6 ;SEND TO FILE
MOVEI T1,[ASCIZ /, reel /]
PUSHJ P,LSTMSG ;SEND
MOVE T1,S$RLNM(MH) ;GET REELID
PUSHJ P,LST6 ;SEND
;HERE TO LIST THE SECOND LINE OF THE SAVE SET HEADER
MOVEI T1,[ASCIZ /
System /]
PUSHJ P,LSTMSG ; ..
MOVEI T3,M(MH) ;START OF DATA AREA
ADD T3,G$LND(MH) ;END OF NON-DATA PORTION
MOVEI T1,M+1(MH) ;ADDRESS OF ASCII STRING
LSTSYS: HLRZ T2,-1(T1) ;GET BLOCK TYPE CODE
CAIN T2,O$SYSN ;SEE IF SYSEM HEADER
PUSHJ P,LSTMSG ;YES, LIST
HRRZ T2,-1(T1) ;GET LENGTH OF BLOCK
ADD T1,T2 ;ADD TO POINTER
CAIGE T1,(T3) ;SEE IF REACHED END
JRST LSTSYS ;CIRCLE
LDB T1,[POINTR (S$MON(MH),CN%MNT)];GET MONITOR TYPE BYTE
CAIL T1,LN$MTP ;SEE IF DEFINED
SETZ T1, ;NO, UNKNOWN
MOVE T1,MTPTBL(T1) ;GET ADDRESS OF MONITOR TYPE STRING
PUSHJ P,LSTMSG ;SEND TO FILE
MOVEI T1,[ASCIZ / monitor /] ; ..
PUSHJ P,LSTMSG ; ..
MOVE P1,S$SVER(MH) ;GET MONITOR VERSION
PUSHJ P,LSTVER ;SEND TO FILE
MOVEI T1,[ASCIZ / APR#/] ; ..
PUSHJ P,LSTMSG ; ..
MOVE T1,S$APR(MH) ;GET APR SERIAL NUMBER
PUSHJ P,LSTDEC ;SEND TO FILE
MOVEI T1,CRLF ;<CR><LF>
PUSHJ P,LSTMSG ;SEND TO FILE
;HERE TO LIST THE THIRD LINE OF THE SAVE SET HEADER
LDB T1,[POINTR (S$MTCH(MH),MT.DEN)] ;GET DENSITY BYTE
MOVE T1,DNSTBL(T1) ;GET ADDRESS OF DENSITY STRING
PUSHJ P,LSTMSG ;SEND TO FILE
MOVEI CH,"9" ;ASSUME 9 TRACK
MOVEI T1,MT.7TR ;SEE IF SEVEN TRACK
TDNE T1,S$MTCH(MH) ;SKIP IF OFF
MOVEI CH,"7" ;LOAD ASCII SEVEN
PUSHJ P,LSTOUT ;SEND
MOVEI T1,[ASCIZ / track /]
PUSHJ P,LSTMSG ;SEND
MOVE T1,S$DATE(MH) ;GET DATE/TIME IN UNIVERSAL FORMAT
PUSHJ P,CONTDT ;CONVERT TO SYSTEM FORMAT
PUSH P,T1 ;SAVE TIME FOR LATER
MOVE T1,T2 ;GET DATE
PUSHJ P,LSTDAT ;LIST DATE
MOVEI CH," " ;SPACE
PUSHJ P,LSTOUT ;SEND
POP P,T1 ;GET TIME BACK
PUSHJ P,LSTTIM ;LIST TIME
MOVEI T1,[ASCIZ / BACKUP /]
PUSHJ P,LSTMSG ;SEND TO FILE
MOVE P1,S$BVER(MH) ;GET VERSION
PUSHJ P,LSTVER ;TYPE VERSION
MOVEI T1,[ASCIZ / tape format /] ; ..
PUSHJ P,LSTMSG ; ..
MOVE T1,S$FMT(MH) ;GET FORMAT
PUSHJ P,LSTDEC ;TYPE DECIMAL
MOVEI T1,CRLF ;SEND CR-LF
PUSHJ P,LSTMSG ;SEND TO FILE
;HERE TO LIST THE FOURTH LINE OF THE SAVE SET HEADER
MOVEI T1,[ASCIZ /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]
Reference in New Issue View Git Blame Copy Permalink