Trailing-Edge
-
PDP-10 Archives
-
ap-c796e-sb
-
backrs.mac
There are 14 other files named backrs.mac in the archive. Click here to see a list.
TITLE BACKRS -- MODULE TO DO THE WORK FOR BACKUP -- %2(216)
SUBTTL FRANK NATOLI/FJN/PFC/KCM/JEF 20-FEB-76
CUSTVR==0 ;DEC DEVELOPMENT
DECVER==2 ;MAJOR VERSION
DECMVR==0 ;MINOR VERSION
DECEVR==216 ;EDIT NUMBER
;+
;.AUTOPARAGRAPH.FLAG INDEX.FLAG CAPITAL.LOWER CASE
;.TITLE ^PROGRAM ^LOGIC ^MANUAL FOR ^^BACKRS\\
;.SKIP 10.CENTER;^^BACKRS\\
;.SKIP 1.CENTER;^PROGRAM ^LOGIC ^MANUAL
;.SKIP 1.CENTER;^VERSION 2
;.SKIP -20.CENTER;<ABSTRACT
;.SKIP 1
;<BACKUP IS A PROGRAM WHICH BACKS UP THE DISK FILE SYSTEM
;ONTO MAG TAPE AND RESTORES FROM THIS TAPE. <BACKRS IS A
;SEPARATE MODULE (ACTUALLY THE SECOND MODULE) OF THE
;PROGRAM AND HANDLES ALL THE WORK.
;^THE FIRST MODULE IS THE COMMAND SCANNER AND SETUP.
;^THIS WORKER MODULE LIVES IN THE LOW SEGMENT
;AND RELEASES AND RESTORES THE HIGH SEGMENT TO ELIMINATE MOST
;OF THE CORE WHEN RUNNING.
;.PAGE;^^
;***COPYRIGHT 1974,1975,1976 DIGITAL EQUIPMENT CORP., MAYNARD,MASS.***
;-\\
; TABLE OF CONTENTS FOR BACKRS
;
;
; SECTION PAGE
; 1. GENERAL INFORMATION....................................... 3
; 2. DEFAULT PARAMETERS........................................ 4
; 3. DEFINITIONS............................................... 5
; 4. IMPURE STORAGE............................................ 10
; 5. TAPE FORMAT............................................... 12
; 6. INITIALIZATION............................................ 24
; 7. DISK TO TAPE MAIN ROUTINES................................ 27
; 8. DISK TO TAPE SUBROUTINES.................................. 42
; 9. TAPE TO DISK MAIN ROUTINES................................ 49
; 10. TAPE TO DISK SUBROUTINES.................................. 64
; 11. TAPE INPUT/OUTPUT SUBROUTINES............................. 69
; 12. DISK INPUT/OUTPUT ROUTINE................................. 82
; 13. LIST OUTPUT SUBROUTINES................................... 83
; 14. DATE CONVERSION SUBROUTINES............................... 92
; 15. FILE VERIFICATION SUBROUTINES............................. 94
; 16. SORT SUBROUTINES.......................................... 97
; 17. CORE ALLOCATION SUBROUTINES............................... 99
; 18. TELETYPE I/O SUBROUTINES.................................. 100
; 19. ERROR MESSAGES............................................ 104
;+
;.LEFT MARGIN 5.RIGHT MARGIN 55
;.SKIP 3
;^THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT
;NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
;BY ^DIGITAL ^EQUIPMENT ^CORPORATION.
;.SKIP 3
;^DIGITAL ^EQUIPMENT ^CORPORATION ASSUMES NO
;RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
;^DIGITAL ^EQUIPMENT ^CORPORATION.
;.SKIP 3
;^THIS SOFTWARE IS FURNISHED TO PURCHASER UNDER A LICENSE
;FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED (WITH
;INCLUSION OF ^DIGITAL ^EQUIPMENT ^CORPORATION'S
;COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS MAY
;OTHERWISE BE PROVIDED FOR IN WRITING BY ^DIGITAL ^EQUIPMENT
;^CORPORATION.
;.LEFT MARGIN 0.RIGHT MARGIN 60
;.PAGE.SUBTITLE ^TABLE OF ^CONTENTS
;.CENTER;^TABLE OF ^CONTENTS
;.NOFILL.NOAUTOP.LM10.TAB STOPS 15,18.SKIP 2
;1. ^GENERAL ^INFORMATION
;2. ^DEFAULT ^PARAMETERS
;3. ^DEFINITIONS
; ^A^CS
; ^SOFTWARE ^CHANNELS
; ^MACROS
; ^OTHER ^DEFINITIONS
; ^FLAG BITS IN <AC ^F
; ^HOME ^BLOCK ^WORDS
;4. ^IMPURE ^STORAGE
;5. ^TAPE ^FORMAT
;6. ^PROGRAM ^INITIALIZATION
;7. ^DISK TO ^TAPE ^MAIN ^ROUTINES
;8. ^DISK TO ^TAPE ^SUBROUTINES
;9. ^TAPE TO ^DISK ^MAIN ^ROUTINES
;10. ^TAPE TO ^DISK ^SUBROUTINES
;11. ^TAPE ^INPUT/^OUTPUT ^SUBROUTINES
;12. ^DISK ^INPUT/^OUTPUT ^ROUTINE
;13. ^LIST ^OUTPUT ^SUBROUTINES
;14. ^DATE ^CONVERSION ^SUBROUTINES
;15. ^FILE ^VERIFICATION ^SUBROUTINES
;16. ^SORT ^SUBROUTINES
;17. ^CORE ^ALLOCATION ^SUBROUTINES
;18. ^TELETYPE ^I/^O ^SUBROUTINES
;19. ^ERROR ^MESSAGES
;^INDEX
;.PAGE.FILL.AUTOP.LM0.TS5,8
SUBTTL GENERAL INFORMATION
;.CHAPTER GENERAL INFORMATION
;
;^SEARCHES ^^MACTEN, UUOSYM\\ AND ^^SCNMAC\\
;-
SEARCH MACTEN,UUOSYM,SCNMAC ;[174]
;%%C==%%C ;SHOW VERSION OF C
%%MACT==%%MACT ;SHOW VERSION OF MACTEN [174]
%%SCNM==%%SCNM ;SHOW VERSION OF SCNMAC
SALL ;CLEAN LISTING
%%%BKP==:DECVER ;ENSURE CONSISTENT VERSION OF BACKUP
SUBTTL DEFAULT PARAMETERS
;+
;.CHAPTER DEFAULT PARAMETERS
;
;\\ ^THE FOLLOWING PARAMETERS CAN NOT BE CHANGED WITHOUT
;RISKING FURTHER DEBUGGING: ^^
;.TS20.LM20.P-20,0.SK.SELECT D
;D+
ND FT$DBG,1 ;PARANOIA CODE
ND FT$IND,0 ;CODE TO DO ALL DISK IO INDEPENDENTLY
ND FT$RCV,1 ;TAPE ERROR RECOVERY CODE
ND FT$CHK,1 ;CODE TO COMPUTE CHECKSUMS
ND FT$EMX,1 ;CODE TO GIVE UP AFTER MAX NBR TAPE ERRORS
ND M,^D32 ;SIZE OF RECORD HEADER
ND N,4 ;NUMBER OF DISK BLOCKS PER RECORD
ND HMBNBR,1 ;UNIT HOME BLOCK ADDRESS
ND FORMAT,1 ;FORMAT NUMBER
ND NDSKBF,8 ;DISK BUFFERS
ND OPRNDB,^D20 ;DISK BUFFERS FOR OPERATORS
ND EMAX,^D100 ;MAX NUMBER OF TAPE ERRORS BEFORE GIVING UP
ND EOTEMX,1 ;MAX NUMBER OF TAPE ERRORS AFTER EOT
;BEFORE GIVING UP ON WRITING REPEATER RECORDS
;D.SELECT _;
;&.FILL;\\
SUBTTL DEFINITIONS
;+
;.FLAGS.LM 0.NOAUTOT.UPPER CASE
;.CHAPTER DEFINITIONS
;.HL1 AC DEFINITIONS
;.NOFILL.TS16;.P0,-1
;-
;AC'S
;&.END SELECT
F=0 ;STATUS FLAGS
T1=1 ;TEMP
T2=T1+1 ; ..
T3=T2+1 ; ..
T4=T3+1 ; ..
P1=T4+1 ;PERMANENT
P2=P1+1 ; ..
P3=P2+1 ; ..
P4=P3+1 ; ..
SP=12 ;FILE SPECIFICATION ADDRESS
LVL=13 ;SFD LEVEL COUNTER
DBUF=14 ;DISK BUFFER ADDRESS
MH=15 ;TAPE HEADER REGION ADDRESS
CH=16 ;ASCII CHARACTER
P=17 ;PUSHDOWN POINTER
;&
;+
;.HL1 SOFTWARE CHANNELS
;-.NOFILL.END SELECT
F.LIST==1 ;LIST CHANNEL (OPEN/CLOSE BY BACKUP) **DUPLICATED IN BACKUP**
F.MTAP==2 ;MAG TAPE CHANNEL (OPEN/CLOSE BY BACKUP) **DUPLICATED IN BACKUP**
FILE==3 ;FILE
STR==4 ;STRUCTURE
MFD==5 ;MASTER-FILE-DIRECTORY
UFD==6 ;USER-FILE-DIRECTORY
;UFD+1 THRU UFD+.FXLND-1 RESERVED FOR SFDS
;&
IFG UFD+.FXLND-20,<PRINTX ? SFD LEVEL TOO DEEP
PASS2
END>
;+
;.AUTOP.LOWER CASE
;.HL1 MACROS
;-
;+
;<SAVE$ _<LIST_> PUSHS THE LIST OF LOCATIONS
;ONTO THE STACK.
;-
DEFINE SAVE$ (LIST$),<
XLIST
IRP (LIST$),< PUSH P,LIST$ >
LIST
>
;+
;<RSTR$ _<LIST_> POPS THE LIST OF LOCATIONS FROM THE STACK.
;-
DEFINE RSTR$ (LIST$),<
XLIST
IRP (LIST$),< POP P,LIST$ >
LIST
>
;+
;<WARN$ (PREFIX,TEXT) ISSUES WARNING MESSAGE.
;-
DEFINE WARN$ (PFX$,TEXT$),<
PUSHJ P,WRNMSG
JRST E$$'PFX$
OUTSTR [ASCIZ\BKP'PFX$\]
OUTSTR [ASCIZ \ TEXT$
\]
E$$'PFX$::>
;+
;<WARN$N (PREFIX,TEXT) ISSUES WARNING MESSAGE (NO CARRIAGE RETURN).
;-
DEFINE WARN$N (PFX$,TEXT$),<
PUSHJ P,WRNMSG
JRST E$$'PFX$
OUTSTR [ASCIZ\BKP'PFX$\]
OUTSTR [ASCIZ\ TEXT$ \]
E$$'PFX$::>
;+
;<OPER$ (PREFIX,TEXT) ISSUES OPERATOR MESSAGE.
;-
DEFINE OPER$ (PFX$,TEXT$),<
E$$'PFX$::OUTSTR [ASCIZ \
$BKP'PFX$ TEXT$
\]
>
;+
;.HL1 OTHER DEFINITIONS
;.UPPER CASE.TS8,16,24
;-.NOFILL.NOAUTOPARAGRAPH.NOFLAGS.END SELECT
MTBBKP==M+<200*N> ;SIZE OF BACKUP RECORD ON TAPE
MTBFRS==24+5*200 ;SIZE OF FRS BLOCK ON TAPE
MTBFSZ==MTBBKP ;SIZE OF INPUT READ
IFG MTBFRS-MTBFSZ,<MTBFSZ==MTBFRS> ; **DUPLICATED IN BACKUP**
NM$TBF==6 ;NUMBER OF TAPE BUFFERS **DUPLICATED IN BACKUP**
CP$INC==^D1000 ;CHECKPOINT INCREMENT
CP$MRG==<NM$TBF+1>*N+10 ;CHECKPOINT MARGIN
NRIB==.RBTIM+1 ;NUMBER OF RIB ARGS USED
NDCH==.DCUCH+1 ;NUMBER OF DSKCHR ARGS USED
LN$SYS==5 ;LENGTH OF SYSTEM NAME BLOCK
LN$SSN==6 ;LENGTH OF SAVE SET NAME BLOCK **DUPLICATED IN BACKUP**
LN$STR==^D36 ;MAX NBR OF STRUCTURES **DUPLICATED IN BACKUP**
FX$MBF==.FXLEN+0 ;/MBEFORE **DUPLICATED IN BACKUP**
FX$MSN==.FXLEN+1 ;/MSINCE **DUPLICATED IN BACKUP**
FX$CNT==.FXLEN+2 ;COUNTS MATCHES **DUPLICATED IN BACKUP**
FX$STR==.FXLEN+3 ;STRUCTURE FLAGS **DUPLICATED IN BACKUP**
FX$LEN==.FXLEN+4 ;LENGTH OF SCAN BLOCK **DUPLICATED IN BACKUP**
ZERO5==0 ;NO ARGS ALLOWED IN LOW ORDER FIVE BITS
IO.END==40 ;END OF FILE BIT IN LH OF BUFFER STATUS WORD
VR.CUS==7B2 ;CUSTOMER VERSION MASK
VR.MAJ==777B11 ;MAJOR VERSION MASK
VR.MIN==77B17 ;MINOR VERSION MASK
VR.EDT==777777B35 ;EDIT VERSION MASK
;&.PAGE
IFN FT$RCV,<
IFE NM$TBF-1, <
PRINTX ? TAPE ERROR RECOVERY CODE REQUIRES MULTIPLE BUFFERS
PASS2
END>>
;+
;.HL1 FLAG BITS IN AC F
;-.NOFILL.END SELECT
FL$IND==1B0 ;INDEPENDENT DISK IO
FL$UFD==1B1 ;FIRST FILE USED IN UFD
FL$FLP==1B2 ;BUBBLE INVERSION
FL$STR==1B3 ;FIRST TIME STRUCTURE USED
FL$EF1==1B4 ;FIRST TAPE EOF
FL$EF2==1B5 ;SECOND TAPE EOF
FL$INI==1B6 ;ENCRIPTION CODE INITIALIZED
FL$PAO==1B7 ;PARTIAL ALLOCATION ONLY
FL$MAT==1B8 ;FILE SPEC MATCHED
FL$EOV==1B9 ;END-OF-VOLUME RECORD BEING SENT
FL$SLE==1B10 ;SLE MESSAGE ISSUED
FL$D75==1B11 ;MATCH ONLY BECAUSE OF /DATE75
FL$CHK==1B12 ;/CHECK
FL$NBF==1B13 ;ISSUED NBF MESSAGE
FL$FRS==1B14 ;DOING FRS CONVERSION
FL$KIL==1B15 ;ABORT OPERATION
FL$TPE==1B16 ;FILE HAD TAPE I/O ERROR
FL$PSI==1B17 ;PSI ENABLED
FL$INP==1B18 ;INPUT FORCED
FL$RCV==1B19 ;RECOVERY CODE
FL$END==1B20 ;END TAPE OUTPUT
FL$OPN==1B21 ;DISK OUTPUT FILE IS OPEN
;&
;+.HL1 HOME BLOCK WORDS
;.NOFILL.FLAG CONTROL #
;#END SELECT
;-
.HMNAM==0 ;SIXBIT HOM
.HMCNP==16 ;BP CLUSTER COUNT (E=7)
.HMCKP==17 ;BP CHECKSUM (E=7)
.HMCLP==20 ;BP CLUSTER ADDRESS (E=7)
.HMMFD==46 ;LOGICAL BLOCK NUMBER WITHIN STRUCTURE OF 1ST RIB FOR MFD
NHOM==.HMMFD+1 ;NUMBER OF HOME BLOCK WORDS USED
;&#FLAG CONTROL .
SUBTTL IMPURE STORAGE
;+
;.TS8,16,24
;.CHAPTER IMPURE STORAGE
;-.NOFILL.NOAUTOPARAGRAPH.NOFLAGS.END SELECT
STOBEG==. ;BEGINNING OF STORAGE
USYSNM: BLOCK LN$SYS ;SYSTEM NAME
UMONTP: BLOCK 1 ;MONITOR TYPE
UMONVR: BLOCK 1 ;MONITOR VERSION
MFDPPN: BLOCK 1 ;MFD PPN
UAPRSN: BLOCK 1 ;APR SERIAL NUMBER
UPHYN: BLOCK 1 ;PHYSICAL DEVICE NAME
UMTCHR: BLOCK 1 ;TAPE CHARACTERISTICS
PSIVCT:: BLOCK 4 ;PSI VECTOR
IFN FT$IND,<
CMDHMB: BLOCK 2 ;<IOWD NHOM,HMBBLK>
HMBBLK: BLOCK NHOM ;HOME BLOCK
CMDRIB: BLOCK 2 ;<IOWD 200,BLKRIB>
BLKRIB: BLOCK 200 ;RIB BLOCK
>;END IFN FT$IND
DSKHDR: BLOCK 3 ;DISK BUFFER HEADER
MDATA: BLOCK 1 ;POINTS TO INPUT TAPE DATA AREA
XMTABF: BLOCK 1 ;POINTS TO BUFFER TAKEN OUT OF RING
ERRCNT: BLOCK 1 ;COUNT OF TAPE ERRORS
SUSDF: BLOCK 1 ;SUPERSEDE DISK FILE [206]
FRSHDR: BLOCK M ;CONVERTED FRS BLOCK HEADER
FRSTIM: BLOCK 1 ;LABEL TIME **DON'T CHANGE ORDER**
FRSDAT: BLOCK 1 ;LABEL DATE **DON'T CHANGE ORDER**
FRSDSD: BLOCK 1 ;LABEL DESTROY DATE **DON'T CHANGE ORDER**
FRSSTM: BLOCK 1 ;SAVE SET TIME **DON'T CHANGE ORDER**
FRSSDT: BLOCK 1 ;SAVE SET DATE **DON'T CHANGE ORDER**
FRSSMD: BLOCK 1 ;SAVE SET MODE **DON'T CHANGE ORDER**
FRSSTK: BLOCK 1 ;SAVE SET TRACKS **DON'T CHANGE ORDER**
FRSSTR: BLOCK 1 ;STR NAME **DON'T CHANGE ORDER**
FRSNAM: BLOCK 1 ;FILE NAME **DON'T CHANGE ORDER**
FRSEXT: BLOCK 1 ;EXTENSION **DON'T CHANGE ORDER**
FRSPPN: BLOCK 1 ;FRS PPN **DON'T CHANGE ORDER**
FRSRDB: BLOCK 1 ;RELATIVE DATA BLOCK **DONT' CHANGE ORDER**
FRSSDB: BLOCK 1 ;NBR SDB **DON'T CHANGE ORDER**
FRSSIZ: BLOCK 1 ;SIZE LAST BLOCK **DON'T CHANGE ORDER**
FRSLVL: BLOCK 1 ;SFD DEPTH **DON'T CHANGE ORDER**
FRSHDE==.-1 ;END OF FRS CONVERSION BLOCKS
CSTR: BLOCK 1 ;STRUCTURE
CSTRFL: BLOCK 1 ;STRUCTURE FLAGS
ACSTR: BLOCK 1 ;ALIAS STRUCTURE
CNAM: BLOCK 1 ;FILE
ACNAM: BLOCK 1 ;ALIAS FILE
CEXT: BLOCK 1 ;EXT
ACEXT: BLOCK 1 ;ALIAS EXT
CBLOCK: BLOCK 1 ;LOGICAL BLOCK ON STRUCTURE
CCDATI: BLOCK 1 ;CREATION DATE/TIME
CADATI: BLOCK 1 ;ACCESS DATE
CMDATI: BLOCK 1 ;MODIFY DATE/TIME
CWSIZE: BLOCK 1 ;BLOCK SIZE
LSTSTR: BLOCK 1 ;LAST STRUCTURE FOR LIST FILE COMPARISON
LSTPTH: BLOCK .FXLND+1;PATH FOR LIST FILE COMPARISON
NTPE: BLOCK 1 ;RELATIVE TAPE NUMBER
NSEQ: BLOCK 1 ;RELATIVE SEQUENCE NUMBER
SAVADR: BLOCK 1 ;ORIGINAL MATCHED FILE SPECIFICATION
D75ADR: BLOCK 1 ;DITTO DUE TO /DATE75
SRTDIR: BLOCK 1 ;WHERE TO GO TO SORT DIRECTORIES
SRTFIL: BLOCK 1 ;WHERE TO GO TO SORT FILES
CHKCNT: BLOCK 1 ;COUNT OF CHECK DIFFERENCES
PTHCHK: BLOCK 1 ;CHECKSUM OF ASCIZ FULL PATH BLOCK
PRESTR: BLOCK 1 ;LAST STRUCTURE
PREPPN: BLOCK 1 ;LAST PPN
SAVACS: BLOCK 10 ;PLACE TO SAVE REGISTERS
SVCODE: BLOCK 1 ;SEED WORD
THSRDB: BLOCK 1 ;RELATIVE DATA BLOCK OF FILE
CHKPNT: BLOCK 1 ;CHECKPOINTS
BKSCLS: BLOCK 1 ;BLOCKS PER CLUSTER
DCHBLK: BLOCK NDCH ;FOR DSKCHR UUO
EXLFIL: BLOCK NRIB ;EXTENDED LOOKUPS/ENTERS/RENAMES
EXLUFD: BLOCK NRIB ; ..
DSKBLT: BLOCK 1 ;EITHER BLT OR PUSHJ P,COMPAR
DSKIO: BLOCK 1 ;EITHER DSKIN OR DSKOUT
PTHBLK: BLOCK .FXLND+3;ROOM FOR PATHING
UPTBLK: BLOCK .FXLND+3;ROOM FOR PATHING
APATH: BLOCK .FXLND+3;ROOM FOR PATHING
ADRLST: BLOCK .FXLND ;ADDRESS OF RIBS
STOEND==.-1 ;END OF STORAGE
;&
SUBTTL TAPE FORMAT
;+.AUTOPA.FLAGS.TS8,16,24,32,,,,,,,,,.P0,-1.FILL.LOWER CASE
;.CHAPTER BACKUP TAPE FORMAT
; <NOTE: ^BACKUP IS DESIGNED FOR TWO PRIMARY FUNCTIONS; PERFORMING SYSTEM
;BACKUP AND INTERCHANGING FILES BETWEEN SYSTEMS. ^FOR THE LATTER FUNCTION,
;^BACKUP PROVIDES AN "INTERCHANGE" SWITCH WHICH CAUSES SYSTEM DEPENDENT
;DATA TO BE IGNORED AND ONLY CRITICAL FILE INFORMATION TO BE WRITTEN ON
;TAPE. ^A RESTORE OPERATION IN INTERCHANGE MODE ALSO IGNORES SYSTEM
;DEPENDENT DATA, ALLOWING THE OPERATING SYSTEM TO SUPPLY DEFAULTS WHERE
;NECESSARY. ^ITEMS NOT INCLUDED IN INTERCHANGE
;MODE ARE NOTED IN THE DESCRIPTION WHICH FOLLOWS.
;.HL1 TAPE RECORD TYPES
;<BACKUP TAPES ARE MADE UP OF A SERIES OF TAPE RECORDS OF VARIOUS TYPES.
;^EACH RECORD IS SELF IDENTIFYING. ^ALL RECORDS ON THE TAPE ARE WRITTEN
;AT THE STANDARD LENGTH OF 544(10) WORDS, MADE UP OF A 32(10) WORD HEADER
;AND A 512(10) DATA AREA. ^EVEN IF THE DATA AREA IS NOT NEEDED, OR IS
;ONLY PARTIALLY NEEDED, IT IS FULLY WRITTEN. ^ALL UNDEFINED OR UNUSED
;WORDS ARE WRITTEN WITH ZEROS AND IGNORED ON READ. ^THIS MAXIMIZES
;THE PROBABILITY OF READING OLD TAPES. ^ALSO THE TAPE FORMAT IS INCLUDED
;IN THE LABELS AND THE SAVE SET HEADERS.
; ^THE RECORD TYPES ARE:
;.LS
;.LE;<T$LBL -- TAPE LABEL USED TO IDENTIFY REEL <ID AND
;DESTRUCTION DATE/TIME. ^THIS RECORD IS OPTIONAL, BUT IF PRESENT
;MUST BE AT THE START OF THE TAPE.
;.LE;<T$BEG -- BEGINNING OF A SAVE SET USED TO IDENTIFY WHEN
;THE SAVE SET WAS WRITTEN AND ON WHAT DEVICE OF WHAT SYSTEM.
;^IT ALSO INCLUDES THE SAVE SET NAME. ^THIS RECORD IS MANDATORY
;AND MUST BE THE FIRST RECORD OF THE SAVE SET.
;.LE;<T$END -- END OF A SAVE SET. ^THIS IS IDENTICAL TO THE <T$BEG
;RECORD EXCEPT THAT IT APPEARS AT THE END.
;.LE;<T$FIL -- THIS IS THE ACTUAL DATA WHICH HAS BEEN SAVED. ^IT IS
;THE ONLY TYPE OF RECORD WHICH IS ENCRYPTED. ^IT IS SELF-IDENTIFYING
;AS TO THE POSITION WITHIN THE FILE, BUT CONTAINS ONLY PART OF
;THE FULL PATH NAME OF THE FILE.
;.LE;<T$UFD -- CONTAINS THE INFORMATION FOR EACH DIRECTORY. ^IT
;GIVES ALL INFORMATION NECESSARY TO RE-CREATE THE DIRECTORY.
;(^NOT WRITTEN IN INTERCHANGE MODE.)
;.LE;<T$EOV -- INDICATES END OF VOLUME (FUTURE).
;.LE;<T$COM -- COMMENT (IGNORED).
;.LE;<T$CON -- CONTINUATION OF SAVE SET. ^THIS IS IDENTICAL TO
;<T$BEG EXCEPT THAT IT INDICATES THE CONTINUATION OF THE SAVE
;SET AT THE START OF A NEW VOLUME. ^THIS ENSURES THAT EACH
;VOLUME IS COMPLETELY SELF IDENTIFYING.
;-.ELS
T$LBL==1 ;LABEL IDENTIFICATION RECORD
T$BEG==2 ;SAVE START
T$END==3 ;SAVE END
T$FIL==4 ;DISK FILE DATA
T$UFD==5 ;UFD RIB
T$EOV==6 ;END OF VOLUME
T$COM==7 ;COMMENT
T$CON==10 ;CONTINUE (SAME DATA AS T$BEG-T$END)
T$MAX==T$CON ;MAXIMUM RECORD TYPE
;+.HL1 STANDARD RECORD FORMAT
;^EVERY TAPE RECORD HAS THE SAME GENERAL FORMAT. ^THIS
;CONSISTS OF A 32(10) WORD RECORD HEADER FOLLOWED BY ONE
;PAGE OF DATA (512(10) WORDS). ^ALL RECORD HEADERS START
;WITH THE SAME FIRST TWELVE WORDS. ^THE FIRST SEVEN WORDS ARE:
;.LS.LE;<G$TYPE -- RECORD TYPE AS DESCRIBED IN
;THE PREVIOUS SECTION. ^THIS IS A SMALL POSITIVE INTEGER.
;.LE;<G$SEQ -- RECORD SEQUENCE NUMBER. ^THIS IS INCREMENTED BY
;ONE FOR EACH RECORD ON THE TAPE. ^IF A RECORD IS REPEATED
;BECAUSE OF A TAPE WRITE ERROR, THE NUMBER OF THE REPEATED RECORD
;IS THE SAME AS THAT OF THE ORIGINAL.
;.LE;<G$RTNM -- RELATIVE TAPE NUMBER. ^THIS IS INCREMENTED BY
;ONE FOR EACH VOLUME.
;-.LE;<G$FLAG -- VARIOUS FLAG BITS:
G$TYPE==0 ;RECORD TYPE
G$SEQ==1 ;SEQUENCE NUMBER
G$RTNM==2 ;RELATIVE TAPE NUMBER
G$FLAG==3 ;RECORD DEPENDENT BITS
;+.LS.LE;<GF$EOF -- THIS FLAG IS SET IF THIS IS THE LAST TAPE
;RECORD FOR THIS DISK FILE. ^ON SHORT FILES,
;THIS CAN EVEN BE SET ON THE FIRST RECORD OF THE FILE!
;.LE;<GF$RPT -- THIS FLAG IS SET IF THIS TAPE RECORD IS A REPEAT
;OF THE PREVIOUS RECORD. ^THIS IS SET WHENEVER THE RECORD IS
;REWRITTEN BECAUSE OF A TAPE WRITE ERROR.
;.LE;<GF$NCH -- THIS FLAG IS SET IF NO CHECKSUM HAS BEEN
;COMPUTED FOR THE TAPE RECORD.
;.LE;<GF$SOF -- THIS FLAG IS SET IF THIS IS THE FIRST
;TAPE RECORD FOR THIS DISK FILE.
;-.ELS
GF$EOF==1B0 ;LAST RECORD OF FILE
GF$RPT==1B1 ;REPEAT OF LAST RECORD WRITE ERROR
GF$NCH==1B2 ;IGNORE CHECKSUM
GF$SOF==1B3 ;START OF FILE
;+.LE;<G$CHK -- CHECKSUM OF THE TAPE RECORD.
;.LE;<G$SIZ -- NUMBER OF WORDS USED FOR DATA IN THIS TAPE RECORD.
;.LE;<G$LND -- NUMBER OF WORDS TO SKIP BEFORE THE DATA STARTS.
;.ELS; ^THE NEXT FOUR WORDS ARE RESERVED FOR FUTURE EXPANSION.
;^THE TWELVTH (LAST) WORD IN THE GENERAL SECTION OF THE RECORD
;HEADER IS RESERVED FOR CUSTOMER USE. ^THE REMAINING 20 WORDS IN THE
;RECORD HEADER VARY FOR EACH RECORD TYPE, WITH THE LAST WORD OF EACH
;RECORD HEADER BEING RESERVED FOR CUSTOMER USE. ^IN INTERCHANGE MODE,
;CUSTOMER RESERVED WORDS WILL BE WRITTEN WITH ZEROS ON A SAVE AND IGNORED ON A READ.
;-
G$CHK==4 ;CHECKSUM
G$SIZ==5 ;NUMBER OF DATA WORDS
G$LND==6 ;TOTAL LENGTH OF NON-DATA SECTION
G$CUSW==13 ;RESERVED FOR CUSTOMER USE
;+.HL1 NON-DATA BLOCKS
;^THE DATA PORTION OF A TAPE RECORD IS PRIMARILY FOR STORING FILE DATA, BUT
;MAY BE USED FOR SAVING SOME OVERHEAD INFORMATION. ^ANY NON-DATA
;INFORMATION WRITTEN IN THE DATA AREA OF A TAPE RECORD IS PREFACED
;WITH A CONTROL WORD OF THE FORM:
; <LH = TYPE, <RH = LENGTH IN WORDS INCLUDING THIS WORD.
; ^MORE THAN ONE OVERHEAD REGION CAN APPEAR. ^IN THIS CASE, THEY FOLLOW
;EACH OTHER WITH NO INTERVENING SPACE. ^THE CURRENTLY DEFINED TYPES FOR
;OVERHEAD BLOCKS ARE:
;.LS
;.LE;<O$NAME -- GIVES THE FULL PATH IDENTIFICATION OF THE FILE WITHOUT
;PUNCTUATION. ^THE PATH COMPONENTS ARE TREATED AS IF THE USER GAVE A
;QUOTED REPRESENTATION IN "<DEC ^INTEGRATED ^COMMAND ^LANGUAGE".
;^THIS BLOCK CONSISTS OF SUB-BLOCKS IN THE STANDARD ORDER: DEVICE,
;DIRECTORIES (TOP DOWN), FILE NAME, EXTENTION, VERSION, GENERATION.
;^SUB-BLOCKS CORRESPONDING TO MISSING FIELDS IN THE PATH SPECIFICATION
;ARE OMITTED. ^EACH SUB-BLOCK IS IN THE FORMAT:
; <WORD0: <LH = TYPE, <RH = LENGTH IN WORDS INCLUDING THIS WORD.
; ^THE REST OF THE SUB-BLOCK IS THE PATH FIELD IN <ASCIZ
;WITHOUT LEADING OR IMBEDDED NULLS, TERMINATED BY AT LEAST
;ONE NULL. ^FOR THE <UFD DIRECTORY FIELD, THE PROJECT AND
;PROGRAMMER HALVES ARE CONVERTED TO OCTAL NUMBERS AND SEPARATED
;BY AN UNDERLINE CHARACTER. ^OMITTED FIELDS WILL BE DEFAULTED. ^IN INTERCHANGE
;MODE, ONLY THE NAME, EXTENSION AND VERSION ARE WRITTEN. ^IN
;INTERCHANGE RESTORE, ONLY NAME, EXTENSION AND VERSION ARE USED.
; ^SUB-BLOCK TYPE CODES ARE:
; 1 = DEVICE
; 2 = NAME
; 3 = EXTENSION
; 4 = VERSION
; 5 = GENERATION
; 40 = DIRECTORY (LOWER DIRECTORIES ARE 41,42, ...)
;.LE;<O$FILE -- A BLOCK CONTAINING FILE ATTRIBUTES. ^THE FIRST SECTION
;OF THIS BLOCK IS A FIXED LENGTH HEADER AREA CONTAINING IN FIXED
;LOCATIONS EITHER SINGLE WORD ATTRIBUTES OR BYTE POINTERS TO <ASCIZ
;STRING ATTRIBUTES LOCATED IN THE REMAINING SECTION. ^ALL DATES AND TIME
;ARE IN UNIVERSAL DATE/TIME FORMAT. ^IN INTERCHANGE MODE ONLY THE CRITICAL
;ATTRIBUTES (STARRED) WILL BE WRITTEN, AND THE REST OF THIS BLOCK WILL
;CONTAIN ZEROS. ^IN THE DESCRIPTION WHICH FOLLOWS, THE SYMBOLS IN BRACKETS
;REPRESENT THE <RIB DATA FROM WHICH THE ATTRIBUTE VALUES WILL BE CONVERTED.
;(^IF NONE IS GIVEN, THE LOCATION WILL BE ZERO)
;.LS;.LE;<A$FHLN (*) -- FIXED HEADER LENGTH IN WORDS.
;.LE;<A$FLGS -- FLAGS:
;.LS;.LE;<B$PERM -- PERMANENT (NOT DELETABLE) [<RP.NDL]
;.LE;<B$TEMP -- TEMPORARY
;.LE;<B$DELE -- ALREADY DELETED
;.LE;<B$DLRA -- DON'T DELETE FOR LACK OF RECENT ACCESS [<RP.ABU]
;.LE;<B$NQCF -- NOT QUOTA CHECKED [<RP.NQC]
;.LE;<B$NOCS -- DOES NOT HAVE VALID CHECKSUMS [<RP.ABC]
;.LE;<B$CSER -- HAS CHECKSUM ERROR [<RP.FCE]
;.LE;<B$WRER -- HAS DISK WRITE ERROR [<RP.FWE]
;.LE;<B$MRER -- HAD <BACKUP READ ERROR ON <RESTORE [<RP.BFA]
;.LE;<B$DAER -- DECLARED BAD BY DAMAGE ASSESSMENT [<RP.BDA]
;-.ELS
B$PERM==1B0 ;PERMANENT
B$TEMP==1B1 ;TEMPORARY
B$DELE==1B2 ;ALREADY DELETED
B$DLRA==1B3 ;DON'T DELETE FOR LACK OF RECENT ACCESS
B$NQCF==1B4 ;NOT QUOTA CHECKED
B$NOCS==1B5 ;DOES NOT HAVE VALID CHECKSUMS
B$CSER==1B6 ;HAS CHECKSUM ERROR
B$WRER==1B7 ;HAS DISK WRITE ERROR
B$MRER==1B8 ;HAD <BACKUP READ ERROR ON RESTORE
B$DAER==1B9 ;DECLARED BAD BY DAMAGE ASSESMENT
;TABLE OF BACKUP FLAGS:
BKPFLG: EXP B$PERM
EXP B$TEMP
EXP B$DELE
EXP B$DLRA
EXP B$NQCF
EXP B$NOCS
EXP B$CSER
EXP B$WRER
EXP B$MRER
EXP B$DAER
LN$FLG==.-BKPFLG
;TABLE OF CORRESPONDING RIB FLAGS:
RIBFLG: EXP RP.NDL
EXP Z
EXP Z
EXP RP.ABU
EXP RP.NQC
EXP RP.ABC
EXP RP.FCE
EXP RP.FWE
EXP RP.BFA
EXP RP.BDA
;+.LE;<A$WRIT (*) -- DATE/TIME OF LAST WRITE [<RB.CRD AND <RB.CRT]
;.LE;<A$ALLS (*) -- ALLOCATED SIZE IN WORDS [<.RBALC]
;.LE;<A$MODE (*) -- MODE OF LAST WRITE [<RB.MOD]
;.LE;<A$LENG (*) -- LENGTH IN BYTES (1^B0 IF _> 2_^35-1) [<.RBSIZ]
;.LE;<A$BSIZ (*) -- BYTE SIZE (7 OR 36).
;.LE;<A$VERS (*) -- VERSION IDENTIFICATION (<.JBVER FORMAT) [<.RBVER]
;.LE;<A$PROT -- PROTECTION [<RB.PRV]. ^THE PROTECTION FOR DIRECTORIES APPEARS
;IN THE DIRECTORY ATTRIBUTE BLOCK (<O$DIRT). ^FOR FILES, THE PROTECTION
;WORD IS DEFINED AS FOUR FIELDS OF EIGHT BITS EACH WITH A "5" STORED
;IN THE LEFTMOST THREE BITS IN ORDER TO AVOID LOOKING LIKE A BYTE POINTER:
; BITS 0-2 "5"
; BIT 3 RESERVED FOR FUTURE
; BITS 4-11 FUTURE ACCESS
; BITS 12-19 OWNER ACCESS
; BITS 20-27 AFFINITY GROUP ACCESS
; BITS 28-35 "WORLD" ACCESS
; ^EACH FILE ACCESS FIELD IS SUBDIVIDED INTO BYTES WHICH DESCRIBE THE
;ATTRIBUTE, WRITE AND READ (RESPECTIVELY) PROTECTIONS ASSOCIATED WITH THE
;FILE. ^A DESCRIPTION OF THE "WORLD" ACCESS FIELD FOLLOWS, WITH THE
;ASSOCIATED <TOPS-10 PROTECTION GIVEN IN PARENTHESES, IF APPLICABLE.
;^THE OWNER AND AFFINITY GROUP (PROJECT) FIELDS ARE SIMILARLY DEFINED.
;.LS
;.LE;<PR$SPC (BIT 28) -- RESERVED FOR SPECIAL CHECKING. ^THE REST OF THE FIELD IS
;SPECIAL IF THIS BIT IS SET.
;.LE;<PR$ATR (BITS 29-31) -- THE ATTRIBUTE SUBFIELD IS A 3-BIT BYTE INTERPRETED AS FOLLOWS:
; 0 -- FILE IS COMPLETELY HIDDEN.
; 1 -- FLIE NAME IS VISIBLE (7-6).
; 2 -- FILE ATTRIBUTES ARE VISIBLE (5-2).
; 3 -- CAN CHANGE UNPROTECTED ATTRIBUTES.
; 4-5 -- (FUTURE)
; 6 -- CAN CHANGE PROTECTION (0).
; 7 -- CAN DELETE THE FILE (1).
;.LE;<PR$WRT (BITS 32-33) -- THE WRITE ACCESS SUBFIELD IS DEFINED AS:
; 0 -- NO WRITE ACCESS (7-5).
; 1 -- APPEND (4).
; 2 -- WRITE (3).
; 3 -- SUPERSEDING GENERATION (2-0).
;.LE;<PR$RED (BITS 34-35) -- THE READ ACCESS SUBFIELD IS DEFINED AS:
; 0 -- NO READ ACCESS (7).
; 1 -- EXECUTE ONLY (6).
; 2 -- CAN READ THE FILE (5-0).
; 3 -- (FUTURE).
;.ELS
;.LE;<A$ACCT -- BYTE POINTER TO ACCOUNT STRING
;.LE;<A$NOTE -- BYTE POINTER TO ANNOTATION STRING [<.RBSPL]
;.LE;<A$CRET -- CREATION DATE AND TIME OF THIS GENERATION
;.LE;<A$REDT -- LAST READ DATE AND TIME OF THIS GENERATION [<RB.ACD]
;.LE;<A$MODT -- MONITOR SET LAST WRITE DATE AND TIME [<.RBTIM]
;.LE;<A$ESTS -- ESTIMATED SIZE IN WORDS [<.RBEST]
;.LE;<A$RADR -- REQUESTED DISK ADDRESS [<.RBPOS]
;.LE;<A$FSIZ -- MAXIMUM FILE SIZE IN WORDS
;.LE;<A$MUSR -- BYTE POINTER TO IDENTIFICATION OF LAST MODIFIER
;.LE;<A$CUSR -- BYTE POINTER TO IDENTIFICATION OF CREATOR [<.RBAUT]
;.LE;<A$BKID -- BYTE POINTER TO IDENTIFICATION OF PREVIOUS <BACKUP [<.RBMTA]
;.LE;<A$BKDT -- DATE AND TIME OF LAST BACKUP
;.LE;<A$NGRT -- NUMBER OF GENERATIONS TO RETAIN
;.LE;<A$NRDS -- NUMBER OF OPENS FOR READ THIS GENERATION
;.LE;<A$NWRT -- NUMBER OF OPENS FOR WRITE THIS GENERATION
;.LE;<A$USRW -- UNDEFINED USER WORD [<.RBNCA]
;.LE;<A$PCAW -- PRIVILEGED CUSTOMER WORD [<.RBPCA]
;-.ELS
A$FHLN==0 ;HEADER LENGTH WORD
A$FLGS==1 ;FLAGS
A$WRIT==2 ;CREATION DATE/TIME
A$ALLS==3 ;ALLOCATED SIZE
A$MODE==4 ;MODE
A$LENG==5 ;LENGTH
A$BSIZ==6 ;BYTE SIZE
A$VERS==7 ;VERSION
A$PROT==10 ;PROTECTION
A$ACCT==11 ;BYTE POINTER ACCOUNT STRING
A$NOTE==12 ;BYTE POINTER TO ANONOTATION STRING
A$CRET==13 ;CREATION DATE/TIME OF THIS GENERATION
A$REDT==14 ;LAST READ DATE/TIME OF THIS GENERATION
A$MODT==15 ;MONITOR SET LAST WRITE DATE/TIME
A$ESTS==16 ;ESTIMATED SIZE IN WORDS
A$RADR==17 ;REQUESTED DISK ADDRESS
A$FSIZ==20 ;MAXIMUM FILE SIZE IN WORDS
A$MUSR==21 ;BYTE POINTER TO ID OF LAST MODIFIER
A$CUSR==22 ;BYTE POINTER TO ID OF CREATOR
A$BKID==23 ;BYTE POINTER TO SAVE SET OF PREVIOUS <BACKUP
A$BKDT==24 ;DATE/TIME OF LAST BACKUP
A$NGRT==25 ;NUMBER OF GENERATIONS TO RETAIN
A$NRDS==26 ;NBR OPENS FOR READ THIS GENERATION
A$NWRT==27 ;NBR OPENS FOR WRITE THIS GENERATION
A$USRW==30 ;USER WORD
A$PCAW==31 ;PRIVILEGED CUSTOMER WORD
LN$AFH==32 ;LENGTH OF FIXED HEADER
;PROTECTION BYTES:
AC$OWN==377B19 ;OWNER ACCESS FIELD
AC$GRP==377B27 ;AFFINITY GROUP ACCESS FIELD
AC$WLD==377B35 ;WORLD ACCESS FIELD
PR$ATR==7B31 ;ATTRIBUTE PROTECTION SUBFIELD
PR$WRT==3B33 ;WRITE PROTECTION SUBFIELD
PR$RED==3B35 ;READ PROTECTION SUBFIELD
;+
;^THE REMAINDER OF THIS BLOCK IS RESERVED FOR FUTURE EXPANSION.
;.LE;<O$DIRT -- A BLOCK CONTAINING DIRECTORY ATTRIBUTES (NOT WRITTEN
;IN INTERCHANGE MODE). ^THE FIRST SECTION OF THIS BLOCK IS A FIXED
;LENGTH HEADER AREA CONTAINING EITHER DIRECTORY ATTRIBUTES OR POINTERS
;TO ATTRIBUTES LOCATED IN THE REMAINING SECTION. ^THE SYMBOLS IN
;BRACKETS REPRESENT THE <RIB DATA USED FOR CONVERSION (THE LOCATION IS ZERO
;IF NONE IS GIVEN). ^THE DIRECTORY PROTECTION WORD APPEARS IN THIS BLOCK
;RATHER THAN IN THE <O$FILE BLOCK (<A$PROT IS ZERO FOR DIRECTORIES).
;.LS
;.LE;<D$FHLN -- FIXED HEADER LENGTH IN WORDS
;.LE;<D$FLGS -- DIRECTORY FLAGS:
;.LS.LE;<DF$FOD -- FILES ONLY DIRECTORY
;.LE;<DF$AAL -- ALPHA ACCOUNTS ARE LEGAL
;.LE;<DF$RLM -- REPEAT LOGIN MESSAGES
;-.ELS
DF$FOD==1B0 ;FILES ONLY DIRECTORY
DF$AAL==1B1 ;ALPHA ACCOUNTS ARE LEGAL
DF$RLM==1B2 ;REPEAT LOGIN MESSAGES
;+.LE;<D$ACCT -- ACCOUNT NUMBER OR <ASCII BYTE POINTER TO ACCOUNT STRING
;.LE;<D$PROT -- DIRECTORY PROTECTION [<RB.PRV].
;^THE DIRCTORY PROTECTION WORD IS DIVIDED INTO THE SAME ACCESS FIELDS
;AS THE FILE PROTECTION WORD, <A$PROT, BUT EACH DIRECTORY ACCESS FIELD
;HAS BITS AS FOLLOWS (<RIB BITS GIVEN IN PARENTHESES):
; ^BIT 28 -- RESERVED FOR SPECIAL CHECKING. ^THE REST OF THE
;FIELD IS SPECIAL IS THIS BIT IS SET.
; ^BITS 29-31 -- (FUTURE)
; ^BIT 32 -- CONNECT ALLOWED
; ^BIT 33 -- CAN OPEN FILES (4)
; ^BIT 34 -- CAN CREATE GENERATIONS (2)
; ^BIT 35 -- DIRECTORY CAN BE READ (1)
;.LE;<D$FPRT -- DEFAULT FILE PROTECTION
;.LE;<D$LOGT -- DATE/TIME OF LAST LOGIN IN <DEC-10 UNIVERSAL FORMAT [<RB.CRD AND <RB.CRT]
;.LE;<D$GENR -- DEFAULT NUMBER OF GENERATIONS TO KEEP
;.LE;<D$QTF -- FIRST-COME-FIRST-SERVED LOGGED-IN QUOTA IN WORDS [<.RBQTF]
;.LE;<D$QTO -- LOGGED OUT QUOTA IN WORDS [<.RBQTO]
;.LE;<D$ACSL -- LIST OF GROUPS WHICH CAN ACCESS THIS DIRECTORY (SEE BELOW)
;.LE;<D$USRL -- LIST OF GROUPS WHICH THIS USER IS IN (SEE BELOW)
;.LE;<D$PRVL -- PRIVILEGE LIST (SEE BELOW)
;.LE;<D$PSWD -- <ASCII BYTE POINTER TO PASSWORD
;.ELS
;^THE LIST ATTRIBUTE WORDS GIVEN ABOVE (<D$ACSL, <D$USRL, <D$PRVL)
;MAY BE IN ANY ONE OF THE FOLLOWING FORMATS:
; A) AN <ASCII STRING POINTER
; B) 5^B2 _+ GROUP (OR 5^B2 _+ PRIVILEGE FOR <D$PRVL)
; C) _-^N,,RELATIVE LOCATION OF START OF LIST
; ^IF IN FORMAT (C), EACH WORD OF THE LIST IS 5^B2 _+ GROUP (5^B2 _+ PRIVILEGE FOR <D$PRVL)
;-
D$FHLN==0 ;FIXED HEADER LENGTH WORD
D$FLGS==1 ;DIRECTORY FLAGS
D$ACCT==2 ;ACCOUNT NUMBER
D$PROT==3 ;DIRECTORY PROTECTION
D$FPRT==4 ;DEFAULT FILE PROTECTION
D$LOGT==5 ;LOGIN DATE/TIME
D$GENR==6 ;NUMBER GENERATIONS TO KEEP
D$QTF==7 ;LOGGED-IN QUOTA
D$QTO==10 ;LOGGED-OUT QUOTA
D$ACSL==11 ;ACCESS LIST
D$USRL==12 ;USER LIST
D$PRVL==13 ;PRIVILEGE LIST
D$PSWD==14 ;PASSWORD
LN$DFH==15 ;LENGTH OF DIRECTORY FIXED HEADER
;+.LE;<O$SYSN -- A BLOCK CONTAINING THE SYSTEM HEADER LINE IN <ASCIZ.
;.LE;<O$SSNM -- A BLOCK CONTAINING THE USER SUPPLIED
;SAVE SET NAME IN <ASCIZ (MAX OF 30 CHARACTERS).
;^THIS BLOCK IS OMITTED IF NO SAVE SET NAME WAS SPECIFIED.
;-.ELS
O$NAME==1 ;FULL PATH NAME BLOCK
O$FILE==2 ;FILE ATTRIBUTE BLOCK
O$DIRT==3 ;DIRECTORY ATTRIBUTE BLOCK
O$SYSN==4 ;SYSTEM HEADER BLOCK
O$SSNM==5 ;SAVE SET NAME BLOCK
;+.HL1 LOCATIONS IN T$LBL RECORD
;^THIS RECORD HAS NO CONTENTS IN THE "DATA" REGION. ^THE REMAINING
;LOCATIONS IN THE RECORD HEADER ARE DEFINED AS FOLLOWS:
;.LS
;.LE;<L$DATE -- DATE/TIME OF LABELLING IN <DEC-10 UNIVERSAL FORMAT
;(I.E. <LH=DAYS SINCE 17-^NOV-1858, <RH=FRACTION OF DAY)
;.LE;<L$FMT -- <BACKUP TAPE FORMAT (CONSTANT = 1).
;.LE;<L$BVER -- VERSION OF <BACKUP WRITING LABEL IN STANDARD
;<.JBVER FORMAT.
;.LE;<L$MON -- MONITOR TYPE (%<CNMNT).
;.LE;<L$SVER -- SYSTEM VERSION (<%CNDVN).
;.LE;<L$APR -- <APR PROCESSOR SERIAL NUMBER ON WHICH
;THIS LABEL WAS WRITTEN (INTEGER).
;.LE;<L$DEV -- PHYSICAL DEVICE ON WHICH THE TAPE WAS WRITTEN
;IN <SIXBIT.
;.LE;<L$MTCH -- <BYTE (31) 0 (1) 7-TRACK (1) 0 (3) DENSITY.
;^DENSITY IS 1=200, 2=556, 3=800, 4=1600, 5=6250.
;.LE;<L$RLNM -- <REELID IN <SIXBIT.
;.LE;<L$DSTR -- DATE/TIME BEFORE WHICH TAPE CAN NOT BE SCRATCHED.
;^BEFORE THIS TIME, THE ONLY VALID OPERATION IS TO APPEND.
;-.ELS
L$DATE==14 ;DATE/TIME OF LABELING
L$FMT==15 ;BACKUP FORMAT
L$BVER==16 ;BACKUP VERSION
L$MON==17 ;MONITOR TYPE
L$SVER==20 ;SYSTEM VERSION
L$APR==21 ;APR SERIAL NUMBER WRITING LABEL
L$DEV==22 ;DEVICE ID WRITING LABEL
L$MTCH==23 ;TAPE WRITE PAREMETERS
L$RLNM==24 ;SIXBIT TAPE REEL NAME
L$DSTR==25 ;DATE/TIME FOR DESTRUCTION
L$CUSW==37 ;RESERVED CUSTOMER WORD
;+.HL1 LOCATIONS IN T$BEG, T$END, T$CON RECORDS
;^THESE SAVE SET RECORDS ALL HAVE THE SAME FORMAT AND ARE DISTINGUISHED
;BY THEIR RECORD TYPES AND THEIR LOCATION ON THE TAPE. ^ALL ITEMS ARE
;FILLED IN AT THE TIME OF WRITTING. ^THE DATA AREA CONTAINS TWO NON-DATA
;BLOCKS, TYPES <O$SYSN AND <O$SSNM. ^RECORD HEADER LOCATIONS FOLLOWING
;THE FIRST STANDARD TWELVE WORDS ARE DEFINED AS FOLLOWS:
;.LS
;.LE;<S$DATE -- DATE/TIME OF WRITING THIS RECORD IN UNIVERSAL FORMAT.
;.LE;<S$FMT -- <BACKUP TAPE FORMAT (CONSTANT = 1).
;.LE;<S$BVER -- <BACKUP VERSION IN <.JBVER FORMAT.
;.LE;<S$MON -- MONITOR TYPE (%<CNMNT).
;.LE;<S$SVER -- SYSTEM VERSION (<%CNDVN).
;.LE;<S$APR -- APR SERIAL NUMBER ON WHICH WRITTEN.
;.LE;<S$DEV -- PHYSICAL NAME OF DEVICE ON WHICH WRITTEN IN <SIXBIT.
;.LE;<S$MTCH -- <BYTE (31) 0 (1) 7-TRACK (1) 0 (3) DENSITY.
;^DENSITY IS 1=200, 2=556, 3=800, 4=1600, 5=6250.
;.LE;<S$RLNM -- <REELID IN <SIXBIT.
;-.ELS
S$DATE==14 ;DATE/TIME OF START/END OF SAVE
S$FMT==15 ;RETRIEVAL VERSION
S$BVER==16 ;BACKUP VERSION
S$MON==17 ;MONITOR TYPE
S$SVER==20 ;SYSTEM VERSION
S$APR==21 ;APR SERIAL NUMBER
S$DEV==22 ;DEVICE ID WRITING SAVE SET
S$MTCH==23 ;TAPE WRITE PARAMETERS
S$RLNM==24 ;REELID
S$CUSW==37 ;CUSTOMER WORD
;+.HL1 LOCATIONS IN T$UFD RECORD
;^THIS RECORD IS NOT WRITTEN IN INTERCHANGE MODE.
;^WHEN WRITTEN, THE DATA PORTION CONTAINS TWO OR THREE NON-DATA BLOCKS:
;TYPES <O$NAME, <O$FILE (OPTIONAL) AND <O$DIRT.
;^REMAINING LOCATIONS IN THE HEADER RECORD CONTAIN:
;.LS
;.LE;<D$PCHK -- CHECKSUM OF THE <O$NAME FULL PATH FILE NAME BLOCK.
;.LE;<D$LVL -- DIRECTORY LEVEL: 0=<UFD, 1=FIRST <SFD, ETC.
;.LE;<D$STR -- FILE STRUCTURE NAME STORED IN THE FOLLOWING FORMAT:
;<BYTE (7) DATA TYPE, LENGTH IN WORDS, <ASCII. (^DATA TYPES
;ARE DEFINED IN THE <T$FIL SECTION.)
;-.ELS
D$PCHK==14 ;PATH CHECKSUM
D$LVL==15 ;UFD LEVEL (UFD=0, SFD1=1, ETC.)
D$STR==16 ;STRUCTURE OF UFD ( MAX OF 12(10) WORDS )
D$CUSW==37 ;CUSTOMER WORD
;+.HL1 LOCATIONS IN T$FIL RECORD
;^THE FIRST TAPE RECORD FOR A FILE CONTAINS TWO NON-DATA BLOCKS,
;TYPES <O$NAME AND <O$FILE. ^THERE IS ROOM FOR TWO BLOCKS
;OF FILE DATA IN THE FIRST TAPE RECORD, AND IF THE FILE WILL
;COMPLETELY FIT IN ONE TAPE RECORD, THESE WILL BE USED.
;^IF THE FILE IS LONGER THAN TWO BLOCKS, THE FILE WILL
;BE STARTED IN THE SECOND TAPE RECORD, SO ITS PAGES
;WILL BE LINED UP WITH TAPE RECORDS. ^EACH TAPE RECORD
;IDENTIFIES THE LOGICAL DISK WORD WITH WHICH IT STARTS.
;^REMAINING LOCATIONS IN THE RECORD HEADER ARE:
;.LS
;.LE;<F$PCHK -- CHECKSUM OF THE FULL PATH FILE NAME BLOCK (<O$NAME).
;^THIS IS JUST A CONSISTENCY CHECK FOR CONSECUTIVE RECORDS OF THE FILE.
;.LE;<F$RDW -- RELATIVE DATA WORD OF FILE OF THE FIRST DATA WORD IN THIS TAPE RECORD.
;.LE;<F$PTH -- A TWELVE WORD BLOCK USED TO STORE INFORMATION
;SUITABLE FOR A RESTORATION OF THE FILE. ^THIS AREA IS BIG ENOUGH
;TO HOLD THE ENTIRE PATH TO A <TOPS-10 FILE IN A <UFD AND TWO <SFDS.
;^THE PATH INFORMATION WILL BE STORED IN THE STANDARD ORDER OF
;DEVICE, <UFD, FIRST <SFD, FILE NAME, EXTENSION; WITH MISSING FIELDS OMITTED.
;^THE PATH INFORMATION WILL BE STORED IN THE FORMAT:
;
;<BYTE (7) DATA TYPE, LENGTH IN WORDS, <ASCII
;
;WHERE DATA TYPES ARE DEFINED AS:
;
; DEVICE = 001
; FILE NAME = 002
; EXTENSION = 003
; DIRECTORY = 040
; (LOWER DIRECTORIES = 041,042, ...)
;-.ELS
F$PCHK==14 ;PATH CHECKSUM
F$RDW==15 ;RELATIVE DATA WORD OF FILE
F$PTH==16 ;START OF PATH BLOCK
LN$PTH==14 ;LENGTH OF F$PTH BLOCK
F$CUSW==37 ;RESERVED CUSTOMER WORD
;DATA TYPES:
.FCDEV==1 ;DEVICE
.FCNAM==2 ;FILE NAME
.FCEXT==3 ;EXTENSION
.FCVER==4 ;VERSION
.FCGEN==5 ;GENERATION
.FCDIR==40 ;DIRECTORY
.FCSF1==41 ;FIRST SFD
.FCSF2==42 ;SECOND SFD
SUBTTL INITIALIZATION
;+
;.CHAPTER PROGRAM INITIALIZATION
;-
;+.HL1 INITIALIZATION
;
;^THE START ADDRESS IS ACTUALLY IN THE MODULE <BACKUP. ^WHEN
;COMMANDED TO START A SAVE OR RESTORE OPERATION, IT CALLS THIS MODULE
;AT ENTRY POINT <BACKRS. <BACKRS FIRST CLEARS THE IMPURE STORAGE AREA,
;THEN COPIES VARIOUS MONITOR INFORMATION FOR LATER USE. ^NEXT IT ENABLES
;FOR INTERRUPTS ON TELETYPE INPUT, IF <PSISER IS AVAILABLE IN THE
;MONITOR SOFTWARE CONFIGURATION. ^IT THEN DISPATCHES TO THE APPROPRIATE
;ROUTINE TO EXECUTE THE OPERATION.
;-
BACKRS::SETZB F,STOBEG ;CLEAR STORAGE
MOVE T1,[STOBEG,,STOBEG+1] ;BLT POINTER
BLT T1,STOEND ; ..
IFN FT$IND,<
MOVE T1,[IOWD NHOM,HMBBLK] ;FOR READING HOME BLOCKS
MOVEM T1,CMDHMB ;STORE
MOVE T1,[IOWD 200,BLKRIB] ;FOR READING RIB BLOCKS
MOVEM T1,CMDRIB ;STORE
>;END IFN FT$IND
MOVEI T1,1 ;INITIALIZE TAPE COUNTER
MOVEM T1,NTPE ;STORE
;HERE TO COPY SYSTEM NAME INTO MY CORE AREA
MOVSI T1,-LN$SYS ;FIVE WORDS
MOVX T2,%CNFG0 ;GETTAB WORD
LOOP1: MOVE T3,T2 ;GET GETTAB
GETTAB T3, ;ACCESS
SETZ T3, ;LOSE
MOVEM T3,USYSNM(T1) ;STORE
ADD T2,[1,,0] ;NEXT WORD
AOBJN T1,LOOP1 ;LOOP
;HERE TO COPY VARIOUS OTHER MONITOR WORDS
MOVX T1,%CNMNT ;MONITOR TYPE
GETTAB T1, ;ACCESS
SETZ T1, ;LOSE
MOVEM T1,UMONTP ;STORE
MOVX T1,%CNDVN ;MONITOR VERSION
GETTAB T1, ;ACCESS
SETZ T1, ;LOSE
MOVEM T1,UMONVR ;STORE
IFN FT$RCV,<
TXZ T1,VR.WHO!VR.MIN;LEAVE MAJOR VERSION NBR
LSH T1,-^D24 ;POSITION
CAIL T1,602 ;SEE IF 6.02 OR LATER
TXO F,FL$RCV ;YES, CAN USE RECOVERY CODE
>;END IFN FT$RCV
MOVX T1,%LDMFD ;MFD PPN
GETTAB T1, ;ACCESS
MOVE T1,[1,,1] ;DEFAULT
MOVEM T1,MFDPPN ;STORE
MOVX T1,%CNSER ;GET SERIAL NUMBER
GETTAB T1, ;ACCESS
SETZ T1, ;LOSE
MOVEM T1,UAPRSN ;STORE
;HERE TO ENABLE PSI IF AVAILABLE
MOVX T1,%CNST2 ;SOFTWARE CONFIGURATION
GETTAB T1, ;ACCESS
SETZ T1, ;LOSE
TXNN T1,ST%PSI ;PSISER AVAILABLE?
JRST SETSRT ;SKIP FOLLOWING IF NOT
TXO F,FL$PSI ;FLAG PSI
MOVEI T1,TTYSER ;SERVICE ROUTINE ADDRESS
MOVEM T1,PSIVCT+.PSVNP;STORE NEW PC IN PSI VECTOR
MOVX T1,PS.VTO ;DISABLE WITH DEBRK. UUO
MOVEM T1,PSIVCT+.PSVFL;STORE
MOVEI T1,PSIVCT ;BASE ADDRESS
PIINI. T1, ;INITIALIZE PSI
TXZ F,FL$PSI ;ERROR--CLEAR PSI FLAG
MOVSI T2,'TTY' ;SET DEVICE
MOVX T3,PS.RID ;REASON=INPUT DONE
SETZ T4, ;ZILCH
MOVX T1,PS.FON!PS.FAC;TURN PSI ON
HRRI T1,T2 ;ADDRESS OF ARG BLOCK
PISYS. T1, ;EXEC
TXZ F,FL$PSI ;ERROR--ZILCH PSI FLAG
SETSRT: MOVE T1,S.SRTD## ;GET SORT INDEX
HRRZ T1,SRTDSP(T1) ;GET ADDRESS TO DISPATCH TO
MOVEM T1,SRTDIR ;STORE
MOVE T1,S.SRTF## ;GET SORT INDEX
HRRZ T1,SRTDSP(T1) ;GET ADDRESS TO DISPATCH TO
MOVEM T1,SRTFIL ;STORE
MOVEI T1,F.MTAP ;POINT TO TAPE CHANNEL
DEVNAM T1, ;GET PHYSICAL UNIT NAME
MOVE T1,S.MOPN##+.OPDEV ; (LOGICAL IF UUO FAILS)
MOVEM T1,UPHYN ;STORE FOR LATER
MOVEI T2,.TFDEN ;INDICATE DENSITY
MOVEI T3,F.MTAP ;TAPE CHANNEL
MOVE T1,[XWD 2,T2] ;ARG FOR TAPEOP
TAPOP. T1, ;READ DENSITY
SETZ T1, ;LOSE (NO INFO)
DPB T1,[POINTR (UMTCHR, MT.DEN)];STORE
MOVEI T2,.TFTRK ;TRACK
MOVE T1,[XWD 2,T2] ;RESET ARG
TAPOP. T1, ;GET TRACK
SETZ T1, ;LOSE
DPB T1,[POINTR (UMTCHR, MT.7TR)];STORE TRACK
SKIPN UMTCHR ;SEE IF TAPOP. LOST
JRST [MOVEI T1,F.MTAP ;CHANNEL
MTCHR. T1, ;TRY MTCHR. FOR TAPE CHARACTERISTICS
SETZ T1 ;LOSE
ANDX T1,MT.DEN!MT.7TR ;CLEAR JUNK
MOVEM T1,UMTCHR;SAVE
JRST .+1] ;PROCEED
SKIPGE S.OPER## ;IF WRITE OPERATION,
PUSHJ P,DUMOUT ; ISSUE DUMMY OUTPUT
MOVE T1,S.OPER## ;RETRIEVE FUNCTION
PJRST @CMDTBL-1(T1) ;DISPATCH AND RETURN
CMDTBL: XWD ZERO5,CHKALL
XWD ZERO5,RSTALL
XWD ZERO5,SAVALL
SRTDSP: EXP CPOPJ,ALPSRT,LOCSRT
SUBTTL DISK TO TAPE MAIN ROUTINES
;+
;.CHAPTER DISK TO TAPE MAIN ROUTINES
;-
;+
;<SAVALL IS THE ROUTINE CALLED TO EXECUTE THE SAVE OPERATION. ^IT FIRST WRITES
;A START-OF-SAVE-SET (<T$BEG) RECORD ON TAPE. ^NEXT, IT SELECTS FROM THE SYSTEM'S
;STRUCTURE LIST, FOR FURTHER PROCESSING, THE FILE STRUCTURES INDICATED BY THE USER
;SPEC LIST PASSED FROM THE <BACKUP MODULE. ^WHEN THE SAVE IS COMPLETED
;AN END-OF-SAVE-SET RECORD (<T$END) IS WRITTEN ON TAPE.
;-
SAVALL: PUSHJ P,SAVE1 ;SAVE 1 PERMANENT
;HERE TO WRITE BEGINNING-OF-SAVE RECORD ON TAPE
MOVEI T1,T$BEG ;INDICATE START OF SAVE
SKIPE S.RSUM## ;SEE IF /RESUME
JRST [MTBSR. F.MTAP, ;BACKSPACE IN CASE CRASH WROTE
MTBSR. F.MTAP, ;JUNK ON TAPE
JRST .+2] ;NO T$BEG RECORD IF RESUMING
PUSHJ P,GENSAV ;FILL IN REST OF CHARS
MOVE P1,S.NGST## ;AOBJN WORD FOR STRUCTURE LIST
;HERE TO SELECT A STRUCTURE
GETSTR: SKIPN T1,S.STRS##(P1) ;GET STRUCTURE NAME
JRST FINSTR ;NULL--LIST FINISHED
MOVSI T2,(1B0) ;START WITH BIT 0
MOVNI T3,(P1) ;SET ARG FOR SHIFTING RIGHT
LSH T2,(T3) ;SHIFT TO CORRECT BIT FOR THIS STR
SKIPN S.INIT+.FXDEV ;ANY INITIAL DEVICE?
JRST GETST1 ;NO
CAME T1,S.INIT##+.FXDEV;SEE IF EXACT MATCH
TDNE T2,S.INIT##+FX$STR;OR IF THIS STR INDICATED BY FLAG
SKIPA ;YES
JRST NXTSTR ;NO. DROP THIS STRUCTURE
SETZM S.INIT##+.FXDEV ;ZILCH
GETST1: MOVEM T1,CSTR ;STORE
MOVEM T1,DCHBLK ; ..
MOVEM T2,CSTRFL ; ..
;HERE TO CHECK IF ANY FILE SPEC ASKS FOR STRUCTURE
MOVE SP,S.FRST## ;LOAD ADDRESS OF SPECS
CHKSTR: CAME T1,FX$LEN+.FXDEV(SP);CHECK FOR EXACT MATCH
TDNE T2,FX$LEN+FX$STR(SP); OR IF THIS STR FLAGGED BY SPEC DEVICE
JRST GOTSTR ;OK. USE THIS STRUCTURE
ADDI SP,FX$LEN*2 ;NEXT FILE SPEC
CAMGE SP,S.LAST## ;SKIP IF DONE
JRST CHKSTR ;CONTINUE
JRST NXTSTR ;CHECK NEXT STRUCTURE
;HERE IF AT LEAST ONE FILE SPEC NEEDS THIS STRUCTURE
GOTSTR: PUSH P,.JBFF## ;SAVE JOBFF
PUSH P,.JBREL## ;SAVE JOBREL
PUSHJ P,SAVSTR ;SAVE STRUCTURE
POP P,T1 ;RESTORE JOBREL
PUSHJ P,DRPCOR ;DROP CORE USED FOR THIS STR
POP P,.JBFF## ;RESTORE JOBFF
TXNE F,FL$KIL ;SEE IF OPERATOR SAID KILL
POPJ P, ; YES--QUIT NOW
NXTSTR: AOBJN P1,GETSTR ;LOOP FOR ALL STRUCTURES
;HERE TO WRITE END-OF-SAVE RECORD ON TAPE
FINSTR: TXO F,FL$END ;WILL FORCE OUTPUT OF ALL BUFFERS
MOVEI T1,T$END ;INDICATE END OF SAVE
PUSHJ P,GENSAV ;WRITE REST OF RECORDS
CLOSE F.MTAP, ;CLOSE CHANNEL
JRST CPOPJ1 ;RETURN TO BACKUP WITH OPERATION DONE
;+
;<GENSAV IS A SUBROUTINE TO GENERATE THE SAVE SET RECORDS.
;^IT IS CALLED WITH ^T1 = RECORD TYPE (<T$BEG, <T$CON, <T$END).
;-
GENSAV: MOVEM T1,G$TYPE(MH) ;STORE
MOVE T1,UMONTP ;GET MONITOR TYPE
MOVEM T1,S$MON(MH) ;STORE
MOVE T1,UMONVR ;GET MONITOR VERSION
MOVEM T1,S$SVER(MH) ;STORE
MOVEI T1,FORMAT ;CURRENT BACKUP FORMAT
MOVEM T1,S$FMT(MH) ;STORE
MOVE T1,.JBVER## ;BACKUP VERSION
MOVEM T1,S$BVER(MH) ;STORE
MOVX T1,%CNDTM ;GET DATE/TIME
GETTAB T1, ;ACCESS O/S
SETZ T1, ;SUBSTITUTE ZERO
MOVEM T1,S$DATE(MH) ;STORE
MOVE T1,UPHYN ;GET PHYSICAL DEVICE NAME
MOVEM T1,S$DEV(MH) ;STORE
MOVE T1,UAPRSN ;GET SERIAL NUMBER
MOVEM T1,S$APR(MH) ;STORE
MOVE T1,UMTCHR ;GET CHARACTERISTICS
MOVEM T1,S$MTCH(MH) ;STORE
MOVE T2,UPHYN ;PHYSICAL TAPE NAME
MOVE T1,[.MTRID,,T2] ;ARG FOR MTCHR.
MTCHR. T1, ;GET REELID
SETZ T3, ;LOSE
MOVEM T3,S$RLNM(MH) ;STORE
MOVEI T2,M(MH) ;LOC FOR SYSTEM NAME BLOCK
MOVEI T1,LN$SYS+2 ;TOTAL LENGTH
HRLI T1,O$SYSN ;TYPE CODE
MOVEM T1,(T2) ;STORE
MOVEI T1,1(T2) ;LOC FOR SYSTEM NAME
HRLI T1,USYSNM ;WHERE I HAVE IT
BLT T1,LN$SYS(T2) ;XFR
SETZM LN$SYS+1(T2) ;INSURE TRAILING NULL FOR ASCIZ
ADDI T2,LN$SYS+2 ;UPDATE POINTER
SKIPN S.SSNM## ;SEE IF SAVE SET NAME SUPPLIED
JRST LSTSAV ;NO, OMIT O$SSNM BLOCK
HRLI T1,O$SSNM ;TYPE CODE FOR SAVE SET NAME
HRRI T1,LN$SSN+2 ;NUMBER OF WORDS
MOVEM T1,(T2) ;STORE CONTROL WORD
MOVEI T1,1(T2) ;LOC FOR SAVE SET NAME
HRLI T1,S.SSNM## ;WHERE IT IS
BLT T1,LN$SSN(T2) ;XFR
SETZM LN$SSN+1(T2) ;INSURE TRAILING NULL
ADDI T2,LN$SSN+2 ;UPDATE
LSTSAV: SETZM (T2) ;FIRST CLEAR REST OF TAPE BUFFER
MOVSI T1,(T2) ;MAKE BLT POINTER
HRRI T1,1(T2) ; ...
BLT T1,MTBBKP-1(MH) ;ZILCH
SUBI T2,M(MH) ;SUBTRACT START ADDRESS
MOVEM T2,G$LND(MH) ;STORE TOTAL LENGTH NON-DATA
PUSHJ P,LSTXXX ;LIST START/END OF SAVE
JRST MTAOUT ;SEND BUFFER & RETURN
;+
;<SAVSTR IS CALLED ONCE FOR EACH STRUCTURE INDICATED BY THE USER'S SPEC
;LIST. <IO CHANNELS ARE INITIALIZED AND THE FILE STRUCTURE'S <MFD READ
;INTO CORE, AND SORTED IF NEEDED. ^THEN THE ^^UFD\\S SPECIFIED FOR THE
;CURRENT STRUCTURE ARE CHOSEN OUT OF THE <MFD FOR FURTHER PROCESSING.
;-
SAVSTR: PUSHJ P,SAVE2 ;SAVE 2 PERMANENTS
TXZ F,FL$STR ;INITIALIZE STRUCTURE SEEN BIT
;HERE TO GET CHARACTERISTICS OF STRUCTURE
MOVE T1,[NDCH,,DCHBLK] ;CALL TO DSKCHR UUO
DSKCHR T1,UU.PHY ;GET STATUS OF STRUCTURE
TDZA T1,T1 ;ASSUME NO SUPER I/O
LDB T1,[POINTR (DCHBLK+.DCUCH,DC.UCC)] ;GET BLOCKS PER CLUSTER
MOVEM T1,BKSCLS ;STORE
;HERE TO INITIALIZE ALL STRUCTURE CHANNELS
MOVE T1,[EXP UU.PHS+.IODMP] ;DUMP MODE
MOVE T2,CSTR ;CURRENT STRUCTURE
SETZ T3, ;NO BUFFERS
OPEN MFD,T1 ;OPEN CHANNEL FOR MFD
JRST DVFAIL ;LOSE
OPEN STR,T1 ;OPEN CHANNEL FOR SCREWING AROUND
JRST DVFAIL ;LOSE
MOVE P1,[-.FXLND,,UFD] ;LEVELS AND CHANNELS
OPNCHN: HRLZ T4,P1 ;GET LEVEL
LSH T4,5 ;SHIFT TO AC FIELD
IOR T4,[OPEN T1] ;FORM OPEN UUO
XCT T4 ;OPEN LEVEL
JRST DVFAIL ;LOSE
AOBJN P1,OPNCHN ;LOOP FOR ALL LEVELS
HRRI T1,.IOBIN ;BUFFERED BINARY MODE
MOVEI T3,DSKHDR ;BUFFER HEADER
OPEN FILE,T1 ;OPEN CHANNEL FOR DISK FILE
JRST DVFAIL ;LOSE
MOVEI T1,NDSKBF ;NBR DISK BUFFERS
SKIPE S.FFA## ;SEE IF [1,2]
MOVEI T1,OPRNDB ;USE LARGER NBR DISK BUFFERS
INBUF FILE,(T1) ;GENERATE DISK BUFFERS
IFN FT$IND,<
TXNN F,FL$IND ;INDEPENDENT IO?
JRST CONT1 ;NO--CONTINUE
MOVE T1,[STR_5,,[EXP HMBNBR]] ;ARG FOR SUPER USETI
SUSET. T1, ;SET TARGET BLOCK
HALT . ;***TEMP***
INPUT STR,CMDHMB ;READ INTO CORE
MOVSI T1,'HOM' ;INSURE HOME BLOCK
CAME T1,HMBBLK+.HMNAM; ..
JRST NOHOME ;TELL HIM IT IS INACCESSABLE
MOVE T1,[STR_5,,HMBBLK+.HMMFD] ;ARG FOR SUPER USETI
SUSET. T1, ;SET TARGET BLOCK
HALT . ;***TEMP***
INPUT STR,CMDRIB ;READ IN RIB
>;END IFN FT$IND
;HERE TO READ MFD INTO CORE
CONT1: SETZM EXLUFD ;ZERO EXTENDED BLOCK
MOVE T1,[EXLUFD,,EXLUFD+1] ; ..
BLT T1,EXLUFD+NRIB-1; ..
MOVEI T1,NRIB-1 ;SET BLOCK FOR LOOKUP
MOVEM T1,EXLUFD+.RBCNT; ..
MOVE T1,MFDPPN ; ..
MOVEM T1,EXLUFD+.RBPPN; ..
MOVEM T1,EXLUFD+.RBNAM; ..
MOVSI T1,'UFD' ; ..
MOVEM T1,EXLUFD+.RBEXT; ..
LOOKUP MFD,EXLUFD ;EXTENDED LOOKUP
JRST ELUFD ;LOSE
SKIPG T1,EXLUFD+.RBSIZ;HOW BIG IS IT?
JRST RLSSTR ;NULL--DROP IT
PUSHJ P,UCORE ;GET CORE TO READ MFD
SKIPA ;CORE NOT AVAILABLE
JRST CONT2 ;CONTINUE
WARN$N (CCM,Cannot copy MFD for)
MOVE T1,CSTR ;TYPE STR NAME
PUSHJ P,SIXOUT ; ...
OUTSTR CRLF ;<CR><LF>
JRST RLSSTR ;DROP THIS STR
CONT2: MOVNS T1 ;NEGATE
HRL P1,T1 ;PUT NEGATIVE SIZE IN LH P1
SUBI P1,1 ;ADJUST IOWD FOR INPUT CMD
SETZ P2, ;ZERO NEXT CMD WORD
INPUT MFD,P1 ;TRY TO READ MFD INTO CORE
PUSHJ P,@SRTDIR ;SORT IT
;HERE TO SELECT A UFD
GETUFD: SKIPE T1,1(P1) ;GET FIRST UFD
CAMN T1,MFDPPN ;DO NOT REPEAT MFD
JRST NXTUFD ;LOSE
HLRZ T2,2(P1) ;GET EXTENSION
CAIE T2,'UFD' ;IT HAD BETTER BE UFD
JRST NXTUFD ;NOT--FORGET THIS ONE
SKIPN S.INIT##+.FXDIR ;ANY INITIAL PPN?
JRST GETUF1 ;NO
CAME T1,S.INIT##+.FXDIR;MATCH?
JRST NXTUFD ;NO--DROP PPN
SETZM S.INIT##+.FXDIR ;ZILCH
GETUF1: MOVEM T1,PTHBLK+.PTPPN;STORE IN PATH BLOCK
SETZM PTHBLK+.PTPPN+1 ;ZILCH NEXT WORD
;HERE TO CHECK IF ANY FILE SPEC ASKS FOR THIS UFD ON THIS STRUCTURE
MOVE SP,S.FRST## ;GET ADDRESS OF SPECS
CHKUFD: MOVE T1,CSTRFL ;GET STRUCTURE FLAG
TDNN T1,FX$LEN+FX$STR(SP);CHECK INPUT STR SPEC
JRST CHKUF1 ;STR NO GOOD
MOVE T3,PTHBLK+.PTPPN;GET CURRENT PPN
XOR T3,FX$LEN+.FXDIR(SP) ;GET DIFF
AND T3,FX$LEN+.FXDIM(SP) ;ZERO DON'T CARES
JUMPE T3,GOTUFD ;BRANCH IF GOOD PPN
CHKUF1: ADDI SP,FX$LEN*2 ;NEXT SPEC
CAMGE SP,S.LAST## ;SKIP IF DONE
JRST CHKUFD ;CHECK NEXT SPEC
JRST NXTUFD ;NO ONE WANTS IT
;HERE IF AT LEAST ONE FILE SPEC NEEDS THIS UFD ON THIS STR
GOTUFD: MOVEI LVL,0 ;START AT LEVEL ZERO
TXZ F,FL$UFD ;UFD USE FLAG
PUSH P,.JBFF## ;SAVE JOBFF
PUSH P,.JBREL## ;SAVE JOBREL
PUSHJ P,SAVUFD ;SAVE FILES
POP P,T1 ;RESTORE JOBREL
PUSHJ P,DRPCOR ;DROP CORE USED FOR THIS UFD
POP P,.JBFF## ;RESTORE JOBFF
TXNE F,FL$KIL ;SEE IF OPERATOR SAID KILL
JRST RLSSTR ;YES
NXTUFD: AOBJN P1,.+1 ;SKIP ONE WORD
AOBJN P1,GETUFD ;CHECK NEXT UFD
;HERE TO RELEASE ALL STR CHANNELS
RLSSTR: RELEAS FILE, ;DONE
RELEAS STR, ; ..
RELEAS MFD, ; ..
MOVE T1,[-.FXLND,,UFD] ;LEVELS AND CHANNELS
RLSUFD: HRLZ T2,T1 ;GET CHANNEL INTO LH
LSH T2,5 ;SHIFT TO AC POSITION
TLO T2,(<RELEAS>) ;FORM RELEASE UUO
XCT T2 ;EXECUTE
AOBJN T1,RLSUFD ;LOOP FOR ALL
POPJ P, ;RETURN
;+
;<SAVUFD IS CALLED ONCE FOR EACH <UFD AND <SFD WHICH MATCHES A DIRECTORY
;SPEC IN THE USER'S LIST. ^THE <UFD OR <SFD <RIB IS READ INTO CORE AND SAVED
;FOR LATER USE IN WRITING <T$UFD RECORDS ON TAPE. ^NEXT, THE <UFD
;OR <SFD ITSELF IS READ INTO CORE AND SORTED, IF NEEDED. ^THE DIRECTORY
;IS THEN SEARCHED FOR FILES WHICH MATCH AN ENTRY IN THE USER'S SPEC LIST.
;^FILES WHICH MATCH A SPEC ARE THEN CHECKED TO SEE IF THEY ALSO
;MATCH ALL USER SET SWITCH RESTRICTIONS. ^FOR A FILE WHICH MATCHES,
;A <T$UFD RECORD IS WRITTEN ON TAPE FOR EACH DIRECTORY IN THE FILE'S
;PATH (UNLESS THE <INTERCHANGE SWITCH WAS GIVEN) AND THEN THE FILE IS SAVED.
;-
SAVUFD: PUSHJ P,SAVE2 ;SAVE C(P1) & C(P2)
;HERE TO LOOKUP THE UFD
SETZM EXLUFD ;ZERO BLOCK
MOVE T1,[EXLUFD,,EXLUFD+1] ; ..
BLT T1,EXLUFD+NRIB-1; ..
MOVEI T1,NRIB-1 ;SET BLOCK
MOVEM T1,EXLUFD+.RBCNT; ..
JUMPG LVL,SETSFD ;SET SFD BLOCK?
MOVE T1,MFDPPN ; ..
MOVE T2,PTHBLK+.PTPPN;CURRENT PPN
MOVSI T3,'UFD' ; ..
JRST SETFIN ;FINISH UP
SETSFD: MOVE T1,[PTHBLK,,UPTBLK] ;BLT POINTER
BLT T1,UPTBLK+.PTPPN-1(LVL) ;TRANSFER
SETZM UPTBLK+.PTPPN(LVL) ;ZILCH LAST ONE
MOVEI T1,UPTBLK ;PATH BLOCK
MOVE T2,PTHBLK+.PTPPN(LVL) ;GET SFD NAME
MOVSI T3,'SFD' ;EXTENSION
SETFIN: MOVEM T1,EXLUFD+.RBPPN;STORE
MOVEM T2,EXLUFD+.RBNAM; ..
MOVEM T3,EXLUFD+.RBEXT; ..
MOVSI T1,UFD(LVL) ;GET CHANNEL IN LH
LSH T1,5 ;PUT IN AC FIELD
IOR T1,[LOOKUP EXLUFD] ;FORM UUO
XCT T1 ;EXEC IT
JRST ELUFD ;LOSE
;HERE TO SAVE A COPY OF THE UFD RIB FOR LATER USE.
;THE RIB INFO IS WRITTEN ON TAPE IN A T$UFD RECORD AND IS USED WHEN
;IN ORDER TO ENTER A SUBSEQUENT FILE ON TAPE THIS UFD IS NEEDED
MOVEI T1,NRIB ;NEED CORE
PUSHJ P,UCORE ;GET IT
SKIPA ;CORE NOT AVAILBLE
JRST CNTUFD ;CONTINUE
WARN$N (CCR,Cannot copy UFD/SFD RIB for)
MOVEI P1,EXLUFD ;INDICATE WHICH
PUSHJ P,GUUO ;TYPE SPEC
JRST CLSUF1 ;LOSE
CNTUFD: MOVEM P1,ADRLST(LVL) ;STORE FOR LATER REF
MOVE T1,P1 ;WHERE TO SAVE IT
HRLI T1,EXLUFD ;WHERE IT NOW IS
BLT T1,NRIB(P1) ;XFR
;HERE TO READ THE DIRECTORY INTO CORE
SKIPG T1,EXLUFD+.RBSIZ;SEE IF SIZABLE
JRST CLSUF1 ;DROP IT IF NULL
PUSHJ P,UCORE ;EXPAND CORE
SKIPA ;CORE NOT AVAILABLE
JRST CNTLVL ;CONTINUE
WARN$N (CCU,Cannot copy UFD/SFD for)
MOVEI P1,EXLUFD ;INDICATE WHICH
PUSHJ P,GUUO ;TYPE SPEC
JRST CLSUF1 ;LOSE
CNTLVL: MOVNS T1 ;NEGATE LENGTH
HRL P1,T1 ;MAKE DUMP MODE IO COMMAND WORD
SUBI P1,1 ;COMPUTE IOWD
SETZ P2, ;ZERO NEXT CMD WORD
MOVSI T1,UFD(LVL) ;GET CHANNEL IN LH
LSH T1,5 ;PUT IN AC FIELD
IOR T1,[INPUT P1] ;FORM UUO
XCT T1 ;EXEC IT
PUSHJ P,@SRTFIL ;SORT IT
;HERE TO SELECT A FILE
GETFIL: SKIPN T1,1(P1) ;GET A FILE NAME
JRST NXTFIL ;NOT INTERESTED IN NULLS
MOVEM T1,CNAM ;STORE
HLRZ T1,2(P1) ;GET EXTENSION
CAIE T1,'SFD' ;SFD?
JRST NOTSFD ;NO--DO NORMAL HANDLING
;***START OF SFD NESTING HANDLER***
CAIGE LVL,.FXLND-1 ;LEVEL EXCEEDED?
AOJA LVL,SAFE1 ;NO--CONTINUE
TXON F,FL$SLE ;ISSUE ONCE
WARN$ (SLE,SFD level exceeded)
JRST NXTFIL ;GET NEXT FILE
SAFE1: MOVE T2,LVL ;COPY LEVEL
IMULI T2,2 ;MAKE INDEX FOR S.INIT SPEC
SKIPN T3,S.INIT+.FXDIR(T2) ;ANY INITIAL SFD?
JRST SAFE2 ;NO
CAME T3,CNAM ;SEE IF MATCH
SOJA LVL,NXTFIL ;NO, DROP IT
SETZM S.INIT+.FXDIR(T2) ;MATCH--ZILCH
SAFE2: HRLZM T1,CEXT ;SAVE 'SFD' EXTENSION
MOVE T2,CNAM ;GET SFD NAME
MOVEM T2,PTHBLK+.PTPPN(LVL) ;STORE IN PATH BLOCK
SETZM PTHBLK+.PTPPN+1(LVL) ;ZILCH NEXT ENTRY
MOVE SP,S.FRST## ;ADDRESS OF SPECS
CHKSFD: PUSHJ P,VER1 ;VERIFY STR,UFD,SFD'S
JRST CHKSF1 ;NO GOOD--SKIP THIS SPEC
PUSH P,.JBFF## ;SAVE C(JOBFF)
PUSH P,.JBREL## ;SAVE JOBREL
PUSHJ P,SAVUFD ;MATCH--CALL UFD(SFD) HANDLER
POP P,T1 ;RESTORE JOBREL
PUSHJ P,DRPCOR ;DROP CORE IF SAVINGS OF 2K
POP P,.JBFF## ;RESTORE C(JOBFF)
SETZM PTHBLK+.PTPPN(LVL) ;ZERO
TXNE F,FL$KIL ;SEE IF OPERATOR SAID KILL
SOJA LVL,CLSUF1 ;YES--UNNEST
SOJA LVL,NXTFIL ;CONTINUE
CHKSF1: ADDI SP,FX$LEN*2 ;UP ADDRESS
CAMGE SP,S.LAST## ;SKIP IF DONE
JRST CHKSFD ;CHECK NEXT
SETZM PTHBLK+.PTPPN(LVL) ;ZERO
SOJA LVL,NXTFIL ;CONTINUE
;***END OF SFD NESTING HANDLER***
;HERE IF THE CURRENT FILE IS NOT AN SFD
NOTSFD: SKIPE S.INIT+.FXDIR+2(LVL);SEE IF INITIAL SFD GIVEN
JRST NXTFIL ;YES, DROP THIS FILE
SKIPN T2,S.INIT+.FXNAM;ANY INITIAL FILE NAME?
JRST SETEXT ;NO
HLRZ T3,S.INIT+.FXEXT;GET INITIAL EXTENSION
CAMN T2,CNAM ;MATCH?
CAME T3,T1 ;EXTENSION MUST MATCH TOO
JRST NXTFIL ;NO, DROP IT
SETZM S.INIT+.FXNAM ;YES, ZILCH
SETEXT: HRLZM T1,CEXT ;STORE
HRRZ T1,2(P1) ;GET COMPRESSED-FILE-POINTER
IMUL T1,BKSCLS ;COMPUTE LOGICAL BLOCK ON STR
MOVEM T1,CBLOCK ;STORE
TLNE T1,(77774B14) ;MAKE SURE IT FITS IN SUSET.
SETZM CBLOCK ;IF NOT, CLEAR
;HERE TO CHECK IF ANY FILE SPEC ASKS FOR THIS FILE
MOVE SP,S.FRST## ;ADDRESS OF SPECS
SETZ P2, ;FLAG INITIAL READ OF FILE RIB
CHKFIL: PUSHJ P,VER1 ;CHECK FILE ID
JRST CHKFI1 ;NO GOOD
PUSHJ P,VER2 ; ..
JRST CHKFI1 ; ..
JUMPL P2,CHKSWT ;IF READ & DECODED ALREADY, GO CHECK SWITCHES
SKIPN S.USET## ;SKIP IF SHOULD USE SUPER USETIS
JRST STNCHK ;NO--USE LOOKUP UUO
MOVSI T1,STR_5 ;GET CHANNEL
ADD T1,CBLOCK ;GET BLOCK NUMBER
SKIPE CBLOCK ;IF SET,
SUSET. T1, ;SET TARGET BLOCK
JRST STNCHK ;FAILURE
MOVE T1,[IOWD NRIB,EXLFIL] ;MAKE COMMAND WORD
SETZ T2, ;ZILCH SECOND COMMAND WORD
INPUT STR,T1 ;READ INTO CORE
MOVE T1,EXLFIL+.RBPPN;VERIFY RIB BLOCK
CAME T1,PTHBLK+.PTPPN; ..
JRST STNCHK ; ..
MOVE T1,EXLFIL+.RBNAM; ..
CAME T1,CNAM ; ..
JRST STNCHK ; ..
HLLZ T1,EXLFIL+.RBEXT; ..
CAMN T1,CEXT ; ..
JRST DECODE ;GO DECODE RIB
STNCHK: SETZM EXLFIL ;ZERO LOOKUP BLOCK
MOVE T1,[EXLFIL,,EXLFIL+1] ; ..
BLT T1,EXLFIL+NRIB-1; ..
MOVEI T1,NRIB-1 ;LIMIT OF ARGS
MOVEM T1,EXLFIL+.RBCNT; ..
CAIGE LVL,1 ;SEE IF FILE ACTUALLY IN SFD
SKIPA T1,PTHBLK+.PTPPN;IT IS IN UFD. DO NOT SUPPLY PATH ADDR
MOVEI T1,PTHBLK ;PPN AND SFD PATH
MOVEM T1,EXLFIL+.RBPPN; ..
MOVE T1,CNAM ;NAME
MOVEM T1,EXLFIL+.RBNAM; ..
MOVE T1,CEXT ;EXT
MOVEM T1,EXLFIL+.RBEXT; ..
LOOKUP STR,EXLFIL ; ..
JRST GOTFIL ;ASSUME FILE IS GOOD
CLOSE STR,CL.ACS ; ..
;HERE TO CHECK IF FILE SATISFIES USER SWITCH RESTRICTIONS
DECODE: MOVEI T1,RP.NFS ;CHECK NO SAVE BIT
TDNE T1,EXLFIL+.RBSTS;ON?
JRST NXTFIL ;YES--SKIP THIS ONE
MOVE T1,EXLFIL+.RBSIZ;GET FILE SIZE
MOVEM T1,CWSIZE ;STORE
SETZ T1, ;ZERO ACCESS TIME
LDB T2,[POINTR (EXLFIL+.RBEXT,RB.ACD)] ;GET ACCESS DATE
PUSHJ P,CONVDT ;CONVERT TO SMITHSONIAN DATE/TIME
MOVEM T1,CADATI ;STORE
LDB T1,[POINTR (EXLFIL+.RBPRV,RB.CRT)] ;GET CREATION TIME
IMULI T1,^D60000 ;CONVERT TO MILLISECONDS
LDB T2,[POINTR (EXLFIL+.RBEXT,RB.CRX)] ;GET EXTENSION OF CREATION
LSH T2,^D12 ;SHIFT OVER
LDB T3,[POINTR (EXLFIL+.RBPRV,RB.CRD)] ;GET BASE CREATION DATE
IOR T2,T3 ;UNITE
PUSHJ P,CONVDT ;CONVERT TO SMITHSONIAN DATE/TIME
MOVEM T1,CCDATI ;STORE
MOVE T1,EXLFIL+.RBTIM ;GET INTERNAL DATE/TIME
MOVEM T1,CMDATI ;SET FOR CHECKER
SETO P2, ;FLAG DECODING DONE
CHKSWT: PUSHJ P,CHKLIM ;CHECK LIMITS
JRST CHKFI1 ;NO GOOD
JRST [TXON F,FL$D75 ;ONLY GOOD BECAUSE DATE75
MOVEM SP,D75ADR; SAVE FOR LATER
JRST CHKFI1] ;CONTINUE LOOP, NOT COUNTING MATCH
TXON F,FL$MAT ;FLAG FIND
MOVEM SP,SAVADR ;SAVE ADDRESS
AOS FX$CNT(SP) ;COUNT MATCH
CHKFI1: ADDI SP,FX$LEN*2 ;ADVANCE TO NEXT SPEC
CAMGE SP,S.LAST## ;SKIP IF DONE
JRST CHKFIL ;CHECK NEXT SPEC
TXZN F,FL$MAT ;ANY FILE MATCH?
JRST [TXZN F,FL$D75 ;NOT MATCH, SEE IF DATE75 WORKS
JRST NXTFIL ;NO--JUST IGNORE FILE
MOVE SP,D75ADR ;YES--USE DATE75 MATCH
JRST GOTFIL] ;AND PROCEED
MOVE SP,SAVADR ;YES. RESTORE C(SP)
;HERE IF AT LEAST ONE FILE SPEC NEEDS THIS FILE
GOTFIL: SKIPE S.TYMS## ;SKIP IF TYPE OUT WANTED
TXOE F,FL$UFD ;FIRST FILE--ANY PREVIOUS?
JRST GOTFL1 ;YES--GO SAVE IT
HLRZ T1,PTHBLK+.PTPPN;GET PROJECT
PUSHJ P,OCTOUT ;TYPE
OUTCHR COMMA ; ..
HRRZ T1,PTHBLK+.PTPPN;GET PROGRAMMER
PUSHJ P,OCTOUT ;TYPE
TXOE F,FL$STR ;SEE IF FIRST TIME FOR STR
JRST RECUFD ;NOPE--FORGET THIS
OUTCHR TAB ;TAB OVER
MOVE T1,CSTR ;GET STR NAME
PUSHJ P,SIXOUT ;TYPE IT
RECUFD: OUTSTR CRLF ;<CR><LF>
GOTFL1: PUSHJ P,XALIAS ;DO ALIASING
SKIPN S.INTR## ;SEE IF /INTERCHANGE
PUSHJ P,WRTUFD ;NO--WRITE T$UFD RECORDS ON TAPE
MOVEI T1,2 ;SEE IF FILE NAMES WANTED
CAMN T1,S.TYMS## ;SKIP IF NOT
PUSHJ P,TYPFIL ;TYPE FILE NAME
PUSH P,NTPE ;SAVE TAPE NUMBER
PUSHJ P,SAVFIL ;SAVE THE FILE
POP P,T1 ;GET TAPE NUMBER BACK
TXNE F,FL$KIL ;SEE IF OPERATOR SAID KILL
JRST CLSUF1 ;YES, STOP NOW
CAMN T1,NTPE ;SEE IF TAPE NUMBER CHANGED
JRST NXTFIL ;NO, PROCEED
TXZ F,FL$UFD ;ZILCH SO PPN WILL BE TYPED
SKIPE S.REPT## ;/REPEAT?
JRST GOTFIL ;YES--SAVE THIS FILE AGAN
NXTFIL: AOBJN P1,.+1 ;ONE WORD
AOBJN P1,GETFIL ;TWO
;HERE TO TERMINATE I/O TO THIS UFD
CLSUF1: MOVSI T1,UFD(LVL) ;GET CHANNEL IN LH
LSH T1,5 ;PUT IN AC FIELD
IOR T1,[CLOSE CL.ACS] ;FORM UUO
XCT T1 ;EXEC IT
SETZM ADRLST(LVL) ;ZILCH IN CASE NO FILE FOUND
SKIPN S.LIST## ;SEE IF /LIST,
POPJ P, ;NO--RETURN
;AVOID SPAWNING A ZILLION FILES - I.E. ONE/PPN [176]
SETZ T1, ; A SPOOLED LPT? [176]
DEVTYP T1, ; GET DEVICE TYPE BITS [176]
JRST CLSUF2 ; ERROR RET - IGNORE [176]
JUMPE T1,CLSUF2 ; NOT A DEVICE OR NOT INITED [176]
TXNN T1,TY.SPL ; A SPOOLED DEVICE? [176]
JRST CLSUF2 ; NO [176]
LDB T1,[POINT 6,T1,35]; GET DEVICE TYPE [176]
CAIN T1,.TYLPT ; IS IT A LPT? [176]
POPJ P, ; YES, AVOID PRESERVE CODE [176]
;HERE TO PRESERVE LISTING FILE IN CASE OF SYSTEM CRASH
CLSUF2: CLOSE F.LIST, ;CLOSE LISTING FILE [176]
LOOKUP F.LIST,S.LENT## ;DO LOOKUP
JRST LSTERR ;REPORT ERROR
ENTER F.LIST,S.LENT## ;RE-ENTER
JRST LSTERR ;OUCH!
USETI F.LIST,-1 ;POSITION TO APPEND TO FILE
POPJ P, ;THAT'S ALL
LSTERR: WARN$N (LF,Listing file error)
SETZM S.LIST## ;ZILCH TO PREVENT FURTHER TROUBLE
MOVEI P1,S.LENT## ;SPEC ADDRESS
JRST EGUUO ;TYPE OUT ERROR MESSAGE & RETURN
;+
;<WRTUFD IS A ROUTINE TO WRITE A <T$UFD RECORD ON TAPE FOR EACH DIRECTORY IN
;THE FILE PATH.
;-
WRTUFD: PUSHJ P,SAVE2 ;SAVE C(P1) & C(P2)
MOVSI P1,-.FXLND ;HOW MANY LEVELS PLUS ONE
WRIB: SKIPG P2,ADRLST(P1) ;ANYTHING TO WRITE?
JRST NORIB ;NO--CONTINUE
HRROS ADRLST(P1) ;YES--FLAG LH
SETZM M(MH) ;CLEAR BUFFER FIRST
MOVSI T1,M(MH) ;MAKE BLT POINTER
HRRI T1,M+1(MH) ; ...
BLT T1,MTBBKP-1(MH);CLEAR BUFFER
MOVEI T1,T$UFD ;LOAD UFD TYPE
MOVEM T1,G$TYPE(MH) ;STORE IN HEADER
HRRZM P1,D$LVL(MH) ;STORE LEVEL
MOVEI T3,D$STR(MH) ;MAKE BP TO D$STR IN HEADER
HRLI T3,440700 ;...
MOVE T1,ACSTR ;GET ALIAS STRUCTURE NAME
MOVEI T2,.FCDEV ;INDICATE DATA TYPE
PUSHJ P,SETPTH ;STORE IN HEADER
MOVE T1,D$LVL(MH) ;INDICATE LEVEL
PUSHJ P,SETASC ;STORE O$NAME FULL PATH OF DIRECTORY
MOVEM T1,D$PCHK(MH) ;SAVE CHECKSUM OF PATH IN HEADER
PUSHJ P,SAVATR ;SAVE O$FILE ATTRIBUTE BLOCK ON TAPE
;HERE TO WRITE O$DIRT NON-DATA BLOCK IN T$UFD RECORD. OUTPUT PLACED AT M+400(MH)
MOVEI T1,200 ;LENGTH OF BLOCK
ADDM T1,G$LND(MH) ;ADD TO NON-DATA LENGTH
HRLI T1,O$DIRT ;POSITION CONTROL CODE
MOVEM T1,400+M(MH) ;STORE CONTROL WORD
MOVEI T1,401+M(MH) ;MAKE POINTER TO DIRECTORY ATTRIBUTES
MOVEI T2,LN$DFH ;FIXED HEADER LENGTH
MOVEM T2,D$FHLN(T1) ;STORE
MOVEI T2,201+M(MH) ;MAKE POINTER TO O$FILE
MOVE T3,A$WRIT(T2) ;GET CREATION DATE/TIME FROM O$FILE BLOCK
MOVEM T3,D$LOGT(T1) ;SAVE FOR LOGIN TIME
SETZB T3,A$PROT(T2) ;ZILCH FILE PROTECTION WORD
LDB T4,[POINTR (.RBPRV(P2), RB.PRV)];GET RIB PROTECTION
LSHC T3,^D30 ;POSITION PROGRAMMER PROTECTION IN T3
DPB T3,[POINTR (D$PROT(T1), AC$OWN)];SET OWNER ACCESS
SETZ T3, ;CLEAR
LSHC T3,3 ;POSITION PROJECT PROTECTION IN T3
DPB T3,[POINTR (D$PROT(T1), AC$GRP)];SET AFFINITY GROUP PROT.
LSH T4,-^D33 ;POSITION WORLD PROTECTION IN T4
TLO T4,(5B2) ;SET "5"
IORM T4,D$PROT(T1) ;STORE DIRECTORY PROTECTION
MOVE T2,.RBQTF(P2) ;GET QUOTA IN BLOCKS FROM RIB
ASH T2,7 ;MULTIPLY BY 200 FOR QUOTA IN WORDS
MOVEM T2,D$QTF(T1) ;STORE
MOVE T2,.RBQTO(P2) ;GET LOGGED OUT QUOTA FROM RIB
ASH T2,7 ;MULTIPLY BY 200 FOR QUOTA IN WORDS
MOVEM T2,D$QTO(T1) ;STORE
PUSHJ P,MTAOUT ;EXEC I/O
NORIB: AOBJN P1,WRIB ;CIRCLE
POPJ P, ;RETURN
;+
;<SAVFIL IS A ROUTINE TO MOVE AN INDIVIDUAL FILE FROM DISK TO TAPE.
;-
SAVFIL: PUSHJ P,SAVE3 ;SAVE SOME ACS
MOVEI T1,NRIB-1 ;SET FOR EXTENDED LOOKUP
MOVEM T1,EXLFIL+.RBCNT; ..
CAIGE LVL,1 ;IF SFD, LOAD ADDRESS OF PATH BLOCK
SKIPA T1,PTHBLK+.PTPPN; ..
MOVEI T1,PTHBLK ; ..
MOVEM T1,EXLFIL+.RBPPN; ..
MOVE T1,CNAM ; ..
MOVEM T1,EXLFIL+.RBNAM; ..
MOVE T1,CEXT ; ..
MOVEM T1,EXLFIL+.RBEXT; ..
LOOKUP FILE,EXLFIL ;LOOKUP FILE
JRST ELFIL ;LOSE
MOVEI T1,CP$INC ;CHECKPOINT INCREMENT
ADDI T1,CP$MRG ;CHECKPOINT MARGIN
MOVEM T1,CHKPNT ;SET INITIAL CHECKPOINT
SETZM THSRDB ;START WITH BLOCK ZERO
SKIPN T1,S.RSUM## ;RESUMING?
JRST STREC ;NO, PROCEED WITH FIRST BLOCK
USETI FILE,(T1) ;POSITION
ADDI T1,CP$MRG ;ADD ON MARGIN
ADDI T1,CP$INC ;ADD ON INCREMENT
MOVEM T1,CHKPNT ;SET NEXT CHECKPOINT
;HERE TO FILL IN THE TAPE RECORD HEADER
STREC: MOVEI T1,T$FIL ;FILE DATA RECORD
MOVEM T1,G$TYPE(MH) ;STORE
MOVSI T3,440700 ;MAKE INITIAL BP
HRRI T3,F$PTH(MH) ;ADDRESS OF F$PTH BLOCK
SKIPE S.INTR## ;SEE IF /INTERCHANGE
JRST CONREC ;YES--DON'T INCLUDE PATH INFO
MOVE T1,ACSTR ;GET FS NAME
MOVEI T2,.FCDEV ;INDICATE DATA TYPE
PUSHJ P,SETPTH ;STORE IN HEADER BLOCK
MOVE T1,APATH+.PTPPN ;GET DIRECTORY
MOVEI T2,.FCDIR ;INDICATE DATA TYPE
PUSHJ P,SETPTH ;STORE
MOVE T1,APATH+.PTPPN+1;GET FIRST SFD NAME
MOVEI T2,.FCSF1 ;INDICATE DATA TYPE
PUSHJ P,SETPTH ;STORE
MOVE T1,APATH+.PTPPN+2;SECOND SFD NAME
MOVEI T2,.FCSF2 ;TYPE CODE
PUSHJ P,SETPTH ;STORE
CONREC: MOVE T1,ACNAM ;GET FILE NAME
MOVEI T2,.FCNAM ;DATA TYPE
PUSHJ P,SETPTH ;STORE
MOVE T1,ACEXT ;GET EXTENSION
MOVEI T2,.FCEXT ;DATA TYPE
PUSHJ P,SETPTH ;STORE
SKIPE T1,THSRDB ;LOAD RELATIVE DATA BLOCK
SUBI T1,1 ;CALCULATE RELATIVE DATA WORD
IMULI T1,200 ; ...
MOVEM T1,F$RDW(MH) ;STORE
MOVE T1,PTHCHK ;GET PATH CHECKSUM
MOVEM T1,F$PCHK(MH) ;SAVE IN HEADER
TXNN F,FL$PSI ;SKIP FOLLOWING IF PSI ENABLED
JRST [PUSHJ P,OPRCMD##;HANDLE ANY TTY INPUT
TXO F,FL$KIL;RETURN HERE IF OPERATOR SAID KILL
JRST .+1] ;CONTINUE
SKIPE THSRDB ;FIRST BLOCK?
JRST STBLK ;NO
;HERE TO HANDLE THE FIRST TAPE RECORD FOR A FILE
MOVX T1,GF$SOF ;YES, LOAD START OF FILE FLAG
SKIPN S.RSUM## ;UNLESS RESUMING,
IORM T1,G$FLAG(MH) ;SET IN HEADER
SETZM M(MH) ;CLEAR FIRST TAPE RECORD FOR FILE
MOVSI T1,M(MH) ;MAKE BLT POINTER
HRRI T1,M+1(MH) ; ...
BLT T1,MTBBKP-1(MH) ;ZILCH ENTIRE BUFFER
MOVEI T1,.FXLND ;INDICATE FILE
MOVEI P2,EXLFIL ;SET ADDRESS OF LOOKUP BLOCK
PUSHJ P,SETASC ;SAVE O$NAME BLOCK
MOVEM T1,F$PCHK(MH) ;SAVE CHECKSUM IN HEADER
MOVEM T1,PTHCHK ;AND FOR LATER USE
PUSHJ P,SAVATR ;SAVE FILE ATTRIBUTES
MOVEI T1,M+200(MH) ;SET POINTER TO O$FILE BLOCK
SKIPN S.RSUM## ;UNLESS RESUMING,
PUSHJ P,LSTFIL ;LIST THIS FILE
PUSHJ P,DSKIN ;GET FIRST DISK BLOCK
JRST CLSFIL ;ERROR -- QUIT
JRST [SKIPE S.RSUM## ;EOF RETURN
JRST RSMERR ;IF RESUMING MEANS USER GAVE BAD CHECKPOINT
JRST SNDLST] ;IF NOT, MEANS ZERO LENGTH FILE -- DONE
SKIPN T1,S.RSUM## ;IF RESUMING, GET BLOCK NUMBER
MOVEI T1,1 ;FIRST BLOCK
MOVEM T1,THSRDB ;STORE RELATIVE BLOCK NUMBER
SKIPE S.RSUM## ;IF RESUMING,
PUSHJ P,TYPRSM ;TYPE RESUME MESSAGE
SETZM S.RSUM## ; AND ZILCH
MOVE T1,EXLFIL+.RBSIZ;GET SIZE OF FILE
CAILE T1,400 ;SEE IF OVER 2 BLOCKS
JRST SNDREC ;YES, START FILE IN 2ND TAPE RECORD
MOVEI P2,M+400(MH) ;WHERE TO START
MOVEI P1,N-2 ;MAX OF 2 BLOCKS FOR FIRST RECORD
CAIG T1,200 ;IF ONLY ONE BLOCK,
MOVEI P1,1 ;ADJUST P1
;HERE TO TRANSFER A DISK BLOCK TO THE TAPE BUFFER
STBLK: MOVSI T1,(DBUF) ;ADDRESS OF DATA
HRRI T1,(P2) ;WHERE TO GO IN TAPE BUFFER
BLT T1,177(P2) ;XFR DISK BLOCK
MOVEI T1,200 ;LENGTH OF BLOCK
ADDM T1,G$SIZ(MH) ;ADD TO RECORD SIZE COUNT
MOVE P3,DSKHDR+.BFCTR;SAVE ACTUAL NUMBER OF WORDS
ADDI P2,200 ;NEXT BLOCK SLOT
PUSHJ P,DSKIN ;GET NEXT DATA BLOCK
JRST CLSFIL ;QUIT IF ERROR
JRST FINFIL ;EOF--DONE
AOS T1,THSRDB ;ANOTHER BLOCK READ
SKIPE S.CKPT## ;CHECKPOINTING?
PUSHJ P,TYPCKP ;YES
SOJG P1,STBLK ;GO XFR NEXT ONE
SNDREC: PUSHJ P,MTAOUT ;SEND TAPE RECORD
MOVEI P1,N ;HOW MANY BLOCKS
MOVEI P2,M(MH) ;WHERE TO WRITE
TXNN F,FL$KIL ;SEE IF OPERATOR SAID KILL
JRST STREC ;NO--GO START AGAIN
PUSHJ P,EAFIL ;YES--ABORT FILE
MOVEI T1,[ASCIZ/
% SAVE ABORTED
/]
SKIPE S.LIST ;SKIP IF NO LISTING NEEDED
PUSHJ P,LSTMSG ;SEND TO LISTING FILE
JRST CLSFIL ;CLOSE FILE
; HERE ON DISK EOF
FINFIL: SUBI P3,200 ;ADJUST DATA WORD COUNT
ADDM P3,G$SIZ(MH) ;TO USE ACTUAL WORD SIZE OF LAST DISK BLOCK
SOJLE P1,SNDLST ;IF BUFFER FULL, SEND LAST RECORD
SETZM (P2) ;CLEAR REMAINDER OF BUFFER
MOVSI T1,(P2) ;MAKE BLT POINTER
HRRI T1,1(P2) ; ...
BLT T1,MTBBKP-1(MH) ;ZILCH TO END OF TAPE BUFFER
SNDLST: MOVX T1,GF$EOF ;MARK AS LAST BLOCK
IORM T1,G$FLAG(MH) ;SET FLAG
PUSHJ P,MTAOUT ;SEND LAST BUFFER
SKIPN S.DELT## ;/DELETE?
JRST CLSFIL ;NO, FINISH FILE
MOVE T1,EXLFIL+.RBNAM ;SAVE FILENAME IN CASE OF ERROR
SETZM EXLFIL+.RBNAM ;ZILCH TO DELETE
RENAME FILE,EXLFIL ;DELETE FILE
SKIPA ;ERROR RETURN
POPJ P, ;OK--THATS ALL
WARN$N (CDF,Cannot delete file)
MOVEM T1,EXLFIL+.RBNAM ;RESTORE FILENAME,
MOVEI P1,EXLFIL ;SET POINTER
JRST EGUUO ;TELL WHICH AND RETURN
CLSFIL: CLOSE FILE,CL.ACS ;INHIBIT ACCESS DATE UPDATING
POPJ P, ;RETURN
SUBTTL DISK TO TAPE SUBROUTINES
;+
;.CHAPTER DISK TO TAPE SUBROUTINES
;-
;+
;<XALIAS IS THE SUBROUTINE TO DO ALIASING.
;^EACH MASKED CHARACTER IN THE OUTPUT FILE SPEC PATH IS REPLACED
;WITH THE CORRESPONDING CHARACTER OF THE CURRENT FILE BEING PROCESSED.
;^THE DEVICE IS SIMPLY RENAMED.
;-
XALIAS: MOVE T1,.FXDEV(SP) ;GET ALIAS STR
CAMN T1,[SIXBIT /ALL/] ;SKIP IF NOT ALL
MOVE T1,CSTR ;ALL. GET ORIGINAL STR BACK
MOVEM T1,ACSTR ;STORE
MOVE T1,CNAM ;GET FILE NAME
TDZ T1,.FXNMM(SP) ;ZILCH
MOVE T2,.FXNAM(SP) ;GET ALIAS
AND T2,.FXNMM(SP) ;ZILCH
IOR T1,T2 ;FORM ALIAS FILE NAME
MOVEM T1,ACNAM ;STORE
MOVE T1,CEXT ;GET EXTENSION
HRLZ T2,.FXEXT(SP) ;GET MASK
TDZ T1,T2 ;ZILCH
HLLZ T3,.FXEXT(SP) ;GET ALIAS
AND T3,T2 ;ZILCH
IOR T1,T3 ;FORM ALIAS FILE NAME
MOVEM T1,ACEXT ;STORE
MOVSI T1,-.FXLND ;START AT UFD LEVEL
MOVE T2,SP ;GET SPEC ADDRESS
XAPATH: MOVE T3,PTHBLK+.PTPPN(T1) ;GET UFD-SFD
TDZ T3,.FXDIM(T2) ;ZILCH
MOVE T4,.FXDIR(T2) ;GET ALIAS
AND T4,.FXDIM(T2) ;ZILCH
IOR T3,T4 ;FORM ALIAS UFD-SFD
MOVEM T3,APATH+.PTPPN(T1) ;STORE
JUMPE T3,CPOPJ ;RETURN NOW IF END OF PATH
ADDI T2,2 ;NEXT DIR-MSK PAIR
AOBJN T1,XAPATH ;GET NEXT UFD-SFD
SETZM APATH+.PTPPN(T1) ;INSURE TRAILING ZERO
POPJ P, ;RETURN
;+
;<SAVATR IS A ROUTINE TO HANDLE PUTTING FILE ATTRIBUTE INFORMATION ONTO THE TAPE.
;^IT PLACES <O$FILE AS THE SECOND BLOCK IN THE TAPE RECORD. ^INPUT IS
;FROM THE EXTENDED LOOKUP BLOCK (ADDRESS IN ^P2). ^OUTPUT PLACED AT ^M+200(<MH).
;-
SAVATR: PUSHJ P,SAVE1 ;MAKE SOME ROOM
MOVEI T1,200 ;LENGTH OF BLOCK
ADDM T1,G$LND(MH) ;ADD TO NON-DATA TOTAL
HRLI T1,O$FILE ;BLOCK TYPE
MOVEM T1,M+200(MH) ;STORE CONTROL WORD
MOVEI P1,M+201(MH) ;MAKE POINTER TO FIXED LENGTH SUBBLOCK
MOVEI T1,LN$AFH ;FIXED HEADER LENGTH
MOVEM T1,A$FHLN(P1) ;STORE
SKIPE T1,S.INTR## ;SEE IF /INTERCHANGE
JRST SETIME ;YES, IGNORE FLAGS
MOVE T2,.RBSTS(P2) ;GET FILE FLAGS
MOVSI T3,-LN$FLG ;FLAG TABLE LENGTH
SETFLG: TDNE T2,RIBFLG(T3) ;IF RIB FLAG SET,
IOR T1,BKPFLG(T3) ; SET CORRESPONDING BACKUP FLAG
AOBJN T3,SETFLG ;LOOP
MOVEM T1,A$FLGS(P1) ;STORE FLAGS
SETIME: LDB T1,[POINTR (.RBPRV(P2), RB.CRT)];GET CREATION TIME
IMULI T1,^D60000 ;CONVERT TO MILLISECONDS
LDB T2,[POINTR (.RBEXT(P2) ,RB.CRX)];HIGH ORDER CREATION BITS
LSH T2,^D12 ;POSITION
LDB T3,[POINTR (.RBPRV(P2), RB.CRD)];LOW ORDER CREATION BITS
IOR T2,T3 ;UNITE
PUSHJ P,CONVDT ;CONVERT TO UNIVERSAL DATE/TIME
MOVEM T1,A$WRIT(P1) ;STORE DATE/TIME
MOVE T1,.RBALC(P2) ;NUMBER BLOCKS ALLOCATED
ASH T1,7 ;WORDS PER BLOCK
MOVEM T1,A$ALLS(P1) ;STORE NBR WORDS ALLOCATED
LDB T1,[POINTR (.RBPRV(P2), RB.MOD)];GET MODE
MOVEM T1,A$MODE(P1) ;STORE
MOVEI T2,^D36 ;ASSUME BINARY
CAIG T1,.IOASL ;SEE IF ASCII
MOVEI T2,7 ;YES--CORRECT BYTE SIZE
MOVEM T2,A$BSIZ(P1) ;STORE BYTE SIZE
MOVE T2,.RBSIZ(P2) ;GET SIZE IN WORDS
CAIG T1,.IOASL ;SEE IF ASCII MODE
IMULI T2,5 ;YES--GET SIZE IN BYTES
TLZ T2,(1B0) ;MAKE SURE BIT 0 IS CLEARED
MOVEM T2,A$LENG(P1) ;STORE LENGTH IN BYTES
SKIPG T1,.FXVER(SP) ;GET VERSION FROM USER, IF SET
MOVE T1,.RBVER(P2) ;IF NOT, USE VERSION FROM FILE
MOVEM T1,A$VERS(P1) ;STORE VERSION ON TAPE
SKIPE T1,S.INTR## ;SEE IF /INTERCHANGE
POPJ P, ;YES--THAT'S ALL FOR O$FILE
;HERE TO FILL REST OF O$FILE BLOCK FOR NON-INTERCHANGE MODE
LDB T2,[POINTR (.RBEXT(P2), RB.ACD)];GET ACCESS DATE
PUSHJ P,CONVDT ;CONVERT TO SMITHSONIAN
MOVEM T1,A$REDT(P1) ;STORE
LDB T1,[POINTR (.FXMOD(SP),FX.PRO)];GET /PROTECTION
LDB T2,[POINTR (.FXMOM(SP),FX.PRO)];SEE IF SET
SKIPN T2 ;IF SET, USE IT
LDB T1,[POINTR (.RBPRV(P2),RB.PRV)];USE RIB PROTECTION
PUSHJ P,SETPRO ;CONVERT TO BACKUP PROTECTION
MOVEM T1,A$PROT(P1) ;STORE
MOVE T1,.RBTIM(P2) ;GET MONITOR SET CREATION DATE/TIME
MOVEM T1,A$MODT(P1) ;STORE
SKIPG T1,.FXEST(SP) ;GET USER ESTIMATE, IF SET
MOVE T1,.RBEST(P2) ;IF NOT, USE FILE ESTIMATE
ASH T1,7 ;CONVERT TO WORD ESTIMATE
MOVEM T1,A$ESTS(P1) ;STORE
MOVE T1,.RBPOS(P2) ;GET LOGICAL BLOCK NUMBER
ASH T1,7 ;CONVERT TO LOGICAL DISK ADDRESS
MOVEM T1,A$RADR(P1) ;STORE
MOVE T1,.RBNCA(P2) ;SAVE CUSTOMER WORDS
MOVEM T1,A$USRW(P1) ; ...
MOVE T1,.RBPCA(P2) ; ...
MOVEM T1,A$PCAW(P1) ; ...
MOVSI T3,440700 ;MAKE ASCII BYTE POINTER
HRRI T3,LN$AFH ;POINT TO END OF FIXED HEADER SUBBLOCK
SKIPE T1,.RBSPL(P2) ;GET ANNOTATION IN SIXBIT
MOVEM T3,A$NOTE(P1) ;STORE ANNOTATION STRING BYTE POINTER
ADDI T3,M+201(MH) ;ADJUST FOR PHYSICAL ADDRESS
PUSHJ P,SETASZ ;STORE ASCIZ STRING
MOVE T2,T3 ;COPY BYTE POINTER
SUBI T2,M+201(MH) ;MAKE RELATIVE BYTE POINTER
SKIPE T1,.RBAUT(P2) ;GET AUTHOR PPN
MOVEM T2,A$CUSR(P1) ;STORE CREATOR STRING BYTE POINTER
PUSHJ P,SETPPN ;STORE ASCIZ STRING
SKIPN T1,.RBMTA(P2) ;GET REEL ID OF LAST TAPE
POPJ P, ;IF NULL, DONE
MOVE T2,T3 ;COPY NEW BYTE POINTER
SUBI T2,M+201(MH) ;MAKE RELATIVE BYTE POINTER
MOVEM T2,A$BKID(P1) ;STORE BP TO LAST BACKUP TAPE
;FALL INTO SETASZ
;+
;<SETASZ IS A SUBROUTINE TO CONVERT A <SIXBIT WORD TO AN <ASCIZ STRING.
;^CALLED WITH ^T1 = <SIXBIT WORD AND ^T3 = <ASCII BYTE POINTER. ^USES ^T1-^T3.
;-
SETASZ: JUMPE T1,CPOPJ ;NOTHING TO STORE
PUSHJ P,STASSX ;CONVERT TO ASCII STRING
MOVEI T1,0 ;NULL
JRST STASCH ;SET NULL & RETURN
;+
;<SETPRO IS A SUBROUTINE TO RETURN THE <BACKUP PROTECTION WORD FROM
;THE <TOPS-10 PROTECTION VALUE. ^CALL WITH ^T1 = <TOPS-10 PROTECTION,
;RETURNS <BACKUP PROTECTION IN ^T1. ^USES ^T1-^T4.
;-
SETPRO: MOVE T3,T1 ;COPY PROTECTION
SETZB T1,T2 ;CLEAR
LSHC T2,^D30 ;POSITION PROGRAMMER PROTECTION IN T2
PUSHJ P,SETPRT ;SET OWNER ACCESS FIELD
LSH T1,^D8 ;POISTION
MOVEI T2,0 ;ZILCH
LSHC T2,3 ;GET PROJECT PROTECTION IN T2
PUSHJ P,SETPRT ;SET AFFINITY GROUP ACCESS FIELD
LSH T1,^D8 ;POSITION
MOVEI T2,0 ;ZILCH
LSHC T2,3 ;GET RIB WORLD PROTECTION
PUSHJ P,SETPRT ;SET WORLD ACCESS FIELD
TLO T1,(5B2) ;SET "5"
POPJ P, ;RETURN WITH PROTECTION IN T1
;+
;<SETPRT IS A SUBROUTINE TO SET A <BACKUP FILE ACCESS SUBFIELD. ^CALLED WITH
;^T2 = <TOPS-10 PROTECTION DIGIT, RETURNS WITH ACCESS SUBFIELD SET IN ^T1.
;^CLOBBERS ^T4.
;-
SETPRT: MOVEI T4,1 ;ASSUME 1 FOR ATTRIBUTE ACCESS VALUE
CAIG T2,5 ;SEE IF PROTECTION GREATER THAN FIVE
ADDI T4,1 ;NO, STEP ATTRIBUTE ACCESS
CAIG T2,1 ;SEE IF RIB PROTECTION > 1
ADDI T4,5 ;NO, INCREMENT ACCESS FIELD
SKIPG T2 ;SEE IF EQUAL TO ZERO
SUBI T4,1 ;YES--ACCESS = 6
DPB T4,[POINTR (T1,PR$ATR)];SET ATTRIBUTE SUBFIELD
;HERE TO SET THE WRITE PROTECTION BITS
MOVEI T4,0 ;START WITH ZERO
CAIG T2,4 ;SEE IF RIB PROTECTION > 4
ADDI T4,1 ;INCREMENT WRITE ACCESS SUBFIELD
CAIG T2,3 ;CHECK RIB PROTECTION
ADDI T4,1 ;INCREMENT WRITE ACCESS SUBFIELD
CAIG T2,2 ;CHECK RIB PROTECTION
ADDI T4,1 ;INCREMENT WRITE ACCESS SUBFIELD
DPB T4,[POINTR (T1, PR$WRT)];SET WRITE ACCESS SUBFIELD
;HERE TO SET READ PROTECTION BITS
MOVEI T4,0 ;START WITH ZERO
CAIG T2,6 ;CHECK RIB PROTECTION
ADDI T4,1 ;INCREMENT READ ACCESS SUBFIELD
CAIG T2,5 ;CHECK RIB PROTECTION
ADDI T4,1 ;STEP READ ACCESS SUBFIELD
DPB T4,[POINTR (T1, PR$RED)];SET READ ACCESS SUBFIELD
POPJ P, ;RETURN
;+
;<SETASC IS A SUBROUTINE TO PUT A FILE'S CANONICAL FULL PATH NAME IN THE
;TAPE RECORD IN <O$NAME BLOCK FORMAT. ^SUB-BLOCKS APPEAR IN THE STANDARD
;ORDER: DEVICE, DIRECTORIES (TOP DOWN), FILE NAME, EXTENSION.
;^CALLED WITH ^T1 = DIRECTORY LEVEL OR <.FXLND IF FILE.
;^INPUT FROM ALIAS INFO, OUTPUT PLACED AT <M(MH).
;^RETURNS CHECKSUM OF <O$NAME BLOCK IN ^T1. ^USES ^T1-^T4.
;-
SETASC: PUSHJ P,SAVE2 ;SAVE SOME ACS
SAVE$ T1 ;SAVE LEVEL FOR LATER
MOVEI T1,200 ;LENGTH OF BLOCK
ADDM T1,G$LND(MH) ;ADD TO TOTAL
HRLI T1,O$NAME ;INDICATE BLOCK TYPE
MOVEM T1,M(MH) ;STORE CONTROL WORD
MOVEI P1,M+1(MH) ;INITIALIZE SUB-BLOCK POINTER
MOVE T1,ACSTR ;GET DEVICE
MOVEI T2,.FCDEV ;DEVICE DATA TYPE
PUSHJ P,SETBLK ;SET SUB-BLOCK
SKIPE S.INTR## ;SEE IF /INTERCHANGE
JRST SETAS2 ;YES--SKIP PATH INFO
MOVN P2,(P) ;GET NEGATIVE LEVEL OR .FXLND IF FILE
HRLZS P2 ;FORM AOBJN WORD
SETAS1: SKIPN T1,APATH+.PTPPN(P2);SEE IF THIS ONE SET
JRST SETAS2 ;NO--ALL DONE WITH DIRECTORIES
MOVEI T2,.FCDIR(P2) ;GET TYPE CODE
PUSHJ P,SETBLK ;SET SUB-BLOCK
AOBJN P2,SETAS1 ;LOOP DOWN SFD CHAIN
SETAS2: RSTR$ P2
CAIE P2,.FXLND ;SEE IF FILE
JRST SETAS3 ;SKIP FOLLOWING IF DIRECCTORY
MOVE T1,ACNAM ;GET FILE NAME
MOVEI T2,.FCNAM ;INDICATE FILE NAME
PUSHJ P,SETBLK ;SET SUB-BLOCK
HLLZ T1,ACEXT ;GET EXTENSION
MOVEI T2,.FCEXT ;INDICATE TYPE
PUSHJ P,SETBLK ;SET SUB-BLOCK
;HERE TO COMPUTE CHECKSUM OF THE O$NAME BLOCK
SETAS3: SETZ T1, ;CLEAR FOR CHECKSUM
MOVSI T2,-200 ;LENGTH OF BLOCK
HRRI T2,M(MH) ;START OF BLOCK
SETAS4: ADD T1,(T2) ;CHECKSUM O$NAME BLOCK
ROT T1,1 ; ...
AOBJN T2,SETAS4 ; ...
POPJ P, ;RETURN WITH CHECKSUM IN T1
;+
;<SETBLK IS A SUBROUTINE CALLED BY <SETASC TO SET CONSECUTIVE SUB-BLOCKS
;IN THE <O$NAME BLOCK. ^CALLED WITH ^T1 = PATH FIELD, ^T2 = PATH TYPE CODE.
;^ASSUMES ^P1 = ADDRESS TO START SUB-BLOCK.
;^UPDATES ^P1 TO FIRST ADDRESS PAST SUB-BLOCK. ^USES ^T1-^T4.
;-
SETBLK: JUMPE T1,CPOPJ ;OMIT SUB-BLOCK IF NULL PATH FIELD
HRLM T2,(P1) ;STORE PATH TYPE CODE
MOVSI T3,440700 ;MAKE ASCII BYTE POINTER
HRRI T3,1(P1) ;START ADDRESS FOR ASCIZ STRING
MOVEI T4,SETASZ ;ASSUME SIXBIT CONVERSION ROUTINE
CAIN T2,.FCDIR ;SEE IF UFD
MOVEI T4,SETPPN ; YES--USE PPN CONVERSION ROUTINE
PUSHJ P,(T4) ;STORE ASCIZ STRING
HRRZS T3 ;CLEAR LEFT HALF
SUBI T3,-1(P1) ;COMPUTE LENGTH OF SUB-BLOCK
HRRM T3,(P1) ;STORE IN CONTROL WORD
ADD P1,T3 ;UPDATE POINTER
POPJ P, ;RETURN
;+
;<SETPPN IS A SUBROUITNE TO CONVERT A <PPN TO AN <ASCIZ STRING. ^THE PROJECT
;AND PROGRAMMER NUMBERS ARE SEPARATED BY AN UNDERLINE CHARACTER.
;^CALLED WITH ^T1 = <PPN AND ^T3 = <ASCII BYTE POINTER. ^USES ^T1-^T4.
;-
SETPPN: SKIPN T4,T1 ;SAVE COPY FOR LATER
POPJ P, ;RETURN IF PPN NULL
HLRZS T1 ;POSITION PROJECT NBR
PUSHJ P,STASOC ;SET ASCII STRING
MOVEI T1,"_" ;USE UNDERLINE AS DIVIDER
IDPB T1,T3 ;SET IN STRING
HRRZ T1,T4 ;GET PROGRAMMER NBR
PUSHJ P,STASOC ;SET ASCII STRING
MOVEI T1,0 ;NULL
JRST STASCH ;SET NULL & RETURN
;+
;<STASSX IS A SUBROUTINE TO CONVERT A <SIXBIT WORD TO AN <ASCII STRING.
;^CALLED WITH ^T1 = <SIXBIT WORD AND ^T3 = <ASCII BYTE POINTER. ^USES ^T1-^T3.
;-
STASSX: MOVE T2,T1 ;POSITION VALUE
STASS1: JUMPE T2,CPOPJ ;RETURN WHEN DONE
MOVEI T1,0 ;CLEAR ACCUMULATOR
LSHC T1,6 ;GET NEXT CHARACTER
SKIPN T1 ;IF BLANK,
MOVEI T1,'?' ; FLAG PROBLEM
ADDI T1," "-' ' ;CONVERT TO ASCII
PUSHJ P,STASCH ;SET CHARACTER
JRST STASS1 ;LOOP
;+
;<STASOC IS A SUBROUTINE TO CONVERT AN OCTAL NUMBER TO AN <ASCII STRING.
;^CALL WITH ^T1 = OCTAL VALUE AND ^T3 = <ASCII BYTE POINTER. ^USES ^T1-^T3.
;-
STASOC: IDIVI T1,10 ;SPLIT DIGIT
HRLM T2,(P) ;STORE DIGIT
SKIPE T1 ;UNLESS DONE,
PUSHJ P,STASOC ; DO IT AGAIN
HLRZ T1,(P) ;GET BACK DIGIT
ADDI T1,"0" ;CONVERT TO ASCII
;FALL INTO STASCH
;+
;<STASCH IS A SUBROUTINE TO OUTPUT A CHARACTER TO A STRING.
;^CALL WITH ^T1 = CHARACTER AND BYTE POINTER IN ^T3.
;-
STASCH: IDPB T1,T3 ;POINTER IS IN T3
POPJ P, ;RETURN
;+
;<SETPTH IS A SUBROUTINE TO STORE FILE PATH INFOMATION IN THE FORMAT:
;<BYTE (7) DATA TYPE, LENGTH IN WORDS, <ASCII CHARACTERS (<F$PTH FORMAT).
;^CALLED WITH ^T1 = FILE INFO, ^T2 = DATA TYPE, BYTE POINTER IN ^T3.
;^USES ^T1-^T4.
;-
SETPTH: JUMPE T1,CPOPJ ;OMIT IN F$PTH IF NULL
IDPB T2,T3 ;SET DATA TYPE
MOVE T4,T3 ;SAVE COPY OF BP FOR LATER
IBP T3 ;INCREMENT BP
CAIE T2,.FCDIR ;SEE IF DIRECTORY
JRST SETPT1 ;NO, MUST BE SIXBIT WORD
SAVE$ T1 ;SAVE COPY FOR LATER
HLRZS T1 ;GET PROJECT NUMBER
PUSHJ P,STASOC ;CONVERT TO ASCII STRING
MOVEI T1,"_" ;UNDERLINE
IDPB T1,T3 ;SET UNDERLINE IN STRING
RSTR$ T1 ;GET PROGRAMMER NUMBER BACK
HRRZS T1 ;CLEAR LEFT HALF
PUSHJ P,STASOC ;CONVERT TO ASCII
SKIPA ;SKIP SIXBIT CONVERSION
SETPT1: PUSHJ P,STASSX ;CONVERT SIXBIT WORD TO ASCII STRING
ADDI T3,1 ;ADVANCE TO NEXT LOCATION
HRLI T3,440700 ;MAKE NEW BP
HRRZ T2,T3 ;CALCULATE # OF WORDS USED
SUBI T2,(T4) ;...
IDPB T2,T4 ;SAVE IN PROPER PLACE
POPJ P, ;RETURN
SUBTTL TAPE TO DISK MAIN ROUTINES
;+
;.CHAPTER TAPE TO DISK MAIN ROUTINES
;-
;+
;<CHKALL IS THE <CHECK COMMAND ENTRY POINT TO THE TAPE READ ROUTINE.
;^FOR THE <CHECK VERB, DISK FILES ARE READ (INSTEAD OF WRITTEN) AND
;COMPARED WORD BY WORD WITH THE TAPE FILES. "^INPUT" IS SET AS THE
;OPERATION FOR DISK <I/O, AND THE <COMPAR SUBROUTINE IS SET
;FOR LATER USE INSTEAD OF A <BLT INSTRUCTION.
;-
CHKALL: TXO F,FL$CHK ;INDICATE /CHECK
MOVE T1,[PUSHJ P,COMPAR] ;COMPARE DATA
MOVEI T2,DSKIN ;INPUT FROM DISK
JRST CHKRST ;GO TO COMMON HANDLER
;+
;<RSTALL IS THE ENTRY POINT TO THE TAPE READ ROUTINE FOR THE <RESTORE AND
;<PRINT COMMANDS. "^OUTPUT" IS SET AS THE DISK <I/O OPERATION AND A <BLT
;INSTRUCTION TO TRANSFER DATA FROM THE TAPE TO DISK BUFFERS IS SET
;FOR LATER EXECUTION INSTEAD OF THE <COMPAR SUBROUTINE.
;-
RSTALL: TXZ F,FL$CHK ;INDICATE NOT /CHECK
MOVE T1,[BLT T1,(T2)] ;COPY DATA
MOVEI T2,DSKOUT ;OUTPUT TO DISK
;+
;<CHKRST MARKS THE START OF COMMON CODE FOR THE TAPE READ ROUTINE.
;^IF A PARTICULAR SAVE SET HAS BEEN SPECIFIED, THE TAPE IS SEARCHED
;FROM THE CURRENT POSITION TO <EOT FOR THE START OF THE SAVE SET.
;^OTHERWISE, READING BEGINS FROM THE CURRENT TAPE POSITION.
;^THE CODE BRANCHES BASED ON THE TYPE OF RECORD IN THE TAPE BUFFER.
;-
CHKRST: MOVEM T1,DSKBLT ;SAVE OPERATION
MOVEM T2,DSKIO ;SAVE DISK ROUTINE
PUSHJ P,SAVE3 ;SAVE C(P1), C(P2) & C(P3)
SETZM PRESTR ;ZERO LAST STR WORD
SETZM PREPPN ;ZERO LAST PPN WORD
MOVEI T1,NRIB*.FXLND ;WORDS FOR UFD & SFD RIBS
PUSHJ P,UCORE ;GET IT
POPJ P, ;LOSE--BACK TO BACKUP
MOVEM P1,ADRLST ;SAVE FOR LATER
SKIPE P2,S.SSNM## ;SAVE SET SPECIFIED?
CAMN P2,[ASCII/ALL/] ; AND NOT "ALL"
JRST RSTREC ;NO--PUNT
;HERE TO FIND THE USER SPECIFIED SAVE SET ON TAPE
SPCSET: PUSHJ P,XMTAIN ;GET RECORD
SKIPA ;HERE ON EOF OR KILL
JRST SAVSET ;SEE IF SAVE SET RECORD
TXNE F,FL$KIL ;SEE IF USER TYPED KILL
POPJ P, ;YES, RETURN TO BACKUP
TXNN F,FL$EF2 ;EOT?
JRST SPCSET ;NO, CONTINUE
WARN$N (SNF,Save set not found)
OUTSTR S.SSNM## ;TELL WHICH
OUTSTR CRLF ;
POPJ P, ;LOSE
SAVSET: MOVE T1,G$TYPE(MH) ;GET RECORD TYPE
CAIE T1,T$CON ;CONTINUE SAVE?
CAIN T1,T$BEG ;START OF SAVE?
SKIPA ;YES
JRST SPCSET ;NEITHER--KEEP GOING
MOVEI T3,M(MH) ;START OF DATA AREA
ADD T3,G$LND(MH) ;END OF NON-DATA PORTION
CAILE T3,MTBFSZ(MH) ;RANGE CHECK, IN CASE JUNK ON TAPE
MOVEI T3,MTBFSZ(MH) ;USE MAX
SKIPA T1,MDATA ;LOAD START ADDRESS
FNDSSN: ADD T1,(T1) ;POINT TO NEXT BLOCK
CAIG T3,(T1) ;SEE IF DONE
JRST SPCSET ;YES, SAVE SET NOT SPECIFIED ON TAPE, SO REJECT
HLRZ T2,(T1) ;GET BLOCK TYPE CODE
CAIE T2,O$SSNM ;RIGHT ONE?
JRST FNDSSN ;NO, KEEP LOOKING
;HERE TO SEE IF SAVE SET NAMES MATCH (IGNORE UPPER/LOWER CASE DIFFERENCES)
HRRZ P1,(T1) ;GET LENGTH OF SSNAME BLOCK
SOS P1 ;MINUS CONTROL WORD
IMULI P1,5 ;GET COUNT OF CHARACTERS
MOVSI T3,440700 ;MAKE ASCII BYTE POINTER TO USER SSNAME
HRRI T3,S.SSNM## ;ADDRESS OF USER SUPPLIED NAME
ADDI T1,1 ;STEP TAPE POINTER
HRLI T1,440700 ;MAKE ASCII BYTE POINTER TO TAPE SSNAME
CHKSSN: SOJL P1,SPCSET ;REJECT IF TAPE OVERFLOW
ILDB T2,T1 ;GET CHARACTER FROM TAPE
CAIL T2,"a" ;SEE IF LOWER CASE ALPHABETIC
CAILE T2,"z" ; ...
SKIPA ;NOT.
SUBI T2,40 ;CONVERT TO UPPER CASE
ILDB T4,T3 ;GET CHARACTER FROM USER SSNAME
CAIL T4,"a" ;SEE IF LOWER CASE ALPHABETIC
CAILE T4,"z" ; ...
SKIPA ;NOT.
SUBI T4,40 ;CONVERT TO UPPER CASE
CAME T2,T4 ;COMPARE CHARACTERS
JRST SPCSET ;NO MATCH
SKIPE T2 ;DONE IF NULL FOUND
JRST CHKSSN ;LOOP FOR MORE CHARACTERS
PUSHJ P,LSTXXX ;LIST RECORD
;HERE TO GET A TAPE RECORD AND DISPATCH BY RECORD TYPE
RSTREC: PUSHJ P,XMTAIN ;GET A BUFFER
JRST [TXNE F,FL$EF2;EOT?
AOSA (P) ; YES--GIVE OPERATION DONE RETURN
TXNE F,FL$KIL ;/KILL?
POPJ P, ;RETURN TO BACKUP (NON-SKIP IF KILL)
JRST RSTREC] ;CONTINUE
MOVE T1,G$TYPE(MH) ;GET RECORD TYPE
CAIN T1,T$END ;END OF SAVE?
JRST HAVEND ;YES
CAIN T1,T$UFD ;IS IT UFD DATA?
JRST [PUSHJ P,HAVUFD;YES--CREATE RIB
JRST RSTREC] ;CONTINUE
CAIN T1,T$FIL ;IS IT FILE DATA?
JRST HAVFIL ;YES--CHECK IT OUT
CAIE T1,T$CON ;CONTINUATION OF SAVE SET?
CAIN T1,T$BEG ;START OF NEW SAVE SET?
JRST [PUSHJ P,LSTXXX ;YES, LIST IT AND
JRST RSTREC] ;CONTINUE
JUMPLE T1,NOSUCH ;UNRECOGNIZABLE RECORD TYPE
CAIG T1,T$MAX ;KNOW OF IT?
JRST RSTREC ;YES--CONTINUE READING
NOSUCH: WARN$N (URT,Unknown record type)
PUSHJ P,OCTOUT ; ..
OUTSTR CRLF ;<CR><LF>
JRST RSTREC ;GET NEXT
;HERE IF HAVE T$END TYPE RECORD IN BUFFER
HAVEND: PUSHJ P,LSTXXX ;LIST RECORD
MOVE T1,S.SSNM## ;SAVE SET SPECIFIED?
CAMN T1,[ASCII/ALL/] ; AND NOT "ALL"
JRST RSTREC ;NO--KEEP GOING
JRST CPOPJ1 ;YES--THIS MUST BE END
;+
;<HAVUFD IS A SUBROUTINE CALLED TO RECREATE THE DIRECTORY <RIB FROM
;THE CURRENT TAPE <T$UFD RECORD. ^OUPUT PLACED AT <ADRLST _+ (36 _* LEVEL).
;^THE <RIB IS USED IF IT IS NECESSARY TO CREATE THE DIRECTORY
;IN ORDER TO RESTORE THE FILE TO THE USER SPECIFIED PATH.
;-
HAVUFD: SKIPE S.INTR## ;SEE IF /INTERCHANGE,
POPJ P, ;YES, IGNORE T$UFD RECORDS
PUSHJ P,SAVE3 ;MAKE SOME ROOM
SKIPL P2,D$LVL(MH) ;GET UFD LEVEL
CAILE P2,.FXLND-1 ;SEE IF LEVEL IN RANGE
POPJ P, ; IF NOT, DROP RECORD
IMULI P2,NRIB ;WORDS PER RIB
ADD P2,ADRLST ;ADD IN BASE ADDRESS
;HERE TO RE-CREATE DIRECTORY RIB FROM T$UFD RECORD
MOVE P3,MDATA ;GET START OF DATA
ADD P3,G$LND(MH) ;POINT TO END
SKIPA P1,MDATA ;GET START ADDRESS AND SKIP
GETRIB: ADD P1,(P1) ;ADD LENGTH OF NON-DATA BLOCK
CAIG P3,(P1) ;END OF NON-DATA YET?
POPJ P, ;YES--DROP RECORD
HLRZ T1,(P1) ;GET BLOCK TYPE CODE
HRRZS P1 ;PREVENT ILL MEM REF AT RSTRIB [207]
CAIE T1,O$FILE ;IS IT O$FILE? [216]
JRST GETRI1 ;NO [216]
SETZM (P2) ;INITIALIZE RIB BLOCK [216]
HRLI T2,(P2) ; -- [216]
HRRI T2,1(P2) ; -- [216]
BLT T2,NRIB-1(P2) ; DOIT [216]
PUSHJ P,RSTRIB ;CONVERT TO RIB
GETRI1: HLRZ T1,(P1) ;GET BLOCK TYPE BACK [216]
CAIE T1,O$DIRT ;IS IT O$DIRT?
JRST GETRIB ;NO--LOOP
;HERE TO FILL IN PROTECTION AND QUOTAS FROM O$DIRT BLOCK
ADDI P1,1 ;POINT TO DIRECTORY DATA
LDB T1,[POINTR (D$PROT(P1), AC$OWN)];GET OWNER ACCESS
LSH T1,3 ;SHIFT PROGRAMMER PROTECTION
LDB T2,[POINTR (D$PROT(P1), AC$GRP)];GET GROUP ACCESS
IOR T1,T2 ;UNITE PROGRAMMER & PROJECT PROTECTIONS
LSH T1,3 ;POSITION PROTECTIONS
LDB T2,[POINTR (D$PROT(P1), AC$WLD)];GET WORLD ACCESS
IOR T1,T2 ;UNITE
DPB T1,[POINTR (.RBPRV(P2), RB.PRV)];SET RIB PROTECTION
MOVE T1,D$QTF(P1) ;GET FCFS LOGGED IN QUOTA IN WORDS
IDIVI T1,200 ;COMPUTE QUOTA IN BLOCKS
SKIPE T2 ;SEE IF OVERFLOW
AOS T1 ;YES, ONE MORE BLOCK
MOVEM T1,.RBQTF(P2) ;SET QUOTA IN RIB
MOVE T1,D$QTO(P1) ;GET LOGGED OUT QUOTA IN WORDS
IDIVI T1,200 ;COMPUTE QUOTA IN BLOCKS
SKIPE T2 ;SEE IF OVERFLOW
AOS T1 ;YES, ONE MORE BLOCK
MOVEM T1,.RBQTO(P2) ;SET QUOTA IN RIB
POPJ P, ;RETURN
;+
;^A BRANCH TO <HAVFIL OCCURS TO HANDLE FILE DATA RECORDS. ^MUST HAVE
;START OF FILE RECORD, UNLESS </RESUME WAS TYPED. ^FILE IDENTIFICATION
;INFO IS READ FROM THE <O$NAME BLOCK, OR THE RECORD HEADER IF RESUMING.
;^THEN THE USER'S SPECS AND SWITCHES ARE CHECKED AGAINST THE TAPE FILE,
;AND <RSTFIL IS CALLED IF THE TAPE FILE SHOULD BE RESTORED.
;-
HAVFIL: MOVX T1,GF$SOF ;START OF FILE?
TDNN T1,G$FLAG(MH) ;SEE IF FLAG SET
JRST [SKIPE S.WRIT## ;NOT. SEE IF /NOWRITE
SKIPN S.RSUM## ;UNLESS /RESUME,
JRST RSTREC ;DROP RECORD
SETZ P2, ;FLAG TO USE RECORD HEADER INFO
JRST GETINF] ;GO GET INFO FROM TAPE RECORD HEADER
MOVE P2,MDATA ;GET ADDRESS OF START OF DATA
HLRZ T1,(P2) ;GET BLOCK TYPE
CAIE T1,O$NAME ;SHOULD BE O$NAME BLOCK
JRST RSTREC ;BALK IF NOT
MOVEI P1,1(P2) ;FIRST O$NAME SUB-BLOCK
HRRZ T1,(P2) ;LENGTH OF O$NAME BLOCK
ADD P2,T1 ;POINT TO END OF O$NAME BLOCK
;HERE TO GET THE PATH INFO FROM THE O$NAME BLOCK OR RECORD HEADER IF P2 = 0.
GETINF: MOVSI T1,'DSK' ;SET DSK AS DEVICE FOR INTERCHANGE MODE
SKIPE T2,S.INTR## ;SEE IF INTERCHANGE MODE
MOVEM T1,CSTR ; YES--SET DEVICE
JUMPG T2,GETNAM ; AND SKIP COPYING PATH INFO FROM TAPE
MOVEI T1,.FCDEV ;INDICATE DATA TYPE
PUSHJ P,GETDAT ;GET DEVICE NAME
MOVEM T1,CSTR ;STORE
MOVE SP,S.FRST ; ADDRESS OF SPECS [175]
MOVE T1,.FXDEV(SP) ; THE OUTPUT DEVICE NAME [175]
SETOM CSTRFL ; SET STR FLAG FOR "ALL" [175]
CAMN T1,[SIXBIT/ALL/]; AND SKIP IF ITS NOT [175]
JRST GETIN1 ; IT IS "ALL" [175]
MOVSI T2,777700 ; NOW TRY FOR "DSK" [175]
MOVEM T2,CSTRFL ; FLAG FOR "DSK" [175]
CAMN T1,[SIXBIT/DSK/]; IS IT "DSK" ? [175]
JRST GETIN1 ; YES [175]
MOVE T2,S.NGST ;LOAD AOBJN WORD TO STR TABLE
CAME T1,S.STRS##(T2) ;FIND MATCH IN STR TABLE
AOBJN T2,.-1 ;LOOP
MOVSI T3,(1B0) ;SET BIT ZERO
MOVNI T1,(T2) ;SET SHIFT ARG
SKIPL T2 ;IF NO MATCH,
TDZA T3,T3 ;CLEAR T3
LSH T3,(T1) ;SHIFT TO CORRECT BIT
MOVEM T3,CSTRFL ;SAVE STR FLAG
GETIN1: MOVSI T2,-.FXLND ;START AT UFD LEVEL [175]
GETPTH: SAVE$ T2 ;SAVE C(T2)
MOVEI T1,.FCDIR(T2) ;INDICATE WHICH DIRECTORY
PUSHJ P,GETDAT ;GET DIRECTORY NAME
RSTR$ T2 ;RESTORE C(T2)
MOVEM T1,PTHBLK+.PTPPN(T2);STORE
SKIPE T1 ;DONE IF NULL
AOBJN T2,GETPTH ;LOOP
MOVEM T1,PTHBLK+.PTPPN(T2); ZERO THE REST OF PTHBLK [177]
AOBJN T2,.-1 ; DO IT [177]
GETNAM: MOVEI T1,.FCNAM ;INDICATE FILE NAME
PUSHJ P,GETDAT ;GET FROM O$NAME BLOCK
MOVEM T1,CNAM ;STORE
MOVEI T1,.FCEXT ;INDICATE EXTENSION
PUSHJ P,GETDAT ;GET EXTENSION
MOVEM T1,CEXT ;STORE
;HERE TO CHECK FOR /INITIAL
SKIPE S.INTR## ;SEE IF /INTERCHANGE
JRST ININAM ;YES, IGNORE ANY INITIAL PATH
SKIPN T1,S.INIT+.FXDEV;SEE IF ANY INITIAL DEVICE
JRST GOTINI ;NO
MOVE T2,CSTRFL ;GET STRUCTURE FLAG
CAME T1,CSTR ;SEE IF EXACT MATCH
TDNE T2,S.INIT##+FX$STR;OR IF STR FLAGGED
SKIPA ;YES, CHECK PATH
JRST RSTREC ;NO, DROP THIS FILE
MOVSI T1,-.FXLND ;CHECK ENTIRE PATH
SETZ T2, ;ZILCH
INIPTH: SKIPN T3,S.INIT+.FXDIR(T2) ;SEE IF ANY INITIAL DIRECTORY
JRST ININAM ;DONE, CHECK FILE NAME
CAME T3,PTHBLK+.PTPPN(T1) ;MATCH?
JRST RSTREC ;NO, DROP THIS FILE
ADDI T2,2 ;NEXT
AOBJN T1,INIPTH ;LOOP FOR ALL
ININAM: MOVE T1,S.INIT+.FXNAM;GET INITIAL FILE NAME, IF ANY
CAME T1,CNAM ;MATCH?
JUMPN T1,RSTREC ;NO, DROP THIS FILE
HLLZ T2,S.INIT+.FXEXT;GET INITIAL EXT, IF ANY
CAME T2,CEXT ;MATCH?
SKIPN S.INIT+.FXEXT ;NO, OKAY IF NO EXTENSION SET
SKIPA ;MATCH FOUND
JRST RSTREC ;DROP FILE
SETZM S.INIT+.FXDEV ;ZILCH
SETZM S.INIT+.FXNAM ; ...
SETZM S.INIT+.FXEXT ; ...
GOTINI: MOVE SP,S.FRST## ;ADDRESS OF SPECS
;HERE TO CHECK IF FILE MATCHES USER SPECS AND SWITCHES
RSTVER: SKIPE S.INTR## ;SEE IF /INTERCHANGE
JRST RSTVR2 ;YES--ONLY FILE NAME AND EXT MUST MATCH
PUSHJ P,VER0 ;COMPARE [175]
JRST RSTNOT ;NO GOOD
AOS FX$CNT+FX$LEN(SP);INDICATE SPEC DIRECTORY FOUND
RSTVR2: PUSHJ P,VER2 ;COMPARE
JRST RSTNOT ;NO GOOD
SKIPE S.RSUM## ;SEE IF /RESUME
JRST RSTYES ; YES, SKIP FOLLOWING
HLRZ T1,(P2) ;GET TYPE CODE OF NEXT BLOCK
CAIE T1,O$FILE ;CHECK IF O$FILE IS NEXT
JRST RSTYES ;NO--ASSUME GOOD
MOVE P1,P2 ;COPY POINTER TO O$FILE
MOVEI T4,1(P1) ;MAKE POINTER TO ATTRIBUTE DATA
MOVE T1,A$LENG(T4) ;GET LENGTH IN BYTES
SETZ T2, ;ZILCH
MOVE T3,A$MODE(T4) ;GET MODE FROM TAPE
CAIG T3,.IOASL ;SEE IF ASCII
IDIVI T1,5 ;CALCULATE LENGTH IN WORDS
SKIPE T2 ;SEE IF REMAINDER,
AOS T1 ; YES, ONE MORE WORD
MOVEM T1,CWSIZE ;STORE
MOVE T1,A$WRIT(T4) ;GET CREATION DATE/TIME
MOVEM T1,CCDATI ;STORE
MOVE T1,A$REDT(T4) ;GET ACCESS DATE
MOVEM T1,CADATI ;STORE
MOVE T1,A$MODT(T4) ;GET MONITOR SET DATE/TIME
MOVEM T1,CMDATI ;STORE FOR CHECKER
PUSHJ P,CHKLIM ;CHECK LIMITS
JRST RSTNOT ;NO GOOD
JRST [TXON F,FL$D75;INDICATE GOOD ONLY BECAUSE /DATE75
MOVEM SP,D75ADR;SAVE POINTER
JRST RSTNOT] ;AND PROCEED, NOT COUNTING MATCH
RSTYES: TXON F,FL$MAT ;MATCH?
MOVEM SP,SAVADR ;STORE
AOS FX$CNT(SP) ;COUNT MATCH
RSTNOT: ADDI SP,FX$LEN*2 ;NEXT SPEC
CAMGE SP,S.LAST## ;SKIP IF DONE
JRST RSTVER ;CONTINUE
TXZN F,FL$MAT ;MATCH?
JRST [TXZN F,FL$D75 ;NO--SEE IF DATE75 WIN
JRST LSTFNS ;NO--CONTINUE SCANNING TAPE [172]
MOVE SP,D75ADR ;YES--RETRIEVE ADDRESS
JRST .+2] ;AND ACCEPT MATCH
MOVE SP,SAVADR ;YES. GET COPY OF ADDR
PUSH P,.JBFF## ;SAVE JOBFF
PUSHJ P,RSTFIL ;RESTORE FILE
POP P,.JBFF## ;RESTORE JOBFF
TXZ F,FL$OPN ;FILE WAS CLOSED
SETZM SUSDF ; CLEAR SUPERSEDING DSK FILE FLAG [206]
TXNE F,FL$KIL ;SEE IF OPERATOR SAID KILL
JRST RSTKIL ;YES
SETZM CNAM ;INDICATE DONE WITH FILE FOR MASTRX ROUTINE
JRST CNTSCN ;CONTINUE SCANNING TAPE [172]
;HERE TO PRINT FILES ON STRUCTURES NOT IN SYS SEARCH LIST
LSTFNS: SKIPN S.PRNT## ;IS THIS A "PRINT" OPERATION? [172]
JRST CNTSCN ; NO [172]
MOVE T1,MDATA ;GET START OF DATA BLOCK [172]
ADDI T1,200 ;POINT TO O$FILE BLOCK [172]
PUSHJ P,LSTFIL ;LIST THE FILE [172]
CNTSCN: MOVE T1,S.SSNM## ;SAVE SET SPECIFIED?
CAMN T1,[ASCII/ALL/] ;AND NOT ALL?
JRST RSTREC ;NO--CONTINUE SCANNING TAPE FOR FILES
;HERE IF SAVE SET NAME IS NOT "ALL". STOP SCANNING IF SPEC LIST SATISFIED.
SKIPA SP,S.FRST## ;START ADDRESS OF SPEC LIST
SPCSAT: ADDI SP,FX$LEN*2 ;NEXT SPEC PAIR
CAML SP,S.LAST## ;END OF SPEC LIST?
JRST CPOPJ1 ;YES--ALL DONE
SKIPN FX$CNT+FX$LEN(SP);THIS DIRECTORY FOUND?
JRST RSTREC ;NO--CONTINUE LOOKING
PUSHJ P,VER0 ;YES--IS IT THE CURRENT ONE? [175]
JUMPE T1,SPCSAT ;NO--PASSED IT [204]
SKIPN FX$CNT(SP) ;YES--ANY FILES MATCH YET?
JRST RSTREC ;NO--KEEP LOOKING
MOVE T1,.FXNMM+FX$LEN(SP);GET FILENAME MASK
CAME T1,[-1] ;ANY WILD CARDS?
JRST RSTREC ;YES--CONTINUE SCAN OF TAPE
HRRO T1,.FXEXT+FX$LEN(SP);GET EXTENSION MASK
CAME T1,[-1] ;WILD?
JRST RSTREC ;YES--CONTINUE SCAN OF TAPE
MOVSI T2,-.FXLND+1 ; NUMBER OF SFD'S [213]
HRRI T2,.FXDIR+FX$LEN+2(SP) ; ADR OF FIRST ONE [213]
SPCSA1: SKIPN (T2) ; ANY SFD'S? [213]
JRST SPCSAT ; NO - SO DONE [213]
SKIPN 1(T2) ; ANY WILD SFD'S? [213]
JRST RSTREC ; YES - KEEP LOOKING [213]
ADDI T2,1 ; INDEX BY TWO [213]
AOBJN T2,SPCSA1 ; CHECK EM ALL [213]
JRST SPCSAT ;NO--THIS SPEC SATISFIED
RSTKIL: MOVEI T1,[ASCIZ/
% RESTORE ABORTED
/]
TXNE F,FL$CHK ;SEE IF /CHECK
MOVEI T1,[ASCIZ/
% CHECK ABORTED
/]
SKIPE S.PRNT## ;SEE IF /PRINT [212]
MOVEI T1,[ASCIZ/
% PRINT ABORTED
/] ; [212]
SKIPE S.LIST ;SKIP IF LISTING NOT NEEDED
PUSHJ P,LSTMSG ;SEND MESSAGE TO LISTING FILE
POPJ P, ;QUIT NOW--RETURN TO BACKUP
;+
;<RSTFIL IS A ROUTINE TO RESTORE A SINGLE FILE FROM TAPE TO DISK.
;-
RSTFIL: SETZM CHKCNT ;CLEAR CHECK COUNT
TXZ F,FL$PAO!FL$TPE ;ZERO FLAGS
SKIPN S.WRIT## ;SEE IF /NOWRITE
TXNE F,FL$CHK ; UNLESS /CHECK
SKIPA ;NEED TO INITIALIZE DISK CHANNELS
JRST TYPOUT ;SKIP UNNECESSARY CODE
;HERE TO COMPUTE ALIAS NAMES AND INITIALIZE CHANNELS
PUSHJ P,XALIAS ;DO ALIASING
;NOTE: CODE WHICH WAS HERE PREVIOUSLY TO SCATTER FILES
;OVER FILE STRUCTURE UNITS WAS DELETED SINCE 5.02 AND
;LATER MONITORS PERFORM THIS FUNCTION AUTOMATICALLY
MOVEI T1,.IODMP ;DUMP MODE
MOVE T2,ACSTR ;LOAD ALIAS STR NAME
SETZ T3, ;NO BUFFERS
OPEN UFD,T1 ;OPEN CHANNEL FOR CREATING UFD
JRST FAIL0 ;LOSE
MOVEI T1,.IOBIN ;BUFFERED BINARY
MOVSI T3,DSKHDR ;OUTPUT BUFFER HEADER ADDDRESS
TXNE F,FL$CHK ;IF /CHECK
MOVSS T3 ; USE FOR INPUT BUFFER
OPEN FILE,T1 ;OPEN CHANNEL FOR WRITING FILE
JRST FAIL0 ;LOSE
TXO F,FL$OPN ;NOW DISK OUTPUT FILE IS OPEN
SETZM EXLFIL ;CLEAR EXTENDED ENTER BLOCK
MOVE T1,[EXLFIL,,EXLFIL+1]; ...
BLT T1,EXLFIL+NRIB-1; ...
;HERE TO FILL ENTER BLOCK
MOVE T1,ACNAM ;GET ALIAS FILE NAME
MOVEM T1,EXLFIL+.RBNAM;STORE IN ENTER BLOCK
MOVE T1,ACEXT ;GET ALIAS EXTENSION
MOVEM T1,EXLFIL+.RBEXT;STORE
MOVE T1,APATH+.PTPPN ;ASSUME UFD LEVEL
SKIPE APATH+.PTPPN+1 ;SEE IF FILE LOCATED IN SFD,
MOVEI T1,APATH ; YES--SET UP PATH POINTER
MOVEM T1,EXLFIL+.RBPPN;STORE
MOVEI P2,EXLFIL ;SET ADDRESS OF ENTER BLOCK
SKIPN S.RSUM## ;SKIP IF RESUMING
PUSHJ P,RSTRIB ;FILL IN O$FILE INFO
;HERE TO RESET ENTER VALUES FROM USER OUTPUT SWITCHES
LDB T1,[POINTR (.FXMOD(SP),FX.PRO)] ;GET /PROTECTION FROM USER
LDB T2,[POINTR (.FXMOM(SP),FX.PRO)] ;SEE IF SET
SKIPE T2 ;IF SET,
DPB T1,[POINTR (EXLFIL+.RBPRV,RB.PRV)] ;SET IN FILE
SKIPLE T1,.FXVER(SP) ;GET /VERSION FROM USER, IF SET
MOVEM T1,EXLFIL+.RBVER ;SET IN ENTER BLOCK
SKIPLE T1,.FXEST(SP) ;IF /ESTIMATE,
JRST [IDIVI T1,200 ;CONVERT TO BLOCKS
SKIPE T2 ;SEE IF OVERFLOW
AOS T1 ; YES, ONE MORE BLOCK
MOVEM T1,EXLFIL+.RBEST; SET IN ENTER BLOCK
JRST .+1] ;PROCEED
SKIPE S.RSUM## ;SEE IF /RESUME,
JRST TYPOUT ; YES--ASSUME NORMAL HANDLING
LDB T1,[POINTR (.FXMOM(SP), FX.SUP)];SEE IF SCAN SUPERSEDE SWITCH
SKIPE T1 ;IF NOT TYPED,
TXNE F,FL$CHK ; OR /CHECK,
JRST CHKSUP ; CHECK BACKUP SUPERSEDE SWITCHES
LDB T1,[POINTR (.FXMOD(SP), FX.SUP)];TYPED--GET SCAN SETTING
JUMPN T1,CLSFL1 ;/ERSUPERSEDE
JRST TYPOUT ;/OKSUPERSEDE
;HERE TO CHECK WHETHER COPY ON DISK (IF ANY) SHOULD BE SUPERSEDED
CHKSUP: SETZM SUSDF ;CLEAR THE SUPERSEDING DSK FILE FLAG [206]
MOVEI T1,1 ;SEE IF SUPERSEDE ALLOWED
CAMN T1,S.SUPR## ;SKIP IF NOT ALWAYS
TXNE F,FL$CHK ;OR IF /CHECK
SKIPA ;YES--NEED LOOKUP
JRST TYPOUT ;NO--MUCH FASTER
MOVE T1,EXLFIL+.RBNAM;GET FILE NAME
HLLZ T2,EXLFIL+.RBEXT;GET EXT
MOVEI T3,0 ;ZERO PRIV WORD
MOVE T4,EXLFIL+.RBPPN ;GET DIRECTORY
LOOKUP FILE,T1 ;FILE THERE?
JRST NOFILE ;NOPE--GOODIE
TXNE F,FL$CHK ;IF /CHECK
JRST TYPOUT ;ASSUME NORMAL HANDLING
MOVE T1,S.SUPR## ;GET SUPERSEDE CODE
CAIN T1,3 ;SKIP IF NOT SUPERSEDE NEVER
JRST CLSFL1 ;CLOSE FILE CORRECTLY
LDB T1,[POINTR (T3,RB.CRT)] ;GET CREATION TIME
IMULI T1,^D60000 ;CONVERT TO MILLISECONDS
LDB T2,[POINTR (T2,RB.CRX)] ;GET EXTENSION
LSH T2,^D12 ;SHIFT OVER
LDB T3,[POINTR (T3,RB.CRD)] ;GET BASE
IOR T2,T3 ;UNITE
PUSHJ P,CONVDT ;CONVERT TO SMITHSONIAN DATE/TIME
CAML T1,CCDATI ;SKIP IF DISK FILE OLDER THAN TAPE FILE [203]
JRST CLSFL1 ;DO NOT OVER-WRITE
SETOM SUSDF ;SET "SUPERSEDE DSK FILE" FLAG [206]
CLOSE FILE, ;DONE WITH FILE
NOFILE: TXNN F,FL$CHK ;NEW FILE--SEE IF /CHECK
JRST TYPOUT ;NOT /CHECK
WARN$N (CNF,Check file not on disk)
MOVEI P1,EXLFIL ;ADDRESS OF LOOKUP BLOCK
PUSHJ P,GUUO ;TYPE INFO
;HERE TO CLOSE FILE CHANNEL AND NOT DISTURB FILE
CLSFL1: CLOSE FILE,CL.ACS ;CLOSE
POPJ P, ;RETURN
TYPOUT: SKIPN S.TYMS## ;SKIP IF TYPE OUT NEEDED
JRST TYPE2 ;FORGET IT
SKIPE S.INTR## ;SEE IF INTERCHANGE MODE
JRST TYPE1 ;SKIP TYPING PATH INFO IF SO
MOVE T1,CSTR ;GET CURRENT STR
MOVE T2,PTHBLK+.PTPPN;GET CURRENT PPN
CAMN T1,PRESTR ;SAME AS LAST?
JRST STRSAM ;STRUCTURE IS THE SAME
MOVEM T1,PRESTR ;STORE NEW LAST STR
MOVEM T2,PREPPN ;STORE
PUSHJ P,TYLPPN ;TYPE LAST PPN
OUTCHR TAB ;TAB OVER
MOVE T1,PRESTR ;GET STR NAME
PUSHJ P,SIXOUT ;TYPE STR NAME
JRST TYPE0 ;TYPE <CR><LF> AND RESTORE
STRSAM: CAMN T2,PREPPN ;SAME AS LAST?
JRST TYPE1 ;YES--RESTORE
MOVEM T2,PREPPN ;NO--REPLACE
PUSHJ P,TYLPPN ;TYPE LAST PPN
TYPE0: OUTSTR CRLF ;<CR><LF>
TYPE1: MOVEI T1,2 ;SEE IF FILE NAMES WANTED
CAMN T1,S.TYMS## ;SKIP IF NOT
PUSHJ P,TYPFIL ;TYPE FILE NAME
TYPE2: SKIPE S.WRIT## ;UNLESS /NOWRITE
SKIPN T2,S.RSUM## ; SEE IF RESUMING
JRST NEWFIL ;NOT. ASSUME NORMAL HANDLING
MOVEI T1,4 ;NBR ARGS FOR LOOKUP
MOVEM T1,EXLFIL ;STORE
LOOKUP FILE,EXLFIL ;FILE SHOULD BE THERE
JRST [SETZM S.RSUM## ;NOT. ZILCH
CAIG T2,1 ;IF REALLY NEW FILE,
JRST NEWFIL ;THAT'S OK
JRST ELFIL] ;OTHERWISE DIE
TXNE F,FL$CHK ;SEE IF /CHECK,
JRST POSITN ;YES, GO POSITION
ENTER FILE,EXLFIL ;RE-ENTER TO UPDATE
JRST [SETZM S.RSUM## ;ZILCH
JRST EEFIL] ;ABORT FILE
POSITN: USETI FILE,(T2) ;POSITION
PUSHJ P,GENDBF ;GENERATE DISK BUFFERS
;HERE TO READ IN THE DISK BLOCK OR DO A DUMMY OUTPUT
PUSHJ P,@DSKIO ;EXEC
JRST XFRERR ;DISK I/O ERROR
JRST RSMERR ;EOF--MEANS USER GAVE INVALID CHECKPOINT
PUSHJ P,TYPRSM ;TYPE RESUMING MESSAGE
MOVE T1,S.RSUM## ;BLOCK NBR WE ARE STARTING AT
MOVEM T1,THSRDB ;STORE
ADDI T1,CP$INC ;ADD ON CHECKPOINT INCREMENT
MOVEM T1,CHKPNT ;SET NEW CHECKPOINT
MOVE T1,F$PCHK(MH) ;GET PATH CHECKSUM FROM TAPE RECORD HEADER
MOVEM T1,PTHCHK ;SAVE IT
SETZM S.RSUM## ;ZILCH
JRST CNTFIL ;CONTINUE WITH FILE
NEWFIL: MOVE T1,MDATA ;GET START OF DATA AREA
ADDI T1,200 ;POINT TO O$FILE BLOCK
PUSHJ P,LSTFIL ;LIST THIS FILE
TXNN F,FL$PSI ;SKIP FOLLOWING IF PSI ENABLED
JRST [PUSHJ P,OPRCMD##;HANDLE ANY TTY INPUT
TXO F,FL$KIL;RETURN HERE IF OPERATOR SAID KILL
JRST .+1] ;CONTINUE
TXNE F,FL$CHK ;IF /CHECK,
JRST NORMAL ; SKIP ENTER
SKIPN S.WRIT## ;IF /NOWRITE,
POPJ P, ; QUIT NOW
;HERE TO ENTER TAPE FILE ON DISK
ADDI P1,1 ;ADJUST TO POINT TO ATTRIBUTE DATA
MOVE T1,A$MODE(P1) ;GET CREATION MODE
SETSTS FILE,(T1) ;FAKE OUT FILSER
PUSHJ P,SETFIL ;SET UP FILE ENTER BLOCK
; HRRZ T3,EXLFIL+.RBEXT;SAVE COPY IN CASE OF ERROR [210]
ENTER FILE,EXLFIL ;TRY TO ENTER FILE
JRST CHKWHY ;LOSE--TRY TO RECOVER
;FILE IS ENTERED. HERE TO TRANSFER ACTUAL DATA.
NORMAL: PUSHJ P,GENDBF ;GENERATE DISK BUFFERS
MOVE P2,MDATA ;GET ADDRESS OF START OF DATA
ADD P2,G$LND(MH) ;SKIP NON-DATA SECTION
MOVE P1,G$SIZ(MH) ;GET NUMBER OF WORDS OF DATA
CAILE P1,400 ;SEE IF IN RANGE
MOVEI P1,400 ;NOT. USE MAX FOR FIRST TAPE BLOCK
MOVEI T1,CP$INC ;CHECKPOINT INCREMENT
MOVEM T1,CHKPNT ;SET INITIAL CHECKPOINT
MOVEI T1,1 ;START WITH RELATIVE-DATA-BLOCK 1
MOVEM T1,THSRDB ;STORE
MOVE T1,F$PCHK(MH) ;GET FILE PATH CHECKSUM
MOVEM T1,PTHCHK ;SAVE FOR LATER CHECKING
PUSHJ P,@DSKIO ;GET FIRST BUFFER OR DO DUMMY OUTPUT
JRST XFRERR ;ERROR RETURN
JRST DSKEO1 ;EOF RETURN--NULL DISK FILE
JUMPLE P1,CHKEND ;MAY BE 0 BLOCKS ON TAPE
XFR1: MOVSI T1,(P2) ;TAPE BUFFER ADDRESS
HRRI T1,(DBUF) ;DISK BUFFER ADDRESS
MOVEI T2,177(T1) ;USUALLY 200 WORDS
CAIL P1,200 ;SEE IF LAST BLOCK IN THIS TAPE BLOCK
JRST XFR2 ;NO
MOVEI T2,-1(T1) ;OFFSET
ADD T2,P1 ;POINT TO END
XFR2: XCT DSKBLT ;COPY OR COMPARE DATA
TXNN F,FL$CHK ;SEE IF /CHECK
CAIL P1,200 ;IS THIS THE LAST BLOCK?
JRST NOTLST ;NO--CONTINUE
;HERE IF LAST DISK BLOCK TO BE WRITTEN
MOVSI T1,(<OUT FILE,0>) ;WILL DO OUTPUT
MOVN T2,P1 ;NEGATE WORD COUNT
ADDM T2,DSKHDR+.BFCTR;DECREMENT BYTE COUNT
MOVNS T2 ;NEGATE AGAIN
PUSHJ P,ALTDSK ;PERFORM SPECIAL OUTPUT
JRST XFRERR ;ERROR RETURN
HALT . ;***TEMP***
JRST ENDBLK ;DONE
;HERE TO CONTINUE TRANSFERING FILE
NOTLST: PUSHJ P,@DSKIO ;ADVANCE DISK BUFFER
JRST XFRERR ;ERROR RETURN
JRST DSKEOF ;EOF RETURN
ENDBLK: ADDI P2,200 ;ADVANCE TO NEXT BLOCK IN RECORD
SUBI P1,200 ;SUBTRACT BLOCK FROM DATA COUNT
AOS T1,THSRDB ;ONE MORE BLOCK
PUSHJ P,RSTCKP ;DO CHECKPOINTING, IF NEEDED
JRST XFRERR ;ERROR DURING CHECKPOINTING
JUMPG P1,XFR1 ;SEE IF ANY MORE TO GO
CHKEND: MOVX T1,GF$EOF ;EOF BIT
TDNN T1,G$FLAG(MH) ;SKIP IF ON
JRST NOTNEW ;GO GET NEXT TAPE RECORD
TXNN F,FL$CHK ;SEE IF /CHECK,
JRST XFRDON ;NO--TRANSFER DONE
;HERE IF /CHECK AND TAPE EOF
WARN$N (CTS,Check tape file shorter)
PUSHJ P,DOWHAT ;TYPE FULL FILE PATH
MOVEI T1,[ASCIZ/ % Check tape file shorter
/]
SKIPE S.LIST ;SEE IF LISTING NEEDED
PUSHJ P,LSTMSG ;SEND MESSAGE TO LISTING FILE
JRST XFRDON ;DONE
;HERE TO GET ANOTHER TAPE RECORD
NOTNEW: PUSHJ P,XMTAIN ;GET NEXT RECORD
JRST XFRERR ;EOF OR KILL--ABORT FILE
MOVE T1,G$TYPE(MH) ;GET RECORD TYPE
CAIE T1,T$BEG ;START OF SAVE SET?
CAIN T1,T$CON ;CONTINUATION OF SAVE SET?
JRST [PUSHJ P,LSTXXX;YES, LIST IT
JRST NOTNEW] ;AND CONTINUE
CAIN T1,T$UFD ;SEE IF DIRECTORY RECORD
JRST [PUSHJ P,HAVUFD;CREATE RIB
JRST NOTNEW] ;CONTINUE
CAIN T1,T$LBL ;SEE IF LABEL RECORD
JRST NOTNEW ;***TEMP***
CAIE T1,T$FIL ;SHOULD BE FILE DATA
JRST XFRERR ;NO GOOD
;HERE TO CONTINUE WITH FILE SINCE RECORD CONTAINS FILE DATA.
CNTFIL: SKIPG P1,G$SIZ(MH) ;ANY SIGNIFICANT DATA?
JRST CHKEND ;NO--SHOULD BE END
CAILE P1,200*N ;SEE IF IN RANGE
MOVEI P1,200*N ;NOT. USE MAX NBR WORDS
MOVE P2,MDATA ;START OF DATA
MOVX T1,GF$SOF ;SEE IF START OF FILE,
TDNE T1,G$FLAG(MH) ;TEST FLAG IN HEADER
JRST MISMAT ;YES--MISSED EOF
MOVE T1,F$PCHK(MH) ;GET PATH CHECKSUM
CAME T1,PTHCHK ;MAKE SURE STILL ON SAME FILE
JRST MISMAT ;NOT. BAD NEWS
MOVE T1,F$RDW(MH) ;GET TAPE RELATIVE DATA WORD
ASH T1,-7 ;CALCULATE RELATIVE DATA BLOCK
AOS T1 ; ...
CAML T1,THSRDB ;SEE IF CURRENT OR LATER
JRST NEWDAT ;YES
MOVE T2,THSRDB ;LOAD NEEDED DISK BLOCK NUMBER
CAIL T2,N(T1) ;SEE IF NEEDED BLOCK IS IN THIS TAPE RECORD
JRST NOTNEW ;NO--DROP IT
SUB T2,T1 ;YES, GET DIFFERENCE
ASH T2,7 ;MULTIPLY BY 200 WORDS
ADD P2,T2 ;ADD TO DATA ADDRESS POINTER
SUB P1,T2 ;AND SUBTRACT FROM WORD COUNT
JUMPG P1,XFR1 ;GO TRANSFER OVER
JRST CHKEND ;FOUL UP?
NEWDAT: TXNN F,FL$CHK ;SEE IF /CHECK
CAMG T1,THSRDB ; OR IF THIS IS THE NEEDED BLOCK
JRST XFR1 ;YES--GO TRANSFER OVER
USETO FILE,(T1) ;NO--POSITION TO FILE BLOCK
MOVEM T1,THSRDB ; AND UPDATE FILE INDEX
JRST XFR1 ;PROCEED
DSKEOF: SUBI P1,200 ;COUNT LAST DATA XFR
DSKEO1: MOVX T1,GF$EOF ;SEE IF LAST TAPE BLOCK
TDNE T1,G$FLAG(MH) ;EOF BIT SHOULD BE ON
JUMPLE P1,XFRDON ;IF NO TAPE DATA LEFT, OK
WARN$N (CDS,Check disk file shorter)
MOVEI P1,EXLFIL ;ADDRESS OF LOOKUP BLOCK
PUSHJ P,GUUO ;TYPE FULL FILE PATH
MOVEI T1,[ASCIZ/ % Check disk file shorter
/]
SKIPE S.LIST ;SKIP IF LISTING NOT NEEDED
PUSHJ P,LSTMSG ;SEND MESSAGE TO LISTING
;FALL INTO XFRDON
;HERE WHEN RESTORE OR CHECK DONE. CLOSE DISK FILE AND CHECK.
XFRDON: MOVE T1,[CLOSE FILE,CL.ACS!CL.DLL] ;LOAD CLOSE UUO
TXNE F,FL$PAO ;POA FLAG ON?
TRZ T1,CL.DLL ;YES--CLEAR CLOSE BIT
XCT T1 ;EXEC FUNCTION
TXNE F,FL$CHK ;SEE IF /CHECK
JRST [SKIPE T1,CHKCNT;SEE IF ANY DIFFERENCES
SKIPN S.LIST ;AND IF LISTING NEEDED
JRST RLSFIL ;NO, SKIP LISTING COUNT
PUSHJ P,LSTTAB;TAB OVER
PUSHJ P,LSTDEC;LIST COUNT OF DIFFERENCES
MOVEI T1,[ASCIZ \ difference(s) found
\]
PUSHJ P,LSTMSG;SEND TO FILE
JRST RLSFIL] ;SKIP SIZE CHECK
IFN FT$DBG,<
PUSHJ P,SETFIL ;RESET LOOKUP/ENTER BLOCK
LOOKUP FILE,EXLFIL ;GET IT AGAIN
JRST ELFIL ;OUCH
MOVE T1,EXLFIL+.RBSIZ;GET FILE SIZE IN WORDS
CAMN T1,CWSIZE ;SAME AS TAPE'S?
JRST TAPERR ;YES
WARN$N (SCE,Size copy error)
MOVEI P1,EXLFIL ;LOAD ADDRESS OF BLOCK
PUSHJ P,GUUO ;TYPE NAME
>;END IFN FT$DBG
TAPERR: TXNN F,FL$TPE ;TAPE READ ERROR?
JRST RLSFIL ;NO, OK
PUSHJ P,SETFIL ;RESET LOOKUP/ENTER BLOCK
MOVX T1,RP.BFA ;INDICATE BACKUP READ ERROR
IORM T1,EXLFIL+.RBSTS;SET FLAG IN FILE STATUS WORD
RENAME FILE,EXLFIL ;RENAME TO STORE FLAG
JFCL ;NICE TRY
RLSFIL: RELEAS FILE, ;RELEASE CHANNEL
RELEAS UFD, ; ..
POPJ P, ;RETURN
MISMAT: WARN$ (HSI,Header file spec inconsistency)
SOS FX$CNT(SP) ;DON'T COUNT MATCH OF PARTIAL FILE
XFRERR: CLOSE FILE,CL.RST ;ABORT FILE
RELEAS FILE, ; ..
RELEAS UFD, ; ..
JRST EAFIL ;TYPE OUT BAD NEWS & RETURN
SUBTTL TAPE TO DISK SUBROUTINES
;+
;.CHAPTER TAPE TO DISK SUBROUTINES
;-
;+
;<COMPAR IS A ROUTINE TO COMPARE TWO AREAS.
;^CALLED WITH ^T1 HAVING <BLT POINTER, AND WITH ^T2 POINTING TO END.
;-
COMPAR: CAIGE T2,(T1) ;SEE IF DONE YET
POPJ P, ;YES--RETURN
HLRZ T3,T1 ;GET BUFFER 1 ADDRESS
MOVE T3,(T3) ;GET NEXT CONTENTS
CAMN T3,(T1) ;COMPARE WITH BUFFER 2
AOBJP T1,COMPAR ;LOOP UNTIL STOPPED
SKIPN CHKCNT ;SEE IF FIRST DIFFERENCE
PUSHJ P,CHKDIF ;YES, WARN USER
AOS CHKCNT ;STEP COUNT OF DIFFERENCES
AOBJP T1,COMPAR ;CONTINUE COMPARING
;+
;<CHKDIF REPORTS THE FIRST DIFFERENCE FOR A FILE ON </CHECK.
;-
CHKDIF: PUSHJ P,SAVE1 ;SAVE C(P1)
WARN$N (CFD,Check files are different)
MOVE T4,T1 ;COPY T1 POINTERS
SAVE$ <T1,T2>
MOVEI P1,EXLFIL ;ADDRESS OF LOOKUP BLOCK
PUSHJ P,GUUO ;TYPE FULL FILE PATH
SKIPN S.LIST ;SEE IF LISTING WANTED
JRST CHKDF1 ;LISTING NOT NEEDED
MOVEI T1,[ASCIZ/ % FIRST DIFFERENCE AT WORD /]
PUSHJ P,LSTMSG ;SEND MESSAGE
MOVE T1,THSRDB ;RELATIVE DATA BLOCK FOR DISK BUFFER
SOS T1 ;CALCULATE DISK WORD
ASH T1,7 ; ...
ADDI T1,(T4) ;ADD POSITION IN BUFFER
SUBI T1,(DBUF) ;SUBTRACT START ADDRESS OF BUFFER
PUSHJ P,LSTDEC ;SEND TO FILE
MOVEI T1,CRLF ;<CR><LF>
PUSHJ P,LSTMSG ;SEND TO FILE
MOVEI T1,[ASCIZ/ DISK: /]
PUSHJ P,LSTMSG ;SEND TO FILE
HLRZ T1,(T4) ;GET LEFT HALF OF DISK WORD
PUSHJ P,LSTOCT ;SEND TO FILE
MOVEI T1,[ASCIZ/,,/]
PUSHJ P,LSTMSG ;HALF WORD FORMAT
HRRZ T1,(T4) ;GET RIGHT HALF OF DISK WORD
PUSHJ P,LSTOCT ;SEND TO FILE
MOVEI T1,[ASCIZ/ TAPE: /]
PUSHJ P,LSTMSG ;SEND TO FILE
MOVSS T4 ;POINT TO TAPE WORD
HLRZ T1,(T4) ;GET LEFT HALF OF TAPE WORD
PUSHJ P,LSTOCT ;SEND TO FILE
MOVEI T1,[ASCIZ/,,/] ;HALF WORD FORMAT
PUSHJ P,LSTMSG ;SEND TO FILE
HRRZ T1,(T4) ;GET RIGHT HALF OF TAPE WORD
PUSHJ P,LSTOCT ;SEND TO FILE
MOVEI T1,CRLF ;<CR><LF>
PUSHJ P,LSTMSG ;SEND TO FILE
CHKDF1: RSTR$ <T2,T1>
POPJ P, ;RETURN
;+
;<GETDAT IS A SUBROUTINE TO GET FILE PATH DATA FROM THE <O$NAME BLOCK,
;OR FROM THE TAPE RECORD HEADER IF P2 = 0. ^CALL WITH ^T1 = TYPE CODE.
;^IF NEW FILE, ASSUMES ^P1 POINTS TO THE FIRST SUB-BLOCK,
;AND ^P2 POINTS TO THE END OF THE <O$NAME BLOCK.
;^RETURNS FILE DATA IN ^T1 OR ^T1 = 0 IF DATA NOT ON TAPE.
;-
GETDAT: PUSHJ P,SAVE2 ;SAVE C(P1) & C(P2)
MOVE T2,T1 ;COPY TYPE
JUMPN P2,GETONM ;IF NEW FILE, GET INFO FROM O$NAME BLOCK
MOVEI P2,F$PTH(MH) ;POINT TO FILE PATH INFO IN HEADER
GETHDR: SETZ T1, ;ZILCH
MOVSI T3,440700 ;MAKE ASCII BYTE POINTER
CAIGE P2,M(MH) ;REACHED END OF HEADER?
SKIPN (P2) ; OR NULL WORD?
POPJ P, ;YES, RETURN WITHOUT DATA
HRR T3,P2 ;BP TO NEW STRING
ILDB T1,T3 ;GET TYPE CODE FROM HEADER
ILDB P2,T3 ;GET LENGTH OF STRING IN WORDS
ADDI P2,(T3) ;SET TO POINT TO NEXT STRING
CAME T1,T2 ;RIGHT ONE?
JRST GETHDR ;NO--TRY NEXT
CAIE T1,.FCDIR ;PPN?
JRST GETSIX ;NO--CONVERT TO SIXBIT
JRST GETPPN ;YES
GETONM: SETZ T1, ;ZILCH IN CASE NOT THERE
HLRZ T3,(P1) ;GET SUB-BLOCK TYPE
CAMN T2,T3 ;COMPARE
JRST GOTDAT ;MATCH
ADD P1,(P1) ;ADVANCE SUB-BLOCK POINTER
SKIPE (P1) ;DONE IF ZERO
CAIG P2,(P1) ;OR IF REACHED END OF O$NAME BLOCK
POPJ P, ;RETURN
JRST GETONM ;TRY NEXT SUB-BLOCK
GOTDAT: MOVE T3,[POINT 7,1(P1)];BP TO ASCIZ STRING
CAIN T2,.FCDIR ;UFD?
JRST GETPPN ;YES--GET PPN
;FALL INTO GETSIX
GETSIX: MOVE T4,[POINT 6,T1];MAKE SIXBIT BP TO T1
SETZ T1, ;CLEAR
GETSX1: CAIG P2,(T3) ;SEE IF REACCHED END OF BLOCK
POPJ P, ;YES, DONE
ILDB T2,T3 ;GET CHAR
JUMPE T2,CPOPJ ;QUIT IF NULL
SUBI T2," "-' ' ;SIXBITIZE
IDPB T2,T4 ;SET IN T1
TLNE T4,77B23 ;SEE IF T1 FULL
JRST GETSX1 ;BACK FOR NEXT CHAR
POPJ P, ;DONE
GETPPN: SETZ T1, ;ZILCH
PUSHJ P,GETOCT ;GET PROJECT NUMBER
POPJ P, ;RETURN WITH PPN=0 IF JUNK ON TAPE
HRLZ T1,T4 ;POSITION
PUSHJ P,GETOCT ;GET PROGRAMMER NUMBER
TDZA T1,T1 ;ZILCH IF JUNK ON TAPE
HRR T1,T4 ;SET IN T1
POPJ P, ;RETURN
GETOCT: SETZ T4, ;CLEAR T4
GETOC1: CAIG P2,(T3) ;SEE IF REACHED END OF BLOCK
JRST CPOPJ1 ;YES, RETURN
ILDB T2,T3 ;GET CHARACTER
SKIPE T2 ;SKIP IF NULL
CAIN T2,"_" ;SEE IF UNDERLINE
JRST CPOPJ1 ;GIVE SKIP RETURN
CAIG T2,"7" ;RANGE CHECK
CAIGE T2,"0" ;SHOULD BE OCTAL DIGIT
POPJ P, ;NOT. GIVE BAD RETURN
SUBI T2,"0" ;DE-ASCIITIZE
ASH T4,3 ;MULTIPLY BASE BY 8
ADD T4,T2 ;ADD IN NEW DIGIT
JRST GETOC1 ;LOOP FOR MORE
;+
;<RSTRIB IS A SUBROUTINE TO FILL AN EXTENDED ENTER BLOCK FROM THE <O$FILE TAPE BLOCK.
;^CALL WITH ^P1 = ADDRESS <O$FILE BLOCK, ^P2 = ADDRESS OF OUTPUT. ^USES ^T1-^T4.
;-
RSTRIB: PUSHJ P,SAVE1 ;SAVE C(P1)
ADDI P1,1 ;MAKE POINTER TO ATTRIBUTE DATA
MOVEI T1,NRIB-1 ;NBR ARGS
MOVEM T1,.RBCNT(P2) ;STORE
MOVE T1,A$WRIT(P1) ;GET CREATION DATE/TIME
PUSHJ P,CONTDT ;CONVERT TO SYSTEM FORMAT
DPB T2,[POINTR (.RBPRV(P2),RB.CRD)];LOW ORDER CREATION BITS
LSH T2,-^D12 ;POSITION HIGH ORDER BITS OF CREATION DATE
DPB T2,[POINTR (.RBEXT(P2),RB.CRX)];SET IN ENTER BLOCK
IDIVI T1,^D60000 ;CONVERT TIME FROM MS TO MINUTES
SKIPE T2 ;SEE IF OVERFLOW
AOS T1 ;YES, ONE MORE MINUTE
DPB T1,[POINTR (.RBPRV(P2),RB.CRT)];SET CREATION TIME
MOVE T1,A$VERS(P1) ;GET VERSION FROM TAPE
MOVEM T1,.RBVER(P2) ;SET IN FILE RIB
MOVE T1,A$ALLS(P1) ;GET NBR ALLOCATED WORDS
IDIVI T1,200 ;GET NBR ALLOCATED BLOCKS
SKIPE T2 ;SEE IF OVERFLOW
AOS T1 ;YES, ONE MORE BLOCK
MOVEM T1,.RBEST(P2) ;SET AS ESTIMATE
SKIPE S.INTR## ;SEE IF /INTERCHANGE
POPJ P, ;YES, IGNORE REST OF O$FILE BLOCK
;HERE TO FILL REST OF ENTER BLOCK FOR NON-INTERCHANGE MODE
SKIPE A$RADR(P1) ;SEE IF ADDRESS REQUESTED
MOVEM T1,.RBALC(P2) ;YES--SET AS ALLOCATED ALSO
SKIPN T1,A$ESTS(P1) ;SEE IF FILE ESTIMATE SET,
JRST RSTADT ;NO, CONTINUE
IDIVI T1,200 ;YES--USE IT TO CALCULATE .RBEST
SKIPE T2 ;SEE IF OVERFLOW
AOS T1 ;ONE MORE BLOCK
MOVEM T1,.RBEST(P2) ;UPDATE .RBEST
RSTADT: MOVE T1,A$REDT(P1) ;GET ACCESS DATE/TIME
PUSHJ P,CONTDT ;CONVERT TO SYSTEM STANDARD
DPB T2,[POINTR (.RBEXT(P2), RB.ACD)];SET IN ENTER BLOCK
SKIPE T1,A$PROT(P1) ;SEE IF PROTECTION SET,
PUSHJ P,RSTPRO ; GET PROTECTION & CONVERT
DPB T1,[POINTR (.RBPRV(P2), RB.PRV)];STORE
PUSH P,P2 ;SAVE OUTPUT ADDRESS
HRRZ P2,-1(P1) ;GET LENGTH OF O$FILE BLOCK
ADDI P2,-1(P1) ;ADD IN START ADDRESS
MOVE T3,A$NOTE(P1) ;GET BP TO ASCIZ STRING (.RBSPL)
JUMPE T3,RSTMTI ;NONE
ADD T3,P1 ;ADD START ADDRESS
PUSHJ P,GETSIX ;CONVERT TO SIXBIT
MOVE T2,(P) ;WHERE TO STORE
MOVEM T1,.RBSPL(T2) ;STORE
RSTMTI: MOVE T3,A$BKID(P1) ;GET RELATIVE BP TO SAVE NAME
JUMPE T3,RSTAUT ;NONE
ADD T3,P1 ;ADD START ADDRESS
PUSHJ P,GETSIX ;CONVERT TO SIXBIT
MOVE T2,(P) ;WHERE TO STORE
MOVEM T1,.RBMTA(T2) ;STORE
RSTAUT: MOVE T3,A$CUSR(P1) ;GET RELATIVE BP TO AUTHOR
JUMPE T3,RSTUSR ;NONE
ADD T3,P1 ;ADD START ADDRESS
PUSHJ P,GETPPN ;CONVERT TO PPN
MOVE T2,(P) ;WHERE TO STORE
MOVEM T1,.RBAUT(T2) ;STORE
RSTUSR: POP P,P2 ;RESTORE P2
MOVE T1,A$USRW(P1) ;GET CUSTOMER WORDS FROM TAPE
MOVEM T1,.RBNCA(P2) ; ...
MOVE T1,A$PCAW(P1) ; ...
MOVEM T1,.RBPCA(P2) ; ...
MOVEI T1,0 ;ZILCH
MOVE T2,A$FLGS(P1) ;GET BACKUP FLAGS FROM TAPE
MOVSI T3,-LN$FLG ;LENGTH OF FLAG TABLES
RSTFLG: TDNE T2,BKPFLG(T3) ;IF BACKUP FLAG SET,
IOR T1,RIBFLG(T3) ; SET CORRESPONDING RIB FLAG
AOBJN T3,RSTFLG ;LOOP
MOVEM T1,.RBSTS(P2) ;STORE FLAGS
MOVE T1,A$RADR(P1) ;GET REQUESTED DISK ADDRESS
IDIVI T1,200 ;CONVERT TO LOGICAL BLOCK NBR
MOVEM T1,.RBPOS(P2) ;STORE
POPJ P, ;RETURN
;+
;<RSTPRO IS A SUBROUTINE TO RETURN THE <RIB PROTECTION FOR A FILE
;FROM THE <BACKUP PROTECTION WORD. ^CALLED WITH ^P1 = ADDRESS OF
;ATTRIBUTE DATA, RETURNS PROTECTION IN ^T1. ^USES ^T1-^T4.
;-
RSTPRO: LDB T1,[POINTR (A$PROT(P1), AC$OWN)];GET OWNER ACCESS FIELD
PUSHJ P,RSTPRT ;CONVERT
MOVEM T1,T4 ;SAVE PROGRAMMER PROTECTION
LDB T1,[POINTR (A$PROT(P1), AC$GRP)];GET GROUP ACCESS FIELD
PUSHJ P,RSTPRT ;CONVERT
LSH T4,3 ;POSITION
IORM T1,T4 ;UNITE AND SAVE
LDB T1,[POINTR (A$PROT(P1), AC$WLD)];GET WORLD ACCESS FIELD
PUSHJ P,RSTPRT ;CONVERT
LSH T4,3 ;POSITION
IOR T1,T4 ;UNITE
POPJ P, ;RETURN WITH PROTECTION IN T1
;+
;<RSTPRT IS A SUBROUTINE TO CONVERT A <BACKUP ACCESS FIELD
;TO A <TOPS-10 PROTECTION VALUE. ^CALLED WITH ACCESS FIELD IN ^T1,
;RETURNS <RIB PROTECTION IN ^T1. ^USES ^T1-^T3.
;-
RSTPRT: MOVEI T3,7 ;START WITH MAX PROTECTION
LDB T2,[POINTR (T1,PR$RED)];GET READ ACCESS BITS
SUB T3,T2 ;ADJUST PROTECTION
CAIGE T3,5 ; ...
MOVEI T3,5 ; ...
LDB T2,[POINTR (T1, PR$WRT)];GET WRITE ACCESS BITS
JUMPN T2,[MOVEI T3,5 ;USE MAX OF 5
SUB T3,T2 ;ADJUST
JRST .+1] ;PROCEED
LDB T2,[POINTR (T1, PR$ATR)];GET ATTRIBUTE FIELD
CAIN T2,7 ;SEE IF = 7
MOVEI T3,1 ; RESET PROTECTION TO 1
CAIN T2,6 ;SEE IF = 6
MOVEI T3,0 ; RESET
MOVE T1,T3 ;COPY PROTECTION
POPJ P, ;RETURN
;+
;<RSTCKP IS A SUBROUTINE TO PRESERVE THE DISK OUTPUT FILE ON A
;RESTORE AT CHECKPOINTS. ^CALLED WITH ^T1 = CURRENT DISK BLOCK.
;^GIVES NON-SKIP RETURN IF PROBLEM WITH LOOKUP OR ENTER.
;-
RSTCKP: SKIPE S.CKPT## ;SEE IF /CPOINT
CAME T1,CHKPNT ; AND CHECKPOINT REACHED
JRST CPOPJ1 ;NO--SKIP BACK
RSTCK1: TXNE F,FL$CHK ;IF /CHECK,
JRST RSTCK2 ;DO TYPEOUT ONLY
CLOSE FILE,CL.ACS ;CLOSE TO PRESERVE FILE
LOOKUP FILE,EXLFIL ;DO LOOKUP
JRST ELFIL ;NOT THERE!!
ENTER FILE,EXLFIL ;RE-ENTER TO UPDATE
JRST EEFIL ;GIVE ERROR RETURN
USETI FILE,-1 ;POSITION TO END TO APPEND
PUSHJ P,GENDBF ;GENERATE DISK BUFFERS
PUSHJ P,DSKOUT ;DO DUMMY OUTPUT
POPJ P, ;ERROR!
HALT RSTCKP ;EOF RETURN--SHOULD NEVER HAPPEN ON OUTPUT
MOVE T1,CHKPNT ;GET CHECKPOINT BACK
RSTCK2: TXNN F,FL$EOV ;IF EOV, NO TYPEOUT
PUSHJ P,TYPCKP ;TYPE CHECKPOINT
JRST CPOPJ1 ;SKIP RETURN
GENDBF: SETSTS FILE,.IOBIN ;BACK TO BUFFERED BINARY
MOVE T1,[OUTBUF FILE,NDSKBF] ;SET UP BUFFERS
TXNE F,FL$CHK ;IF /CHECK,
MOVE T1,[INBUF FILE,NDSKBF] ; DO INBUF
XCT T1 ;GENERATE BUFFERS
POPJ P, ;RETURN
;+
;^A BRANCH TO <CHKWHY IS TAKEN IF THE <ENTER <UUO FOR RESTORING A TAPE
;FILE FAILS. ^IF A MISSING DIRECTORY IN THE RESTORATION PATH CAUSED THE
;FAILURE, THE NEEDED DIRECTORY IS CREATED, AND THE <ENTER RETRIED.
;-
CHKWHY: HRRZ T1,EXLFIL+.RBEXT;GET ERROR CODE
CAIN T1,ERPOA% ;PARTIAL ALLOCATION?
JRST POACOD ;YES--FIX
CAIE T1,ERIPP% ;SKIP IF NO UFD
CAIN T1,ERSNF% ;SFD NOT FOUND?
SKIPA ; YES--CAN TRY FIX UP
JRST EEFIL ;FATAL ERROR
SETZ LVL, ;START AT UFD LEVEL
MAKSFD: SKIPN T1,APATH+.PTPPN(LVL) ;SEE IF LEVEL EXISTS
JRST PATHOK ;NOPE. TRY ENTER AGAIN
MOVE T2,LVL ;WHAT LEVEL WE'RE AT
IMULI T2,NRIB ;HOW MANY WORDS PER RIB
ADD T2,ADRLST ;ADD IN BASE ADDRESS
HRLZ T3,T2 ;LH
HRRI T3,EXLUFD ;BLOCK
BLT T3,EXLUFD+NRIB-1;TRANSFER
MOVEM T1,EXLUFD+.RBNAM;STORE NAME
MOVE T1,MFDPPN ;GET MFD PPN
MOVEM T1,EXLUFD+.RBPPN;SET PPN
MOVSI T1,'UFD' ;INSURE CORRECT EXTENSION
JUMPLE LVL,LEVEL0 ;SKIP FOLLOWING IF UFD
MOVE T1,APATH+.PTPPN-1(LVL) ;GET ONE HIGHER SFD
MOVEM T1,UPTBLK+.PTPPN-1(LVL) ;STORE
SETZM UPTBLK+.PTPPN(LVL) ;INSURE TRAILING ZERO
MOVEI T1,UPTBLK ;WHERE TO FIND PATH
MOVEM T1,EXLUFD+.RBPPN;STORE
MOVSI T1,'SFD' ;LOAD EXTENSION
LEVEL0: HLLM T1,EXLUFD+.RBEXT;STORE EXTENSION
MOVEI T1,3 ;JUST .RBPPN,NAM,EXT
MOVEM T1,EXLUFD+.RBCNT;STORE
LOOKUP UFD,EXLUFD ;IS IT THERE?
JRST ENTSFD ;MUST DO ENTER
JRST NXTSFD ;THAT GUY'S THERE
ENTSFD: MOVEI T1,NRIB-1 ;WHOLE RIB
MOVEM T1,EXLUFD+.RBCNT;STORE
HRRZ T1,.RBEXT(T2) ;GET RH BACK
HRRM T1,EXLUFD+.RBEXT;CLEAR ERROR CODE AND RESET
MOVEI T1,RP.DIR ;DIRECTORY BIT
MOVEM T1,EXLUFD+.RBSTS;SET IT
SETZM EXLUFD+.RBDEV ;ZILCH
SETZM EXLUFD+.RBELB ; ..
SETZM EXLUFD+.RBEUN ; ..
SETZM EXLUFD+.RBUSD ; ..
SETZM EXLUFD+.RBNXT ; ..
SETZM EXLUFD+.RBPRD ; ..
SETZM EXLUFD+.RBUFD ; ..
SETZM EXLUFD+.RBFLR ; ..
SETZM EXLUFD+.RBXRA ; ..
SKIPLE T1,S.UPRT## ;SEE IF /UPROTECT
DPB T1,[POINTR (EXLUFD+.RBPRV, RB.PRV)];SET IT
HRLOI T1,377777 ;PLUS INFINITY AS DEFAULT QUOTA
HRLOI T2,001777 ; PLUS INFINITY IN WORDS [214]
CAMN T2,EXLUFD+.RBQTF; IS IT? [214]
MOVEM T1,EXLUFD+.RBQTF; YES - BACK TO BLOCKS [214]
CAMN T2,EXLUFD+.RBQTO; PLUS INFINITY IN WORDS? [214]
MOVEM T1,EXLUFD+.RBQTO; YES - BACK TO BLOCKS [214]
SKIPN S.INTR## ; DOES 0 DENOTE +INFINITY? [215]
JRST ENTSF2 ; NO - NOT INTERCHANGE MODE [215]
SKIPG EXLUFD+.RBQTF ;QUOTA SET?
MOVEM T1,EXLUFD+.RBQTF;USE DEFAULT
SKIPG EXLUFD+.RBQTO ;QUOTA SET?
MOVEM T1,EXLUFD+.RBQTO;USE DEFAULT
ENTSF2: ENTER UFD,EXLUFD ;ATTEMPT TO CREATE UFD [215]
JRST EEUFD ;ERROR RETURN
USETO UFD,2 ;INSURE 1 BLOCK
NXTSFD: CLOSE UFD,CL.ACS ;CLOSE UFD
AOJA LVL,MAKSFD ;LOOP
PATHOK: PUSHJ P,SETFIL ;RESET EXLFIL BLOCK
MOVE T1,A$WRIT(P1) ;GET CREATION DATE/TIME [210]
PUSHJ P,CONTDT ;CONVERT TO SYSTEM FORMAT [210]
LSH T2,-^D12 ;GET JUST HI-ORDER BITS [210]
DPB T2,[POINTR (.RBEXT(P2),RB.CRX)];RESTORE DATE [210]
ENTER FILE,EXLFIL ;TRY TO ENTER FILE
SKIPA ;CHECK FOR ERPOA%
JRST NORMAL ;OK
HRRZ T1,EXLFIL+.RBEXT;GET ERROR CODE
CAIE T1,ERPOA% ;POA?
JRST EEFIL ;NO--QUIT
POACOD: TXO F,FL$PAO ;FLAG AS SUCH
JRST NORMAL ;PROCEED
SETFIL: MOVEI T1,NRIB-1 ;ARG COUNT
MOVEM T1,EXLFIL+.RBCNT;STORE
SETZM EXLFIL+.RBPOS ; ..
SETZM EXLFIL+.RBDEV ; ..
SETZM EXLFIL+.RBSTS ; ..
SETZM EXLFIL+.RBELB ; ..
SETZM EXLFIL+.RBEUN ; ..
SETZM EXLFIL+.RBUSD ; ..
SETZM EXLFIL+.RBNXT ; ..
SETZM EXLFIL+.RBPRD ; ..
SETZM EXLFIL+.RBUFD ; ..
SETZM EXLFIL+.RBFLR ; ..
SETZM EXLFIL+.RBXRA ; ..
POPJ P, ;RETURN
SUBTTL TAPE INPUT/OUTPUT SUBROUTINES
;+
;.CHAPTER TAPE I/O ROUTINES
;
;<MTAOUT IS THE SUBROUTINE TO OUTPUT A TAPE RECORD. ^ALL WRITE PROBLEMS
;(INCLUDING WRITE LOCK) ARE CORRECTED WITHIN THIS SUBROUTINE.
;^WRITE ERRORS ARE CORRECTED FOR BY REWRITING THE DATA IN A
;REPEATER RECORD. (^THIS DEPENDS ON THE SYNCRONIZE-IF-ERROR FEATURE
;OF 6.02 AND LATER MONITORS.) ^CALL WITH <MH = ADDRESS OF OUTPUT BLOCK HEADER.
;^IT IS ASSUMED THAT THE DATA FOLLOWS THE HEADER IMMEDIATELY.
;-
;HERE FOR ENTRY POINT AND ENCRIPTION CODE
MTAOUT: TXNE F,FL$KIL ;IF KILL ALREADY, DON'T WRITE MORE
POPJ P, ;RETURN
PUSHJ P,SAVE3 ;PRESERVE ACS
MOVE T1,G$TYPE(MH) ;GET RECORD CODE
CAIN T1,T$FIL ;FILE DATA?
SKIPN S.CRYP## ;PASSWORD TYPED?
JRST MTAOU1 ;LOSE--NO SCRAMBLING
MOVEM 7,SAVACS+7 ;SAVE AC0 THRU AC7
MOVEI 7,SAVACS ; ..
BLT 7,SAVACS+6 ; ..
MOVE 7,SAVACS+7 ;RESTORE IF NEEDED
TXOE F,FL$INI ;INITIALIZED?
JRST CLSCRM ;YES--SKIP THIS
IFLE F-7,<
MOVEM F,SAVACS+F ;STORE NEWLY SET BIT
>;END IFLE F-7
MOVEI 7,S.CRYP## ;LOC OF PASSWORD
PUSHJ P,CRASZ.## ;CALL CODER
MOVEM 5,SVCODE ;SAVE SEED
CLSCRM: MOVSI 7,-200*N ;HOW MANY WORDS
HRRI 7,M(MH) ;WHERE IT'S AT
MOVE 1,G$LND(MH) ;GET LENGTH OF NON-DATA SECTION
HRLS 1 ;PUT IN LH ALSO
ADD 7,1 ;DON'T ENCRYPT NON-DATA
MOVE 6,F$RDW(MH) ;GET RELATIVE WORD
ADDI 6,200 ;FORCE OVERFLOW
ASH 6,-7 ;GET RELATIVE BLOCK
MOVE 5,SVCODE ;GET SEED BACK
PUSHJ P,CRYPT.## ;CALL ENCRIPTER
MOVSI 7,SAVACS ;RESTORE REGISTERS
BLT 7,7 ; ..
MTAOU1: AOS T1,NSEQ ;GET SEQUENCE NUMBER
MOVEM T1,G$SEQ(MH) ;STORE
MOVE T1,NTPE ;GET TAPE NUMBER
MOVEM T1,G$RTNM(MH) ;STORE
IFE FT$CHK <
MOVX T1,GF$NCH ;INDICATE NO CHECKSUM
IORM T1,G$FLAG(MH) ;SET FLAG IN RECORD HEADER
>;END IFE FT$CHK
IFN FT$CHK <
PUSHJ P,CHKSUM ;COMPUTE CHECKSUM
>;END IFN FT$CHK
DUMOUT: SETZB P3,S.MBPT##+.BFCTR;ZERO COUNT AND ERROR POSITION POINTER
MOVEI T1,MTBBKP ;LOAD OUTPUT BLOCK SIZE
ADDM T1,S.MBPT##+.BFPTR;INCREMENT BYTE POINTER
OUT F.MTAP, ;EXECUTE OUTPUT UUO
JRST MTASET ;SUCCESSFUL OUTPUT
OUTERR: WAIT F.MTAP, ;WAIT FOR I/O TO FINISH
GETSTS F.MTAP,P1 ;GET ERROR STATUS BITS
TRNN P1,IO.IMP ;CHECK WRITE LOCK BIT
JRST NOTLOK ;NO--CHECK OTHERS
SETSTS F.MTAP,.IOBIN ;CLEAR STATUS
OPER$ (TWL,Tape write locked--add write ring then type "GO")
PUSHJ P,TYI ;WAIT FOR GO
JRST MTASET ;ALL OK
NOTLOK: TRNN P1,IO.EOT ;CHECK END OF TAPE BIT
JRST NOTEOT ;NO--CHECK OTHERS
TXNE F,FL$EOV ;SEE IF EOV SENT
JRST MTASET ;IT HAS. FINISH THIS TAPE UP
TXO F,FL$END ;INDICATE END OF SAVE
PUSHJ P,MTASET ;FORCE OUTPUT OF REMAINING BUFFERS
MOVEI T1,T$EOV ;FORM EOV RECORD
MOVEM T1,G$TYPE(MH) ;STORE
TXO F,FL$END!FL$EOV ;WILL FORCE OUT EOV RECORD
PUSHJ P,MTAOU1 ;SEND EOV
;FALL INTO MULTIR
; HERE TO HANDLE REEL SWITCHING
MULTIR: TXZ F,FL$EOV ;CLEAR EOV FLAG
TXNN F,FL$RCV ;SEE IF RECOVERY CODE AVAILABLE
JRST [CLOSE F.MTAP, ;NO--WRITE THE REST OF THE BLOCKS
PUSHJ P,DUMOUT;DO A DUMMY OUTPUT
JRST MULTR2] ;PROCEED
MTEOF. F.MTAP, ;WRITE 2 EOFS
MTEOF. F.MTAP, ; ..
MULTR2: SKIPE S.MULT## ;SEE IF /NOMULTIREEL
JRST NEWTAP ;NO, GO ASK FOR NEW TAPE
OUTSTR [ASCIZ/
?BKPRES Reached EOT on single reel save
/]
MONRT. ;.CONTINUE WILL WORK
NEWTAP: AOS NTPE ;INCREMENT TAPE NUMBER
PUSHJ P,NEXTAP ;GET NEXT TAPE
SETZM ERRCNT ;INITIALIZE COUNT FOR NEW REEL
TXNE F,FL$KIL ; WAS KILL TYPED? [200]
POPJ P, ; YEP - SO EXIT [200]
MOVEI T1,T$CON ;CONTINUATION OF SAVE SET
PUSHJ P,GENSAV ;WRITE T$CON ON NEW TAPE
SKIPE S.INTR## ;SEE IF /INTERCHANGE
POPJ P, ;YES, DON'T WRITE T$UFD RECORDS
MOVSI T1,-.FXLND ;HOW MANY LEVELS
HRRZS ADRLST(T1) ;CLEAR LH(ADRLST)
AOBJN T1,.-1 ; ...
PUSHJ P,WRTUFD ;WRITE T$UFD RECORDS
POPJ P, ;RETURN
NEXTAP: SKIPE CNAM ;FILE SPLIT ACCROSS REELS?
PUSHJ P,TYEFIL ;YES, TYPE FILE SPEC AND BLOCK NBR
MTUNL. F.MTAP, ;START UNLOADING THE TAPE
OPER$ (EOT,Reached EOT--mount new tape then type "GO")
PUSHJ P,TYI ;WAIT FOR GO
POPJ P, ;RETURN
;HERE TO SAVE THE RING HEADER'S POSITION AFTER THE FIRST ERROR
NOTEOT: SKIPN P3 ;SEE IF FIRST TIME THRU
HRRZ P3,S.MBPT## ;YES--SAVE CURRENT POSITION IN RING
;HERE TO FIND THE BUFFER WHICH HAD THE OUTPUT PROBLEM
PUSHJ P,FNDBUF ;FIND THE BUFFER
JRST NOFIND ;LOSE
;HERE WHEN PROBLEM BUFFER FOUND
FOUND: ANDCAM P1,-1(P2) ;CLEAR ERROR BITS IN BUFFER STATUS WORD
TXNE P1,IO.DER!IO.DTE!IO.BKT ;DATA ERRORS?
JRST DATERR ;YES
NOREPT: SETSTS F.MTAP,.IOBIN ;NO--ONLY EOT, CLEAR STATUS
HRRZ P2,(P2) ;FORCE OUT FOLLOWING BUFFER
CAME P2,P3 ; UNLESS DONE WITH RING
JRST FRCOUT ;FORCE OUT NEXT BUFFER
TXNN F,FL$EOV ;WROTE EOV ALREADY?
JRST MTASET ;NO
JRST NORCOV ;YES
DATERR: MOVEI MH,2(P2) ;SET POINTER
PUSHJ P,MASTER ;REPORT ERROR
MOVE T1,ERRCNT ;GET COUNT OF TAPE ERRORS
TXNE P1,IO.EOT ;PASSED EOT?
CAIGE T1,EOTEMX ;YES--TIME TO GIVE UP ON REPEATERS?
SKIPA ;NO, PROCEED
JRST NOREPT ;YES
IFN FT$EMX,<
CAIGE T1,EMAX ;SEE IF MAXIMUM REACHED
JRST CNTOUT ;NO--CONTINUE OUTPUTTING
OUTSTR [ASCIZ /
?BKPRTE Reached Tape error maximum
/]
MONRT. ;EXIT TO MONITOR
SETZM ERRCNT ;.CONTINUE WILL KEEP TRYING
>;END IFN FT$EMX
;READY TO WRITE REPEATER RECORD--WRITE 3 INCHES BLANK TAPE FIRST
;TO PASS BAD SPOT ON TAPE.
CNTOUT: MTBLK. F.MTAP, ;WRITE 3 IN. BLANK TAPE
SETSTS F.MTAP,.IOBIN ;CLEAR STATUS AFTER WRITING BLANK TAPE
;SEE IF REALLY CAN USE RECOVERY CODE
SKIPE (MH) ;SEE IF MONITOR ZEROED BUFFER IN SPITE OF UU.IBC
TXNN F,FL$RCV ;OR IF MONITOR DOESN'T SUPPORT UU.SIE
JRST MTARST ;NO RECOVERY POSSIBLE
;TO PREVENT RUNNING OFF THE END OF TAPE, WRITE ONLY ONE REPEATER
;OF A BAD RECORD AFTER IO.EOT IS SEEN
IFN FT$RCV,<
MOVX T1,GF$RPT ;REPEATER FLAG
TDNE T1,G$FLAG(MH) ;SEE IF THIS IS A REPEATER
TXNN P1,IO.EOT ; AND NEAR END OF TAPE
SKIPA ;NO--WRITE A REPEATER RECORD
JRST NOREPT ;YES--GIVE UP ON THIS RECORD
IORM T1,G$FLAG(MH) ;SET REPEATER FLAG IN RECORD HEADER
IFN FT$CHK <
PUSHJ P,CHKSUM ;CORRECT CHECKSUM FOR REPEATER RECORD
>;END IFN FT$CHK
;CLEAR ALL USE BITS TO INSURE THAT THE REPEATER RECORD IS THE NEXT
;RECORD ACTUALLY OUTPUT TO TAPE
FRCOUT: MOVSI T1,(1B0) ;USE BIT
MOVE T2,P2 ;WHERE TO START
CLRUSE: ANDCAM T1,(T2) ;CLEAR USE BIT
HRR T2,(T2) ;GO AROUND RING
CAME T2,P2 ;DONE?
JRST CLRUSE ;NO
;READY TO DO OUTPUT. RESET RING HEADER BYTE POINTER TO FAKE OUT MONITOR
HRRM P2,S.MBPT## ;POINT RING HEADER TO ERROR BUFFER
MOVEI T1,1(P2) ;PRETEND JUST FINISHED FILLING
ADDI T1,MTBBKP ;THIS BUFFER
HRRM T1,S.MBPT##+.BFPTR;SET BYTE POINTER
SETZM S.MBPT##+.BFCTR ;ZILCH COUNT
;IF THIS OUTPUT WINS, MAKE SURE ALL CURRENTLY FILLED BUFFERS
;IN RING ARE OUTPUT BEFORE FILLING ANY NEW BUFFER.
OUT F.MTAP,(P2) ;WRITE REPEATER RECORD
JRST BUFOUT ;WON--SEE IF MONITOR HAS CAUGHT UP YET
CHKERR: WAIT F.MTAP, ;WAIT FOR I/O
PUSHJ P,FNDBUF ;FIND ERROR BUFFER
SKIPA ;LOSE--JUST RESET STATUS AND CONTINUE
JRST FOUND ;GO TAKE CARE OF IT
SETSTS F.MTAP,.IOBIN ;CLEAR ERROR STATUS
;FALL INTO BUFOUT
BUFOUT: HRRZ T2,S.MBPT## ;GET CURRENT BUFFER ADDRESS
CAMN T2,P3 ;CAUGHT UP YET TO ORIGINAL POSITION?
JRST MTASET ;YES--CAN CONTINUE FILLING BUFFERS
;HERE TO CONTINUE DOING OUTPUT UNTIL MONITOR ADVANCES RING HEADER
;POINTER TO ITS POSITION AFTER THE FIRST ERROR.
SETZM S.MBPT##+.BFCTR ;ZERO COUNT
MOVEI T1,MTBBKP ;LOAD OUTPUT BLOCK SIZE
ADDM T1,S.MBPT##+.BFPTR;INCREMENT BYTE POINTER
OUT F.MTAP, ;DO OUTPUT UNTIL CAUGHT UP
JRST BUFOUT ;SUCCESSFUL OUTPUT
JRST CHKERR ;CHECK ERROR
>;END IFN FT$RCV
NOFIND: SETSTS .IOBIN ;CLEAR STATUS & REPORT STRANGE ERROR
WARN$ (UOE,Untraceable output error)
;IF END OF SAVE, FORCE OUTPUT OF REMAINING BUFFERS BEFORE CLOSING
;THE CHANNEL TO TAKE ADVANTAGE OF TAPE ERROR RECOVERY CODE.
MTASET: TXNN F,FL$END ;SEE IF END OF SAVE SET
JRST MTARST ;NO, GO CLEAR RECORD HEADER
IFN FT$RCV,<
TXNN F,FL$RCV ;SEE IF RECOVERY CODE AVAILABLE
JRST NORCOV ;NO
WAIT F.MTAP, ;WAIT FOR ANY I/O IN PROGRESS
GETSTS F.MTAP,T1 ;GET STATUS
TRNE T1,IO.DER!IO.DTE!IO.BKT ;IF DATA ERRORS,
JRST NOTEOT ;GO WRITE A REPEATER RECORD
TRNE T1,IO.EOT ;IF EOT,
SETSTS F.MTAP,.IOBIN ; MUST CLEAR EOT BEFORE DOING OUTPUT
MOVSI T1,(1B0) ;USE BIT
SKIPN P3 ;FIRST TIME THRU?
HRRZ P3,S.MBPT## ;YES--GET CURRENT POSITION
MOVE P2,P3 ;WHERE TO START
FINRNG: TDNE T1,(P2) ;RECORD OUTPUT TO TAPE YET?
JRST FRCOUT ;NO--FORCE OUT
HRRZ P2,(P2) ;GO AROUND RING
CAME P2,P3 ;DONE?
JRST FINRNG ;NO--CONTINUE
>;END IFN FT$RCV
NORCOV: TXZ F,FL$END ;CLEAR
;HERE TO CLEAR RECORD HEADER OF NEW RECORD
MTARST: HRRZ MH,S.MBPT##+.BFPTR;GET NEW BUFFER POINTER ADDRESS
ADDI MH,1 ;ADJUST ADDRESS
SETZM (MH) ;CLEAR RECORD HEADER
MOVSI T1,(MH) ;MAKE BLT POINTER
HRRI T1,1(MH) ; ...
BLT T1,M-1(MH) ;ZILCH HEADER
POPJ P, ;RETURN
;+
;<FNDBUF IS A SUBROUTINE TO FIND WHICH BUFFER IN THE RING HAD A WRITE
;PROBLEM. ^ON EXIT, ^P2 = ADDRESS OF PROBLEM BUFFER AND ^P1 = ERROR
;BITS FOUND. ^NON-SKIP RETURN IF CAN'T FIND IT.
;-
FNDBUF: MOVE P2,S.MBPT## ;START AT CURRENT POSITION
FNDBF1: MOVE P1,-1(P2) ;GET BUFFER STATUS WORD
ANDI P1,IO.DER!IO.DTE!IO.BKT!IO.EOT ;SAVE ONLY ERROR BITS
JUMPN P1,CPOPJ1 ;IF ANY SET, GIVE SKIP RETURN
HRR P2,(P2) ;GET TO NEXT BUFFER
CAME P2,S.MBPT## ;FOUL UP?
JRST FNDBF1 ;NO--KEEP CHECKING
POPJ P, ;YES--LOSE
;+
;<XMTAIN IS THE TAPE INPUT SUBROUTINE. ^IT GIVES A NON-SKIP RETURN
;ON END OF FILE OR IF THE <KILL COMMAND IS DETECTED. (^THESE CONDITIONS
;ARE FLAGGED IN <AC ^F.) ^IF THE RECORD'S CHECKSUM AGREES WITH THAT SAVED
;IN THE RECORD HEADER, IT IS SIMPLY PASSED TO THE MAIN PROGRAM. ^IF NOT,
;LOOK FOR A REPEATER RECORD. ^IF NO REPEATER IS NEXT, THERE IS NO
;BETTER COPY OF THE DATA ON TAPE, SO THE CURRENT RECORD IS USED
;ANYWAY. ^OTHERWISE IT IS DROPPED IN FAVOR OF THE REPEATER RECORD,
;AND THE SAME ALGORITHM IS APPLIED TO THE REPEATER RECORD.
;^IF THE RECORD WAS NEVER CHECKSUMED (<GF$NCH BIT IN <G$FLAG), THE
;ABOVE ALGORITHM IS APPLIED BASED ON WHETHER THE MONITOR SET DATA
;ERROR BITS IN THE BUFFER FILE STATUS WORD FOR THE RECORD.
;-
XMTAIN: TXNE F,FL$KIL ;IF /KILL ALREADY,
POPJ P, ;DON'T DO ANY MORE TAPE INPUT
PUSHJ P,SAVE2 ;SAVE C(P1) AND C(P2)
TXZ F,FL$NBF!FL$FRS ;CLEAR NBF MESSAGE THIS BLOCK & FRS CONVERSION
DOINPT: TXZE F,FL$INP ;INPUT DONE ALREADY?
JRST BUFSTS ;YES
IFN FT$EMX,<
SKIPLE T1,ERRCNT ;GET CURRENT ERROR COUNT
CAIGE T1,EMAX ;SEE IF MAXIMUM REACHED
JRST CNTINP ;NO, CONTINUE INPUT
OUTSTR [ASCIZ /
?BKPRTE Reached tape error maximum
/]
MONRT. ;EXIT TO MONITOR
SETZM ERRCNT ;.CONTINUE WILL KEEP TRYING
>;END IFN FT$EMX
CNTINP: SETZM S.MBPT##+.BFCTR ;ZERO HEADER
MOVEI T1,MTBFSZ ;LOAD BUFFER SIZE
ADDM T1,S.MBPT##+.BFPTR;INCREMENT BYTE POINTER
INPUT F.MTAP, ;EXECUTE INPUT UUO
BUFSTS: HRRZ P2,S.MBPT## ;GET BUFFER ADDRESS
MOVE P1,-1(P2) ;GET STATUS FROM BUFFER HEADER
TLNN P1,IO.END ;END OF FILE?
JRST NIEOF ;NO--SKIP
CLOSE F.MTAP, ;YES--CLEAR STATUS
TXOE F,FL$EF1 ;ADJUST FLAGS
TXO F,FL$EF2 ; ...
TXNE F,FL$EF2 ;IF SECOND EOF,
MTBSF. F.MTAP, ; BACKSPACE OVER IT
POPJ P, ;EOF RETURN
NIEOF: MOVEI MH,2(P2) ;SET BUFFER POINTER
MOVEI T1,M(MH) ;POINT TO DATA AREA
MOVEM T1,MDATA ;STORE FOR LATER USERS
MOVE T1,G$TYPE(MH) ;GET RECORD TYPE
CAIE T1,T$EOV ;SEE IF END-OF-VOLUME
JRST NOTEOV ;NO, CONTINUE
TXO F,FL$EOV ;FLAG EOV
TXNE F,FL$OPN ;SKIP IF NOT WRITING ON DISK
PUSHJ P,RSTCK1 ;PRESERVE DISK FILE
JFCL ;LOSE (WARNING ISSUED)
CLOSE F.MTAP, ;RESET STATUS
TXZ F,FL$EF1!FL$EF2!FL$EOV ;RESET EOF BITS
PUSHJ P,NEXTAP ;GET NEXT TAPE
SETZM PREPPN ;WILL CAUSE PPN TO BE RETYPED
SETZM ERRCNT ;CLEAR COUNT OF TAPE ERRORS FOR NEW TAPE
TXNE F,FL$KIL ; WAS KILL TYPED? [200]
POPJ P, ; YEP - SO EXIT [200]
JRST DOINPT ;GO GET NEXT RECORD
NOTEOV: TXZ F,FL$EF1!FL$EF2 ;ZERO EOF BITS
TRNE P1,IO.DER!IO.DTE!IO.BKT ;SEE IF DATA ERRORS
SETSTS F.MTAP,.IOBIN ;CLEAR ERROR STATUS
TXNN F,FL$PSI ;SEE IF PSI ENABLED
JRST [PUSHJ P,OPRCMD##;NO--HANDLE ANY TTY INPUT
TXO F,FL$KIL;HERE IF OPERATOR SAID KILL
JRST .+1] ;CONTINUE
TXNE F,FL$KIL ;SEE IF OPERATOR SAID KILL
POPJ P, ;YES--GIVE ERROR RETURN
MOVEI T1,MTBBKP ;INDICATE BACKUP TAPE BLOCK LENGTH
MOVE T2,0(MH) ;GET FIRST WORK OF TAPE BLOCK
TLNN T2,777770 ;SEE IF FRS OR BACKUP
JRST TSTIBL ;OK--CHECK FOR IBL
TXOE F,FL$NBF ;WARNING ISSUED ALREADY?
JRST DOINPT ;YES, JUST SKIP THE RECORD
WARN$N (NBF,Not BACKUP format)
PUSHJ P,MASTRX ;TYPE FILE SPEC
JRST DOINPT ;LOOP UNTIL ONE FOUND
TSTIBL: TXZ F,FL$NBF ;GOOD--CLEAR FLAG
TLNE T2,-1 ;IF FRS,
PUSHJ P,CNVFRS ; GO CONVERT TO BACKUP HEADER
CAMN T1,S.MBPT##+.BFCTR ;SEE IF CORRECT BLOCK LENGTH
JRST TSTCHK ;OK--GO TEST CHECKSUMMING
AOS ERRCNT ;STEP COUNT OF TAPE ERRORS
WARN$N (IBL,Incorrect block length)
PUSHJ P,MASTRX ;TYPE FILE SPEC
SKIPN SUSDF ;DOES OLDER FILE EXIST? [206]
JRST DOINPT ;NO - SKIP OVER FLAKY DATA [206]
POPJ P, ;DONT SUPERSEDE OLD FILE WITH BAD FILE [206]
TSTCHK: MOVX T1,GF$NCH ;NO CHECKSUM FLAG
TDNN T1,G$FLAG(MH) ;WAS IS CHECKSUMED?
JRST CMPCKS ;YES--GO COMPARE CHECKSUMS
IFN FT$RCV,<
TRNN P1,IO.DER!IO.DTE!IO.BKT ;ANY DATA ERRORS?
JRST USEREC ;NO, USE THE RECORD
PUSHJ P,RPTNXT ;IS THERE A REPEATER NEXT?
SKIPA ; NO [206]
JRST DOINPT ;YES--CAN DROP THIS RECORD
SKIPN SUSDF ;IS THERE AN OLDER FILE? [206]
JRST USEREC ;NO - USE THIS RECORD [206]
POPJ P, ;YES - SO DONT SUPERSEDE [206]
>;END IFN FT$RCV
CMPCKS: MOVE T3,G$CHK(MH) ;GET TAPE CHECKSUM FOR COMPARISON
IFN FT$CHK,<
PUSHJ P,CHKSUM ;RECOMPUTE CHECKSUM
>;END IFN FT$CHK
CAMN T3,G$CHK(MH) ;COMPARE
JRST USEREC ;MATCH--USE IT
IFN FT$RCV,<
PUSHJ P,RPTNXT ;REPEATER NEXT?
SKIPA ;NO
JRST DOINPT ;YES--CAN DROP THIS RECORD
>;END IFN FT$RCV
WARN$N (CHK,Checksum inconsistency)
PUSHJ P,MASTER+1 ;TELL WHERE
SKIPE SUSDF ; SUPERSEDING NOW? [206]
POPJ P, ; YES - ABORT TO SAVE OLD FILE [206]
;FALL INTO USEREC
;HERE TO USE THE RECORD POINTED TO BY MH.
USEREC: TRNE P1,IO.DER!IO.DTE!IO.BKT;IF WORD ERRORS,
PUSHJ P,MASTER ;REPORT THEM
;HERE TO TEST FOR ENCRYPTION AND DO UNSCRAMBLING.
MOVE T1,G$TYPE(MH) ;GET RECORD TYPE
CAIN T1,T$FIL ;FILE DATA?
SKIPN S.CRYP## ;PASSWORD TYPED?
JRST CPOPJ1 ;RETURN NOW
MOVEM 7,SAVACS+7 ;SAVE REGISTERS
MOVEI 7,SAVACS ; ..
BLT 7,SAVACS+6 ; ..
MOVE 7,SAVACS+7 ;RESTORE IF NEEDED
TXOE F,FL$INI ;INITIALIZED?
JRST UNSCRM ;CALL UNSCRAMBLER
IFLE F-7,<
MOVEM F,SAVACS+F ;STORE NEWLY SET FLAG
>;END IFLE F-7
MOVEI 7,S.CRYP## ;ARGS
PUSHJ P,CRASZ.## ; ..
MOVEM 5,SVCODE ;STORE
UNSCRM: MOVSI 7,-200*N ;GET NEGATIVE NBR WORDS
HRR 7,MDATA ;WHERE TO FIND THEM
MOVE 1,G$LND(MH) ;GET LENGTH OF NON-DATA SECTION
HRLS 1 ;PUT IN LEFT HALF ALSO
ADD 7,1 ;ONLY DATA IS ENCRYPTED
MOVE 6,F$RDW(MH) ;GET RELATIVE DATA WORD
ADDI 6,200 ;FORCE OVERFLOW
ASH 6,-7 ;GET RELATIVE BLOCK
MOVE 5,SVCODE ;GET SEED BACK
PUSHJ P,CRYPT.## ;GO TRANSLATE
MOVSI 7,SAVACS ;RESTORE REGISTERS
BLT 7,7 ; ..
JRST CPOPJ1 ;SKIP RETURN
;ROUTINE TO CONVERT FRS TAPES TO BACKUP
CNVFRS: WARN$ (FRS,FRS tapes not supported) ;***TEMP***
POPJ P, ;***TEMP***
PUSHJ P,SAVE2 ;MAKE SOME EXTRA ROOM
TXO F,FL$FRS ;FOR MINOR AFFECTS HANDLED ELSEWHERE
STORE T1,FRSHDR,FRSHDE,0 ;CLEAR CONVERSION AREA
TRO T2,(GF$NCH) ;SET NO CHECKSUM FLAG
HRLZM T2,FRSHDR+G$FLAG;RH(WORD 0) ARE LH FLAGS
HLRZM T2,FRSHDR+G$TYPE ;LH(WORD 0) IS RECORD TYPE
MOVE T1,1(MH) ;WORD 1 IS
MOVEM T1,FRSHDR+G$RTNM ; TAPE COUNTER
MOVEI T2,2(MH) ;POINT TO TYPE SPECIFIC REGION
MOVE T4,FRSHDR+G$TYPE ;GET TYPE
MOVE T4,FRSTBL-1(T4) ;GET POINTER OF WORK TO DO
CNVFR1: MOVE T3,(T4) ;GET POINTER FOR TRANSFERS
CNVFR2: MOVE T1,(T2) ;GET NEXT INPUT
MOVEM T1,FRSHDR(T3) ;STORE IN NEXT OUTPUT
AOS T2 ;INCREMENT INPUT
AOBJN T3,CNVFR2 ;LOOP OVER CONSECUTIVE STORES
AOBJN T4,CNVFR1 ;LOOP OVER ALL STORES
MOVSI P2,-FRSDTL ;GET LOOP OF DATES TO CONVERT
CNVFR3: MOVE P1,FRSDTM(P2) ;GET NEXT INSTRUCTION
HLRZ T2,P1 ;GET ADDRESS OF DATE
TRZE T2,1B18 ;CLEAR FLAG
TDZA T1,T1 ;CLEAR TIME IF SET
MOVE T1,-1(T2) ; ELSE, GET TIME
IMULI T1,^D60000 ;CONVERT TIME TO MILLISECONDS
SKIPN T2,(T2) ;GET DATE
JRST CNVFR4 ;NOT SET--IGNORE
PUSHJ P,CONVDT ;CONVERT IT
MOVEM T1,FRSHDR(P1) ;STORE RESULT
CNVFR4: AOBJN P2,CNVFR3 ;LOOP OVER DATES
SKIPE T1,FRSSTK ;GET 7-TRACK FLAG
MOVX T1,MT.7TR ;SET FOR MTCHR.
LDB T2,[POINTR (FRSSMD,IO.DEN)] ;GET DENSITY
DPB T2,[POINTR (T1,MT.DEN)] ;SET FOR MTCHR.
MOVEM T1,FRSHDR+S$MTCH ;SET WHERE BACKUP DOES IT
MOVE T2,FRSHDR+G$TYPE;GET TYPE
CAIE T2,T$FIL ;SEE IF FILE,
JRST CNVFR5 ;NO
MOVX T1,GF$SOF ;SET START OF FILE FLAG
SKIPN FRSRDB ;SEE IF FIRST DATA BLOCK
IORM T1,FRSHDR+G$FLAG;SET FLAG IF SO
MOVE T1,FRSSDB ;GET NBR SDB
JUMPE T1,CNVFIL ;SKIP IF NULL
SUBI T1,1 ;CALCULATE G$SIZ
IMULI T1,200 ; ..
ADD T1,FRSSIZ ;ADD ON SIZE OF LAST BLOCK
CNVFIL: MOVEM T1,FRSHDR+G$SIZ ;STORE
SKIPE T1,FRSRDB ;GET RELATIVE DATA BLOCK
SUBI T1,1 ;CALCULATE RELATIVE DATA WORD
IMULI T1,200 ; ...
MOVEM T1,FRSHDR+F$RDW;STORE
MOVEI T1,177+24(MH) ;POINT TO UFD
SUB T1,FRSLVL ;SUBTRACT LEVEL
SETZM -1(T1) ;ZILCH ONE HIGHER
;***TEMP*** CREATE ASCIZ NAME
CNVFR5: SKIPN T1,FRSSTR ;LOAD FS NAME
JRST CNVFR6 ;IF NONE, NOT FILE OR UFD TYPE
MOVE T3,[POINT 7,FRSHDR+F$PTH];INITIAL PATH POINTER
CAIN T2,T$UFD ;SEE IF UFD TYPE
MOVE T3,[POINT 7,FRSHDR+D$STR];CORRECT POINTER
MOVEI T2,.FCDEV ;INDICATE DATA TYPE
PUSHJ P,SETPTH ;SET IN PATH BLOCK
SKIPN T1,FRSPPN ;GET FRS PPN
JRST CNVFR6 ;MUST BE UFD TYPE
MOVEI T2,.FCDIR ;INDICATE DATA TYPE
PUSHJ P,SETPTH ;SET IN PATH BLOCK
MOVE T1,FRSNAM ;GET FILE NAME
MOVEI T2,.FCNAM ;DAT TYPE
PUSHJ P,SETPTH ;STORE
MOVE T1,FRSEXT ;EXTENSION
MOVEI T2,.FCEXT ;DATA TYPE
PUSHJ P,SETPTH ;STORE
CNVFR6: MOVEI T1,24(MH) ;SET DATA POINTER
MOVEM T1,MDATA ; FOR ALL USERS
MOVEI MH,FRSHDR ;POINT TO CONVERTED HEADER
MOVEI T1,MTBFRS ;INDICATE FRS BLOCK SIZE
POPJ P, ;RETURN
;TABLE OF TRANSLATIONS BY RECORD TYPE
FRSTBL: -FRSLLB,,FRSTLB ;1=LABEL
-FRSLSS,,FRSTSS ;2=START SAVE SET
-FRSLSS,,FRSTSS ;3=END SAVE SET
-FRSLFL,,FRSTFL ;4=FILE
-FRSLDR,,FRSTDR ;5=DIRECTORY
-FRSLJK,,FRSTJK ;6=JUNK
-FRSLJK,,FRSTJK ;7=JUNK
;TABLES CONTAINING -NO WORDS (0=1),,ADDRESS TO STORE
FRSTLB: ;LABEL
L$RLNM ;TAPE REEL NAME
-3,,FRSTIM-FRSHDR ;TIME, DATE, DESTROY DATE
;-16 CONTAIN NOTHING
FRSLLB==.-FRSTLB
FRSTSS: ;START/END SAVE SET
-5,,S$BVER+2 ;SYSTEM NAME***TEMP***
S$SVER ;VERSION
-2,,S$FMT ;FORMAT VERSION, FRS VERSION
-4,,FRSSTM-FRSHDR ;TIME, DATE, MODE, TRACKS
S$BVER+1 ;SAVE SET NAME***TEMP***
S$DEV ;DEVICE
;-4 CONTAIN NOTHING
FRSLSS==.-FRSTSS
FRSTFL: ;FILE
-5,,FRSSTR-FRSHDR ;STR, NAME, EXT, PPN, REL DATA BLK
G$CHK ;CHECKSUM
-3,,FRSSDB-FRSHDR ;BLKS IN REC, WRDS IN L.BLK, LVL
;-11 CONTAIN NOTHING
FRSLFL==.-FRSTFL
FRSTDR: ;DIRECTORY
FRSSTR-FRSHDR ;UFD STRUCTURE
D$LVL ;DIRECTORY LEVEL
;-20 CONTAIN NOTHING
FRSLDR==.-FRSTDR
FRSTJK: ;UNKNOWN TYPE
-22,,G$FLAG+1 ;STRAIGHT TRANSLATION
FRSLJK==.-FRSTJK
;TABLE OF DATE CONVERSIONS
;FORMAT: BYTE (1)NO TIME (17)SOURCE DATE (18) RESULT
FRSDTM: BYTE (1)0 (17)FRSDAT (18)L$DATE ;LABEL CREATION
BYTE (1)1 (17)FRSDSD (18)L$DSTR ;DESTROY DATE
BYTE (1)0 (17)FRSSDT (18)S$DATE ;SAVE SET DATE
FRSDTL==.-FRSDTM
;+
;<MASTER IS A SUBROUTINE TO REPORT TAPE <I/O PROBLEMS. ^THE
;SPECIFIC <I/O ERROR IS TYPED AND IF THE TAPE RECORD CONTAINED FILE DATA,
;THE FILE SPECIFICATION AND BLOCK NUMBER ARE ALSO TYPED.
;-
MASTER: PUSHJ P,ERRBIT ;TYPE ERROR BIT INFO
AOS ERRCNT ;STEP TAPE ERROR COUNT
SKIPGE S.OPER## ;WRITE OPERATION?
OUTSTR [ASCIZ /writing /] ;MESSAGE
SKIPL S.OPER## ;ACTUALLY A READ OPERATION?
OUTSTR [ASCIZ /reading /] ;MESSAGE
MOVE T1,G$TYPE(MH) ;GET RECORD TYPE
CAIE T1,T$FIL ;FILE DATA?
JRST NONFIL ;NO--NOTE
TXO F,FL$TPE ;SET TAPE READ ERROR FLAG
MOVE T3,[POINT 7,F$PTH(MH)];POINTER TO FILE INFO
ILDB T1,T3 ;GET FIRST BYTE
CAIE T1,.FCDEV ;SEE IF DEVICE
JRST MSTDIR ;NO
PUSHJ P,TYPID ;TYPE FS NAME
OUTCHR COLON ; ..
MSTDIR: CAIE T1,.FCDIR ;SEE IF DIRECTORY NEXT
JRST MSTFIL ;JUMP IF NOT
OUTCHR LBR ; ..
MSTSFD: PUSHJ P,TYPID ;TYPE DIRECTORY
CAIGE T1,.FCSF1 ;SFD NEXT?
JRST MSTRBR ;NO
OUTCHR COMMA ;YES, TYPE COMMA
JRST MSTSFD ;LOOP TO TYPE SFD
MSTRBR: OUTCHR RBR ;RIGHT BRACKET
MSTFIL: CAIE T1,.FCNAM ;FILE NAME NEXT?
JRST MSTBLK ;NO
PUSHJ P,TYPID ;TYPE FILE NAME
CAIE T1,.FCEXT ;EXTENSION NEXT?
JRST MSTBLK ;NO
OUTCHR DOT ; ..
PUSHJ P,TYPID ;TYPE EXTENSION
MSTBLK: OUTSTR [ASCIZ /(BLOCK=/]
MOVE T1,F$RDW(MH) ;GET RELATIVE DATA WORD
ADDI T1,200 ;FORCE OVERFLOW
ASH T1,-7 ;GET RELATIVE BLOCK NBR
PUSHJ P,DECOUT ;TYPE
OUTSTR [ASCIZ /)
/]
POPJ P, ;DONE
MASTRX: OUTSTR [ASCIZ /reading /];MESSAGE
SKIPN CNAM ;DURING FILE DATA?
JRST NONFIL ;NO
TXO F,FL$TPE ;SET TAPE READ ERROR FLAG
JRST DOWHAT ;TYPE FILE SPEC AND RETURN
NONFIL: OUTSTR [ASCIZ /non-file data
/]
POPJ P, ;RETURN
;+
;<ERRBIT IS A SUBROUTINE TO DECODE THE TAPE ERROR STATUS BITS AND
;TYPE APPROPRIATE WARNING MESSAGES.
;-
ERRBIT: TRNE P1,IO.DER
WARN$N (THE,Tape hardware error)
TRNE P1,IO.DTE
WARN$N (TPE,Tape parity error)
TRNE P1,IO.BKT
WARN$N (BTL,Block too large)
POPJ P, ;RETURN
;+
;<CHKSUM COMPUTES THE CHECKSUM FOR A TAPE RECORD AND STORES THE VALUE
;IN THE RECORD HEADER AT <G$CHK. ^CALL WITH <MH POINTING TO THE TAPE
;BUFFER. ^USES ^T1 _& ^T2.
;-
IFN FT$CHK,<
CHKSUM: SETZB T1,G$CHK(MH) ;START WITH ZERO
MOVSI T2,-MTBBKP ;AOBJN WORD FOR TAPE BUFFER
HRR T2,MH ;GET START ADDRESS OF BUFFER
CHKSM1: ADD T1,(T2) ;DO CHECKSUMMING
ROT T1,1 ; ...
AOBJN T2,CHKSM1 ;NEXT WORD
MOVEM T1,G$CHK(MH) ;STORE IN HEADER
POPJ P, ;RETURN
>;END IFN FT$CHK
;+
;<RPTNXT IS A ROUTINE TO DETERMINE IF THE FOLLOWING RECORD ON TAPE
;IS A REPEATER RECORD. ^CALLED WITH ^P2 = POINTER TO SECOND WORD
;OF CURRENT BUFFER HEADER. ^A SKIP RETURN IS GIVEN IF A REPEATER
;RECORD IS NEXT. ^THE <FL$INP FLAG IS SET IF INPUT WAS FORCED IN
;ORDER TO LOOK AHEAD.
;-
IFN FT$RCV,<
RPTNXT: PUSHJ P,SAVE1 ;SAVE C(P1)
WAIT F.MTAP, ;WAIT FOR I/O TO FINISH
HRRZ P1,(P2) ;ADDRESS OF NEXT BUFFER
MOVSI T1,(1B0) ;USE BIT
TDNE T1,(P1) ;SEE IF FILLED YET
JRST TSTRPT ;YES--GO CHECK REPEATER BIT
;HERE TO FORCE INPUT OF NEXT TAPE RECORD TO SEE IF IT IS A REPEATER.
;FIRST, REMOVE CURRENT BUFFER FROM RING TO PREVENT IT FROM BEING
;OVERWRITTEN WITH NEW DATA. NEED TO FIND PREVIOUS BUFFER TO UPDATE
;IT'S POINTER.
PUSHJ P,FNDPRV ;GET ADDRESS OF PREVIOUS IN T1
;HERE WITH T1 = ADDRESS OF PREVIOUS BUFFER. IF XMTABF = 0 REMOVE
;CURRENT BUFFER FROM RING AND SAVE IT'S ADDRESS IN XMTABF. IF
;XMTABF IS NON-ZERO, THERE ALREADY IS A BUFFER OUT OF THE RING,
;SO SWITCH THEM.
SKIPN T2,XMTABF ;GET REMOVED BUFFER, IF ANY
MOVE T2,P1 ;USE NEXT BUFFER INSTEAD
HRRM T2,(T1) ;STUFF INTO PREVIOUS BUFFER
SKIPE XMTABF ;SKIP IF NOT SWITCHING
HRRM P1,@XMTABF ;UPDATE POINTER OF INSERTED BUFFER
MOVEM P2,XMTABF ;SAVE ADDRESS OF REMOVED BUFFER
MOVSI T1,(1B0) ;CLEAR USE BIT OF REMOVED BUFFER
ANDCAM T1,(P2) ; SO IT WONT CAUSE TROUBLE LATER
;NOW CAN FORCE INPUT SAFELY
SETZM S.MBPT##+.BFCTR ;ZILCH
MOVEI T1,MTBFSZ ;LOAD BUFFER SIZE
ADDM T1,S.MBPT##+.BFPTR;SET POINTER
INPUT F.MTAP,(P1) ;FORCE INPUT ON THIS BUFFER
TXO F,FL$INP ;FLAG INPUT DONE
;HERE TO SEE IF NEXT TAPE RECORD IS A REPEATER RECORD
;ALSO REJECT RECORD IF BAD BUFFER SIZE OR NOT BACKUP FORMAT
TSTRPT: ADDI P1,2 ;POINT TO DATA
MOVE T2,(P1) ;FIRST DATA WORD
TLNE T2,777770 ;SEE IF JUNK
POPJ P, ;NO GOOD--GIVE BAD RETURN
MOVEI T1,MTBBKP ;BACKUP BUFFER SIZE
TLNE T2,-1 ;SEE IF FRS
MOVEI T1,MTBFRS ;LOAD FRS BUFFER SIZE
CAME T1,-1(P1) ;CHECK BUFFER COUNT
POPJ P, ;NO GOOD--GIVE BAD RETURN
MOVX T1,GF$RPT ;REPEATER FLAG
TDNE T1,G$FLAG(P1) ;SEE IF ON
AOS (P) ;YES--ADVANCE RETURN
POPJ P, ;RETURN
>;END IFN FT$RCV
;+
;<FNDPRV IS A ROUTINE TO FIND THE PREDECESSOR BUFFER IN A RING.
;^CALL WITH ^P2 = ADDRESS OF "CURRENT" BUFFER (<LH MUST BE ZERO).
;^RETURNS WITH ^T1 = ADDRESS OF PREDECESSOR BUFFER. ^CLOBBERS ^T2.
;-
FNDPRV: MOVE T1,P2 ;START WITH CURRENT BUFFER
FNDPR1: HRRZ T2,(T1) ;LOAD THIS BUFFER'S POINTER
CAMN T2,P2 ;DOES IT POINT TO THE CURRENT BUFFER?
POPJ P, ;YES--RETURN WITH PREVIOUS ADR IN T1
HRRZ T1,(T1) ;GO AROUND RING
JRST FNDPR1 ;FIND PREVIOUS
SUBTTL DISK INPUT/OUTPUT ROUTINE
;+
;.CHAPTER DISK INPUT/OUTPUT ROUTINE
;-
;+
;<DSKOUT AND <DSKIN ARE THE USUAL ENTRY POINTS TO THE DISK <I/O
;ROUTINE. ^EITHER AN <OUT OR AN <IN <UUO IS EXECUTED AND A DOUBLE
;SKIP RETURN IS GIVEN IF NO PROBLEM IS ENCOUNTERED. ^ON EXIT, <DBUF
;IS SET TO POINT TO THE "NEW" DISK BUFFER. ^A SINGLE SKIP RETURN
;INDICATES END OF FILE. ^ON AN ERROR RETURN FROM THE <UUO,
;THE SUBROUTINE ISSUES A WARNING AND GIVES A NON-SKIP RETURN.
;
;<ALTDSK IS AN ALTERNATE ENTRY POINT TO THE DISK <I/O ROUTINE WHICH
;IS USED WHEN WRITING THE LAST DISK BLOCK FOR A FILE ON A <RESTORE.
;^IT IS CALLED TO ADJUST THE DISK RING HEADER BYTE POINTER FOR THE ACTUAL
;NUMBER OF DATA WORDS IN THE BUFFER. ^THIS CAUSES THE MONITOR TO RECORD
;THE FILE SIZE IN <.RBSIZ CORRECTLY.
;-
DSKOUT: SKIPA T1,[OUT FILE,0] ;OUTPUT CALL
DSKIN: MOVSI T1,(<IN FILE,0>) ;INPUT CALL
SETZ T2, ;ZERO C(T2)
EXCH T2,DSKHDR+.BFCTR;ZERO BYTE COUNT
ALTDSK: ADDM T2,DSKHDR+.BFPTR;INCREMENT BYTE POINTER
XCT T1 ;XCT I/O UUO
JRST DSKSET ;OK
WAIT FILE, ;WAIT FOR I/O TO CEASE
GETSTS FILE,T1 ;GET ERROR STS
TRNE T1,IO.EOF ;SKIP IF NOT EOF
JRST CPOPJ1 ;RETURN
WARN$N (DIO,Disk I/O error)
PUSHJ P,OCTOUT ;TYPE STATUS
OUTSTR [ASCIZ / during/] ;TELL WHEN
SAVE$ P1 ;SAVE C(P1)
MOVEI P1,EXLFIL ;ADDRESS OF LOOKUP/ENTER BLOCK
PUSHJ P,GUUO ;TYPE OUT
RSTR$ P1 ;RESTORE C(P1)
POPJ P, ;RETURN
DSKSET: HRRZ DBUF,DSKHDR+.BFPTR;FIRST DATA WORD MINUS ONE
AOJA DBUF,CPOPJ2 ;RETURN
SUBTTL LIST OUTPUT SUBROUTINES
;+
;.CHAPTER LIST OUTPUT SUBROUTINES
;-
;+
;<LSTTAB INSERTS A TAB INTO THE LISTING FILE.
;-
LSTTAB: MOVEI CH,.CHTAB ;LOAD HORIZONTAL TAB
;+
;<LSTOUT IS THE SUBROUTINE CALLED TO HANDLE FILLING AND OUTPUTING
;THE LISTING BUFFERS.
;-
LSTOUT: SOSG S.LBPT##+.BFCTR ;SEE IF ANY ROOM LEFT
OUTPUT F.LIST, ;NONE. ADVANCE BUFFERS
IDPB CH,S.LBPT##+.BFPTR;STORE CHARACTER
POPJ P, ;RETURN
;+
;<LSTMSG OUTPUTS AN <ASCIZ STRING TO THE LISTING FILE. ^CALL
;WITH ADDRESS OF STRING IN ^T1.
;-
LSTMSG: HRLI T1,440700 ;BYTE POINTER
LSTMSA: ILDB CH,T1 ;GET CHARACTER
JUMPE CH,CPOPJ ;RETURN IF NULL
PUSHJ P,LSTOUT ;SEND TO FILE
JRST LSTMSA ;LOOP FOR NEXT CHAR
;+
;<LST6 CONVERTS THE <SIXBIT WORD IN ^T1 TO <ASCII AND LISTS IT.
;-
LST6: MOVE T2,T1 ;COPY C(T1)
LST6A: JUMPE T2,CPOPJ ;RETURN IF NULL
MOVEI T1,0 ;FIRST ZILCH
LSHC T1,6 ;CAPTURE A CH
MOVEI CH," "-' '(T1) ;FORM ASCII EQUIV IN CH
PUSHJ P,LSTOUT ;SEND TO FILE
JRST LST6A ;CONTINUE
;+
;<LSTOCT LISTS THE OCTAL NUMBER IN ^T1.
;<LSTDEC LISTS THE DECIMAL NUMBER IN ^T1.
;-
LSTOCT: TDZA T3,T3 ;OCTAL RADIX
LSTDEC: MOVEI T3,2 ;DECIMAL RADIX
MOVEI CH,"-" ;MINUS SIGN
SKIPGE T1 ;SEE IF POSITIVE
PUSHJ P,LSTOUT ;SEND MINUS SIGN TO FILE
LSTNBR: IDIVI T1,8(T3) ;SPLIT DIGITS
MOVMS T2 ;CLEAR MINUS SIGN
HRLM T2,(P) ;STORE DIGIT ON STACK
SKIPE T1 ;SKIP IF DONE
PUSHJ P,LSTNBR ;RECURSE
HLRZ CH,(P) ;FETCH CH OFF STACK
ADDI CH,"0" ;CONVERT TO ASCII
JRST LSTOUT ;SEND TO FILE
;+
;<LSTBTH LISTS TWO DIGITS OF THE DECIMAL NUMBER IN ^T1, WITH A
;LEADING ZERO IF LESS THAN TEN.
;
;<LSTTWO LISTS TWO DIGITS OF THE DECIMAL NUMBER IN ^T1, WITH A
;LEADING SPACE IF LESS THAN TEN.
;-
LSTBTH: MOVEI CH,"0" ;SET LEADING ZERO
SKIPA ; ...
LSTTWO: MOVEI CH," " ;SET LEADING SPACE
IDIVI T1,^D10 ;SPLIT DIGITS
SKIPE T1 ;SKIP IF CORRECT
MOVEI CH,"0"(T1) ;WRONG. GET ASCII DIGIT
PUSHJ P,LSTOUT ;SEND TO FILE
MOVEI CH,"0"(T2) ;GET SECOND DIGIT
JRST LSTOUT ;SEND TO FILE
;+
;<LSTDAT LISTS A DATE IN <DD-MMM-YY FORMAT.
;^CALL WITH ^T1 = DATE IN SYSTEM FORMAT.
;-
LSTDAT: IDIVI T1,^D31 ;GET DAYS
SAVE$ T1 ;STORE QUOTIENT ON STACK
MOVEI T1,1(T2) ;GET DAYS IN T1
PUSHJ P,LSTTWO ;SEND TO FILE
RSTR$ T1 ;RETRIEVE QUOTIENT
IDIVI T1,^D12 ;GET MONTHS
SAVE$ T1 ;STORE QUOTIENT ON STACK
MOVEI T1,MONTBL(T2) ;GET MONTH
PUSHJ P,LSTMSG ;SEND TO FILE
MOVEI CH,"-" ;SECOND DASH
PUSHJ P,LSTOUT ;TO FILE
RSTR$ T1 ;RETRIEVE YEARS
ADDI T1,^D64 ;64 IS BASE YEAR
JRST LSTDEC ;SEND TO FILE
;+
;<LSTTIM LISTS THE TIME IN <HH:MM:SS FORMAT WITH LEADING ZEROS.
;^CALL WITH ^T1 = TIME IN MILLISECONDS.
;-
LSTTIM: IDIV T1,[^D3600000] ;CALCULATE HOURS
IDIVI T2,^D60000 ;CALCULATE MINUTES
IDIVI T3,^D1000 ;CALCULATE SECONDS
PUSH P,T3 ;SAVE SECONDS FOR LATER
PUSH P,T2 ;SAVE MINUTES FOR LATER
PUSHJ P,LSTBTH ;LIST HOURS
MOVEI CH,":" ;SET COLON
PUSHJ P,LSTOUT ;LIST COLON
POP P,T1 ;GET MINUTES BACK
PUSHJ P,LSTBTH ;LIST MINUTES
MOVEI CH,":" ;SET COLON
PUSHJ P,LSTOUT ;LIST COLON
POP P,T1 ;GET SECONDS BACK
JRST LSTBTH ;LIST SECONDS AND RETURN
;+
;<LSTXXX IS A SUBROUTINE TO LIST THE START/END OF SAVE SET INFORMATION.
;-
LSTXXX: SKIPN S.LIST## ;SKIP IF LISTING ORDERED
POPJ P, ;RETURN
PUSHJ P,SAVE1 ;SAVE C(P1)
SETZM LSTSTR ;CLEAR LAST LIST STR
MOVE T2,G$TYPE(MH) ;GET RECORD TYPE [211]
CAIE T2,T$CON ;IF CONTINUATION, [211]
JRST LSTXX1 ;NOT CONTINUATION [211]
MOVEI CH,14 ;GET A FORM-FEED [211]
MOVEI T1,F.LIST ;LISTING CHANNEL [211]
DEVCHR T1, ;GET CHARACTERISTICS [211]
TXNN T1,DV.TTY ;IS DEV A TTY? [211]
PUSHJ P,LSTOUT ;NO - START A NEW PAGE [211]
LSTXX1: MOVEI T1,[ASCIZ /Start/] ;ASSUME START OF SAVE [211]
CAIN T2,T$CON ;IF CONTINUATION,
MOVEI T1,[ASCIZ /
**********************************************************************
Continuation/]
CAIN T2,T$END ;SKIP IF NOT END OF SAVE
MOVEI T1,[ASCIZ /
End/]
PUSHJ P,LSTMSG ;SEND TO FILE
MOVEI T1,[ASCIZ / of save set /] ;COMMON CODE
PUSHJ P,LSTMSG ; ..
MOVEI T3,M(MH) ;START OF DATA AREA
ADD T3,G$LND(MH) ;END OF NON-DATA PORTION
MOVEI T1,M+1(MH) ;ADDRESS OF ASCII STRING
LSTSSN: HLRZ T2,-1(T1) ;GET BLOCK TYPE CODE
CAIN T2,O$SSNM ;SEE IF SAVE SET BLOCK
PUSHJ P,LSTMSG ;LIST SAVE SET NAME
HRRZ T2,-1(T1) ;GET LENGTH OF BLOCK
ADD T1,T2 ;ADVANCE POINTER
CAIGE T1,(T3) ;SEE IF MORE BLOCKS
JRST LSTSSN ;YES, CIRCLE
MOVEI T1,[ASCIZ / on /] ;TELL WHERE
PUSHJ P,LSTMSG ;SEND TO FILE
MOVE T1,S$DEV(MH) ;GET PHYSICAL DEVICE NAME
PUSHJ P,LST6 ;SEND TO FILE
MOVEI CH," " ;SPACE
PUSHJ P,LSTOUT ;SEND
MOVE T1,S$RLNM(MH) ;GET REELID
PUSHJ P,LST6 ;SEND
;HERE TO LIST THE SECOND LINE OF THE SAVE SET HEADER
MOVEI T1,[ASCIZ /
System /]
PUSHJ P,LSTMSG ; ..
MOVEI T3,M(MH) ;START OF DATA AREA
ADD T3,G$LND(MH) ;END OF NON-DATA PORTION
MOVEI T1,M+1(MH) ;ADDRESS OF ASCII STRING
LSTSYS: HLRZ T2,-1(T1) ;GET BLOCK TYPE CODE
CAIN T2,O$SYSN ;SEE IF SYSEM HEADER
PUSHJ P,LSTMSG ;YES, LIST
HRRZ T2,-1(T1) ;GET LENGTH OF BLOCK
ADD T1,T2 ;ADD TO POINTER
CAIGE T1,(T3) ;SEE IF REACHED END
JRST LSTSYS ;CIRCLE
LDB T1,[POINTR (S$MON(MH),CN%MNT)];GET MONITOR TYPE BYTE
CAIL T1,LN$MTP ;SEE IF DEFINED
SETZ T1, ;NO, UNKNOWN
MOVE T1,MTPTBL(T1) ;GET ADDRESS OF MONITOR TYPE STRING
PUSHJ P,LSTMSG ;SEND TO FILE
MOVEI T1,[ASCIZ / monitor /] ; ..
PUSHJ P,LSTMSG ; ..
MOVE P1,S$SVER(MH) ;GET MONITOR VERSION
PUSHJ P,LSTVER ;SEND TO FILE
MOVEI T1,[ASCIZ / APR#/] ; ..
PUSHJ P,LSTMSG ; ..
MOVE T1,S$APR(MH) ;GET APR SERIAL NUMBER
PUSHJ P,LSTDEC ;SEND TO FILE
MOVEI T1,CRLF ;<CR><LF>
PUSHJ P,LSTMSG ;SEND TO FILE
;HERE TO LIST THE THIRD LINE OF THE SAVE SET HEADER
LDB T1,[POINTR (S$MTCH(MH),MT.DEN)] ;GET DENSITY BYTE
MOVE T1,DNSTBL(T1) ;GET ADDRESS OF DENSITY STRING
PUSHJ P,LSTMSG ;SEND TO FILE
MOVEI CH,"9" ;ASSUME 9 TRACK
MOVEI T1,MT.7TR ;SEE IF SEVEN TRACK
TDNE T1,S$MTCH(MH) ;SKIP IF OFF
MOVEI CH,"7" ;LOAD ASCII SEVEN
PUSHJ P,LSTOUT ;SEND
MOVEI T1,[ASCIZ / track /]
PUSHJ P,LSTMSG ;SEND
MOVE T1,S$DATE(MH) ;GET DATE/TIME IN UNIVERSAL FORMAT
PUSHJ P,CONTDT ;CONVERT TO SYSTEM FORMAT
PUSH P,T1 ;SAVE TIME FOR LATER
MOVE T1,T2 ;GET DATE
PUSHJ P,LSTDAT ;LIST DATE
MOVEI CH," " ;SPACE
PUSHJ P,LSTOUT ;SEND
POP P,T1 ;GET TIME BACK
PUSHJ P,LSTTIM ;LIST TIME
MOVEI T1,[ASCIZ / BACKUP /]
PUSHJ P,LSTMSG ;SEND TO FILE
MOVE P1,S$BVER(MH) ;GET VERSION
PUSHJ P,LSTVER ;TYPE VERSION
MOVEI T1,[ASCIZ / tape format /] ; ..
PUSHJ P,LSTMSG ; ..
MOVE T1,S$FMT(MH) ;GET FORMAT
PUSHJ P,LSTDEC ;TYPE DECIMAL
MOVEI T1,CRLF ;SEND CR-LF
PUSHJ P,LSTMSG ;SEND TO FILE
;HERE TO LIST THE FOURTH LINE OF THE SAVE SET HEADER
MOVEI T1,[ASCIZ /Tape number /]
PUSHJ P,LSTMSG ;SEND
MOVE T1,NTPE ;GET TAPE NUMBER
PUSHJ P,LSTDEC ;SEND
MOVEI T1,[ASCIZ /
**********************************************************************
/]
MOVEI T2,T$CON ;ASTERISK OFFSET FOR CONTINUATION HEADER
CAMN T2,G$TYPE(MH) ; ...
PUSHJ P,LSTMSG ;SEND ASTERISK LINE
MOVEI T1,CRLF ;SEND ONE CR-LF
PUSHJ P,LSTMSG ;SEND TO FILE
MOVEI T1,CRLF ;FINISH WITH SECOND CR-LF
JRST LSTMSG ;SEND TO FILE
;+
;<LSTVER IS A SUBROUTINE TO DECODE AND LIST THE VERSION IN
;<.JBVER FORMAT IN ^P1.
;-
LSTVER: LDB T1,[POINTR (P1,VR.MAJ)] ;GET MAJOR VERSION
PUSHJ P,LSTOCT ;SEND TO FILE
LDB T1,[POINTR (P1,VR.MIN)] ;GET MINOR VERSION
JUMPE T1,NMINOR ;BRANCH IF NO MINOR
MOVEI CH,"A"-1(T1) ;GET UPDATE LETTER
PUSHJ P,LSTOUT ;SEND TO FILE
NMINOR: LDB T1,[POINTR (P1,VR.EDT)] ;GET EDIT VERSION
JUMPE T1,NEDIT ;BRANCH IF NO EDIT
MOVEI CH,"(" ;OPEN PARENS
PUSHJ P,LSTOUT ; ..
PUSHJ P,LSTOCT ;SEND EDIT NUMBER TO FILE
MOVEI CH,")" ;CLOSE PARENS
PUSHJ P,LSTOUT ;SEND TO FILE
NEDIT: LDB T1,[POINTR (P1,VR.CUS)] ;GET CUSTOMER VERSION
JUMPE T1,CPOPJ ;RETURN IF DONE
MOVEI CH,"-" ;DASH
PUSHJ P,LSTOUT ;TO FILE
JRST LSTOCT ;SEND CUSTOMER VERSION TO FILE
DNSTBL: EXP [ASCIZ /Unknown BPI /]
EXP [ASCIZ /200 BPI /]
EXP [ASCIZ /556 BPI /]
EXP [ASCIZ /800 BPI /]
EXP [ASCIZ /1600 BPI /]
EXP [ASCIZ /6250 BPI /]
EXP [ASCIZ /(6) BPI /]
EXP [ASCIZ /(7) BPI /]
MTPTBL: EXP [ASCIZ / Unknown/]
EXP [ASCIZ / TOPS-10/]
EXP [ASCIZ / ITS/]
EXP [ASCIZ / TENEX/]
LN$MTP==.-MTPTBL ;LENGTH OF MONITOR TYPE TABLE
;+
;<LSTFIL LISTS THE FILE DATA INFORMATION.
;^CALL WITH ^T1 = ADDRESS OF <O$FILE BLOCK.
;-
LSTFIL: SKIPN S.LIST## ;SKIP IF LISTING ORDERED
POPJ P, ;RETURN
PUSHJ P,SAVE2 ;SAVE C(P1), C(P2)
MOVEI P1,1(T1) ;POINT TO O$FILE DATA
;HERE TO COMPARE THIS FILE STR-PATH WITH LAST ONES
SETZ P2, ;ZERO INDICATES NO CHANGE
MOVE T1,ACSTR ;GET ALIAS FS NAME
SKIPL S.OPER## ;SEE IF /SAVE
MOVE T1,CSTR ;NOT. USE CURRENT FS NAME
CAME T1,LSTSTR ;COMPARE
JRST DIFF ;DIFFERENT
SETZ T2, ;START AT UFD LEVEL AT LSTPTH
MOVEI T3,APATH+.PTPPN ;COMPARE WITH ALIAS PATH
SKIPL S.OPER## ;SEE IF /SAVE
MOVEI T3,PTHBLK+.PTPPN;NOT. USE PATH BLOCK
CMPPTH: MOVE T4,LSTPTH(T2) ;GET ENTRY FROM BLOCK
CAME T4,(T3) ;COMPARE WITH TAPE BLOCK
JRST DIFF ;DIFFERENT
JUMPE T4,LSTFID ;BRANCH IF DONE
ADDI T3,1 ;NEXT WORD IN BLOCK
AOJA T2,CMPPTH ;COMPARE NEXT
DIFF: SETO P2, ;MINUS 1 INDICATE CHANGE
MOVEM T1,LSTSTR ;STORE
MOVSI T1,APATH+.PTPPN;ALIAS PATH
SKIPL S.OPER## ;SEE IF /SAVE
MOVSI T1,PTHBLK+.PTPPN;USE PATH BLOCK
HRRI T1,LSTPTH ;TRANSFER TO LISTING PATH BLOCK
BLT T1,LSTPTH+.FXLND;XFR
MOVEI T1,CRLF ;CR-LF
PUSHJ P,LSTMSG ;SEND TO FILE
;HERE TO LIST INDIVIDUAL FILE IDENTIFIERS
LSTFID: MOVE T1,ACNAM ;GET ALIAS NAME
SKIPL S.OPER## ;SEE IF /SAVE
MOVE T1,CNAM ;NOT. USE CURRENT FILE NAME
PUSHJ P,LST6 ;SEND TO FILE
PUSHJ P,LSTTAB ;TAB OVER
MOVE T1,ACEXT ;GET ALIAS EXTENSION
SKIPL S.OPER## ;SEE IF /SAVE
MOVE T1,CEXT ;NOT. USE CURRENT EXT
PUSHJ P,LST6 ;SEND TO FILE
PUSHJ P,LSTTAB ;TAB OVER
MOVE T1,A$LENG(P1) ;GET SIZE IN BYTES
MOVE T2,A$MODE(P1) ;GET FILE MODE
CAIG T2,.IOASL ;SEE IF ASCII
IDIVI T1,5 ;GET SIZE IN WORDS
ADDI T1,177 ;FORCE OVERFLOW
ASH T1,-7 ;COMPUTE SIZE IN BLOCKS
PUSHJ P,LSTDEC ;SEND TO FILE
PUSHJ P,LSTTAB ;TAB OVER
SKIPE A$PROT(P1) ;SEE IF NO PROTECTION ON TAPE,
SKIPE S.INTR## ; OR IF INTERCHANGE MODE
JRST LSTFCD ;YES--NO PROTECTION TO LIST
MOVEI CH,"<" ;PROTECTION
PUSHJ P,LSTOUT ; ..
PUSHJ P,RSTPRO ;GET PROTECTION AND CONVERT
IDIVI T1,100 ;SPLIT DIGITS
IDIVI T2,10 ;T1-T2-T3
MOVEI CH,"0"(T1) ;FIRST
PUSHJ P,LSTOUT ; ..
MOVEI CH,"0"(T2) ;SECOND
PUSHJ P,LSTOUT ; ..
MOVEI CH,"0"(T3) ;THIRD
PUSHJ P,LSTOUT ; ..
MOVEI CH,">" ; ..
PUSHJ P,LSTOUT ; ..
LSTFCD: PUSHJ P,LSTTAB ;TAB OVER
MOVE T1,A$WRIT(P1) ;GET DATE/TIME
PUSHJ P,CONTDT ;CONVERT TO SYSTEM FORMAT
MOVE T1,T2 ;GET DATE
PUSHJ P,LSTDAT ;LIST DATE
JUMPE P2,LSTFLX ;BRANCH IF NO STR-PATH CHANGE
SKIPE S.INTR## ;SEE IF /INTERCHANGE
JRST LSTFLX ;SKIP PATH INFO IF SO
;HERE TO LIST THE FULL FILE PATH
PUSHJ P,LSTTAB ;TAB OVER
MOVE T1,LSTSTR ;GET STR NAME
PUSHJ P,LST6 ;SEND TO FILE
MOVEI CH,":" ;END OF STR
PUSHJ P,LSTOUT ;SEND TO FILE
PUSHJ P,LSTTAB ;TAB OVER
MOVEI CH,"[" ;START OF PATH
PUSHJ P,LSTOUT ;SEND TO FILE
HLRZ T1,LSTPTH ;GET PROJECT
PUSHJ P,LSTOCT ;SEND TO FILE
MOVEI CH,"," ;COMMA
PUSHJ P,LSTOUT ;SEND TO FILE
HRRZ T1,LSTPTH ;GET PROGRAMMER
PUSHJ P,LSTOCT ;SEND TO FILE
MOVEI P2,LSTPTH+1 ;GET ADDRESS OF SFD NAMES
SFDLST: SKIPN T1,(P2) ;SEE IF ONE IS THERE
JRST CLSPTH ;BRANCH IF DONE
MOVEI CH,"," ;LOAD COMMA
PUSHJ P,LSTOUT ;SEND TO FILE
PUSHJ P,LST6 ;SEND SFD NAME TO FILE
AOJA P2,SFDLST ;CONTINUE
CLSPTH: MOVEI CH,"]" ;END OF PATH
PUSHJ P,LSTOUT ;SEND TO FILE
LSTFLX: MOVEI T1,CRLF ;<CR><LF>
JRST LSTMSG ;SEND TO FILE
SUBTTL DATE CONVERSION SUBROUTINES
;+.CHAPTER DATE CONVERSION SUBROUTINES
;-
RADIX 10 ;***NOTE WELL***
;+
;<CONVDT CONVERTS DATE IN OLD FORMAT AND TIME IN MINUTES TO SMITHSONIAN DATE/TIME.
;^CALLED WITH ^T1 = TIME IN MINUTES SINCE MIDNIGHT, ^T2 = DATE IN OLD FORMAT.
;^ON EXIT ^T1 = SMITHSONIAN DATE/TIME.
;-
CONVDT: PUSHJ P,SAVE1 ;PRESERVE P1
SAVE$ T1 ;SAVE TIME FOR LATER
IDIVI T2,12*31 ;T2=YEARS-1964
CAILE T2,2217-1964 ;SEE IF BEYOND 2217
JRST GETNW2 ;YES--RETURN -1
IDIVI T3,31 ;T3=MONTHS-JAN, T4=DAYS-1
ADD T4,MONTAB(T3) ;T4=DAYS-JAN 1
MOVEI P1,0 ;LEAP YEAR ADDITIVE IF JAN, FEB
CAIL T3,2 ;CHECK MONTH
MOVEI P1,1 ;ADDITIVE IF MAR-DEC
MOVE T1,T2 ;SAVE YEARS FOR REUSE
ADDI T2,3 ;OFFSET SINCE LEAP YEAR DOES NOT GET COUNTED
IDIVI T2,4 ;HANDLE REGULAR LEAP YEARS
CAIE T3,3 ;SEE IF THIS IS LEAP YEAR
MOVEI P1,0 ;NO--WIPE OUT ADDITIVE
ADDI T4,<1964-1859>*365+<1964-1859>/4+<31-18>+31(T2)
;T4=DAYS BEFORE JAN 1,1964 +SINCE JAN 1
; +ALLOWANCE FOR ALL LEAP YEARS SINCE 64
MOVE T2,T1 ;RESTORE YEARS SINCE 1964
IMULI T2,365 ;DAYS SINCE 1964
ADD T4,T2 ;T4=DAYS EXCEPT FOR 100 YR. FUDGE
HRREI T2,64-100-1(T1) ;T2=YEARS SINCE 2001
JUMPLE T2,GETNW1 ;ALL DONE IF NOT YET 2001
IDIVI T2,100 ;GET CENTURIES SINCE 2001
SUB T4,T2 ;ALLOW FOR LOST LEAP YEARS
CAIE T3,99 ;SEE IF THIS IS A LOST L.Y.
GETNW1: ADD T4,P1 ;ALLOW FOR LEAP YEAR THIS YEAR
CAILE T4,^O377777 ;SEE IF TOO BIG
GETNW2: SETOM T4 ;YES--SET -1
RSTR$ T1 ;GET MILLISEC TIME
MOVEI T2,0 ;CLEAR OTHER HALF
ASHC T1,-17 ;POSITION
DIV T1,[24*60*60*1000] ;CONVERT TO 1/2**18 DAYS
HRL T1,T4 ;INCLUDE DATE
POPJ P, ;RETURN
;+
;<CONTDT CONVERTS DATE FROM SMITHSONIAN DATE/TIME TO OLD SYSTEM FORMAT.
;^CALL WITH ^T1 = DATE/TIME, RETURN WITH ^T1=TIME IN MILLISECONDS,
;^T2=DATE IN SYSTEM FORMAT (.<LT. 0 IF ARG .<LT. 0). ^USES ^T1-^T4.
;-
CONTDT: PUSH P,T1 ;SAVE TIME FOR LATER
JUMPL T1,CNTDT6 ;DEFEND AGAINST JUNK INPUT
HLRZ T1,T1 ;GET DATE PORTION (DAYS SINCE 1858)
ADDI T1,<1857-1500>*365+<1857-1500>/4-<1857-1500>/100+<1857-1500>/400+31+28+31+30+31+30+31+31+30+31+17
;T1=DAYS SINCE JAN 1, 1501
IDIVI T1,400*365+400/4-400/100+400/400
;SPLIT INTO QUADRACENTURY
LSH T2,2 ;CONVERT TO NUMBER OF QUARTER DAYS
IDIVI T2,<100*365+100/4-100/100>*4+400/400
;SPLIT INTO CENTURY
IORI T3,3 ;DISCARD FRACTIONS OF DAY
IDIVI T3,4*365+1 ;SEPARATE INTO YEARS
LSH T4,-2 ;T4=NO DAYS THIS YEAR
LSH T1,2 ;T1=4*NO QUADRACENTURIES
ADD T1,T2 ;T1=NO CENTURIES
IMULI T1,100 ;T1=100*NO CENTURIES
ADDI T1,1501(T3) ;T1 HAS YEAR, T4 HAS DAY IN YEAR
MOVE T2,T1 ;COPY YEAR TO SEE IF LEAP YEAR
TRNE T2,3 ;IS THE YEAR A MULT OF 4?
JRST CNTDT0 ;NO--JUST INDICATE NOT A LEAP YEAR
IDIVI T2,100 ;SEE IF YEAR IS MULT OF 100
SKIPN T3 ;IF NOT, THEN LEAP
TRNN T2,3 ;IS YEAR MULT OF 400?
TDZA T3,T3 ;YES--LEAP YEAR AFTER ALL
CNTDT0: MOVEI T3,1 ;SET LEAP YEAR FLAG
;T3 IS 0 IF LEAP YEAR
SUBI T1,1964 ;SET TO SYSTEM ORIGIN
IMULI T1,31*12 ;CHANGE TO SYSTEM PSEUDO DAYS
JUMPN T3,CNTDT2 ;IF NOT LEAP YEAR, PROCEED
CAIGE T4,31+29 ;LEAP YEAR--SEE IF BEYOND FEB 29
JRST CNTDT5 ;NO--JUST INCLUDE IN ANSWER
SOS T4 ;YES--BACK OFF ONE DAY
CNTDT2: MOVSI T2,-11 ;LOOP FOR 11 MONTHS
CNTDT3: CAMGE T4,MONTAB+1(T2) ;SEE IF BEYOND THIS MONTH
JRST CNTDT4 ;YES--GO FINISH UP
ADDI T1,31 ;NO--COUNT SYSTEM MONTH
AOBJN T2,CNTDT3 ;LOOP THROUGH NOVEMBER
CNTDT4: SUB T4,MONTAB(T2) ;GET DAYS IN THIS MONTH
CNTDT5: ADD T1,T4 ;INCLUDE IN FINAL RESULT
CNTDT6: EXCH T1,(P) ;SAVE ANSWER, GET TIME
TLZ T1,-1 ;CLEAR DATE
MUL T1,[24*60*60*1000] ;CONVERT TO MILLI-SEC.
ASHC T1,17 ;POSITION RESULT
POP P,T2 ;RECOVER DATE
POPJ P, ;RETURN
MONTAB: EXP 0,31,59,90,120,151,181,212,243,273,304,334,365
RADIX 8 ;***NOTE WELL***
SUBTTL FILE VERIFICATION SUBROUTINES
;+
;.CHAPTER FILE VERIFICATION ROUTINES
;-
;+
;<VER0 VERIFIES THAT THE INPUT DEVICE NAME MATCHES THE NAME FROM
;THE <O$NAME BLOCK ON TAPE. ^SKIP RETURN IF MATCH.
;-
VER0: MOVE T1,FX$LEN+.FXDEV(SP); GET INPUT DEVICE NAME [175]
CAME T1,CSTR ; SAME AS TAPE DEVICE NAME? [175]
CAMN T1,[SIXBIT/ALL/]; NO, "ALL" MATCHES ANY STR [175]
JRST VER001 ; A MATCH [175]
CAME T1,[SIXBIT/DSK/]; "DSK" MATCHES ANY STR [175]
POPJ P, ; DIFFERENT [175]
VER001: CAME T1,.FXDEV(SP) ; SKIP STR-FLAG TEST IF [175]
JRST VER101 ; OUTPUT DEV NEQ INPUT DEV [175]
;+
;<VER1 VERIFIES THAT THE PATH OF THE CURRENT FILE MATCHES THE
;USER'S INPUT SPEC (ADDRESS IN <SP). ^IF THE FILE IS AN <SFD, IT
;MUST MATCH DOWN TO THE CURRENT LEVEL IN <LVL. ^NON-^^SFD\\S MUST
;MATCH AT ALL LEVELS. ^SKIP RETURN IF MATCH.
;^ON THE NON-MATCH RETURN T1 CONTAINS ZERO IF DIFFERENCE WAS
;DUE TO PPN AND NON-ZERO IF DUE TO SFD DIFFERENCE.
;-
VER1: MOVE T1,CSTRFL ;GET CURRENT STR FLAG
TDNN T1,FX$LEN+FX$STR(SP);CHECK INPUT STR WORD
POPJ P, ;STR NO GOOD--RETURN NOW
VER101: MOVNI T1,1(LVL) ;GET NEGATIVE LEVEL COUNT [175]
HRLZS T1 ;FORM AOBJN WORD FOR SFD
MOVSI T2,'SFD' ;SEE IF CURRENT FILE IS AN SFD,
CAME T2,CEXT ; IF NOT,
MOVSI T1,-.FXLND ; USE AOBJN WORD FOR FILES
MOVE T2,SP ;ANOTHER INDEX
SFDCHK: MOVE T3,PTHBLK+.PTPPN(T1) ;GET SFD NAME
XOR T3,FX$LEN+.FXDIR(T2) ;GET DIFFERENCES
AND T3,FX$LEN+.FXDIM(T2) ;BLOT OUT DIFFERENCES
JUMPN T3,SFDCH1 ;RETURN IF NO GOOD [204]
ADDI T2,2 ;INCREMENT
AOBJN T1,SFDCHK ;LOOP
JRST CPOPJ1 ;SKIP BACK
SFDCH1: HRRZ T1,T1 ; ZERO THE LEFT HALF [204]
POPJ P, ; NON-MATCH RETURN [204]
;+
;<VER2 VERIFIES THAT THE FILE NAME AND EXTENSION OF THE CURRENT FILE
;MATCH THE USER'S INPUT SPEC (ADDRESS IN <SP). ^A SKIP RETURN IS GIVEN
;ON A MATCH.
;-
VER2: MOVE T1,CNAM ;GET CURRENT NAME
XOR T1,FX$LEN+.FXNAM(SP) ; ..
AND T1,FX$LEN+.FXNMM(SP) ; ..
JUMPN T1,CPOPJ ; ..
MOVE T1,CEXT ;GET CURRENT EXT
XOR T1,FX$LEN+.FXEXT(SP) ; ..
HRLZ T2,FX$LEN+.FXEXT(SP) ; ..
AND T1,T2 ; ..
JUMPE T1,CPOPJ1 ;GOOD RETURN
POPJ P, ;BAD RETURN
;+
;<CHKLIM IS A SUBROUTINE TO CHECK A FILE SPEC AGAINST THE USER'S
;SELECTIVE SWITCHES. ^CALL WITH <SP = ADDRESS OF FILE SPEC BLOCK.
;^NON-SKIP RETURN IF FILE DOES NOT MEET TIME AND SIZE SPECIFICATIONS.
;^SKIP RETURN IF FILE WILL LOSE EXCEPT FOR </DATE75 DEFENSE.
;^DOUBLE SKIP INDICATES FILE MEETS TIME AND SIZE SPECIFICATIONS.
;^NOTE THAT ON AN INTERCHANGE RESTORE, ACCESS AND MONITOR-SET
;DATE/TIME SWITCHES DO NOT APPLY. ^ALSO, SELECTION SWITCHES ARE
;IGNORED FOR CERTAIN ^^PPN\\S AND IF THE <RP.ABU BIT IS
;SET FOR A FILE. (SEE <CHKABU FOR MORE INFO ON THIS).
;-
CHKLIM: MOVEI T4,2 ;SET WINNING INCREMENT
PUSHJ P,CHKABU ;SEE IF ALWAYS BACKUP
JRST CHKLMX ;YES--GIVE NORMAL RETURN
MOVE T1,CWSIZE ;GET SIZE
MOVE T2,FX$LEN+.FXFLI(SP) ;GET LOWER LIMIT
MOVE T3,FX$LEN+.FXFLM(SP) ;GET UPPER LIMIT
PUSHJ P,CHKRNG ;CHECK RANGE
POPJ P, ;COMPLETE LOSAGE
MOVE T1,CCDATI ;GET CREATION DATE/TIME
MOVE T2,FX$LEN+.FXSNC(SP) ;GET LOWER LIMIT
MOVE T3,FX$LEN+.FXBFR(SP) ;GET UPPER LIMIT
PUSHJ P,CHKRNG ;CHECK RANGE
MOVEI T4,1 ;INDICATE LOSE
SKIPE S.INTR## ;SEE IF /INTERCHANGE
SKIPG S.OPER## ;AND /RESTORE,
SKIPA ; NO, CONTINUE
JRST CHKD75 ; YES, IGNORE OTHER DATES
MOVE T1,CADATI ;GET ACCESS DATE/TIME
MOVE T2,FX$LEN+.FXASN(SP) ;GET LOWER LIMIT
MOVE T3,FX$LEN+.FXABF(SP) ;GET UPPER LIMIT
PUSHJ P,CHKRNG ;CHECK RANGE
MOVEI T4,1 ;INDICATE LOSE
MOVE T1,CMDATI ;GET MODIFY DATE/TIME
MOVE T2,FX$LEN+FX$MSN(SP) ;GET LOWER LIMIT
MOVE T3,FX$LEN+FX$MBF(SP) ;GET UPPER LIMIT
PUSHJ P,CHKRNG ;CHECK RANGE
MOVEI T4,1 ;INDICATE LOSE
CHKD75: SKIPG S.DT75## ;SEE IF /DATE75
CAIE T4,1 ;NO--IF 1,
SKIPA ;ELSE
MOVEI T4,0 ;IF NOT /DATE75 AND LOST, SET 0
CAIE T4,1 ;UNLESS JUST DATE LOSAGE,
JRST CHKLMX ; GO RETURN
MOVEI T4,0 ;POSSIBLE DATE75, SET FOR FAILURE
HLRZ T1,CCDATI ;GET CREATION DATE
CAIL T1,115103 ;IF BEFORE 1-JAN-67
CAIN T1,122661 ; OR = 5-JAN-75
MOVEI T4,1 ;INDICATE DATE75
HLRZ T1,CADATI ;GET ACCESS DATE
CAIL T1,115103 ;IF BEFORE 1-JAN-67
CAIN T1,122661 ; OR = 5-JAN-75
MOVEI T4,1 ;INDICATE DATE75
CHKLMX: ADDM T4,(P) ;ADVANCE RETURN
POPJ P, ;RETURN
;INTERNAL ROUTINE TO CHECK C(T1) WITHIN RANGE C(T2)-C(T3)
CHKRNG: JUMPLE T2,CHKRG1 ;IS LOWER LIMIT NOT SET, SKIP ON
CAMGE T1,T2 ;IF BELOW LOWER LIMIT,
POPJ P, ; GIVE ERROR RETURN
CHKRG1: JUMPLE T3,CPOPJ1 ;IF UPPER LIMIT NOT SET, WIN
CAMLE T1,T3 ;IF ABOVE UPPER LIMIT,
POPJ P, ; GIVE ERROR RETURN
JRST CPOPJ1 ;GIVE OK RETURN
;+
;<CHKABU IS A SUBROUTINE TO CHECK THE <RP.ABU BIT FOR A FILE. ^ALSO CHECKS
;IF <PPN = [^A,*] OR [10,^B] FOR ^A _& ^B <.LE. 7 IN ORDER TO SAVE/RESTORE
;ALL LIBRARIES, ETC.(UNLESS </NOEXEMPT WAS TYPED).
;^SKIP RETURN IF SHOULD CONTINUE CHECKING USER SWITCHES.
;-
CHKABU: SKIPE S.INTR## ;IF /INTERCHANGE,
JRST CPOPJ1 ; ALWAYS CONTINUE
MOVX T1,RP.ABU ;ALWAYS BACKUP BIT
MOVEI T2,EXLFIL+.RBSTS ;POINT TO FILE STATUS WORD
SKIPL S.OPER## ;SEE IF /SAVE
JRST [MOVX T1,B$DLRA;CORRESPONDING BACKUP FLAG
MOVEI T2,A$FLGS+1(P1);POINT TO BACKUP FLAGS
JRST .+1] ;PROCEED
TDNE T1,(T2) ;SEE IF FLAG ON
POPJ P, ;YES--ALWAYS ACCEPT
SKIPN S.XMPT## ;/NOEXEMPT?
JRST CPOPJ1 ;YES--DONT CHECK PPNS
HLRZ T1,PTHBLK+.PTPPN;GET PROGET NUMBER
CAIG T1,7 ;SEE IF PRJ < OR = 7
POPJ P, ;YES--ALWAYS ACCEPT
CAIE T1,10 ;SEE IF [10,B]
JRST CPOPJ1 ;NO--CHECK SWITCHES
HRRZ T1,PTHBLK+.PTPPN;YES--GET PROGRAMMER NUMBER
CAILE T1,7 ;SEE IF PRG < OR = 7
AOS (P) ;NO--ADVANCE RETURN
POPJ P, ;RETURN
SUBTTL SORT SUBROUTINES
;+
;.CHAPTER SORT SUBROUTINES
;-
;+
;<LOCSRT HANDLES THE SORT BY LOCATION (COMPRESSED FILE POINTER).
;^USES A BUBBLE SORT. ^CALL WITH ^P1 = START ADDRESS OF <MFD OR DIRECTORY.
;-
LOCSRT: MOVE T1,P1 ;COPY POINTER
ADD T1,[2,,0] ;SKIP FIRST
JUMPGE T1,CPOPJ ;RETURN
LOC1: HRRZ T2,2(T1) ;GET CFP OF FIRST
HRRZ T3,4(T1) ;GET CFP OF SECOND
CAMLE T2,T3 ;SKIP IF LE
JRST LOCINV ;INVERSION
LOC2: AOBJN T1,.+1 ;ADVANCE 1
AOBJN T1,LOC1 ;CONTINUE IF MORE
TXZE F,FL$FLP ;ZILCH & SKIP IF NO INVERSIONS
JRST LOCSRT ;SCAN AGAIN
POPJ P, ;RETURN
LOCINV: MOVE T2,1(T1) ;GET FIRST FILE NAME
EXCH T2,3(T1) ;EXCHANGE
MOVEM T2,1(T1) ; ..
MOVE T2,2(T1) ;GET FIRST EXT
EXCH T2,4(T1) ;EXCHANGE
MOVEM T2,2(T1) ; ..
TXO F,FL$FLP ; ..
JRST LOC2 ; ..
;+
;<ALPSRT HANDLES THE ALPHABETIC SORT. ^USES A BUBBLE SORT.
;^CALL WITH ^P1 = START ADDRESS OF <MFD OR DIRECTORY.
;-
ALPSRT: MOVE T1,P1 ;COPY POINTER
ADD T1,[2,,0] ;SKIP FIRST
JUMPGE T1,CPOPJ ;RETURN
ALP1: MOVE T2,1(T1) ;GET FIRST FILE NAME
TLC T2,(1B0) ;COMPLEMENT SIGN BIT
MOVE T3,3(T1) ;GET SECOND FILE NAME
TLC T3,(1B0) ;COMPLEMENT SIGN BIT
CAMLE T2,T3 ;TEST
JRST INVERT ;INVERSION
CAME T2,T3 ;SKIP IF EQUAL
JRST ALP2 ;FINISHED
HLRZ T2,2(T1) ;GET FIRST EXT
HLRZ T3,4(T1) ;GET SECOND EXT
CAMLE T2,T3 ;TEST FOR INVERSION
JRST INVERT ;INVERSION
ALP2: AOBJN T1,.+1 ;ADVANCE 1
AOBJN T1,ALP1 ;ADVANCE 2
TXZE F,FL$FLP ;ZERO & TEST IF ANY INVERSIONS
JRST ALPSRT ;THERE WERE SOME--CONTINUE
POPJ P, ;NONE--SKIP BACK
INVERT: MOVE T2,1(T1) ;GET FIRST
EXCH T2,3(T1) ;EXCHANGE FIRST WITH SECOND
MOVEM T2,1(T1) ;PUT SECOND IN FIRST
MOVE T2,2(T1) ;GET FIRST
EXCH T2,4(T1) ;EXCHANGE FIRST WITH SECOND
MOVEM T2,2(T1) ;PUT SECOND IN FIRST
TXO F,FL$FLP ;SET BIT
JRST ALP2 ;CONTINUE
SUBTTL CORE ALLOCATION SUBROUTINES
;+
;.CHAPTER CORE ALLOCATION SUBROUTINES
;-
;+
;<UCORE IS A SUBROUTINE TO ALLOCATE CORE. ^CALL WITH ^T1 = NUMBER OF WORDS
;TO ALLOCATE. ^NON-SKIP RETURN IF NO CORE AVAILABLE (WILL ISSUE WARNING).
;^ON A SKIP RETURN ^P1 = ADDRESS OF ZEROED BLOCK.
;^PRESERVES ^T1, CLOBBERS ^T2.
;-
UCORE: MOVE P1,T1 ;COPY NUMBER OF WORDS
CAILE T1,377777 ;SEE IF REASONABLE
JRST NOCORE ;TAKE ERROR RETURN IF NOT
ADD P1,.JBFF## ;INCREMENT TO FORM NEW JOBFF
MOVE T2,P1 ;COPY AGAIN
CAMG T2,.JBREL## ;SKIP IF TOO BIG
JRST UCORE1 ;IT FITS--GOOD
CAIG T2,377777 ;TOO LARGE?
CORE T2, ;EXPAND IF NECESSARY
JRST NOCORE ;LOSE
UCORE1: MOVE T2,.JBFF## ;GET OLD JOBFF
SETZM (T2) ;ZILCH FIRST WORD
HRLS T2 ;PUT IN LH
ADDI T2,1 ;FORM BLT POINTER
BLT T2,-1(P1) ;ZERO NEW CORE
EXCH P1,.JBFF## ;GET BASE ADDR
JRST CPOPJ1 ;SKIP BACK
;+
;<DRPCOR DROPS CORE TO ^C(^T1) IF THIS WILL SAVE 2^K OR MORE.
;^THIS AVOIDS UNNECESSARY SWAPPING AND SYSTEM OVERHEAD OF
;REPEATED UP/DOWNS.
;-
DRPCOR: MOVEI T2,2000(T1) ;ADD ON 2K
CAMGE T2,.JBREL## ;SEE IF UNDER JOBREL
CORE T1, ;DROP CORE
JFCL ;NICE TRY
POPJ P, ;RETURN
SUBTTL TELETYPE I/O SUBROUTINES
;+
;.CHAPTER TELETYPE I/O SUBROUTINES
;
;<TYI HANDLES OPERATOR INTERFACE AT <EOT AND ON TAPE WRITE LOCK. ^IT
;DISABLES <PSI, SIMULATES /<STOP AND CALLS THE RUN-TIME COMMAND HANDLER,
;<OPRCMD, TO PROCESS THE <TTY INPUT.
;-
TYI: MOVX T1,PS.FOF ;TURN OFF PSI
PISYS. T1, ;EXEC
JFCL ;PROBABLY NEVER TURNED ON
OUTSTR [ASCIZ \/\] ;DISPLAY PROMPT
MOVEI T1,1 ;SET STOP
MOVEM T1,S.STOP## ; ...
INCHWL T1 ;WAIT TILL LINE INPUT
PUSHJ P,OPRCMD##+2 ;CALL RUN TIME COMMAND HANDLER (CHAR IN T1)
TXO F,FL$KIL ;HERE IF COMMAND IS KILL
SETZM S.STOP## ;CLEAR STOP
MOVX T1,PS.FON ;TURN PSI BACK ON
PISYS. T1, ;EXEC
TXZ F,FL$PSI ;ERROR--ZILCH FLAG
POPJ P, ;CONTINUE
;+
;<SIXOUT TYPES OUT THE <SIXBIT WORD IN ^T1.
;-
SIXOUT: MOVE T2,T1 ;COPY C(T1)
SIXOU1: JUMPE T2,CPOPJ ;RETURN IF DONE
MOVEI T1,0 ;ZILCH T1
LSHC T1,6 ;CAPTURE CH
MOVEI CH," "-' '(T1) ;CONVERT TO ASCII
OUTCHR CH ;OUTPUT TO TTY
JRST SIXOU1 ;GET NEXT ONE
;+
;<OCTOUT TYPES THE OCTAL NUMBER IN ^T1.
;<DECOUT TYPES THE DECIMAL NUMBER IN ^T1.
;-
OCTOUT: TDZA T3,T3 ;INDICATE BASE 8
DECOUT: MOVEI T3,2 ;INDICATE BASE 10
SKIPGE T1 ;IF NEGATIVE,
OUTSTR [ASCIZ /-/] ; INDICATE
NBROUT: IDIVI T1,8(T3) ;START SPLITTING NUMBER
MOVMS T2 ;FORCE POSITIVE
HRLM T2,(P) ;STORE DIGIT ON STACK
SKIPE T1 ;SEE IF DONE
PUSHJ P,NBROUT ;KEEP GOING
HLRZ T1,(P) ;GET DIGIT OFF STACK
ADDI T1,"0" ;CONVERT BINARY TO ASCII
OUTCHR T1 ;OUTPUT TO TTY
POPJ P, ;RETURN
;+
;<DOWHAT IS CALLED BY THE RUN-TIME COMMAND HANDLER, <OPRCMD, IF THE
;COMMAND IS <WHAT. ^IT REPORTS THE FULL PATH IDENTIFICATION OF
;THE CURRENT FILE BEING PROCESSED.
;-
DOWHAT::PUSHJ P,TYSPEC ;TYPE FULL PATH SPEC
OUTSTR CRLF ;<CR><LF>
POPJ P, ;AND RETURN
;+
;<TYSPEC TYPES THE FULL PATH SPEC OF THE CURRENT FILE (NO CARIAGE RETURN).
;-
TYSPEC: SKIPN T1,CSTR ;GET STR NAME, IF ANY
POPJ P, ;NOTHING TO TYPE
PUSHJ P,SIXOUT ;TYPE DEVICE
OUTCHR COLON ;COLON
SKIPE S.INTR## ;SEE IF /INTERCHANGE
JRST TYPNAM ;YES--SKIP PATH INFO
OUTCHR LBR ;LEFT BRACKET
HLRZ T1,PTHBLK+.PTPPN;PRJ NBR
PUSHJ P,OCTOUT ;TYPE
OUTCHR COMMA ;...
HRRZ T1,PTHBLK+.PTPPN;PROGRAMMER NMR
PUSHJ P,OCTOUT ;TYPE
MOVSI T3,-.FXLND+1 ;HOW MANY SFD LEVELS
TYPSFD: SKIPN T1,PTHBLK+.PTPPN+1(T3);GET SFD NAME IF ANY
JRST TYPRBR ;NULL--CLOSE BRACKETS
OUTCHR COMMA ;TYPE COMMA
PUSHJ P,SIXOUT ;TYPE SFD
AOBJN T3,TYPSFD ;LOOP
TYPRBR: OUTCHR RBR ;RIGHT BRACKET
TYPNAM: MOVE T1,CNAM ;GET FILE NAME
PUSHJ P,SIXOUT ;PRINT
SKIPN T1,CEXT ;GET EXTENSION
POPJ P, ;DONE
OUTCHR DOT ;PERIOD
JRST SIXOUT ;TYPE EXTENSION
;+
;<TYEFIL TYPES THE CURRENT FILE'S FULL PATH SPEC AND BLOCK NUMBER. ^CALLED AT
;END OF TAPE SO FIRST REEL NEVER NEEDS TO BE REMOUNTED IN CASE OF CRASH.
;-
TYEFIL: SKIPE S.LIST## ;SEE IF LISTING FILE
OUTPUT F.LIST, ; OUTPUT LISTING BUFFER FIRST
PUSHJ P,TYSPEC ;TYPE FULL PATH SPEC
OUTSTR [ASCIZ\(BLOCK=\];MESSAGE
MOVE T1,THSRDB ;GET CURRENT BLOCK NUMBER
PUSHJ P,DECOUT ;TYPE
OUTSTR [ASCIZ\)
\]
POPJ P, ;RETURN
;+
;<TYPFIL TYPES THE FILE NAME AND EXTENSION OF THE CURRENT FILE
;BEING PROCESSED.
;-
TYPFIL: MOVE T1,CNAM ;FILE NAME
PUSHJ P,SIXOUT ;TYPE
SKIPN T1,CEXT ;EXTENSION
JRST NOEXT ;GO AROUND
OUTCHR TAB ;TAB OVER
PUSHJ P,SIXOUT ;TYPE EXTENSION
NOEXT: OUTSTR CRLF ;<CR><LF>
POPJ P, ;RETURN
;+
;<TYLPPN TYPES THE <PPN IN <PREPPN.
;-
TYLPPN: HLRZ T1,PREPPN ;GET PROJ
PUSHJ P,OCTOUT ;TYPE
OUTCHR COMMA ;COMMA
HRRZ T1,PREPPN ;GET PROG
JRST OCTOUT ;TYPE
;+
;<TYPID IS CALLED BY <MASTER TO TYPE SUCCESSIVE PATH FIELD
;COMPONENTS. ^AN <ASCII BYTE POINTER TO THE <F$PTH SECTION
;OF THE TAPE RECORD HEADER IS SET UP BY <MASTER. <TYPID TYPES
;THE FIELD AND RETURNS WITH THE TYPE CODE OF THE NEXT FIELD IN ^T1.
;-
TYPID: ILDB T2,T3 ;GET # OF WORDS
CAILE T2,M-F$PTH ;SEE IF IN RANGE
MOVEI T2,M-F$PTH ;NOT. USE MAX
ADDI T2,(T3) ;ADD START ADDRESS
TYPID1: ILDB T1,T3 ;GET CHARACTER
CAIN T2,(T3) ;SEE IF DONE
POPJ P, ;RETURN WITH T1=TYPE BYTE OF NEXT PATH NAME
JUMPE T1,TYPID1 ;IGNORE NULLS
CAIN T1,"_" ;SEE IF UNDERLINE,
MOVEI T1,"," ;CONVERT TO COMMA
OUTCHR T1 ;SEND TO TTY
JRST TYPID1 ;GET NEXT CHARACTER
POPJ P, ;RETURN
;+
;<TYPRSM TYPES THE RESUME MESSAGE.
;-
TYPRSM: OUTSTR [ASCIZ \Resuming at checkpoint \]
MOVE T1,S.RSUM## ;LOAD BLOCK NBR
PUSHJ P,DECOUT ;TYPE IT
OUTSTR CRLF ;<CR><LF>
POPJ P, ;THAT'S ALL
;+
;<TYPCKP TYPES THE CHECKPOINT IF IT HAS BEEN REACHED AND SETS THE NEXT
;CHECKPOINT. ^CALLED WITH ^T1 = CURRENT DISK BLOCK NUMBER.
;-
TYPCKP: CAME T1,CHKPNT ;HIT CHECKPOINT YET?
POPJ P, ;NO, RETURN
MOVEI T2,CP$INC ;LOAD CHECKPOINT INCREMENT
ADDM T2,CHKPNT ;SET NEXT CHECKPOINT
SKIPG S.OPER## ;IF /SAVE,
SUBI T1,CP$MRG ;SUBTRACT THE MARGIN
PUSHJ P,DECOUT ;DISPLAY CHECKPOINT
OUTSTR CRLF ;FOLLOWED BY <CR><LF>
POPJ P, ;RETURN
;+
;<TTYSER IS THE SERVICE ROUTINE FOR <PSI INTERUPT ON <TTY INPUT.
;^IT SAVES ALL TEMPOARY ^^AC\\S, AND CALLS THE RUN-TIME COMMAND
;HANDLER, <OPRCMD, TO PROCESS THE COMMAND. ^THEN THE ^^AC\\S ARE
;RESTORED AND THE INTERUPT DISMISSED.
;-
TTYSER: SAVE$ <T1,T2,T3,T4> ;SAVE ALL TEMP ACS
PUSHJ P,OPRCMD## ;SERVICE TTY INPUT
TXO F,FL$KIL ;RETURN HERE IF OPERATOR SAID KILL
RSTR$ <T4,T3,T2,T1> ;RESTORE ALL TEMP ACS
DEBRK. ;DISMISS INTERUPT
HALT TTYSER ;ERROR RETURN
HALT TTYSER ;UNIMPLEMENTED RETURN
;+
;<WRNMSG IS A SUBROUTINE CALLED BY THE <WARN$ AND <WARN$N MACROS.
;^IT HANDLES OUTPUTING THE LISTING BUFFER AND </MESSAGE:NOPREFIX.
;-
WRNMSG: SKIPE S.LIST ;SEE IF LISTING CHANNEL OPENED
OUTPUT F.LIST, ;YES, OUTPUT BUFFER BEFORE MESSAGE
OUTSTR [ASCIZ \
%\]
AOS (P) ;SKIP RETURN
PUSH P,T1 ;SAVE T1
MOVX T1,JWW.PR ;SEE IF /MESSAGE:NOPREFIX
TDNN T1,S.VRBO## ;PREFIX NEEDED?
AOS -1(P) ;NO--GIVE DOUBLE SKIP RETURN
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
SUBTTL ERROR MESSAGES
NOCORE: WARN$ (NEC,Not enough core)
POPJ P,0
FAIL0: SKIPA T1,T2
DVFAIL: MOVE T1,CSTR
WARN$N (COD,Cannot OPEN ")
PUSHJ P,SIXOUT
OUTSTR [ASCIZ \"
\]
POPJ P,0
IFN FT$IND,<
NOHOME: WARN$N (CRH,Cannot read HOME block for structure ")
MOVE T1,CSTR
PUSHJ P,SIXOUT
OUTSTR [ASCIZ \"
\]
POPJ P,0
>;END IFN FT$IND
RSMERR: WARN$ (RIC,Resume at invalid checkpoint attempted)
SETZM S.RSUM## ;ZILCH
;FALL INTO EAFIL
EAFIL: PUSHJ P,SAVE1
MOVEI P1,EXLFIL
WARN$N (ABT,Abort)
JRST GUUO
ELUFD: PUSHJ P,SAVE1
MOVEI P1,EXLUFD
JRST LMSG
ELFIL: PUSHJ P,SAVE1
MOVEI P1,EXLFIL
LMSG: HRRZ T1,.RBEXT(P1) ;LOAD ERROR CODE
LDB T2,[POINTR (.FXMOD(SP), FX.PRT)]
CAIN T1,2 ;PROTECTION FAILURE?
JUMPN T2,CPOPJ ;IF /OKPROTECTION DON'T MUMBLE
WARN$N (FLE,File LOOKUP error)
JRST EGUUO
EEUFD: PUSHJ P,SAVE1
MOVEI P1,EXLUFD
JRST EMSG
EEFIL: PUSHJ P,SAVE1
MOVEI P1,EXLFIL
EMSG: HRRZ T1,.RBEXT(P1) ;LOAD ERROR CODE
LDB T2,[POINTR (.FXMOD(SP), FX.PRT)]
CAIN T1,2 ;PROTECTION FAILURE?
JUMPN T2,CPOPJ ;IF /OKPROTECTION DON'T MUMBLE
WARN$N (FEE,File ENTER error)
EGUUO: HRRZ T1,.RBEXT(P1) ;GET ERROR CODE
PUSHJ P,OCTOUT ;TYPE IT
HRRZ T2,.RBEXT(P1) ;GET ERROR CODE AGAIN
CAIL T2,ERRLTH ;RANGE CHECK
JRST GUUO ;OUT OF RANGE, SKIP ABREV
OUTCHR LPAREN
ROT T2,-1 ;GET ABREVIATION FROM TABLE
MOVE T1,ERRTBL(T2) ; ..
TLNE T2,(1B0)
MOVSS T1
HLLZS T1
PUSHJ P,SIXOUT
OUTCHR RPAREN
GUUO: OUTCHR SPACE
MOVE T1,CSTR
SKIPL S.OPER##
MOVE T1,ACSTR
PUSHJ P,SIXOUT
OUTCHR COLON
HLRZ T1,.RBEXT(P1)
CAIE T1,'UFD'
JRST NOTUFD
HLRZ T1,.RBNAM(P1)
PUSHJ P,OCTOUT
OUTCHR COMMA
HRRZ T1,.RBNAM(P1)
PUSHJ P,OCTOUT
JRST JOIN1
NOTUFD: MOVE T1,.RBNAM(P1)
PUSHJ P,SIXOUT
JOIN1: HLLZ T1,.RBEXT(P1)
JUMPE T1,JOIN2
OUTCHR DOT
PUSHJ P,SIXOUT
JOIN2: SKIPE S.INTR##
JRST EDONE+1
HLRZ T1,.RBPPN(P1)
JUMPE T1,JOIN3
OUTCHR LBR
PUSHJ P,OCTOUT
OUTCHR COMMA
HRRZ T1,.RBPPN(P1)
PUSHJ P,OCTOUT
EDONE: OUTCHR RBR
OUTSTR CRLF
POPJ P,0
JOIN3: HRRZ P1,.RBPPN(P1)
HLRZ T1,2(P1)
PUSHJ P,OCTOUT
OUTCHR COMMA
HRRZ T1,2(P1)
PUSHJ P,OCTOUT
JOIN4: SKIPN T1,3(P1)
JRST EDONE
OUTCHR COMMA
PUSHJ P,SIXOUT
AOJA P1,JOIN4
SAVE1: EXCH P1,(P)
PUSH P,.+3
HRLI P1,-1(P)
JRA P1,(P1)
CAIA .
AOS -1(P)
JRST POP1
SAVE2: EXCH P1,(P)
PUSH P,P2
PUSH P,.+3
HRLI P1,-2(P)
JRA P1,(P1)
CAIA .
AOS -2(P)
JRST POP2
SAVE3: EXCH P1,(P)
PUSH P,P2
PUSH P,P3
PUSH P,.+3
HRLI P1,-3(P)
JRA P1,(P1)
CAIA .
AOS -3(P)
JRST POP3
SAVE4: EXCH P1,(P)
PUSH P,P2
PUSH P,P3
PUSH P,P4
PUSH P,.+3
HRLI P1,-4(P)
JRA P1,(P1)
CAIA .
AOS -4(P)
POP4: POP P,P4
POP3: POP P,P3
POP2: POP P,P2
POP1: POP P,P1
POPJ P,0
CPOPJ2: AOS (P)
CPOPJ1: AOS (P)
CPOPJ: POPJ P,0
ERRTBL: SIXBIT /FNFIPP/
SIXBIT /PRTFBM/
SIXBIT /AEFISU/
SIXBIT /TRNNSF/
SIXBIT /NECDNA/
SIXBIT /NSDILU/
SIXBIT /NRMWLK/
SIXBIT /NETPOA/
SIXBIT /BNFNSD/
SIXBIT /DNESNF/
SIXBIT /SLELVL/
SIXBIT /NCESNS/
SIXBIT /FCULOH/
ERRLTH==<.-ERRTBL>*2
MONTBL: ASCIZ /-Jan/
ASCIZ /-Feb/
ASCIZ /-Mar/
ASCIZ /-Apr/
ASCIZ /-May/
ASCIZ /-Jun/
ASCIZ /-Jul/
ASCIZ /-Aug/
ASCIZ /-Sep/
ASCIZ /-Oct/
ASCIZ /-Nov/
ASCIZ /-Dec/
DOT: "."
COLON: ":"
COMMA: ","
LPAREN: "("
RPAREN: ")"
LBR: "["
RBR: "]"
TAB: EXP .CHTAB
SPACE: EXP " "
CRLF: BYTE(7).CHCRT,.CHLFD,0
;&.DO INDEX
END ;&.SKIP2;[^END OF <BACKRS.PLM]