Trailing-Edge
-
PDP-10 Archives
-
bb-l014t-bm_tops20_v7_0_atpch20
-
autopatch/dumper.x20
There is 1 other file named dumper.x20 in the archive. Click here to see a list.
; Edit= 557 to DUMPER.MAC on 13-Oct-88 by EVANS
;**PERFORMANCE** - Change PBSIZ (buffer size) from 200 to 40.
; Edit= 556 to DUMPER.MAC on 27-Sep-88 by EVANS, for SPR #21314
;Zero-out the buffer after an ending record in INTERCHANGE mode, so we don't
;leave garbage for a short record following to pick up.
; Edit= 555 to DUMPER.MAC on 20-Sep-88 by GSCOTT, for SPR #21608
;Check MT%DVE before other MT%xxx bits in REAERR.
; Edit= 554 to DUMPER.MAC on 12-Aug-88 by EVANS, for SPR #21638
;Be sure to use correct FDB-length when looking for ARCHIVE info on a 4.1
;DUMPER tape being restored by 6.0 DUMPER.
; Edit= 553 to DUMPER.MAC on 1-Aug-88 by EVANS, for SPR #21897
;Be sure "Tape offline" message gets to OPR, and batch jobs can get a "%" if
;user desires error character.
; Edit= 550 to DUMPER.MAC on 5-Apr-88 by EVANS, for SPR #21569
;Add the FB%NDL (never delete) bit to the mask at NWMASK:.
; *** Edit 549 to DUMPER.MAC by EVANS on 1-Mar-88, for SPR #21906
; Prevent endless loop if GDSTS% fails after calling BAKOUT.
; *** Edit 548 to DUMPER.MAC by EVANS on 28-Jan-88, for SPR #21703
; Print the sequential tape number at the beginning of a new tape.
; *** Edit 547 to DUMPER.MAC by EVANS on 2-Apr-87
; Set AC1 to zero so OUTMSG doesn't get confused.
; *** Edit 546 to DUMPER.MAC by EVANS on 31-Mar-87
; Fix edit 544
; *** Edit 545 to DUMPER.MAC by EVANS on 31-Mar-87, for SPR #21413
; Set tape format explicitly for MTOPR% - don't get a tape format from the job
; *** Edit 544 to DUMPER.MAC by EVANS on 24-Feb-87, for SPR #21537
; Add a percent-sign to the "Tape went offline" error string.
; *** Edit 543 to DUMPER.MAC by EVANS on 20-Nov-86, for SPR #21408
; Don't ignore DUMPO% error - inform the user something is wrong.
; *** Edit 542 to DUMPER.MAC by WAGNER on 11-Jun-86, for SPR #21118
; Fix DUMPER such that it can find the maximum blocking factor for tapes with
; density of 6250.
; *** Edit 541 to DUMPER.MAC by WAGNER on 3-Jun-86, for SPR #21242
; Increase storage for up to 100 VOLIDS in a tape set, from old limit of 10.
; *** Edit 540 to DUMPER.MAC by WAGNER on 28-Apr-86, for SPR #21225
; Fix DUMPER to not get and write a VOLID if tape was set UNAVAILABLE, in
; routines NOEOTW and SVSETA.
; *** Edit 539 to DUMPER.MAC by MAYO on 10-Mar-86, for SPR #21064
; Non-existant devices in a SAVE command should not generate the ?Device must
; be DISK error. It is probably just an offline disk.
; *** Edit 538 to DUMPER.MAC by MAYO on 31-Jan-86, for SPR #21078
; Replace 534 with something more verbose; type tape number and proper VOLID at
; NXTTAP.
; *** Edit 537 to DUMPER.MAC by MAYO on 31-Jan-86
; Enable preloading when using PMAP.
; *** Edit 536 to DUMPER.MAC by MAYO on 22-Jan-86, for SPR #20905
; If cleaning up a failing command, and the command was a RETRIEVAL with a
; request still active, requeue a request for the Alternate tape.
; *** Edit 535 to DUMPER.MAC by MAYO on 2-Dec-85
; Prevent two EOFs from being read as EOT on labeled tapes. Also, allow mail to
; be sent to a file's author, not last writer, if compiled with a different
; FTLWR.
; *** Edit 534 to DUMPER.MAC by MAYO on 25-Nov-85
; Save the VOLID of the tape when doing Retrievals with tape allocation
; disabled. Otherwise, tapes get unloaded and remounted for every file
; retrieved.
; Edit 533 to DUMPER.MAC by MAYO on 18-Oct-85
; Set .FBBK1 to the tape volid if the monitor allows it during SAVE/INCR.
; Edit 532 to DUMPER.MAC by MAYO on 6-Aug-85
; Fix typo at NEWDCR+16 (T4 instead of P4)
; Edit 531 to DUMPER.MAC by MAYO on 6-Aug-85
; Rewrite code at ENDFIL:+11 to make SAVE/INCR:n not save extra files.
; Edit 530 to DUMPER.MAC by MAYO on 6-Aug-85
; GETTAD should skip on a bad parse
; Edit 529 to DUMPER.MAC by MAYO on 6-Aug-85
; Insure we get correct tape after refusing a tape mounted out of order.
TITLE DUMPER - The TOPS-20 backup/retrieval utility
SEARCH MONSYM,MACSYM,QSRMAC,GLXMAC
.DIRECT FLBLST ;DON'T EXPAND TEXT
SALL ;KEEP LISTING READABLE
CPYRIG: ASCIZ +
DUMPER - TOPS-20 Backup/Archival Utility
Copyright (C) 1985 by Digital Equipment Corporation, Maynard, Mass
THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
+
; See the end of the file for several essays that may prove useful
; to people interested in maintaining, altering, or customising
; DUMPER.
SUBTTL Version info and edit history
.MAJOR==FTVERS
.MINOR==0
.EDIT=^D557
.WHO=0
COMMENT +
# who date Edit description, decreasing order
--- --- --------- -----------------------------------------------------
SM 6-Aug-85 DUMPER released as part of 6.1; see top of file for
edit history after release.
528 SM 21-Jun-85 DUMPER doesn't always write LEOT when switching to the
next tape. Teach it to do so, so other programs can
read DUMPER tapes.
527 SM 18-Jun-85 Don't call REWCV/FNDEND at ARCHVA:. That causes an EOT
mark to be written when not wanted. Instead, set mode
to read and use REWCV1/FNDEND. Also, Interchange files
are never invisible, fix F.INTR at FIXFDE:...
526 SM 17-Jun-85 Failure at ARC1 shouldn't abort Archive run. Also,
teach DUMPER to scream and halt at CRDI26,27,28 errors,
going on after a long error message ONLY.
525 SM 30-May-85 Allow SET DENSITY midtape if it changes nothing.
524 SM 24-May-85 Replace edit 523 with something faster and better.
523 SM 21-May-85 Don't try to set ARCF bits from an Interchange tape.
522 SM 3-Apr-85 Ignore Permament quota on a RETRIEVE, check Working
quota only.
521 SM 2-Apr-85 Files weren't set invisible on RESTORE. Fix the
typo in FIXFDE (should use T1 not P1).
520 SM 28-Feb-85 Have EXACT mode apply to RESTORE as well, and have it
preserve Generation numbers.
519 SM 20-Feb-85 Invent NXTINC to force file to be picked up on the
next SAVE/INC. Call it in ARC1.
518 SM 19-Feb-85 When GNJFN fails in SAVE, make sure error was "No more
files" - if it wasn't, issue error and stop save.
517 SM 1-Feb-85 Make SAVE tapeswitch code simpler. Neaten LIST and
PRINT. REWIND cleanup.
516 SM 28-Jan-85 Add code to notice if DUMPER was built for TOPS-20 v6
and is being run under v5. Code is under FTMONI.
Make sure to get JFNs after RESTORE.
515 SM 22-Jan-85 The return of FILEST after CONTST, by popular demand.
More info typed when processing savesets. JFNs now
properly dropped on RESTORE to overquota directories.
Cosmetic changes. Have GETREC set up LSTSEN. Notice
volid changes more often. Clean up old readahead
chains. Use CZ%ABT when dropping tape. Stop reading
tape when JFNLST is exhausted. Add PRINT/FAST.
514 SM 21-Jan-85 If doing FILES, make sure against margin before typing
output. Have YESNO avoid ?errors under BATCH.
513 SM 31-Dec-84 Obey FB%NOD on normal saves and any kind of incremental.
Ignore it on any kind of archival. Also, have ^A's
"typeout of last file seen on tape" not type file
attribute information or repetitive information.
512 SM 27-Dec-84 Have RESTORE command store the last filename read
from tape in a buffer (LSTSEN). Teach ^A to type
this buffer.
511 SM 18-Dec-84 EXACT mode goes in under FTEXAC. Make /TAPE-INFO the
default. Make ANNSEQ return filename like ^A would.
Have PRINT type out saveset headers to user.
510 SM 14-Dec-84 Interrupts for ^A and data error should not be on the
same level. Move data error up one.
509 SM 6-Dec-84 Fix Sequential Checksum.
508 SM 29-Nov-84 When dumping files, notice FB%DIR and skip the file.
507 SM 12-Nov-84 If error is GJFX3 (no more JFNS), give special error,
since ERSTR would only say "can't find error message
file"
506 SM 5-Nov-84 Allow saves of offline files; do not save nonexistant
files.
505 SM 10-Oct-84 Provide code to properly support /TAPE-INFO on RESTORE.
504 SM 8-Oct-84 Only obey FB%NOD during incremental saves. Fix
meaningless PASS2 error.
503 SM 28-Sep-84 Always allow retry on MT Offline. ^E to get out.
502 SM 26-Sep-84 Teach QUASAR timer to go off only when needed.
Invent FTASKR.
501 SM 21-Sep-84 ^A during INITIAL scan shouldn't report a page number.
Neaten up /FULL handling.
500 SM 22-Aug-84 DUMPER writing finished.
+
SUBTTL Definitions
; AC def's
F==0 ;FLAGS (F.????)
T1==1 ;THE USUAL SCRAP
T2==2
T3==3
T4==4
Q1==5
Q2==6
Q3==7
P1==10
P2==11
P3==12
P4==13
P5==14
BS=16 ;BACKOUT STACK
P=17 ;STACK POINTER
;Constants
CURFMT==6 ;CURRENT FORMAT NUMBER, DO NOT CHANGE
;6 GAINED "TONEXT" RECORD TYPE
;5 GAINED PASSWORD ENCRYPTION AND OTHER CRDIR%oids
;4 IS THE LOWEST LEGAL TAPE TYPE
FTVERS==6 ;VERSION OF THE MONITOR INTENDED FOR
;Conditional assembly flags. Use only 0 or -1 unless otherwise noted.
;-1 usually means "ON"
FTDEB==0 ;DEBUGGER CODE IF -1 (LITTLE IMPACT)
FTINVI==-1 ;USER REQUESTED ARCHIVED FILES GO INVISIBLE
;AFTER ARCHIVAL, IF -1 (SLOWS ARCHIVING)
FTUSAG==-1 ;DO USAGE RECORDS IF -1 (SLOWS ARCHIVING)
FTCHKS==-1 ;DO INTERNAL CHECKSUMMING (SLOWS EVERYTHING)
FTMONI==-1 ;CHECK MONITOR VERSION AT STARTUP, IF -1
FTCKPN==-1 ;CHECKPOINT LIST FILE EACH PAGE, IF -1
FTASKR==1 ;WHEN RETRIEVING A FILE WITH A NAME DIFFERENT
; THAN THE NAME ON TAPE, 0 ask the Operator
; if it should be restored; 1 retrieve it;
; -1 do not retrieve it
FTMAIL==-1 ;ALLOW MAIL COMMAND AND SUPPORT, IF -1 (NEW)
FTLWR==-1 ;SEND ARCHIVE MAIL TO FILE'S LAST WRITER IF -1
;If 0, send to author
FTEXAC==-1 ;ALLOW EXACT MODE COMMAND (NEW)
FTIND==0 ;(DO NOT) ALLOW INDUSTRY COMMAND (HISTORICAL)
MAXJFN==777 ;Max jfns allowed
MXJFPG=<MAXJFN+777>/1000
REEVAL==0 ;REEVAL .gt. 0 to try and do output opts.
;(Increases CPU time, may decrease elasped)
WAITTM==^D15 ;Minutes to wait for QUASAR to get back to us.
BDTMAX==^D35 ;Number of bad tapes to remember
TAKLEN==^D10 ;Number of nested take files allowed
BFRSIZ==^D3300 ;PARSE BUFFER SIZE (LARGE FOR LONG SAVE CMDS)
ATMSIZ==^D50 ;ATOM BUFFER SIZE
BFRLEN=BFRSIZ*5-1 ;CHARS ALLOWED IN CMD BUFFER
ATMLEN=ATMSIZ*5-1 ;CHARS ALLOWED IN ATOM BUFFER
IFL REEVAL,<PRINTX ?Illegal value of REEVAL
PASS2 ;;This would be fatal
END>
IFN FTUSAG,< SEARCH ACTSYM >
IFN FTMAIL,< .REQUIRE SYS:ARMAIL
EXTERN MLINIT,MLTOWN,MLTLST,MLDONE,.MLNFL >
; flags in AC F
F.PRIV==1B0 ;WHEEL OR OPR
F.SUBJ==1B1 ;IF ON A PTY
F.INTR==1B2 ;INTERCHANGE MODE IS ON
F.NSEQ==1B3 ;IGNORE SEQUENCE NUMBERS/CHECKSUMS WHEN READING
F.BACK==1B4 ;READING BACKWARDS, ERRORS ARE SPECIAL
F.FAKE==1B5 ;MADE A FAKE RECORD - SKIP CERTAIN OPERATIONS
F.EOF==1B6 ;SAW EOF RECENTLY
F.EOT==1B7 ;SAW EOT (DOING POST-EOT PROCESSING)
F.OEOF==1B8 ;PASSED AN EOF RECENTLY
F.NORD==1B9 ;NO READING NOW (EOT OR WRITING)
F.NVOL==1B10 ;DON'T VOLSWITCH WHILE READING (GETREC)
F.CIRC==1B11 ;RECORD IS INTERCHANGE-CONVERTED
F.ILAB==1B12 ;READING A LABELED TAPE THE HARD WAY
F.BLKF==1B13 ;WROTE AND NO REWIND (MAYN'T CHANGE WRIBKF)
F.NBOT==1B14 ;NOT AT BOT ANYMORE
F.DERR==1B15 ;SAW A DATA ERROR, REPORT SOON
F.36MD==1B16 ;INDUSTRY MODE (NOT IN USE)
F.WILD==1B17 ;USE WILD SPECS
F.NO==1B18 ;A "NO" COMMAND
F.FILT==1B19 ;FILES COMMAND
F.DIRT==1B20 ;DIRECTORY COMMAND
F.CSEQ==1B21 ;CHECKSUMMING SEQUENTIALLY
F.CHKS==1B22 ;CHECKSUMMING, ANY FLAVOR
F.CREA==1B23 ;CREATE DIRECTORES ON RESTORE
F.DDIR==1B24 ;PLEASE SAVE DIRECTORY INFO THIS TIME
F.NDIR==1B25 ;DO NOT SAVE DIRECTORY INFO THIS TIME
F.GOT1==1B26 ;GOT A FILE WHILE READING OR WRITING
F.RACC==1B27 ;ACCOUNTING: USER OR SYSTEM DEFAULT
F.RPRO==1B28 ;PROTECTION: USER OR SYSTEM DEFAULT
F.SSA==1B29 ;SUPERSEDE ALWAYS
F.SSN==1B30 ;SUPERSEDE NEVER
F.RETR==1B31 ;RETRIEVAL IN PROGRESS
F.CHCK==1B32 ;CHECK IN PROGRESS
F.SARC=1B33 ;RESTORE SUPRESSING ARCHIVE INFO
F.WAIT==1B34 ;WAITING ON QUASAR
F.ABT==1B35 ;ABORT COMMAND GIVEN
; flags for the terminal and list file I/O handler (in LSTFLG)
LS.TTY==1B0 ;output to TTY
LS.LST==1B1 ;output to list file
; flags for the SAVE command (in DMPFLG)
D.COL==1B0 ;COLLECTION/MIGRATION
D.ARC==1B1 ;ARCHIVAL
D.MIG==1B2 ;MIGRATION
D.AOEF==1B17 ;ARCHIVE ONLINE EXPIRED FILES (COLLECTION)
D.FINC==1B18 ;FULL INCREMENTAL
D.INC==377777 ;INCREMENTAL NUMBER
; flags for the PRINT command
P.FAST==1B0 ;FAST mode
; offsets in the first page of a buffer in freespace. Do not change the
; order here.
NXTBUF==0 ;next buffer
;offset 1 not used currently
SIZBUF==2 ;number of pages in this buffer
PNTBUF==3 ;pointer into MAPFRE used by DELPGS
TRPBUF==4 ;text to type at RELPGT time or 0
TREBUF==5 ;where to add text to
ERRCNT==6 ;times tried to write this buffer
DATAST==20 ;first word available for data
;Command bytes used by RELPGT (in text pointed to by buffer's TRPBUF)
TR.END==0 ;end of texts
TR.FIL==1 ;filename follows
TR.DIR==2 ;Directory name follows
TR.TXT==3 ;Random text follows
TR.FDT==4 ;Directory or file text follows
; offsets in the header of a DUMPER logical record (6 words)
.CHKSM==0 ;LOGICAL RECORD CHECKSUM
.FLAG==1 ;FLAG WORD
.TAPNO==2 ;TAPE NUMBER
.PAGNO==3 ;PAGE NUMBER
.TYP==4 ;TYPE OF RECORD
.SEQ==5 ;SEQUENCE NUMBER
; .PAGNO flags
PG.CON==1B0 ;Means TONEXT
PG.NFN==1B1 ;Always set (historical)
; .FLAG flags
FL.HIS==(170000);Always set in .FLAG (historical)
FL.NCK==1B0 ;No real checksum in .CHKSM
; types of records (these are negated on tape)
DATA==0 ;FILE CONTENTS PAGE
SAVEST==1 ;SAVESET HEADER (NOT CONTINUED)
FILEST==2 ;FILE HEADER
FILEEN==3 ;FILE END
TAPEEN==4 ;END OF SAVESETS (TAPE TRAILER)
DIRECT==5 ;DIRECTORY INFOMATION
CONTST==6 ;CONTINUED SAVESET HEADER
FILL==7 ;FILLER RECORD, IGNORED, NOT RETURNED AS SUCH BY GETREC
SAVEEN==FILL ;GETREC PASSES THIS BACK WHEN EOF IS READ (SAVESET END)
TONEXT==10 ;TO NEXT TAPE RECORD (CONTINUED FILE)
MAXTYP==10 ;LARGEST VALUE
;SAVESET HEADER INFO (SAVEST, CONTST)
SV.FMT==0 ;FORMAT OF TAPE
SV.PNT==1 ;POINTER TO SAVESET NAME (SV.MSG)
SV.TAD==2 ;GTAD OF SAVE
SV.VOL==3 ;VOLID OF TAPE (NOT USED)
SV.EDT==4 ;EDIT NUMBER OF DUMPER
SV.MSG==20 ;SAVESET NAME
;Page boundaries
%PGEAT==100 ;Start of page assignments
;Allocate page macro
DEFINE ALP(name,num<1>),<
name==%PGEAT
%PGEAT==%PGEAT+num>
ALP DIRPAG
DIRBUF=DIRPAG*1000 ;MUST BEGIN ON PAGE BOUNDARY
;DIRECTORY INFORMATION BLOCK
UHNAM==40 ;NAME STRING
UHPSW==60 ;PASSWORD STRING
UHACT==100 ;ACCOUNT STRING
UGLEN==200 ;USER/DIRECTORY GROUP LENGTH
CDUG==200 ;USER GROUPS
CDDG==400 ;DIRECTORY GROUPS
CDSG==600 ;SUBDIRECTORY GROUPS
ALP FDBPAG
FDBBUF=FDBPAG*1000
FDBFFF==0 ;OFFSET TO FDB IN FILEEN
FDBOFF==200 ;OFFSET TO FDB IN FILEST
FDB=FDBBUF+FDBOFF
ALP JF1PAG,MXJFPG
JFNLST=JF1PAG*1000 ;WHERE JFNS GO
ALP JF2PAG,MXJFPG
JF2LST=JF2PAG*1000
ALP SSNPAG ;SAVESET HEADERS BUILT HERE
SSNBUF=SSNPAG*1000 ;ADDRESS OF SAME
SCRPAG==SSNPAG ;page whose contents don't matter
SCRBUF==SCRPAG*1000
ALP MBFPAG
MBUF=MBFPAG*1000
ALP QS1PAG
QSRMSS=QS1PAG*1000
ALP QS2PAG
QSRMSR=QS2PAG*1000
;**;[557] Change PBSIZ DEE 13-OCT-88
PBSIZ==40 ;[557] Change from 200 to 40
ALP PAGPAG,PBSIZ
PAGBUF=PAGPAG*1000
; the bounds of pages available to the free space manager
ALP FRESPC,0 ;start at wherever we are
PAGMAX==675 ;mayn't use this or beyond
NUMPAG=PAGMAX-FRESPC+1 ;number of pages in freespace
IFL NUMPAG-60,<PRINTX ?Not enough DUMPER freespace
PASS2
END>
;Useful symbols
JFNSAL=1B2+1B5+1B8+1B11+1B14+JS%PAF ;JFNS%, do all fields
PAGSIZ=1000 ;For DDT, mostly
IFG FTVERS-5,<
CD.LEN=.CDPPN+1
>
IFLE FTVERS-5,<
CD.LEN=.CDDFE+1
VI%DEC==0
>
FILNM=.ARPSZ+1
NHEAD==6 ;HEADER LENGTH FOR DUMPER
NIHEAD==40 ;HEADER LENGTH FOR INTERCHANGE
MAXBKF==^D15 ;MAX. BLOCKING FACTOR
; for list file formatting
PAGLIN==^D56 ;LINES/PAGE
FLCOL==^D5 ;COLUMN FOR FILE NAME
DDCOL==^D50 ;COLUMN FOR PASSWORD ENCRYPTION VERSION
WTCOL==^D60 ;COLUMN FOR WRITE DATE
SZCOL==^D80 ;COLUMN FOR SIZE
CSCOL==^D100 ;COLUMN FOR CHECKSUM
FFLCOL==^D2 ;SAME, FOR PRINT/FAST
FWTCOL==^D52
FSZCOL==^D68
FCSCOL==^D73 ;SHOULD END AT COLUMN 79
SUBTTL Defines
;Useful Defines
;Defines needed to make DUMPER work under monitor v5.any or less
IFLE <FTVERS-5>,< ;;;If for monitor v5
DEFINE ERJMPR(addr),< ;;;V5 doesn't have ERJMPR
ERCAL [MOVEI T1,addr ;;;We do the equivalent
HRRM T1,(P) ;;;Which is to return the err code in T1
JRST FNDERR]>;;;and dispatch to addr through FNDERR
DEFINE DOJSS(jsi,addr),<;;Doesn't have ERJMPS either
DMOVEM T1,JSITMP ;;;So for any jsys we save T1 and T2
jsi ;;;then do the jsys
ERCAL [MOVEI T1,addr ;;;and when it fails
HRRM T1,(P) ;;;set up to dispatch to the right place
DMOVE T1,JSITMP;;with the AC's unchanged
RET]> ;;;This does the dispatch
OPDEF ERJMPS [ERJMP] ;;;For cases that don't matter
>
IFG <FTVERS-5>,< ;;;DOJSS is needed for v5
DEFINE DOJSS(jsi,addr),<
jsi ;;;Do the jsys
ERJMPS addr> ;;;on error dispatch with AC's preserved
>
;TYPE addr types the string at that address. Literals are acceptable.
DEFINE TYPE(locstr),<
CALL [PUSH P,T1
HRROI T1,locstr
JRST OUTMSA] >
;TYPCHR "chr" types the character out.
DEFINE TYPCHR(chr),<
CALL [PUSH P,T1
MOVEI T1,<chr>
JRST OUTMSC] >
;TYPEAT addr is just like TYPE, but the addr contains a byte pointer to
; the text
DEFINE TYPEAT(locptr),<
CALL [PUSH P,T1
MOVE T1,locptr
JRST OUTMSG] >
;SELECT sets the output flags as listed, return flagword in the AC
DEFINE SELECT(flags,ac<T1>),<
MOVX ac,flags
MOVEM ac,LSTFLG >
;JSERRD for jsys errors that just shouldn't happen
DEFINE JSERRD(text, where<BAKOUT>, entri<ERJMPS>),<
entri [CALL ANNERR ;;ANNOUNCE COMMAND IF TAKING
HRROI T1,[ASCIZ\?text\]
CALL LSTERR ;;REPORT WHAT ERROR WAS
JRST where] > ;;GO WHEREVER REQUESTED
;ERROR for general errors that just shouldn't happen. However be very careful
; where you let it jump to. BAKOUT is not always a good choice!
DEFINE ERROR(text, where<BAKOUT>),<
JRST [CALL ANNERR
TYPE [ASCIZ\?text\]
JRST where] >
;WARN types a message with the approprate leadin character.
DEFINE WARN(locstr),<
CALL [CALL IFCRLF
TYPE [ASCIZ ~%'locstr~]
RET] >
;DISPAT jumps off to one of three points depending on label type.
DEFINE DISPAT(mtaloc<.+1>,mtuloc<.+1>,mtlloc<.+1>),<
MOVE T1,MTTYP
JRST @[EXP mtaloc, mtuloc, mtlloc]+1(T1) >
;IFMTA jumps to the given address if the tape is MTA, not MT
DEFINE IFMTA(mtaloc<.+2>),<
SKIPGE MTTYP
JRST mtaloc >
;SKPMTA skips if the device is MTA
OPDEF SKPMTA [SKIPL MTTYP]
;SKPNLB skips if tape is not labeled
OPDEF SKPNLB [SKIPLE MTTYP]
;IFMT jumps if the tape is MT, not MTA
DEFINE IFMT(mtloc<.+2>),<
SKIPL MTTYP
JRST mtloc >
;IFLAB jumps to the given address if the tape is labeled
DEFINE IFLAB(labloc<.+2>),<
SKIPLE MTTYP
JRST labloc >
;Command table macro
DEFINE CTB (addr,txt,fla<0>),<
IF1, < %%C==0>
IF2, < IFDEF addr, < %%C=addr>
IFNDEF addr, < %%C=NOCMD
PRINTX ?txt not in
>
>
XWD [ IFN fla,<EXP CM%FW!fla>
ASCIZ \txt\],%%C
>
;TB does up a keyword table without the fanciness of the CTB macro
DEFINE TB(val,text),<
[ASCIZ\text\],,val >
;GUIDES does the GUIDE call and dispatches to NOCMD if it fails. Don't
; call this in a literal.
DEFINE GUIDES(text,whr<NOCMD>),<
JRST [HRROI T1,[ASCIZ ~text~]
CALL GUIDE
JRST whr
JRST .+1] >
;CONFIRM does a confirm. Dispatches to NOCMD on error, hurts no AC's.
DEFINE CONFIRM(whr<NOCMD>),<
CALL CONFRM
JRST whr >
DEFINE PRINTY(arg),<IF2, PRINTX arg>
SUBTTL Interchange definitions
BKFMT==1 ;FORMAT VERSION NUMBER (CONSTANT)
;RECORD TYPES
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
;STANDARD RECORD
G$TYPE==0 ;RECORD TYPE
G$SEQ==1 ;SEQUENCE NUMBER
G$RTNM==2 ;RELATIVE TAPE NUMBER
G$FLAG==3 ;RECORD DEPENDENT BITS
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
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
;O$FILE/A$FLGS
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
;O$FILE BLOCK
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 FIELDS
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
;O$DIRT/D$FLGS
DF$FOD==1B0 ;FILES ONLY DIRECTORY
DF$AAL==1B1 ;ALPHA ACCOUNTS ARE LEGAL
DF$RLM==1B2 ;REPEAT LOGIN MESSAGES
;O$DIRT BLOCK
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
;NON-DATA BLOCK TYPES
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
;T$LBL RECORD
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
;T$BEG, T$END, T$CON RECORDS
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
;T$UFD RECORD
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
;T$FIL RECORD
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
F$NND==400 ;LENGTH OF NON-DATA PORTION OF FIRST RECORD
;T$FIL/O$NAME SUB-BLOCK 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 Variables
;Variables cleared at START time
CLRDAT:!
OKIAE: BLOCK 1 ;-1 IF ^A, ^E SHOULD WORK
INTRQ: BLOCK 1 ;-1 IF USER REQUESTS INTERRUPT VIA ^E
;0 IF NO INTERRUPT IN PROGRESS
;1 IF NEW COMMAND DUE TO INTERRUPT
CMDWAS: BLOCK 1 ;POINTER TO WHAT CMD WAS INTERRUPTED
CURCMD: BLOCK 1 ;POINTER TO CURRENT COMMAND INFO
MTJFN: BLOCK 1 ;MAGTAPE JFN
OPNFOR: BLOCK 1 ;0 OR OPENF% BITS FOR MTA OPEN
OPNREQ: BLOCK 1 ;REQUESTED VALUE FOR OPNFOR
OLDBKF: BLOCK 1 ;SAVED BLOCKING FACTOR FOR WRITING
LSTJFN: BLOCK 1 ;LIST JFN
SUPMRK: BLOCK 1 ;NONZERO IF NO RECORDING OF TAPE IN FILE
INIJFN: BLOCK 1 ;INITIAL FILESPEC JFN
JFN: BLOCK 1 ;FILE JFN IN PROGRESS
MSTAD: BLOCK 1 ;MODIFIED AFTER TEST
WSTAD: BLOCK 1 ;WRITTEN AFTER TEST
ASTAD: BLOCK 1 ;REF'D AFTER TEST
EXACT: BLOCK 1 ;IN EXACT MODE (DUMP)
NFJFN: BLOCK 1 ;NUMBER OF FILE INPUT JFNS
SAVENO: BLOCK 1 ;SAVESET # (IF ARCHIVE) OR 0
ARCTSN: BLOCK 1 ;LAST ARCHIVE SAVESET NUMBER READ
TRAPTO: BLOCK 1 ;WHERE TO GO WHEN INPUT GETS INTERRUPTED
NXTRTP: BLOCK 1 ;NEXT RETRIEVAL REQUEST IN QUEUE
RETFIN: BLOCK 1 ;NONZERO IF DONE WITH RETRIEVAL
BDTCNT: BLOCK 1 ;NUMBER OF KNOWN MISSING RETRIEVAL TAPES
INFILE: BLOCK 1 ;-1 IF BETWEEN FILEST & FILEEN (DUMP)
PASWDC: BLOCK 1 ;NONZERO IF PASSWORD PROBLEMS OK
LSTSEN: BLOCK FDBOFF+1 ;HOLDS FILENAME DURING RESTORES
CLREND==.-1
;Variables that can be trash at start time (ie, always inited specially before
; use.)
CFNBFR: BLOCK 40 ;USED BY ^A
BDTLST: BLOCK BDTMAX+1
MBTAD: BLOCK 1 ;MODIFIED BEFORE TEST
WBTAD: BLOCK 1 ;WRITTEN BEFORE TEST
ABTAD: BLOCK 1 ;ANY FILE REF BEFORE TEST
PRITTY: BLOCK 1 ;PRINTING TO A TTY IF NONZERO
;MTDSG to MTDEV are generally meaningless unless MTJFN is nonzero
MTDSG: BLOCK 1 ;DEVICE DESIGNATOR
NVOLID: BLOCK 1 ;# OF EXTRA VOLIDS (FOR ARCHIVAL)
;**;[541] CHANGE 1 LINE AT VOLID6:+0.L DSW 6/3/86
VOLID6: BLOCK ^D101 ;[541]SIXBIT TAPE VOLID OR 0, UP TO 100
;TAPES, CURRENT AT OFFSET 0
VOLID: BLOCK 2 ;ASCIZ VOLID OF TAPE
MTTYP: BLOCK 1 ;LABEL TYPE
;(-1 MTA, 0 UNLABELED MT, 1 LABELED MT)
MTAUNT: BLOCK 1 ;UNIT NUMBER OF DRIVE (CHKJFN)
MTDEV: BLOCK 6 ;DEVICE NAME
MNTDSG: BLOCK 1 ;MOUNT REQUEST DESIGNATOR
ORGTAP: BLOCK 1 ;TAPE WE STARTED SAVING THIS FILE ON
TAPENO: BLOCK 1 ;CURRENT TAPE NUMBER
P2JFN: BLOCK 1 ;PASS 2 JFN
ARCCNT: BLOCK 1 ;# OF ARCHIVED FILES ON TAPE THIS SAVE
ARCINF: BLOCK .ARPSZ+1 ;FOR ARCF% INFO
FSTARC: BLOCK 25 ;1ST FILE THIS TAPE ARCHIVED
SAVETP: BLOCK 1 ;SAVESET TYPE
TAKSTK: BLOCK 1 ;TAKE STACK POINTER
TAKSTR: BLOCK TAKLEN+1 ;TAKE JFN STACK
RPSSTK: BLOCK 1 ;REPARSE OP STACK POINTER
RPSSTR: BLOCK 420 ;REPARSE STACK (LOC 0 HAS RPSSTK FOR ^E)
RPSISR: BLOCK 20 ;REPARSE UNDER ^E COMMANDS
STRING: BLOCK <TMPLEN==100> ;FOR STRING HACKS, ETC
TABTMP: BLOCK 6 ;FOR TABOUT
IFN FTMAIL,<
FILNMM: BLOCK 1 ;PNTR TO FILES TO SEND MAIL ABOUT
FILNMS: BLOCK 205 ;LIST OF FILES FOR MAIL (TEXT FIELD)
MALBLK: BLOCK 3 ;FOR MLTOWN (MAIL)
MALTO: BLOCK 30 ;MAIL TO FIELD (MAIL)
DOTLOC: BLOCK 101 ;PLACES DOTS EXIST IN DIRECTORY (MAIL)
>
JSITMP: BLOCK 2 ;AC SAVE FOR V5 DOJSS MACRO
IFCTMP: BLOCK 2 ;AC SAVES FOR IFCRLF
ICOTMP: BLOCK 2 ;AC SAVES FOR DMPICO
GEITMP: BLOCK 2 ;AC SAVES DURING GETREC
LSTFLG: BLOCK 1 ;FLAGS FOR THE TTY/LIST FILE SYSTEM
PRIFLG: BLOCK 1 ;PRINT COMMAND FLAGS
LSTPOS: BLOCK 1 ;POSITION IN LIST FILE
LSTLIN: BLOCK 1 ;LINE NUMBER ON PAGE IN LIST FILE
LSTPGN: BLOCK 1 ;PAGE NUMBER IN LIST FILE
LSTFIL: BLOCK 25 ;FILENAME TO LIST TO
FORMAT: BLOCK 1 ;TAPE FORMAT NUMBER
DMPFLG: BLOCK 1 ;SAVE COMMAND FLAGS
UNLFLG: BLOCK 1 ;"SAVE" SHOULD UNLOAD TAPES WHEN DONE
NODFLG: BLOCK 1 ;IGNORE FB%NOD WHEN SET
I3ACS: BLOCK 20 ;INTERRUPT AC STORAGE (LEVEL 3)
I2ACS: BLOCK 20 ;.. (LEVEL 2)
ICMACS: BLOCK 20 ;NEW COMMAND AC STORAGE (FOR ^E)
OUTMST: BLOCK 1 ;POINTER TO LAST TEXT OUTPUT
OUTMSX: BLOCK 1 ;USED BY TYPE AND TYPCHR
CHKTMP: BLOCK 2 ;STORE FOR CHKSUM
ADDTMP: BLOCK 2 ;STORE FOR ADDREC
CURBLK: BLOCK 1 ;POINTER TO CURRENT PHYS. RECORD
LASTYP: BLOCK 1 ;LAST RECORD TYPE READ (GETREC)
REASEQ: BLOCK 1 ;LAST READ SEQUENCE NUMBER (GETREC)
LSTSEQ: BLOCK 1 ;REASEQ VALUE AFTER KILCHN
ARSETS: BLOCK 1 ;#OF TIMES A FILE WAS ARCHIVED (0,1,2)
ARSSTB: BLOCK 7 ;FOR SETTING ARCF% INFO (DUMP/ARC1)
DIRDMD: BLOCK 1 ;# OF DIRECTORIES DUMPED (DUMP, LOAD)
NOFILS: BLOCK 1 ;FILES IN THIS DIRECTORY (DUMP)
USRCNT: BLOCK 1 ;PAGES IN THIS DIRECTORY (DUMP)
TOTFIL: BLOCK 1 ;TOTAL FILES SAVED (DUMP, LOAD)
TOTCNT: BLOCK 1 ;TOTAL PAGES SAVED (DUMP, LOAD)
TOTSKP: BLOCK 1 ;TOTAL FILES SKIPPED (NOT LOADED)
TOTDEL: BLOCK 1 ;TOTAL FILES DELETED WHILE LOADING
WRISEQ: BLOCK 1 ;CURRENT SEQUENCE NUMBER
ENDPNT: BLOCK 1 ;LAST BLOCK IN DMPCHA LIST
BLKCNT: BLOCK 1 ;DEC'D AS LOGICAL RECORDS ARE TOUCHED
BLKPNT: BLOCK 1 ;POINTER INTO BUFFER FOR RECORDS
DMPCHA: BLOCK 1 ;HEAD OF DUMP CHAIN
LSTDMP: BLOCK 1 ;LAST DUMPED RECORD
;KEEP THE NEXT TWO TOGETHER AND IN ORDER
CURHEA: BLOCK 1 ;ADDR OF CURRENTLY READ HEADER
CURDAT: BLOCK 1 ;ADDR OF CURRENTLY READ 1000WORD DATA
WRIBKF: BLOCK 1 ;TAPE BLOCKING FACTOR - WRITE
REABKF: BLOCK 1 ;TAPE BLOCKING FACTOR - READ
CURREN: BLOCK 1 ;PAGE OF FILE IN PROGRESS
FFREE: BLOCK 1 ;NEXT KNOWN HOLE
PBHOLD: BLOCK 1 ;# UNPROCESSED PAGES IN PAGPAG
WRDPNT: BLOCK 1 ;ADDR OF NEXT FILE PAGE TO DO
FILIOC: BLOCK 1 ;FILES EXAMINED SINCE LAST TAPE OUT
RECCMD: BLOCK 2 ;IOWD WORD FOR I/O AND A 0
BUFPAG: BLOCK 1 ;PAGES NEEDED PER PHYS. RECORD
BUFFRE: BLOCK 1 ;OFFSET TO UNUSED SPACE IN BUFFER
SAFECT: BLOCK 1 ;NUMBER OF BFRS SAFE TO GEN
BFRCNI: BLOCK 1 ;COUNT OF BUFFERS SINCE LAST IDLE
BFRCNT: BLOCK 1 ;TOTAL BUFFERS
LVPC3: BLOCK 1 ;PC FOR INTERRUPTS
LVPC2: BLOCK 1 ;..
LVPC1: BLOCK 1 ;..
MAPFRE: BLOCK NUMPAG/^D36+1 ;MEMORY MANAGEMENT BIT ARRAY
STACK: BLOCK 150 ;STACK
INTSTK: BLOCK 140 ;STACK FOR ^E COMMANDS
QSRSTK: BLOCK 100 ;STACK FOR QSRINT
LINBUF: BLOCK <NLINB==30> ;FOR RANDOM USER STRINGS
STKSAV: BLOCK 1 ;STACK AT COMMAND BEGINNING
TAPHEA: BLOCK 6 ;ANY KIND OF HEADER
SAVHEA: BLOCK 6 ;FOR SAVING HEADER DURING TAOE SWITCH
;KEEP THE NEXT TWO ADJACENT/IN ORDER
DENSIT: BLOCK 1 ;DENSITY
PARITY: BLOCK 1 ;PARITY
FRCSET: BLOCK 1 ;-1 IF DENSITY/PARITY SET VIA CMD
CONBUF: BLOCK 20 ;HOLDS STR:<DIR> CONNECTED TO
BGNTAD: BLOCK 1 ;WHEN WE STARTED THE SAVE
;KEEP THE NEXT TWO ADJACENT/IN ORDER
CONSTR: BLOCK 1 ;POINTS TO CONNECTED STR (CONBUF)
CONDIR: BLOCK 1 ;POINTS TO CONNECTED DIR (CONBUF)
LSTDIR: BLOCK 30 ;LAST DIR SENT TO TAPE (DUMP, RESTOR)
DDOFLG: BLOCK 1 ;-1 IF NEW <INPUT> (DUMP/DMPFIL)
OUTFLS: BLOCK 1 ;POINT TO FILENAME IN OUTSPC
OUTDRS: BLOCK 1 ;POINTER TO END OF STR:<DIRECTORY>
OUTGEN: BLOCK 1 ;POINTER TO GEN IN OUTSPC (LOAD)
OUTACS: BLOCK 1 ;POINT TO ACCOUNT IN OUTSPC
OUTSPC: BLOCK 50 ;FILESPEC FOR TAPE (DUMP)
OUTDIR: BLOCK 25 ;DIRECTORY FOR TAPE (DUMP,RESTOR)
ICFDB: BLOCK .FBLN0+1 ;INTERCHANGE COPY OF FDB
FILNAM: BLOCK 50 ;FILENAME (LOAD)
DMPNUM: BLOCK 1 ;<INPUT> DIRECTORY NUMBER
INDIR: BLOCK 25 ;INPUT DIR (DUMP)
DIRINF: BLOCK .CDMOD+1 ;INCOMING DIR INFO (DUMP/COLLECT)
CHKCN0: BLOCK 1 ;FOR CHECKSUMMING AT SAVE TIME
LSTPGE: BLOCK 1 ;..
DEFSTR: BLOCK 20
DEFDIR: BLOCK 20
DEFNAM: BLOCK 30
DEFEXT: BLOCK 30
DEFGEN: BLOCK 3
ATOM: BLOCK ATMSIZ
BFFR: BLOCK BFRSIZ
ATOM2: BLOCK ATMSIZ
BFFR2: BLOCK BFRSIZ
SSNTXT: BLOCK ATMSIZ+1 ;SAVESET NAME
TPTSK: BLOCK 1 ; Internal task name on ret blk
TPRQUS: BLOCK 1 ; User who requested the retrieve
ABTFLG: BLOCK 1 ; Abort received from QUASAR
; Do not separate the following block
TPBLK:!
TPOFL: BLOCK 1 ; Flags
TAP1ID: BLOCK 1 ; Tape 1 ID
SSF1ID: BLOCK 1 ; Tape 1 saveset & tape file #
TAP2ID: BLOCK 1 ; Tape 2 ID
SSF2ID: BLOCK 1 ; Tape 2 saveset & tape file #
TPODT: BLOCK 1 ; Tape write date
TPPSZ: BLOCK 1 ; # pages in file
TAPNAM: BLOCK ^D48 ; Space for file name (^V's incl)
TPACT: BLOCK <2*^D39>/5 ; Account of request
PDB: BLOCK .IPCAS+11
MPDB: BLOCK 10
IFN FTUSAG,<
USABLK: BLOCK <NUSABL==27>
USASTR: BLOCK 15
USADIR: BLOCK 20
USAACT: BLOCK 10
USASSI: BLOCK 2
>
TMPVAR: ;Quick storage for various variables (faster than storing on stack)
FLGTMP: BLOCK 1
NOITMP: BLOCK 1
MAILFL: BLOCK 1
DATSET: BLOCK 1
HLPJFN: BLOCK 1
TRAPSP: BLOCK 1
REQTMP: BLOCK 1
ATSAVE: BLOCK 1
ATFILE: BLOCK 1
DMPTMP: BLOCK 1
STOPLD: BLOCK 1
EOTLCK: BLOCK 1
REWTMP: BLOCK 1
DMPTIM: BLOCK 1
SCNJFN: BLOCK 1
DIR: BLOCK 1
ARCGST: BLOCK 1
ENDFDB: BLOCK 1
FPGCNT: BLOCK 1
RMRPGE: BLOCK 1
SUMTMP: BLOCK 1
FIXTMP: BLOCK 1
TRNCNT: BLOCK 1
RETSVN: BLOCK 1
RETFLN: BLOCK 1
INDEX: BLOCK 1
AUTTMP: BLOCK 1
MALJFN: BLOCK 1
NUMDOT: BLOCK 1
LSTTMP: BLOCK 1
MATCH: BLOCK 1
INTCHA: BLOCK 1
INTTMP: BLOCK 1
APRID: BLOCK 1
ICOLEN: BLOCK 1
GETTMP: BLOCK 1
GE2TMP: BLOCK 1
TMP: BLOCK 1
QYNPMT: BLOCK 1
QYNTMP: BLOCK 1
QYNVAL: BLOCK 1
INPTMP: BLOCK 1
INIFLG: BLOCK 1
LDLCOP: BLOCK 1 ;[556] last data word copied from interchange record
SUBTTL Writables
;Writables - things that are a mix of data and variables
WRITEA:
ACKBLK: MSHSIZ,,.QOHEL ; Size & hello
MF.NOM ; No message, just an ACK
0 ; ACK code to be filled in
PD0BLK: .MURSP
.SPQSR
QSRPID: 0
PD1BLK: .MUSPQ
0
^D15
PD2BLK: .MUCRE
.FHSLF
MYPID: 0
PD3BLK: .MUPIC
0
QSRCHN
PD4BLK: .MUSSQ
0
030030
MTIAB: 2 ;FOR MTOPRs
BLOCK 2
GUIINB: <.CMNOI>B8
BLOCK 1
KEYINB: <.CMKEY>B8
BLOCK 1
CMDBLK: 0,,TRAPRP
.PRIIN,,.PRIOU ;< FOR BALANCE
-1,,[ASCIZ/DUMPER>/]
-1,,BFFR
-1,,BFFR
BFRLEN
BFRLEN
-1,,ATOM
ATMLEN
GTJBLK
GTJBLK: BLOCK 16
EXABLK: GJ%OFG+GJ%XTN
.NULIO,,.NULIO
0
0
0
0
0
0
0
G1%SLN
RETBLK: 0 ;FLAGS, FILLED IN AT RUNTIME
.NULIO,,.NULIO ;NO EXTRA INPUT OR OUTPUT
0 ; No device default
0 ; No directory
0 ; No name
0 ; No type
0 ; No protection
0 ; No account
0 ; No special JFN
G1%IIN ; Find invisible files
TAPBLK: 0,,RPMTAN
.PRIIN,,.PRIOU
BLOCK 1
-1,,BFFR2
-1,,BFFR2
BFRLEN
BFRLEN
-1,,ATOM2
ATMLEN
0
VOLBLK: 0,,VOLPRS
.PRIIN,,.PRIOU
BLOCK 1
-1,,BFFR2
-1,,BFFR2
BFRLEN
BFRLEN
-1,,ATOM2
ATMLEN
0
QYNBLK: 0,,QYNRPS
.PRIIN,,.PRIOU
BLOCK 1
-1,,BFFR2
-1,,BFFR2
BFRLEN
BFRLEN
-1,,ATOM2
ATMLEN
0
SUBTTL Startup code
;Code, etc.
;Entry vector
VECT: JRST ST ;START
JRST REE ;REENTRY
BYTE (3).WHO (9).MAJOR (6).MINOR (18) <VI%DEC+.EDIT> ;VERSION
VECLEN=.-VECT
DEFINE CTA(name),<
name,,[SIXBIT/name/]
>
;Conditional flags, for debugging and output
CTFOOF: CTA FTVERS
CTA FTDEB
CTA FTINVI
CTA FTUSAG
CTA FTCHKS
CTA FTMONI
CTA FTCKPN
CTA FTASKR
CTA REEVAL
CTA WAITTM
CTFLEN=.-CTFOOF
PURGE CTA
DEFINE CT(tex1,tex2),<
[ASCIZ/tex1/],,[ASCIZ/tex2/]
>
CTFEXP:
CT <>,<Runs under this release of TOPS-20 (or later)>
CT <Debugging code off>,<debugging code on>
CT <Archived files left visible>,<Archived files set invisible>
CT <Archiving does not write usage records>,<Archiving writes usage records>
CT <Checksumming off (tapes unreadable to old DUMPERs)>,<Normal checksumming>
CT <Monitor version not checked>,<Monitor version checked at startup>
CT <List files not checkpointed>,<List files checkpointed each page>
CT <>,<Operator not consulted when Retrieval filename doesn't match>
CT <Output optimization not attempted>,<Output optimization attempted>
CT <RETRIEVE waits forever for a request>,<Minutes a RETRIEVE will wait>
PURGE CT
;Code
REE: MOVEI P,STACK-1
SELECT LS.TTY
TYPE CPYRIG
TYPE [ASCIZ/ Version /]
MOVEI T2,FTVERS
CALL DECOUT
TYPCHR "("
MOVEI T2,.EDIT
ANDI T2,377777
CALL DECOUT
TYPE [ASCIZ/) with the following compile time settings:
/]
MOVSI T4,-CTFLEN
OPTTYP: HRRZ T3,CTFOOF(T4)
MOVE T3,(T3)
CALL SIXOUT
TYPCHR .CHTAB
HLRE T2,CTFOOF(T4)
CALL DECOUT
HRRO T1,CTFEXP(T4)
CAIN T2,0
HLRO T1,CTFEXP(T4)
SKIPN (T1)
JRST NOEXPG
TYPCHR .CHTAB
TYPEAT T1
NOEXPG: TYPE CRLF
AOBJN T4,OPTTYP
TYPE CRLF
;JRST DUMPER
START:BEGIN:DUMPER:ST: ;COVER ALL GUESSES
IFL FTMONI*<FTVERS-5>,< ;;TEST FOR RIGHT MONITOR
;This code causes DUMPER to be unrunnable if you try to use version 6 DUMPER
; on under a version 5 Monitor. It is unrunnable anyway, but this provides
; a polite message saying so, instead of an illegal instruction trap.
IF1,<PRINTX This version of DUMPER will not run under a Release 5 Monitor>
HLLZ T1,JSYST
JUMPE T1,MONV5 ;IN CASE BUILD FAILED BUT SAVED ANYWAY
SETO T1,
JSYST: CNFIG% ;JSYS NEW TO 6
ERJMP .+1 ;THIS WILL FAIL UNDER BOTH 5 AND 6
MOVX T1,.FHSLF ;BUT THE ERROR CODE WILL BE DIFFERENT
GETER%
MOVEI T1,(T2) ;ISOLATE ERROR CODE
CAIE T1,ILINS2 ;CHECK FOR UNDEFINED JSYS ERROR
JRST MONV6 ;NO, JSYS EXISTS, VERSION IS 6 OR LATER
MONV5: HRROI T1,STOP5 ;NO. WRONG. STOP.
PSOUT% ;EXPLAIN THE PROBLEM
HALTF% ;STOP
JRST MONV5 ;CONTINUE CAN'T HELP
STOP5: ASCIZ/
?This version of DUMPER has been built for a version 6 Monitor.
The Monitor you are running is one previous to version 6.
Please edit DUMPER.MAC, change FTVERS to match the major release number
of your Monitor, compile it, and try again.
Or, run an older version of DUMPER.
/
MONV6:
>
MOVEI P,STACK-1 ;SET STACK UP
MOVX T1,LS.TTY
MOVEM T1,LSTFLG ;OUTPUT TO TTY: ONLY FOR NOW
MOVEI T1,1 ;FIRST TAPE NUMBER
MOVEM T1,TAPENO
MOVEM T1,WRIBKF ;DEFAULT BLOCKING FACTOR
HRLOI T1,377777 ;POSITIVE INFINITY
MOVEM T1,MBTAD ;THE THREE "AFTER" DATES
MOVEM T1,WBTAD ;THE "BEFORE" DATES ARE ZEROED BELOW
MOVEM T1,ABTAD
MOVEI T1,CURFMT
MOVEM T1,FORMAT ;ESTABLISH DEFAULT FORMAT
HRROI T1,[ASCIZ/DUMPER>/] ;SET STARTUP PROMPT
MOVEM T1,CMDBLK+.CMRTY ;..
RESET% ;CLEAR THE UNIVERSE
MOVX F,F.DIRT+F.RACC+F.RPRO ;ALL FLAGS TO DEFAULTS
CALL SETPGS ;SET UP MEMORY MANAGEMENT
SETZM CLRDAT ;CLEAR VARIABLE SPACE
MOVE T1,[CLRDAT,,CLRDAT+1]
BLT T1,CLREND
MOVEI T1,TAKSTR
MOVEM T1,TAKSTK ;SET UP TAKE STACK
SETO T1,
MOVE T2,[-2,,Q1]
MOVEI T3,.JIDEN
GETJI% ;GET JOB DEFAULT DENSITY AND PARITY
JSERRD <>,.+2
DMOVEM Q1,DENSIT ;SAVE THEM
SETZM FRCSET ;DENSITY/PARITY ARE DEFAULT, NOT SET
SETO T1, ;ON A PTY?
HRROI T2,T1
MOVEI T3,.JICPJ ;WE CARE BECAUSE SOME MESSAGES WILL
GETJI% ;THEN GET A "$" LEADER
ERJMPS .+2 ;DOESN'T HURT TO ASSUME "YES"
CAIL T1,0
TXO F,F.SUBJ ;ON A SUBJOB
MOVEI T1,.FHSLF ;Set up interrupts
MOVE T2,[LEVTAB,,CHNTAB]
SIR% ;DECLARE INTERRUPT TABLES
EIR%
MOVE T2,CHNMSK ;TURN ON THE CHANNELS
AIC% ;ACTIVATE CHANNELS
MOVE T1,[.TICCE,,CECHN]
ATI% ;ACTIVATE ^E INTERRUPT
MOVE T1,[.TICCA,,CFCHN]
ATI% ;AND ^A
MOVX T1,.FHSLF
RPCAP%
TXNE T3,SC%WHL+SC%OPR ;WHEEL OR OPR PRIVS ON?
TXO F,F.PRIV ;YES, PRIVS!
HRROI T1,[ASCIZ/MTA-DUMPER:/] ;GET MTA-DUMPER: IF THERE
STDEV%
ERJMPS PANIC ;IT ISN'T
HRROI T2,MTDEV
CALL CSTR ;COPY IY INTO PLACE
CALL CHKMTD ;AND GTJFN IT
JUMPE T1,[
WARN <Bad definition for MTA-DUMPER:, ignored>
JRST PANIC] ;OOPS
TYPE <[ASCIZ/[Using MTA-DUMPER:]
/]>
;Here after cleaning up after a bad error. Commands done from
; ^E interrupt should never come here.
PANIC: MOVEI P,STACK-1 ;GET A CLEAN STACK
CALL GCMD ;DO A COMMAND
JRST .-1 ;DO ANOTHER COMMAND
GCMD: SETZM OKIAE ;OFF INTERRUPTS ON ^A, ^E
GCMDI: SETZM CURCMD ;NO COMMAND IN PROGRESS
SKIPL INTRQ ;SPARE INTERRUPT LEFT OVER?
JRST GCMDP ;NO
SETZM INTRQ ;YES, LOSE IT
TYPE [ASCIZ/ [Interrupt ignored] /]
GCMDP: DMOVE T1,[EXP CMDBLK,INIINB] ;DO THE COMMAND INIT
CALL PARSE ;PROMPT
JFCL ;SNH
TXZ F,F.NO+F.ABT ;NOT AN ABORT COMMAND
SKIPN INTRQ
TXZ F,F.NVOL+F.DERR+F.NDIR+F.FAKE+F.NSEQ+F.WILD
MOVEM F,FLGTMP
MOVEM P,STKSAV ;SAVE STACK IN CASE REPARSE
MOVEI T1,RPSSTR
SKIPE INTRQ ;GET PROPER REPARSE BACKOUT STACK
MOVEI T1,RPSISR
MOVEM T1,RPSSTK ;SAY NO REPARSE OPS NEED DOING YET
RPRS: MOVEI T2,CM1INB ;ASSUME NOT UNDER INTERRUPT
SKIPE INTRQ ;ARE WE UNDER AN INTERRUPT??
MOVEI T2,CM2INB ;YES, USE THE INTERRUPT COMMANDS LIST
TXZ F,F.NO ;"NO" ISN'T SET YET
PARCMD: MOVEI T1,CMDBLK
CALL PARSE ;PARSE A COMMAND
JRST UKCERR ;UNKNOWN COMMAND
MOVEM T2,CURCMD ;STORE THE COMMAND INFO
HRRZ T1,(T2)
JRST (T1)
;Routine should return to CMDEND (if all OK), BAKOUT (if failing or ABORTed),
; or NOCMD (if the parse didn't work properly).
UKCERR: CALL ANNERR ;SOME SORT OF ERROR COMING UP
MOVEI T1,CM1LST ;SEE IF TRYING TO TYPE REAL COMMAND..
SKIPN INTRQ ;AT THE WRONG TIME
MOVEI T1,CM2LST ;IE, GET "OTHER" COMMAND LIST
HRROI T2,ATOM ;GET WHAT HE TYPED
TBLUK% ;LOOK FOR IT IN THE NO-INTER TABLE
TXNN T2,TL%ABR!TL%EXM ;MATCH?
JRST UK1ERR ;NO, JUST BAD TYPING
TYPE [ASCIZ/?The /]
HLRO T1,(T1)
TYPEAT T1 ;TYPE THE ILLEGAL COMMAND BACK
TYPE [ASCIZ/ command will not be legal until /]
SKIPN INTRQ ;UNDER ^E?
JRST BADTM1 ;NO
TYPE [ASCIZ/ABORT (/]
HRRZ T1,CMDWAS ;TYPE THE INTERRUPTED COMMAND BACK
HLRO T1,(T1)
TYPEAT T1
TYPE [ASCIZ/) is typed./]
JRST NOCMD
BADTM1: TYPE [ASCIZ/a command is
interrupted with Control-E./]
JRST NOCMD
UK1ERR: TYPE [ASCIZ/?Not a defined command/]
;NOCMD assumes nothing mapped needs unmapping.
; Come here when commands under the ^E interrupt fail.
NOCMD: SETZM OKIAE ;NO MORE ^A NOW
CALL UNDO ;GET THINGS LEFT BY PARSING
CALL WHERE ;IF INPUT FROM PRIMARY..
CALL UNTAKE ;DON'T UNDO TAKE FILES ON HIM
MOVE F,FLGTMP
JRST GCMDP
;Here if ^U or rubout
TRAPRP: CALL UNDO ;UNDO THE EFFECTS OF THE PARTIAL PARSE
GRPRS: MOVE F,FLGTMP ;RECOVER FLAGS BEFORE PARSE
MOVE P,STKSAV ;RESTORE THE STACK
JRST RPRS ;AND GO REPARSE
;Here if a command fails midstream or gets an ABORT. Clean up pages,
; drop PIDs, toss take files, and do everything else to make reality
; stable.
BAKOUT: CALL WHERE ;IF INPUT FROM PRIMARY, DON'T HURT TAKES
CALL UNTAKE ;TOSS ANY COMMAND FILES
;JRST GETOUT ;FINISH UP
;GETOUT is where we go if a command failed in an "acceptable" way, ie an EOT
; command given while already at EOT.
GETOUT: CALL KILLIO ;STOP TAPE, DROP BUFFERS, MAPPED FILES.
CALL UNDO ;GET ANYTHING LEFT BY PARSING
JRST PANIC ;AND SET UP ANEW
KILLIO: SETO T1, ;UNMAP FILE PAGES
MOVE T2,[.FHSLF,,PAGPAG]
MOVE T3,[PM%CNT+PBSIZ]
PMAP%
ERJMPS .+1
;**;[536] At KILLIO:+5L, add 5 lines and label SM 22-Jan-86
TXZN F,F.RETR ;[536] DID WE DIE ON RETRIEVAL?
JRST NORETD ;[536] NO, SKIP THIS
CALL UNLOAD ;[536] YES, TOSS TAPE NOW
CAIE P5,0 ;[536] DID WE HAVE A REQUEST IN PROGRESS?
CALL RETFAI ;[536] YES, REQUEUE OR DROP REQUEST
NORETD: SKIPE T1,LSTDMP ;[536] IS THERE A LAST OUTPUT BUFFER?
CALL RELPGS ;YES, KILL IT
SETZM LSTDMP
CALL KILCHN ;LOSE QUEUED TAPE DATA
SETZM WRISEQ ;NO IDEA WHERE WE ARE
SKIPE T1,CURBLK ;IS THERE A CURRENT BUFFER ALLOCATED?
CALL RELPGS ;YES, BYEBYE
SETZM CURBLK
SKIPE T1,MYPID ;HAVE A PID?
CALL RELPID ;MAKE IT HISTORY
SKIPE T1,LSTJFN ;LIST FILE OPEN?
CALL DRPJFN ;YES, BYEBYE
SETZM LSTJFN
SKIPE T1,INIJFN ;NO INITIAL JFN
CALL DRPUFN
SETZM INIJFN
SKIPE T1,JFN ;ANYTHING HERE?
CALL DRPJFN
SETZM JFN
SETZM INIFLG ;NOT SCANNING OVER ANYTHING
CALL WAITFN ;WAIT FOR TAPE TO STOP MOVING
CALL CLRERR ;TOSS OLD ERRORS
SKIPN T1,MTJFN ;MAKE SURE READING FORWARD
JRST NOTAPF
MOVX T2,.MOSDR
SETZ T3,
MTOPR%
ERJMPS .+1 ;OH WELL
NOTAPF: TXZ F,F.BACK ;NOT READING FORWARD
SETZM TRAPTO ;NO INPUT ROUTINE TO WATCH
TXZE F,F.RETR ;NOT RETRIEVING
CALL UNLOAD ;IF WE WERE, UNLOAD
RET
KILCHN: SKIPE T1,DMPCHA ;DELETE OLD CHAIN
CALL CLRCH2
NTOSS: SETZM BLKCNT
CALL LOSSEQ ;TOSS SEQUENCE NUMBER
TXZ F,F.NVOL+F.FAKE+F.CIRC+F.EOF+F.NSEQ ;THESE FLAGS SHOULD GO
RET
CLRCHN: SKIPN T1,DMPCHA
RET
CLRCH2: CALL RELPGS
JUMPN T1,.-1
SETZM DMPCHA ;THIS MEANS NEXT READ GETS CUTE
RET
;Here if command finishes normally and should clean out a readahead
; chain. ^E possible commands should not come here.
CMDFIN: CALL KILCHN
;Here at command end (if it finishes normally). Do normal cleanups.
CMDEND: CALL IFCRL2
JRST CLRERR ;AND RET TO CALLER
SUBTTL Interrupt code
;This code handles the interrupts (^A, ^E, timer, quasar) and the friends
; of ABORT and CONTINUE.
;TIMER% interrupt. Break out if QUASAR takes too long to get back to us,
; and set the "finished" flag.
TIMINT: TXZN F,F.WAIT ;WAITING?
DEBRK% ;NO, RETURN IMMEDIATELY
MOVEM T1,RETFIN ;SAVE T1
SKIPE NXTRTP ;DID WE GET A REQUEST?
JRST TIMIN2 ;YES, JUST IN TIME
HRROI T1,[ASCIZ/
?Assuming no requests in the retrieval queue./]
PSOUT% ;NO, COMPLAIN
TIMIN2: HLRZ T1,CHNTAB+TIMCHN
AOS @LEVTAB-1(T1) ;BREAK THE WAIT
SKIPE NXTRTP ;ANOTHER MESSAGE IN THE QUEUE?
TDZA T1,T1 ;YES, RETURN SAYING NOT DONE
SETO T1, ;NO, AND WAITED LONG ENOUGH
EXCH T1,RETFIN ;GET T1 BACK; SET STATE OF "DONE" FLAG
DEBRK% ;RETURN TO CALLER
;^A is a request for program information
;^A can happen at any time. Unlike ^E, which merely sets a flag and
; returns, we have to actually do things without disturbing anything
; important. Hence, we don't use TYPE or DECOUT or anything like
; that - we just do output to .PRIOU (it's faster anyway).
CFINT: SKIPL OKIAE ;DO WE WANT TO HANDLE ^A NOW?
JRST NOINTN ;NO INTERRUPTS LEGAL NOW
MOVEM 17,I3ACS+17 ;SAVE AC'S
MOVEI 17,I3ACS
BLT 17,I3ACS+16
CALL CFINFO ;CALL ROUTINE TO DO IT
RETIN3: MOVSI 17,I3ACS ;RESTORE INTERRUPT ACS
BLT 17,17
DEBRK%
;CFINFO can be called at ^A interrupt time, or any other time.
; Don't add code that changes the state of anything here. Ie, calling
; IFCRLF is wrong because it changes IFCTMP, etc.
CFINFO: MOVEI T1,.PRIOU
DOBE%
RFPOS%
HRROI T1,CRLF
TRNE T2,-1
PSOUT%
HRRZ T1,CURCMD ;TYPE THE NAME OF THE COMMAND IN PROGRESS
HLRO T1,(T1)
LDB T2,[POINT 7,(T1),6] ;IS THERE A COMMAND NAME?
JUMPE T2,CFNCMN ;NO, MUST BE INVISIBLE
PSOUT%
HRROI T1,[ASCIZ/ in progress. /]
PSOUT%
CFNCMN:
IFN FTDEB,<
CALL PRCUSE ;WHAT PERCENT OF MEMORY IS USED UP?
JUMPE T2,CFNMEM
MOVEI T1,"("
PBOUT%
MOVEI T3,^D10
MOVX T1,.PRIOU
NOUT%
ERJMPS .+1
HRROI T1,[ASCIZ/%) /] ;TYPE THE USAGE
PSOUT%
>
CFNMEM: CALL CFNFIL
SKIPN LSTSEN
JRST CFNNLF
;Type out last file seen on tape (during RESTORE, PRINT, etc) here.
;Measure the string, ignoring the ;Pnnnnnn;Aaccountname stuff.
;As it gets measured, compare it to the result of the last filename typed
; via the ^A (stored in CNFBFR by CFNFIL). If it is the same, it isn't
; worth typing, so don't.
SETZ T3,
MOVE T1,[POINT 7,LSTSEN]
MOVE T4,[POINT 7,CFNBFR]
CNTFLN: ILDB T2,T1
ILDB Q1,T4 ;EITHER BYTE POINTER OR 0
CAIN T2,";"
SETZ T2,
CAIE Q1,(T2)
SETZ T4, ;DIFFERENT. IT IS WORTH TYPING OUT.
JUMPE T2,CNTFL2 ;END. GO TYPE IT (MAYBE)
CAIE T2,.CHCNV ;IS IT ^V?
AOJA T3,CNTFLN ;NO. COUNT AS A CHARACTER AND GO ON
ILDB T2,T1 ;YES, NEXT COULD BE ANYTHING
ILDB Q1,T4
CAIE Q1,(T2)
SETZ T4,
ADDI T3,2
JRST CNTFLN
CNTFL2: JUMPN T4,CFNNLF ;T4 NONZERO IF STRINGS WERE THE SAME
HRROI T1,[ASCIZ/
Last seen on tape: /]
PSOUT%
HRROI T2,LSTSEN
MOVX T1,.PRIOU
SOUT%
ERJMPS .+1
CFNNLF: HRROI T1,CRLF
PSOUT%
RET
CFNFIL: SETZM CFNBFR
SKIPN T2,JFN
RET
HRROI T1,[ASCIZ/(Initial) /]
SKIPE INIFLG ;SCANNING FILES VIA INITIAL?
PSOUT% ;YES, SAY SO
HRROI T1,[ASCIZ/File: /]
PSOUT%
HRROI T1,CFNBFR
MOVE T3,[JFNSAL]
JFNS%
ERJMPS CPOPJ
HRROI T1,CFNBFR
PSOUT%
SKIPGE T2,CURREN
RET
HRROI T1,[ASCIZ/ (/]
PSOUT%
MOVX T1,.PRIOU
MOVEI T3,^D10
NOUT%
ERJMPS .+1
MOVEI T1,")"
PBOUT%
RET
;^E is a request for the prompt, with the option to CONTINUE or ABORT
CEINT: AOSE OKIAE ;DO WE CARE?
JRST NOINTN
MOVEM T1,INTRQ ;SAVE T1 FOR A MOMENT
HRROI T1,[ASCIZ/
Interrupting.../]
PSOUT% ;DON'T USE TYPE, TOO MUCH TROUBLE
SETO T1,
EXCH T1,INTRQ ;RESTORE T1, SET INTRQ TO -1
SKIPN TRAPTO ;GO SOMEWHERE SPECIAL?
DEBRK% ;NO, ALL DONE
EXCH T1,TRAPTO ;SAVE T1, GET TRAPTO
TXO T1,PC%USR ;IN USER MODE PLEASE (BREAK FROM JSYS)
MOVEM T1,LVPC3 ;WHERE WE RETURN TO
TXZ T1,PC%USR
EXCH T1,TRAPTO ;RESTORE T1
DEBRK% ;HOME
;Here when we get a ^E or ^A and don't want one. Beep at user.
NOINTN: MOVEM T1,NOITMP
MOVEI T1,.CHBEL
PBOUT% ;TAKE THAT!
ERJMPS .+1
MOVE T1,NOITMP
DEBRK%
;TSTINT is slightly tricky.
;Here to test for an interrupt. Return +2 if no interrupt or there was
; one and the user went off and did commands and then continued. +1 means
; the user did an ABORT command. This may return through ABOCON.
TSTINT: SKIPL INTRQ ;^E INTERRUPT FLAGGED?
JRST CPOPJ1 ;NO, SKIP HOME
MOVEM 17,ICMACS+17 ;YES, SAVE AC'S
MOVEI 17,ICMACS
BLT 17,ICMACS+16
MOVNS INTRQ ;MAKE POSITIVE <<
HRROI T1,[ASCIZ/DUMPER>>/]
MOVEM T1,CMDBLK+.CMRTY;PUT UP INTERRUPT PROMPT
MOVE T1,CURCMD
MOVEM T1,CMDWAS ;STORE THE INTERRUPTED COMMAND INFO
MOVE T1,RPSSTK ;SAVE THE OLD REPARSE OP STACK
MOVEM T1,RPSSTR ;IN AN UNUSED LOC
MOVEI T1,RPSISR ;AND SET UP THE INTERRUPT REPARSE OP STACK
MOVEM T1,RPSSTK ;..
MOVEI P,INTSTK ;GET A NEW STACK
MOVE T1,[.PRIIN,,.PRIOU]
CALL PUSTAK ;INPUT FROM THE TERMINAL
CALL GCMDI ;CALL THE COMMAND SCANNER
JRST .-1 ;DO COMAMNDS UNTIL CONTINUE OR ABORT
;CONTINUE and ABORT don't come to the above JRST .-1 because they restore
; the old stack pointer and hence act like the return from TSTINT.
$CONT: HRRZ T1,CMDWAS ;GET POINTER TO INTERRUPTED COMMAND NAME
HLRO T1,(T1)
CALL GUIDE ;GUIDE WITH COMMAND TO CONTINUE
JRST NOCMD ;DIDN'T MATCH
CONFIRM
TYPE [ASCIZ/ Continuing /]
MOVE T1,CMDWAS ;PUT THE INTERRUPTED COMMAND..
MOVEM T1,CURCMD ;BACK AS THE NEW ONE
TXZ F,F.ABT
JRST ABOCON
$ABORT: HRRZ T1,CMDWAS ;GET A POINTER TO INTERRUPTED COMMAND NAME
HLRO T1,(T1)
CALL GUIDE ;GUIDE WITH THE DOOMED COMMAND
JRST NOCMD
CONFIRM
TYPE [ASCIZ/ Aborting /]
TXO F,F.ABT
;Here with F.ABT on to return +1 with ^A, ^E still off (presumably to
; hit a JRST BAKOUT and abort the interrupted command), or F.ABT off to
; return +2 with ^A, ^E back on. This code represents the return
; from CALLing TSTINT.
ABOCON: SETZM CMDWAS ;CLEAR THE INTERRUPED COMMAND INFO
TYPEAT GUIINB+.CMDAT ;TYPE COMMAND NAME (LAST GUIDE TEXT)
TYPE [ASCIZ/ command...
/]
CALL TAKEOF
JFCL ;MUST HAVE CLEARED THE JFN STACK FOR ERROR
MOVE T1,RPSSTR ;RECOVER LAST REPARSE OP STACK POINTER
MOVEM T1,RPSSTK ;.. <
HRROI T1,[ASCIZ/DUMPER>/]
MOVEM T1,CMDBLK+.CMRTY;PUT NORMAL PROMPT BACK
MOVE 17,[ICMACS+1,,1];RESTORE AC'S 1-17 (KEEP CURRENT FLAGS IN 0!)
BLT 17,16
MOVE 17,ICMACS+17
SETZM INTRQ ;OFF GOES THE FLAG
TXNE F,F.ABT ;ABORT OR CONTINUE?
RET ;ABORT, RETURN
SETOM OKIAE ;GIVE ^A, ^E BACK
JRST CPOPJ1 ;AND RET +2
;Here on a file data interrupt. Needed, because these can happen when we touch
; a page after PMAPing it in (ie, at COMCH1)
DAEINT: SKIPG JFN ;DO WE KNOW WHERE IT CAME FROM?
DEBRK% ;NO. DON'T TRY TO SAY
DMOVEM T1,I2ACS+1
MOVEM T3,I2ACS+3
CALL IFCRL2
HRROI T1,[ASCIZ/%Disk data error on /]
PSOUT%
MOVE T2,JFN
SETZ T3,
MOVEI T1,.PRIOU
JFNS%
ERJMPS .+1
HRROI T1,CRLF
PSOUT%
DMOVE T1,I2ACS+1
MOVE T3,I2ACS+3
DEBRK%
; Here on PSI for IPCF message arrived
QSRINT: MOVEM 17,I3ACS+17
MOVEI 17,I3ACS
BLT 17,I3ACS+16
MOVEI P,QSRSTK-1
RECALL: CALL RCVQSR
JRST RETQSR
MOVE T1,.MSFLG(P1) ; Get flags
MOVE T2,.MSCOD(P1) ; Get ack code
TXNE T1,MF.ACK ; Guy want an ACK?
CALL DOACK ; Ack him now
TXNE T1,MF.NOM ; No message?
JRST RECALL ; Yes, just eat that
TXNN T1,MF.WRN ; Warning message?
TXNE T1,MF.FAT ; Fatal message
JRST QSTEXT ; Is a message, print it
LOAD T1,MS.TYP,.MSTYP(P1), ; Get type code
CAIN T1,.QONEX ; Next job msg?
JRST QSNXT ; Yes
CAIN T1,.QOABO ; Abort msg?
JRST QSABT ; Yes
CAIN T1,.QORCK ; Checkpoint?
JRST RECALL ; Yes
CAIN T1,.QOSUP ; Setup message?
JRST QSSETU ; Yes
WARN <Unknown message type received>
JRST RECALL ;Loop to check queues
QSNXT: MOVE T1,.EQITN(P1) ; Get task name
MOVEM T1,TPTSK ; And remember it
MOVX T1,RC%EMO ; Exact match pls
HRROI T2,.EQOWN(P1) ; Point to owner of request
SETZB T3,TPRQUS ; No stepping info
RCUSR%
ERJMPS FLOWN ; Bombed
TXNN T1,RC%NOM+RC%AMB+RC%NMD+RC%WLD ; Failure or wild?
MOVEM T3,TPRQUS ; No, Remember who
FLOWN: HRLI T1,.EQLIM+1(P1) ; From there
HRRI T1,.ARTP1+TPBLK ; To there
BLT T1,TPBLK+.ARSF2 ; Move tape info
MOVE T1,.EQLIM(P1) ; Get time & flag
MOVEM T1,.ARODT+TPBLK
MOVEI P1,QSRMSR
LOAD T2,EQ.LOH,.EQLEN(P1)
ADD T2,P1 ;POINT TO THE FP
LOAD T3,FP.LEN,(T2) ;GET FP LENGTH
ADD T2,T3 ;POINT TO FD
HRROI T1,.FDFIL(T2) ;POINT TO FILESPEC
HRROI T2,TAPNAM ; Move file name to there
CALL CSTR
HRROI T1,.EQACT(P1) ; Where it is now
HRROI T2,TPACT ; Where account should be
CALL CSTR
MOVEI T1,TPBLK
MOVEM T1,NXTRTP
QSNXT1: HLRZ T1,CHNTAB+QSRCHN; Get level we're at
TXZE F,F.WAIT ;WAITING?
AOS @LEVTAB-1(T1) ; Yes, make him go again
MOVEM F,I3ACS ;MAKE SURE CHANGES TO F GET KEPT
RETQSR: MOVSI 17,I3ACS
BLT 17,17
DEBRK%
QSSETU: MOVE T1,SUP.TY(P1) ; Get object type
CAIE T1,.OTRET ; Of type we expect?
JRST [
HRROI T1,[ASCIZ/%Bad setup message
/]
PSOUT%
JRST RECALL]
MOVE T1,SUP.FL(P1) ; Get flags
TXNE T1,SUFSHT ; Shutdown rather than start up?
JRST [SETOM RETFIN ; Yes, flag, and...
JRST QSNXT1] ; ..leave as though we got a null request
MOVE T2,SUP.UN(P1) ; Get the unit #
MOVE T3,SUP.NO(P1) ; And NODE name
CALL ZIPMSS ; Setup to send
MOVE T1,[RSU.SZ,,.QORSU] ; Respond to setup
MOVEM T1,.MSTYP(P1) ; Length and type
MOVE T1,[.OTRET] ; Object type
MOVEM T1,RSU.TY(P1)
MOVEM T2,RSU.UN(P1) ; Unit number
MOVEM T3,RSU.NO(P1) ; Node name
MOVX T1,%RSUOK ; Say SETUO OK
MOVEM T1,RSU.CO(P1) ; Response code
SETZM RSU.DA(P1) ; No attributes
MOVE P1,[RSU.SZ,,QSRMSS]
CALL SNDQSR ; Send it
JRST RECALL
QSABT: HRROI T1,[ASCIZ/
%Abort received/]
PSOUT%
AOS ABTFLG ; Note we got the abort poke
JRST RECALL
QSTEXT: MOVEI T1,"%"
TXNE T1,MF.FAT ; Fatal msg?
MOVEI T1,"?"
PBOUT%
HRROI T1,[ASCIZ/QUASAR info - /]
PSOUT%
HRROI T1,.OHDRS+ARG.DA(P1) ;GET ADDRESS OF TEXT
PSOUT% ;PRINT IT
HRROI T1,CRLF
PSOUT%
JRST RECALL ; Done here
LEVTAB: LVPC1
LVPC2
LVPC3
CECHN==1
QSRCHN==2
TIMCHN==3
CFCHN==4
CHNTAB: 0 ;0 Free
3,,CEINT ;1 ^E
3,,QSRINT ;2 IPCF Msg from QUASAR recv'd
3,,TIMINT ;3 TIMER channel to limit quasar infinit wait
3,,CFINT ;4 ^A
0 ;5 free
0 ;6 Arith overflow
0 ;7 Float overflow
0 ;8 Reserved
0 ;9 PDL overflow
0 ;10 EOF
2,,DAEINT ;11 File Data error .ICDAE
0 ;12 Disk full
0 ;13 Reserved
0 ;14 Reserved
0 ;15 Ill Inst
0 ;16 Ill mem read
0 ;17 Ill mem write
0 ;18 Reserved
0 ;19 Inferior stopped
0 ;20 Sys res exhausted
0 ;21 Reserved
0 ;22 Non existant page
0 ;23 Free, 23-35
0 ;24
0 ;25
0 ;26
0 ;27
0 ;28
0 ;29
0 ;30
0 ;31
0 ;32
0 ;33
0 ;34
0 ;35
CHNMSK: 1B<CECHN>!1B<QSRCHN>!1B<CFCHN>!1B<.ICDAE>
;NOT TIMCHN, WHICH WE TURN ON AND OFF
SUBTTL TAKE command
;TAKE and friends
$TAKE: HLRZ T1,TAKSTK ;GET THE TAKE STACK COUNT
CAIL T1,TAKLEN ;ALL FULL UP?
ERROR <TAKEs nested too deeply, aborting.>
GUIDES <COMMANDS FROM FILE>
MOVX T1,GJ%OLD ;JUST AN OLD FILE, PLEASE
MOVEM T1,GTJBLK+.GJGEN
SETZM GTJBLK+.GJDEV
SETZM GTJBLK+.GJDIR
SETZM GTJBLK+.GJNAM
HRROI T1,[ASCIZ/CMD/]
MOVEM T1,GTJBLK+.GJEXT
DMOVE T1,[EXP CMDBLK,FICINB] ;INPUT FILE OR CONFRM
CALL PARSE
ERROR <Not a Confirm or a File Specification>,NOCMD
CAIN T3,.CMCFM ;CONFIRM OR FILE?
JRST TAKEND
CALL RPSJFN ;SAVE JFN FOR REPARSE
CONFIRM
HRRZ T1,T2 ;GET JFN IN T1
MOVE T2,[7B5+OF%RD] ;TRY TO OPEN
OPENF%
JSERRD <Can't OPEN file>,NOCMD ;IF AN ERROR OCCURS, SAY WHY AND DIE
HRLZS T1 ;JFN IN LH
HRRI T1,.NULIO ;OUTPUT (NOWHERE) IN RH
CALL PUSTAK
JRST CMDEND
;HERE WITH T1/ INJFN,,OUTJFN TO PUSH TO NEW INPUT & OUTPUT
PUSTAK: MOVE Q1,TAKSTK ;GET THE TAKE STACK
EXCH T1,CMDBLK+.CMIOJ;WHERE COMND LOOKS NOW
PUSH Q1,T1 ;SAVE OLD SOURCE ON TAKE JFN STACK
MOVEM Q1,TAKSTK ;SAVE STACK POINTER
RET
TAKEND: SKIPN INTRQ ;DOING ^E STUFF?
JRST TAKEN2 ;NO, JUST ACT LIKE EOF
MOVE Q1,TAKSTK
ADJSP Q1,-1 ;SIGH. TOSS THE PUSHED ^E LEVEL
CALL TAKEO2 ;NOW TOSS THE LEVEL THE USER MEANT
JFCL ;FINE, HE'S JUST MAKING SURE
MOVE T1,[.PRIIN,,.PRIOU]
CALL PUSTAK ;AND LET HIM KEEP TAKING TO ME
JRST CMDEND
TAKEN2: CALL TAKEOS
ERROR <No TAKE files active>,CMDEND
JRST CMDEND
TAKEOS: TXOA F,F.NO ;DON'T WANT ENDING MESSAGE
TAKEOF: TXZ F,F.NO ;ALLOW END MESSAGE
MOVE Q1,TAKSTK ;GET TAKE STACK
TAKEO2: TLNN Q1,-1
RET ;NO OPERATION IF EMPTY STACK
POP Q1,T1 ;RESTORE PREVIOUS JFNS
MOVEM Q1,TAKSTK
EXCH T1,CMDBLK+.CMIOJ;GIVE BACK LAST JFNS
HLRZ T2,T1 ;GET COMMAND INPUT JFN IN T2
CAIN T2,.PRIIN ;IS IT MAIN (^E WOULD DO THIS)
JRST CPOPJ1 ;YEAH, DON'T ANNOUNCE OR CLOSE
TXZE F,F.NO
JRST TAKEO3 ;NO ENDING MESSAGE
CALL IFCRLF ;ANNOUNCE WHAT'S ENDING
TYPE <[ASCIZ/[Ending /]>
CALL TYJFNS
TYPE CBCR ;CLOSE BRACKET CRLF
TAKEO3: MOVE T1,T2
CLOSF% ;CLOSE THE FILE OUT
JSERRD <>,CPOPJ1 ;FAILURE SEEMS UNLIKELY
JRST CPOPJ1 ;+2 RET
;Here to blow away all take files
UNTAKE: CALL TAKEOF ;END THE CURRENT TAKE FILES
RET ;DONE
JRST UNTAKE ;GO UNTIL NONE LEFT
SUBTTL Simple commands
;Simple routines
;Put user declared saveset name into SSNTXT, where DUMP will get it.
$SSNAM: DMOVE T1,[EXP CMDBLK,TXTINB]
CALL PARSE
JSERRD <>,NOCMD,JRST
CONFIRM
HRROI T1,ATOM
HRROI T2,SSNTXT
CALL CSTR
JRST CMDEND
;PARITY
$PAR: MOVEI Q1,PARITY
MOVEI T2,PARTAB
JRST PARDEN
;DENSITY
$DEN: MOVEI Q1,DENSIT
MOVEI T2,DENTAB
PARDEN: GUIDES <OF MAGTAPE>
MOVEI T1,CMDBLK
CALL KEYWRD
ERROR <Illegal selection>,NOCMD
CONFIRM
HRRZ T2,(T2) ;GET DATA
CAMN T2,(Q1) ;IS THE USER CHANGING ANYTHING?
JRST CMDEND ;NO, DON'T MUCK WITH THE JFN
TXNE F,F.NBOT
ERROR <Can't change tape settings mid-tape, please rewind first>,NOCMD
MOVEM T2,(Q1) ;STORE WHEREVER CALLER REQUESTED
SETOM FRCSET
;Come here if you are changing the flavor of the OPENF% on the drive in some
; way. It causes the drive to be dropped if it is opened.
RESEOP: SKIPE MTJFN ;GOT A JFN OUT THERE?
SKIPN OPNFOR ;OPEN IN A REAL WAY?
JRST CMDEND ;NOT THERE OR OPEN, FINE.
SETZ T1, ;WE DON'T WANT IT OPEN...
CALL GMOJFN ;SO NEXT OPENF% WILL USE NEW INFO
JFCL ;SNH
JRST CMDEND
DENTAB: NDENTB,,NDENTB
TB .SJD16,<1600-BPI>
TB .SJDN2,<200-BPI>
TB .SJDN5,<556-BPI>
TB .SJD62,<6250-BPI>
TB .SJDN8,<800-BPI>
TB .SJDDN,<JOB-DEFAULT>
NDENTB==.-DENTAB-1
PARTAB: NPARTB,,NPARTB
TB .SJPRE,<EVEN>
TB .SJPRO,<ODD>
NPARTB==.-PARTAB-1
;NO
$NO: DMOVE T1,[EXP CMDBLK,NOIINB]
SKIPE INTRQ ;INTERRUPTING A COMMAND?
MOVEI T2,NOCINB ;YES, LIMIT THE POSSIBILITIES
CALL PARSE
ERROR <No such NO option>,NOCMD
TXO F,F.NO
HRRZ T2,(T2)
JRST (T2)
NOIINB: <.CMKEY>B8+NOCINB
EXP NOCTAI
NOCINB: <.CMKEY>B8
EXP NOCTAB
NOCTAI: NIOTB,,NIOTB
CTB $AB4, <ABEFORE>
CTB $ASI, <ASINCE>
CTB $B4, <BEFORE>
CTB KILSDT, <DATES>
IFN FTEXAC,<
CTB EXACTM, <EXACT>
>
IFN FTIND,<
CTB $INDMD, <INDUSTRY>,CM%INV
>
CTB $INISP, <INITIAL>
CTB $INTER, <INTERCHANGE>
CTB $MB4, <MBEFORE>
CTB $MSI, <MSINCE>
CTB $SINCE, <SINCE>
NIOTB=.-NOCTAI-1
NOCTAB: NNOTB,,NNOTB
CTB $CSUM, <CHECKSUM>
CTB $CREAT, <CREATE>
CTB $LDIR, <DIRECTORIES>
CTB $LFIL, <FILES>
CTB $LIST, <LIST>
CTB $SIL, <SILENCE>
NNOTB==.-NOCTAB-1
;TURN SIMPLE FLAGS ON OR OFF HERE
$SIL: MOVX T2,F.DIRT+F.FILT
TXCA F,F.NO ;SILENCE IS SORT OF BACKWARDS
$LDIR: MOVX T2,F.DIRT
JRST DOFLA2
$LFIL: MOVX T2,F.FILT
JRST DOFLA2
$CREAT: MOVX T2,F.CREA+F.DDIR
HRROI T1,[ASCIZ/DIRECTORIES FROM TAPE DATA/]
;JRST DOFLAG
DOFLAG: CALL GUIDE
JRST NOCMD
DOFLA2: CONFIRM
TXNN F,F.NO
JRST ONFLAG
ANDCM F,T2
JRST FLAGCH
ONFLAG: TXNE F,F.PRIV
JRST FLAGOK
TXNE T2,F.CREA ;TRYING TO TURN ON PRIVED THINGS?
OPRERR: ERROR <That requires WHEEL or OPR privs>,NOCMD
FLAGOK: IOR F,T2
TXNE T2,F.DIRT ;TYPE DIRECTORIES GOING ON?
SETOM DDOFLG ;YES, MAYBE FORCE OUT CURRENT DIRECTORY!
TXNE F,F.CREA ;ENABLING CREATE?
SETZM PASWDC ;YES, MAKE SURE THIS ERROR IS WARNED ABOUT
FLAGCH: JRST CMDEND
;INTERCHANGE
$INTER: GUIDES <FORMAT>
CONFIRM
TXNE F,F.NO
JRST [TXNN F,F.INTR;TURNING OFF?
JRST CMDEND ;YES, IF ALREADY OFF, JUST LEAVE
JRST CHNINT] ;CHANGING STATE, GO ON
TXNE F,F.INTR ;TURNING ON, IS IT ALREADY ON?
JRST CMDEND ;YES, JUST LEAVE
CHNINT: TXNE F,F.NBOT ;MAY NOT CHANGE MID-TAPE!
ERROR <May not change INTERCHANGE state mid-tape, please REWIND first>
TXNN F,F.NO ;PRECEDING "NO"?
JRST INTEYE
TXZE F,F.INTR
SKIPN T2,OLDBKF
JRST CMDEND
MOVEM T2,WRIBKF
CAIN T2,1
JRST CMDEND
TYPE <[ASCIZ/[Restoring BLOCKING-FACTOR to /]>
CALL DECOUT
TYPE CBCR
JRST CMDEND
INTEYE: TXOE F,F.INTR
JRST CMDEND
MOVEI T1,1
EXCH T1,WRIBKF ;SET BLOCKING FACTOR TO 1 FOR INTERCHANGE
MOVEM T1,OLDBKF ;AND SAVE OLD ONE
JRST CMDEND
IFN FTEXAC,<
;EXACT MODE FLAG
EXACTM: GUIDES <MODE>
CONFIRM
SETOM EXACT
TXNE F,F.NO
SETZM EXACT
JRST CMDEND
> ;END IFN FTEXAC
IFN FTIND,<
$INDMD: GUIDES <MODE>
CONFIRM
TXNE F,F.NO
TXZA F,F.36MD
TXO F,F.36MD
JRST RESEOP
>
;Set up INITIAL filespec
$INISP: GUIDES <FILESPEC>
TXNE F,F.NO
JRST [SETZ T2,
JRST INIS2]
SETZB T1,12
MOVX T3,GJ%OLD+GJ%IFG
CALL SETWLD
DMOVE T1,[EXP CMDBLK,FILINB]
CALL PARSE
ERROR <Illegal file specification>
CALL RPSJFN
INIS2: CONFIRM
EXCH T2,INIJFN
HRRZ T1,T2
CAIE T1,0
CALL DRPUFN
JRST CMDEND
;Set up LIST file
$LIST: SETZM MAILFL
TXNE F,F.NO
JRST LISTOF
GUIDES <LOG INFORMATION ON FILE>
LISTCL: DMOVE T1,[EXP CMDBLK,LISINB]
CALL PARSE
JSERRD <>,NOCMD,JRST
CAIE T3,.CMSWI
JRST NOLISM
HRRZ T2,(T2)
JUMPE T2,LISTCL
TXNN F,F.PRIV ;/MAIL NEEDS PRIVS
JRST OPRERR
SETOM MAILFL
DMOVE T1,[EXP CMDBLK,LI3INB]
CALL PARSE
JSERRD <>,NOCMD,JRST
NOLISM: CALL RPSJFN
CONFIRM
CALL CHKJFN ;MAKE SURE IT'S REASONABLE!
TLNE T3,-1 ;ILLEGAL OR CURRENT MTA
ERROR <Illegal LIST file choice>,NOCMD
MOVE T2,T1
HRROI T1,LSTFIL
MOVE T3,[JFNSAL]
JFNS%
MOVE T1,T2 ;TOSS THE JFN NOW
CALL DRPUFN
JRST CMDEND
LISTOF: CONFIRM
SETZM LSTFIL
JRST CMDEND
LISINB: <.CMOFI>B8+CM%DPP+LI2INB
BLOCK 2
-1,,[ASCIZ/LPT:DUMPER.LOG/]
LI2INB: <.CMSWI>B8
LI2TAB
LI2TAB: LI2LEN,,LI2LEN
IFN FTMAIL,<
[ASCIZ/MAIL/],,1
>
[ASCIZ/NOMAIL/],,0
LI2LEN=.-LI2TAB-1
LI3INB: <.CMOFI>B8+CM%DPP
BLOCK 2
-1,,[ASCIZ/DUMPER-MAIL.TXT/]
;CHECKSUM
$CSUM: TXNE F,F.NO
JRST NCSUM
GUIDES <FILES>
DMOVE T1,[EXP CMDBLK,CSMTAB]
CALL KEYWRD
ERROR <No such CHECKSUM option>,NOCMD
CONFIRM
HRRZ T2,(T2) ;PICK UP ADDRESS OF FLAGS
TXZ F,F.CHKS+F.CSEQ ;TURN THEM ALL OFF
IOR F,(T2) ;ON THE ONES SELECTED
JRST CMDEND
NCSUM: CONFIRM
TXZ F,F.CHKS+F.CSEQ
JRST CMDEND
CSMTAB: NCKLEN,,NCKLEN
TB [F.CHKS], <BY-PAGES>
TB [F.CHKS+F.CSEQ], <SEQUENTIAL>
NCKLEN==.-CSMTAB-1
;SUPERSEDE
$SUP: DMOVE T1,[EXP CMDBLK,STBL]
CALL KEYWRD ;PARSE KEYWORD
ERROR <No such SUPERSEDE option>
CONFIRM
HRRZ T2,(T2) ;GET FLAG ADDRESS
TXZ F,F.SSA+F.SSN ;MOVE THEM TO F
IOR F,(T2)
JRST CMDEND
STBL: NSTBL,,NSTBL
TB [F.SSA], <ALWAYS>
TB [F.SSN], <NEVER>
TB [0], <OLDER>
NSTBL==.-STBL-1
;ACCESSED-BEFORE
$AB4: MOVEI Q1,ABTAD
JRST DATEST
;ACCESSED-SINCE
$ASI: MOVEI Q1,ASTAD
JRST DATESF
;WRITTEN-BEFORE
$B4: MOVEI Q1,WBTAD
JRST DATEST
;WRITTEN-SINCE
$SINCE: MOVEI Q1,WSTAD
JRST DATESF
;MOVED-BEFORE
$MB4: MOVEI Q1,MBTAD
;JRST DATEST
DATEST: TXNE F,F.NO
JRST CLRSDO
GUIDES <DATE AND TIME>
CALL GETTAD
JRST NOCMD
MOVEM T1,(Q1)
JRST DATEND
;MOVED-SINCE
$MSI: MOVEI Q1,MSTAD
;JRST DATESF
DATESF: TXNE F,F.NO
JRST CLRSDI
GUIDES <DATE AND TIME>
CALL GETTAD
JRST NOCMD
MOVEM T1,(Q1)
GTAD%
CAMGE T1,(Q1)
WARN <The date and time given has not yet occured>
DATEND: SETOM DATSET ;DATE HAS BEEN SET
JRST CMDEND
CLRSDI: TDZA T1,T1
CLRSDO: HRLOI T1,377777
CONFIRM
MOVEM T1,(Q1)
JRST CMDEND
KILSDT: CONFIRM
SETZM MSTAD
SETZM WSTAD
SETZM ASTAD
HRLOI T1,377777
MOVEM T1,MBTAD
MOVEM T1,WBTAD
MOVEM T1,ABTAD
JRST DATEND
$$SET: DMOVE T1,[EXP CMDBLK,SETTBL]
CALL KEYWRD ;PARSE KEYWORD
ERROR <No such SET option>
HRRZ T2,(T2)
JRST (T2) ;AND GO ON
SETTBL: NSETTB,,NSETTB
TB SETBLK, <BLOCKING-FACTOR>
TB TAPNUM, <TAPE-NUMBER>
NSETTB==.-SETTBL-1
TAPNUM: GUIDES <DECIMAL NUMBER>
DMOVE T1,[EXP CMDBLK,NUMINB]
CALL PARSE
JSERRD <>,NOCMD,JRST
CONFIRM
CAIG T2,0
ERROR <Tape number must be positive>,NOCMD
MOVEM T2,TAPENO
JRST CMDEND
SETBLK: GUIDES <TO>
DMOVE T1,[EXP CMDBLK,NUMINB]
CALL PARSE
JSERRD <>,NOCMD,JRST
GUIDES <RECORDS>
CONFIRM
SKIPE T1,REABKF ;DO WE KNOW THE BLOCKING FACTOR?
CAMN T1,T2 ;YES, IF NOT THE SAME DON'T TAKE
TXNE F,F.BLKF ;BLOCKING FACTOR UNCHANGABLE?
JRST ILCHBK
CAIG T2,MAXBKF ;MUST BE WITHIN LIMIT
CAIGE T2,1 ;MUST BE 1 OR GREATER
ERROR <That BLOCKING-FACTOR is illegal>
TXNE F,F.INTR ;INTERCHANGE MODE?
JRST SETBKI ;YES, CAN'T USE YET, SAVE FOR LATER
MOVEM T2,WRIBKF ;REMEMBER BLOCKING-FACTOR
JRST CMDEND
SETBKI: MOVEM T2,OLDBKF ;TURNING OFF INTERCHANGE WILL BRING THIS IN
TYPE [
ASCIZ/ Not setting BLOCKING-FACTOR yet - INTERCHANGE mode is set.
Turning INTERCHANGE off will give you your requested BLOCKING-FACTOR./]
JRST CMDEND
ILCHBK: SKIPN T2,T1 ;IF 0, REABKF WAS NEVER SET (WE ONLY WROTE..
MOVE T2,WRIBKF ; AND NEVER READ).
ILCHB2: ERROR <Tape blocking factor is already set to >,.+1
CALL DECOUT
TYPE [ASCIZ/, please REWIND first/]
JRST BAKOUT
$PRO: GUIDES <OF RESTORED FILES FROM>
DMOVE T1,[EXP CMDBLK,ACCTAB]
CALL KEYWRD ;PARSE KEYWORD
ERROR <No such PROTECTION option>,NOCMD
CONFIRM
HRRZ T2,(T2)
CAIN T2,0
TXZA F,F.RPRO
TXO F,F.RPRO
JRST CMDEND
$ACC: GUIDES <OF RESTORED FILES FROM>
DMOVE T1,[EXP CMDBLK,ACCTAB]
CALL KEYWRD ;PARSE KEYWORD
ERROR <No such ACCOUNT option>
CONFIRM
HRRZ T2,(T2)
CAIN T2,0
TXZA F,F.RACC
TXO F,F.RACC
JRST CMDEND
;ARGUMENT KEYWORD TABLE FOR PROTECTION AND ACCOUNT
ACCTAB: NACCTB,,NACCTB
TB 0, <SYSTEM-DEFAULT>
TB 1, <TAPE>
NACCTB==.-ACCTAB-1
;FORMAT - use if midtape
$FMT: GUIDES <VERSION NUMBER IS>
DMOVE T1,[EXP CMDBLK,FMTINB]
CALL PARSE
ERROR <Not a decimal number>
CONFIRM
CAIG T2,CURFMT ;THIS IS THE MAX
CAIGE T2,4 ;THIS IS THE MINIMUM
ILFMTV: ERROR <DUMPER doesn't support that tape format>
MOVEM T2,FORMAT ;SAVE SPECIFIED NUMBER
JRST CMDEND
FMTINB: <.CMNUM>B8+CM%DPP
^D10
BLOCK 1
-1,,[BYTE(7)"0"+CURFMT] ;May this convention (which will break
;at CURFMT=10) outlive DUMPER.
;HELP command - type HLP:DUMPER.HLP at him.
TYPHLP: CONFIRM
HRROI T2,[ASCIZ/HLP:DUMPER.HLP/]
MOVX T1,GJ%SHT+GJ%OLD
GTJFN%
ERJMPS [HRROI T2,[ASCIZ/SYS:DUMPER.HLP/]
MOVX T1,GJ%SHT+GJ%OLD
GTJFN%
ERJMPS [ERROR <Can't find help file>,NOCMD]
JRST .+1]
HRRZM T1,HLPJFN
HRRZ T2,T1
CALL RPSJFN
MOVE T1,T2
MOVX T2,7B5+OF%RD
OPENF% ;OK, READY TO DUMP OUT
JSERRD <>,NOCMD
HLPLP: MOVE T1,HLPJFN ;SUCK IN A FEW SCORE BYTES
HRROI T2,STRING
HRROI T3,-TMPLEN*5+2
SIN%
ERJMPS .+2 ;EOF, I'M SURE
TDZA T3,T3 ;NO EOF, CLEAR FLAG
MOVX T3,1B0 ;EOF, MARK IT
IDPB T3,T2 ;THIS INSURES ENDING NULL
CHKCO: MOVX T1,.PRIOU
RFMOD% ;^O WOULD INDICATE HE'S LOST INTEREST
TXZE T2,TT%OSP
JRST [SFMOD% ;HE GOT BORED. TURN ^O OFF AND QUIT
JRST QHELP]
NOCO: HRROI T1,STRING ;TYPE THE BUFFER AT HIM
PSOUT%
JUMPE T3,HLPLP ;DID WE RAISE EOF?
TYPE CRLF
QHELP: MOVE T1,HLPJFN ;YES, DROP JFN
CALL DRPJFN
SETZM HLPJFN ;AND FORGET WE HAD IT
JRST CMDEND ;DONE
;Exit routine
LEAVE: CONFIRM
CALL MTCLS
HALTF%
JRST CMDFIN ;FOR A CONTINUE
SUBTTL TAPE command and friends
;TAPE command and friends
$TAPE: GUIDES <DEVICE>
DMOVE T1,[EXP CMDBLK,MTAINB]
CALL PARSE
JSERRD <>,NOCMD,JRST
CONFIRM
HRROI T1,ATOM ;GET DEVICE NAME
CALL CHKMTS ;SET UP MTDEV AND DO CHKMTD
JRST NOCMD ;NOT QUITE LEGAL IT SEEMS
JRST CMDEND
;GMOJF(I,O) makes sure a drive is open for reading (GMOJFI) or writing (GMOJFO)
; If the drive is already open in the right mode, fine. If not, it closes
; and reopens. Since it uses GMTJFN, it will prompt for the device at need.
GMOJFI: SKIPA T1,[OF%RD]
GMOJFO: MOVX T1,OF%WR
;Pass the OPENF% flags (OF%RD, OF%WR) in T1 here to get tape open
; in that mode. Closes the current tape if needed, requests device if
; needed, etc. +2 ret if OK.
GMOJFN: MOVEM T1,OPNREQ
GMOJFQ: CALL GMTJFN ;GET A JFN
RET ;CAN'T, SINGLE RETURN
MOVE T2,OPNREQ ;HOW DO WE WANT IT?
CAMN T2,OPNFOR ;THE WAY IT IS NOW?
JRST GMOJF2 ;YES, FINE
SKIPN OPNFOR ;NO. IS IT OPEN AT ALL NOW?
JRST OPNTAP ;NO - JUST GO OPEN
HRLI T1,(CO%NRJ) ;YES, MUST CLOSE (BUT KEEP JFN PLEASE!)
CLOSF%
JSERRD <>,.+1 ;DOES NOT HAPPEN
JUMPE T2,GMOJF2 ;DO WE JUST WANT A JFN BUT NOT OPEN?
OPNTAP: TLO T2,(17B9) ;NO, SET THE I/O MODE...
HRRZS T1 ;ISOLATE JFN
OPENF% ;AND DO IT
JSERRD <Can't open magtape>,MTCLS
ANDX T2,OF%RD!OF%WR ;ONLY SAVING THESE FLAGS
GMOJF2: SKIPN OPNFOR ;WAS IT OPEN AT ALL BEFORE?
CALL MTBOT ;NO, ASSUME AT BEGINNING
MOVEM T2,OPNFOR ;GOT IT OPEN, SAVE OPEN STATE
JUMPE T2,CPOPJ1
;**;[545] Replace 16 lines with 8 at GMOJF2:+4L DEE 31-MAR-87
MOVEI T3,.SJDMC ;[545] Assume CORE-DUMP data mode
IFN FTIND,<
TXNE T2,OF%WR ;[545] Did we open for writing?
TXNN F,F.36MD ;[545] Yes, want INDUSTRY mode?
SKIPA ;[545] No, neither
MOVEI T3,.SJDM8 ;[545] OK - set INDUSTRY mode
>
MOVE T1,MTJFN ;GET TAPE JFN
MOVEI T2,.MOSDM ;FUNCTION = SET DATA MODE
MTOPR% ;DO IT
ERJMPS [WARN <Can't set tape DATA MODE, using job default.>
JRST OPREAD]
OPREAD: MOVE T1,MTJFN
IFLAB LABOPN ;NOW SEE WHAT SORT OF TAPE IS OPEN
SKIPN FRCSET ;IS DENSITY SET VIA A COMMAND OR PRECEDENT?
JRST CHKBKF ;NO, SO LEAVE IT ALONE
MOVEI T2,.MOSDN ;UNLABELED, SET DENSITY PER REQUEST
MOVE T3,DENSIT
DOJSS MTOPR%,<[
WARN <Unable to set DENSITY, job default used.>
JRST .+1]>
MOVE T1,MTJFN
MOVEI T2,.MOSPR ;SET PARITY PER REQUEST
MOVE T3,PARITY
DOJSS MTOPR%, CHKBKF
JRST CHKBKF ;DONE
LABOPN: MOVEI T2,.MOSDS
MOVE T3,OPNFOR
TXNE T3,OF%WR ;OPEN FOR WRITE?
MTOPR% ;YES, SET DEFERRED VOLUME-SWITCH
JSERRD <LABOPN>
CHKBKF: MOVE T1,MTJFN
MOVEI T2,.MORDN ;GET DENSITY WE SET OR HAVE
MTOPR%
ERJMPS UNKDNS ;CANT?
SETOM FRCSET ;INSIST ON IT NOW
MOVEM T3,DENSIT ;MAKE IT THE NEW DEFAULT
UNKDNS: MOVE T1,OPNFOR
TXNN T1,OF%WR ;WRITING TO TAPE?
JRST CPOPJ1 ;NO, DONE
MOVSI T2,-DNKLEN ;LOOK FOR TAPE DENSITY IN THE TABLE
CHKBK2: HRRZ T1,DNKTAB(T2) ;..
CAIN T1,(T3) ;..
JRST SETBK1 ;FOUND IT
AOBJN T2,CHKBK2
JRST CPOPJ1 ;NOT IN TABLE, TAKE NO ACTION
SETBK1: HLRZ T1,DNKTAB(T2) ;PICK UP MAX BLOCKING FACTOR
CAML T1,WRIBKF ;ACCEPTABLE?
JRST CPOPJ1 ;YES
MOVEM T1,WRIBKF ;NO, CHANGE IT
MOVE T2,T1 ;SO WE CAN TYPE IT
WARN <Tape BLOCKING-FACTOR too high, using >
CALL DECOUT
JRST CPOPJ1 ;+2 HOME
OPNERR: CALL MTCLS
HRROI T1,MTDEV
JRST LSTERR ;ERROR MESSAGE AND +1 HOME
;Max blocking factor for density
DNKTAB: 1,,.SJDN2
3,,.SJDN5
4,,.SJDN5
^D10,,.SJD16
^D35,,.SJD62
DNKLEN=.-DNKTAB ;[542] LENGTH +1 FOR PROPER AOBJN INDEXING
;**;[542] CHANGE 1 LINE AT DNKTAB:+5.L DSW 6/11/86
;This returns a MTA JFN in T1 with a +2 ret, or +1 if the user
; interrupted and aborted.
GMTJFN: SKIPE T1,MTJFN
JRST CPOPJ1
REQMTA: CALL GETNAM
RET
HRROI T1,ATOM2 ;GET DEVICE NAME
CALL CHKMTS ;DO STUFF WITH IT
JRST REQMTA ;NOT LEGAL, TRY AGAIN
MOVE T2,LSTTMP
MOVEM T2,LSTFLG ;RESTORE OLD OUTPUT FLAGS FROM GETNAM/QUEST
JRST CPOPJ1 ;OK, RETURN JFN
;GET A TAPE NAME INTO ATOM2
GETNAM: MOVEM P,TRAPSP
MOVEI T1,INTREQ
MOVEM T1,TRAPTO
HRROI T1,[ASCIZ/Tape specification needed: /]
MOVEI T2,STRING
MOVEI T3,TAPBLK ;SET UP TO DO PROMPT
CALL QUEST
MOVEM P,REQTMP
RPMTAN: MOVE P,REQTMP
DMOVE T1,[EXP TAPBLK,MTAINB]
CALL PARSE ;HOPEFULLY
ERROR <Illegal magtape designator>,GETNAM
MOVEI T2,CONINB
CALL PARSE ;GET CONFIRM
ERROR <Not confirmed>,GETNAM
SETZM TRAPTO
JRST CPOPJ1
INTREQ: SETZM TRAPTO
MOVE P,TRAPSP ;RATHER LIKE A REPARSE
CALL TSTINT
RET ;ABORTED, AS EXPECTED
JRST GETNAM
;Here with a byte pointer in T1 to a device name (with or without colon).
; it stores in in MTDEV and does CHKMTD.
CHKMTS: HRROI T2,MTDEV ;INTO MTDEV
CALL CSTRB
CAIN T3,":" ;WHAT WAS LAST CHAR?
JRST CHKMTD ;ITS A COLON, ALL SET
MOVEI T3,":"
IDPB T3,T2 ;PUT THE COLON IN
SETZ T3,
IDPB T3,T2 ;AND AN ENDING NULL
;Here with a device name in MTDEV. Returns with T1 and
; MTJFN set up if a reasonable device was given. They are 0 if something
; unreasonable came in. +1 always. If MTJFN is set up, the following will
; also be set up: MTDSG (designator), VOILD6 (sixbit volid if available),
; VOLID (asciz volid), MTTYP (magtape type), if applicable.
CHKMTD: CALL MTCLS ;CLOSE ANY PREVIOUS TAPE
CHKMTF: HRROI T1,MTDEV
STDEV%
ERJMPS NOTACM
MOVE T1,T2 ;PUT DESIGNATOR IN T1
MOVEM T1,MTDSG ;AND SAVE IT
DVCHR% ;WHAT SORT OF DEVICE?
LDB T4,[POINT 9,T2,17] ;IS IT?
CAIE T4,.DVMTA ;ONLY LEGAL CHOICE
JRST NOTMTA ;SORRY, YOU CAN'T DO THAT
HRREM T3,MTAUNT ;SAVE THE UNIT NUMBER
MOVE T4,T1 ;PUT THE DESIGNATOR IN T4 FOR GETTYP BELOW
MOVX T1,GJ%SHT ;LET'S TRY FOR A JFN
HRROI T2,MTDEV ;POINT TO DEVICE NAME
GTJFN% ;GO FOR IT...
ERJMPS NOTACM ;CAN'T HAVE IT, GO COMPLAIN
SETZM REABKF ;SAY WE HAVEN'T READ FROM THIS TAPE YET
MOVEM T1,MTJFN ;GOTCHA
TXZ F,F.EOF+F.NORD ;ASSUME WE CAN READ, ETC.
CALL GETTYP ;GET TAPE TYPE AND VOLUME INFO SET UP
JRST NOMTAR ;FAILED, GO COMPLAIN
MOVE T1,MTJFN ;RETURN JFN
JRST CPOPJ1
;Error stuff for CHKMTD
NOTMTA: ERROR <Device is not a magtape - >,.+1
TYPE MTDEV
JRST NOMTAR
NOTACM: ERROR <Can't get information on device >,.+1
HRROI T1,MTDEV
CALL LSTERR ;GIVE ERROR CODE
;JRST NOMTAR
NOMTAR: CALL MTCLS ;DROP IT, IT ISN'T GOOD
SETZ T1, ;RETURN 0 FOR FAILURE
RET
;Here with JFN in T1 and designator in T4. Get tape type and volid info
; as approprate. Ret +1 or +2.
GETTYP: SETOM MTTYP ;ASSUME MTA FOR NOW
SETZM VOLID ;ASSUME NONE
SETZM VOLID6
TXNN T4,DV%PSD ;PSEUDODEVICE (MT NOT MTA)?
JRST CPOPJ1 ;ITS AN MTA (ASSIGNED). DONE HERE.
CALL GETVOL ;GET THE VOL, AND SET UP MTIAB
MOVEI T2,.MORLI ;FIND OUT MT LABEL TYPE
MOVEI T3,MTIAB ;JFN STILL IN T1, GETVOL'S ARGBLK WILL WORK
HRRZS MTIAB ;JUST THE COUNT, PLEASE
MTOPR%
ERJMPS ILLTTP ;INFO NOT AVAILABLE
MOVE T1,MTIAB+1 ;FETCH LABEL INFO
MOVEI T2,1 ;ASSUME LABELED MT
CAIE T1,.LTANS ;ANSIASCII?
CAIN T1,.LTT20 ;OR TOPS20?
JRST CHKMT2 ;YES, STORE IT
SETZ T2, ;NOW ASSUME UNLABELED
CAIE T1,.LTUNL ;TEST IT
ILLTTP: ERROR <Illegal tape type - UNLABELED or TOPS20 only>,CPOPJ
CHKMT2: MOVEM T2,MTTYP
JRST CPOPJ1
;Here with the JFN in T1. Returns VOLID and VOLID6 set up.
GETVOL: MOVEI T2,.MOINF ;NEED SOME MT INFO
MOVEI T3,MTIAB ;ARG BLOCK AT MTIAB
HRRZS MTIAB ;JUST THE COUNT IN MTIAB, PLEASE
MTOPR% ;GET VOLUME NAME
ERJMPS .+2 ;CANT
SKIPA T3,MTIAB+2 ;FETCH VOLUME NAME
SETZ T3, ;CAN'T, RETURN NOTHING
;**;[538] Add label at GETVOL:+7L SM 31-Jan-86
DOVOLS: MOVEM T3,VOLID6 ;[538] STORE
CALL C6TO7
V6TO7S: DMOVEM T2,VOLID ;STORE THE ASCIZ STRING
RET
DRPTAP: SETZM VOLID
SETZM VOLID6
SETZM MTDSG
;JRST MTCLS
;Here to close the tape if it is open
MTCLS: SKIPN MTJFN
RET
CALL WAITFN
SETZ T1,
EXCH T1,MTJFN
PAT07A: TXO T1,CZ%ABT
DOJSS CLOSF%,<[
RLJFN%
JRST .+1
JRST .+1]>
SETZM MTJFN
SETZM OPNFOR
RET
SUBTTL Unload, Rewind
;UNLOAD, REWIND
$UNL: CONFIRM
SKIPN MTJFN
ERROR <No tape device specified yet>,NOCMD
IFMTA .+2
ERROR <Use the Monitor DISMOUNT TAPE command>,NOCMD
CALL GMOJFI ;MAKE SURE READING
JRST BAKOUT ;SORRY, CANT
CALL UNLMTA ;UNLOAD THE MTA (MAY NOT BE LEGAL)
CALL DRPTAP ;AND LOSE THE TAPE
JRST CMDEND ;ALL DONE
;REWIND
$REW: DMOVE T1,[EXP CMDBLK,RWTINB]
CALL PARSE ;PARSE KEYWORD
ERROR <Illegal Keyword>,NOCMD
HRRZ T2,(T2) ;GET DISPATCH ADDRESS
JRST (T2) ;OFF TO KEYWORD HANDLER
RWTINB: <.CMKEY>B8+CM%DPP
EXP RWTB
BLOCK 1
-1,,[ASCIZ/CURRENT-VOLUME/]
RWTB: RWTBL,,RWTBL
[ASCIZ/CURRENT-VOLUME/],,REWC
[ASCIZ/SWITCHING/],,REWS
RWTBL==.-RWTB-1
TPNINB: <.CMNUM>B8+CM%SDH+CM%DPP+CM%HPP
^D10
-1,,[ASCIZ/decimal sequence number of volume within set/]
-1,,[ASCIZ/1/]
REWC: CONFIRM
SETOM OKIAE ;SO CAN USE "ABORT" DURING GMTJFN
CALL GMOJFI ;GET JFN ON DRIVE
JRST NOCMD ;COULDN'T
SETZM OKIAE
CALL REWCV1 ;REWIND TO BEGINNING OF CURRENT VOLUME
SETZM LSTSEN
JRST CMDEND
REWS: GUIDES <TO VOLUME NUMBER>
DMOVE T1,[EXP CMDBLK,TPNINB]
CALL PARSE
ERROR <Need a decimal number here>,NOCMD
CONFIRM
SKIPG Q3,T2
ERROR <Tape number must be positive>,NOCMD
SETOM OKIAE
CALL GMOJFI ;GET THE JFN
JRST NOCMD ;CAN'T
SETZM OKIAE
DISPAT RSMTA,RSUMT,RSLMT ;DISPATCH ON TAPE TYPE (MTA,MT UNL,MT LAB)
RSMTA: ERROR <Use TAPE command to switch MTA devices>,NOCMD
RSLMT: CAIE Q3,1
ERROR <Labeled tapes can only be switched to volume 1>,NOCMD
MOVEI T2,.MOREW
CALL MTBACK
JRST RSBEGI
RSUMT: MOVE T1,MTJFN
MOVEI T2,.MOVLS ;VOLUME-SWITCH FUNCTION
MOVEI T3,Q1 ;ARG BLOCK ADDRESS
MOVEI Q1,3 ;PUT SIZE IN ARG BLOCK
MOVEI Q2,.VSMNV ;MOUNT ABSOULTE VOLUME # (IN Q3)
MTOPR%
WAITTS: JSERRD <Cannot switch to specified volume>,NOCMD
CALL MTBOT ;REWIND TAPE, RESET COUNTERS
RSBEGI: MOVE T1,MTJFN ;FOR GETVOL
CALL GETVOL
SETZM LSTSEN
JRST CMDEND ;DONE
;REWCV rewinds the current volume
REWCV: SKIPN MTJFN
JRST MTBOT
PUSH P,OPNFOR ;LABELED TAPES DEMAND READ MODE
CALL GMOJFI ;WHEN REWINDING, SO GET IT
JRST BAKOUT
CALL REWCV1 ;DO THE REWIND
POP P,OPNREQ ;RESTORE OLD MODE
CALL GMOJFQ ;AND OPEN IT AS IT WAS
JRST BAKOUT
RET ;DONE
REWCV1: DISPAT REWMTA,REWMT,REWMT
REWMT: MOVEI T2,.MORVL ;MT, USE REWIND VOLUME
JRST MTBACK ;GO DO
REWMTA: MOVEI T2,.MOREW ;ASSIGNED TAPE REWIND
JRST MTBACK
;UNLOAD unloads tapes if possible.
UNLOAD: SKIPE MNTDSG ;DID WE GET ONE THROUGH QUASAR?
JRST [SETZ T1,
CALL SETMNT ;YES, LOSE IT
JRST MTBOT]
IFMT REWCV ;MT'S AREN'T UNLOADED, SO JUST REWIND
UNLMTA: MOVEI T2,.MORUL ;UNLOAD
MTBACK: SKIPE T1,MTJFN
MTOPR%
WINDIN: JSERRD <>,.+1
;JRST MTBOT
;Set parameters for BOT or new tape. Hurts no AC's that don't deserve it.
MTBOT: SETOM ATSAVE ;FOR RETRIEVAL
SETOM ATFILE
SETZM REABKF ;IF READING, MUST REFIGURE DENSITY, ETC
SETZM WRISEQ ;RESET SEQUENCE NUMBERS
SETZM REASEQ
SETZM LSTSEQ
TXZ F,F.EOF+F.NORD+F.FAKE+F.CIRC+F.ILAB+F.BLKF+F.EOT+F.OEOF+F.NBOT
;REWOUND TAPE, ALL OK
RET ;RETURN FROM MTBOT
$EOT: CONFIRM
SETOM OKIAE ;INTERRUPTABLE!
CALL GMOJFI ;GET DRIVE FOR READING AT LEAST
JRST NOCMD ;ODD
CALL FNDENA ;GET TO THE END
TYPE [ASCIZ/ End of Tape./]
JRST CMDEND
;Find the TAPEEN record
FNDEND: CALL GMOJFI
JRST BAKOUT
FNDENA: TXO F,F.NVOL!F.NSEQ ;DON'T VOLSWITCH PLEASE!
FNDEN2: CALL GETREC
CAIN T3,TAPEEN
JRST FNDEN3 ;DONE
CAIN T3,SAVEST
CALL TYPHDR
CAIE T3,TONEXT ;ONLY PASSED BACK IF F.NVOL LIT
JRST FNDEN2
CALL UNLOAD
ERROR <This tape is FULL, please mark it>
FNDEN3: TXZ F,F.NVOL!F.NSEQ
RET
SUBTTL SAVE command
;Quick SAVE-like commands (ARCHIVE, MIGRATE, COLLECT)
COLLEC: MOVX T1,D.COL
JRST DMPCOM
ARCHIV: MOVX T1,D.ARC
JRST DMPCOM
MIGRAT: MOVX T1,D.MIG
DMPCOM: TXNN F,F.PRIV
JRST OPRERR
MOVEM T1,DMPFLG
CALL SETSTP
JRST DMPENT
;SAVE dispatches here
DUMP: SETZM SAVETP ;ASSUME NORMAL SAVE
SETZM DMPFLG ;CLEAR FLAGS (ARCHIVAL,COLLECT,INCREMENTAL)
DMPENT: GUIDES <DISK FILES>
SETZM UNLFLG ;DON'T ASSUME UNLOAD
MOVSI Q1,-MAXJFN ;NUMBER OF JFNS ALLOWED
CALL GETCON ;GET DEFAULTS
SKIPN DMPFLG ;IF ALREADY FLAGGED, JUST GO FOR FILE
SKIPA Q2,[DMPINB] ;EITHER A SWITCH OR A FILESPEC
DUMPAG: MOVEI Q2,DM2INB ;HERE AFTER COMMA PARSE OR 1ST FILE (NO SWITCHS)
MOVE T1,CONSTR
TXNE F,F.PRIV ;PRIVS DECIDE OUR DEFAULTS
SKIPA T2,[POINT 7,[ASCIZ/*/]] ;WILD DIRECTORY
MOVE T2,CONDIR ;UNPRIVED, GET DEFAULT SET UP BY GETCON
DMPSWF: MOVX T3,GJ%OLD+GJ%IFG+GJ%XTN ;WILD, EXTRA FLAGS
CALL SETWLD ;SET UP FOR WILD FILE SPEC
SKIPA T2,Q2 ;CONTAINS EITHER (FILE,SWITCH) OR (FILE)
DUMPPF: MOVEI T2,DM2INB ;BACK FROM SWITCH, JUST DO FILE NOW
MOVEI T1,CMDBLK
SETZ Q2, ;ASSUME YES FILENAME/NO ERROR
CALL PARSE
JRST DFLERR ;ERROR MUST BE EXAMINED
CAIE T3,.CMSWI ;FILENAME OR SWITCH?
JRST FLJFNS ;FILE, DO JFNS STUFF
HRRZ T2,(T2) ;SWITCH. GO PROCESS AND RETURN TO DUMPPF
JRST (T2)
;List of "FILE NOT FOUND" error codes - 0 means end
OKGJXL: BYTE (18)GJFX16,GJFX17,GJFX18,GJFX19,GJFX20,GJFX24
BYTE (18)GJFX32,GJFX35,GJFX36,GJFX38,0
DFLERR: MOVE T3,[POINT 18,OKGJXL] ;LIST OF "OK" GTJFN ERRORS
DFLERS: ILDB T1,T3 ;WE SCAN THEM
CAIN T1,0 ;END OF LIST? IF 0, ILLEGAL ERROR, DIE
JSERRD <Not a Switch or File Specification>,NOCMD,JRST
CAIE T1,(T2) ;CHECK LEGALITY
JRST DFLERS ;NO, TRY AGAIN
MOVE Q2,T2 ;SAVE ERROR FOR LATER (OTHERWISE 0)
MOVX T1,GJ%OFG ;SET UP TO PARSE-ONLY THE NOT-FOUND FILESPEC
HLLM T1,GTJBLK+.GJGEN; ..
DMOVE T1,[EXP CMDBLK,DM2INB]
CALL PARSE ;REPARSE THE BAD ATOM
JSERRD <>
FLJFNS: CALL RPSJFN ;SAVE THE JFN FOR A REPARSE
CALL CHKDSK ;GET INFO ON JFN (AND PUT JFN IN T1)
MBDERR: ERROR <Device must be DISK>,NOCMD
MOVEM T1,JFNLST(Q1) ;SAVE INPUT JFN
TLNN T3,(1B2) ;DID CHKDSK SAY "NO SUCH DEVICE?"
JRST SAVCPF ;NO, FINE
WARN <No mounted disk named >
MOVE T2,T1 ;YES, TELL WHAT IS WRONG, AND GIVE JFN
MOVX T3,1B2+JS%PAF ;JUST TYPE DEVICE NAME AND COLON
CALL TYJFNF
TYPE [ASCIZ/, no files will be saved from it.
/] ;THE SAD TRUTH
SAVCPF: MOVEM Q2,JF2LST(Q1) ;SAVE 0 OR ERROR CODE
;MAKE UP "AS" JFN
MOVX T2,GJ%OFG
HLLM T2,GTJBLK+.GJGEN;PARSE ONLY
CALL OFNAME ;MAKE UP OUTPUT NAME DEFAULTS
SETOM DMPTMP ;SAY "NO CONFIRM YET"
SKIPE DMPFLG ;COLLECTION/MIGRATION/INCREMENTAL/ARCHIVAL?
JRST DUSEDF ;YES, ERROR CHECK, AND NO (AS) FILE
DMPOJN: GUIDES <AS>
DMOVE T1,[EXP CMDBLK,CCFINB]
CALL PARSE
JSERRD <Illegal "AS" file specification>,NOCMD,JRST
MOVEM T3,DMPTMP
CAIE T3,.CMFIL ;DID I PARSE A FILESPEC?
JRST USDEFA ;NO, ASSUME DEFAULTS
IFN FTEXAC,<
SKIPN EXACT ;EXACT MODE?
JRST DMPJF2 ;NOT EXACT MODE, TAKE AS IS
HRRZ T1,T2 ;DROP THE COMND% JFN
RLJFN% ;..
ERJMPS .+1
MOVE T1,GTJBLK+.GJGEN
HRRM T1,EXABLK+.GJGEN
DMOVE T1,GTJBLK+.GJDEV ;GIVE GTJFN THE SAME DEFAULTS
DMOVEM T1,EXABLK+.GJDEV
DMOVE T1,GTJBLK+.GJNAM
DMOVEM T1,EXABLK+.GJNAM
MOVEI T1,EXABLK ;DO AGAIN, WITH G1%SLN LIT, SO
HRROI T2,ATOM ;WE CAN FORCE NON-EXPANSION OF
GTJFN% ;LOGICAL NAMES
JSERRD <Can't re-GTJFN file for EXACT mode> ;WHY?
MOVE T2,T1
> ;END IFN FTEXAC
JRST DMPJF2 ;YES, GO USE
;Here to do things with the Archival/Incremental jfns. They have very
; different rules.
DUSEDF: MOVE Q3,JFNLST(Q1) ;FETCH THE FLAGS
MOVE P4,[ASCIZ/*/] ;ONLY LEGAL STRING FOR A WILD FIELD
MOVSI T4,-4
WLDCHK: TDNN Q3,[EXP GJ%DIR, GJ%NAM, GJ%EXT, GJ%VER](T4)
JRST WLDCHE
CAME P4,@[EXP DEFDIR, DEFNAM, DEFEXT, DEFGEN](T4)
ERROR <Illegal use of wildcard in special SAVE>
WLDCHE: AOBJN T4,WLDCHK
USDEFA: CALL GDEFFL ;ASSUME THE DEFAULTS
JSERRD <>,NOCMD,JRST ;CANT??!?
DMPJF2: SKIPE JF2LST(Q1) ;DID WE GET AN ERROR FOR AN INPUT FILE?
JRST [CALL DRPJF2 ;YES, TOSS THE JFN
JRST DMPJFQ] ;AND GO ON
CALL RPSJFN ;DISCARD IF WE REPARSE
MOVEM T2,JF2LST(Q1) ;NO, SO KEEP THE OUTPUT FILE
DMPJFQ: AOBJN Q1,.+2
ERROR <JFN list overflow>,NOCMD
MOVE T3,DMPTMP ;GET LAST PARSE RESULT
NOASGV: CAIN T3,.CMCFM ;DID HE CONFIRM?
JRST DUMPGO ;YES, ALL DONE
MOVE T1,DMPFLG
TXNE T1,D.COL+D.ARC+D.MIG ;ARCHIVE/COLLECTION/MIGRATION?
JRST [CALL CONFRM
ERROR <Only one file specification allowed>,NOCMD
JRST DUMPGO]
CAIN T3,.CMCMA
JRST DUMPAG
DMOVE T1,[EXP CMDBLK,CCINB]
CALL PARSE
ERROR <Comma or Carriage Return required>,NOCMD
CAIE T3,.CMCFM
JRST DUMPAG ;IT WAS COMMA. GO GET ANOTHER PAIR.
;Here when the parsing's done
DUMPGO: MOVX T1,.FHSLF ;LET'S TRACK OUR CPU-TIME
RUNTM%
MOVEM T1,DMPTIM ;WHEN WE STARTED
MOVNS Q1 ;RH HAS FILE COUNT
HRLZ P5,Q1 ;MAKE INTO AOBJN COUNT
MOVEM P5,NFJFN ;STORE
PAT05A: AOSG DATSET ;1ST SAVE SINCE SET SINCE/BEFORE STUFF?
JRST NODWRN ;FINE, DON'T BOTHER TO REMIND HIM
SETO T1, ;SEE IF STILL SET, IF SO, REMIND HIM
AND T1,ABTAD ;SEE IF ANY DATE COMMANDS ARE IN EFFECT..
AND T1,MBTAD ;+INFINITY MEANS NO DATE SET FOR ?BTAD DATES
AND T1,WBTAD
TDC T1,[377777,,-1] ;IF RESULT IS NONZERO, A DATE IS SET
IOR T1,ASTAD ;0 MEANS NO DATE SET, FOR ?STAD DATES
IOR T1,MSTAD
IOR T1,WSTAD
CAIE T1,0
TYPE [ASCIZ ~[Before and Since commands are still in effect]
~]
NODWRN: HRROI T1,SSNTXT
SETZM SSNBUF+SV.PNT
SETZM SSNBUF+SV.MSG ;CLEAR THIS BEFORE COPYING IN
HRROI T2,SSNBUF+SV.MSG
CALL CSTR ;STORE SAVESET NAME SET BY USER
TXNE F,F.CREA ;CREATE TYPED? (DO DIRECTORIES?)
TXO F,F.DDIR ;YES, DO DIRECTORIES
TXZE F,F.NDIR ;UNLESS ASKED NOT TO EXPLICITLY (/NOINC)
TXZ F,F.DDIR ;IN WHICH CASE, OFF THE FLAG
;From here down, F.DDIR is the general case, and F.NDIR is lit/cleared for
; each jfn. F.NDIR decides if it is really meaningful to write full dir info
; to tape, or whether just the name will do. This is used to prevent something
; like "SAVE DSK:<*>*.* (AS) DSK:<FOO>*.*" from saving meaningless
; directory info.
SETZM LSTSEN ;TELL ^A NO LAST FILE SEEN
SETOM OKIAE ;OK FOR THIS NOW!
SETZM TOTFIL ;COUNT FILES AND PAGES SAVED
SETZM TOTCNT ;..
SETZM DIRDMD
SETZM ARCCNT ;DIDN'T ARCHIVE ANY FILES YET
SETZM SAVENO ;ASSUME NOT SPECIAL
SETZM INFILE ;NOT BETWEEN FILEST & FILEEN
;POSITION TO PROPER PLACE. ODD FOR ARCH TAPES, ETC
MOVE T1,DMPFLG
TXNN T1,D.ARC+D.COL+D.MIG
JRST NOTARC ;NOT ARCHIVAL/MIGRATION/COLLECT
ARCHVA: CALL GMOJFI ;FORCE READ MODE
JRST BAKOUT
CALL REWCV1 ;REWIND THE TAPE
HRROI T1,[ASCIZ/Is this a new tape? /]
CALL YESNO ;ASK THE USER
JUMPE T2,OLDTAP ;HE SAID NO
HRROI T1,[ASCIZ/Are you sure? /]
CALL YESNO
JUMPN T2,ARCBEG
ERROR <Aborting>
OLDTAP: TYPE [ASCIZ/ Looking for last saveset
/]
CALL FNDEND ;FIND THE END OF THE TAPE
ARCNST: AOS T1,ARCTSN ;BUMP THE LAST SEEN ARCHIVE SAVESET #
TRNN T1,400000 ;HAS IT GOTTEN ABSURDLY LARGE? SET TO 1 THEN
JRST ARCSET ;IT'S FINE
ARCBEG: MOVEI T1,1
MOVEM T1,ARCTSN ;TRACK FOR OUR OWN PURPOSES
ARCSET: MOVEM T1,SAVENO ;PUT WHERE IT WILL GO INTO THE HEADER
NOTARC: GTAD%
MOVEM T1,BGNTAD ;WHEN WE STARTED THE SAVE
MOVEM T1,SSNBUF+SV.TAD ;SOME ROUTINES LOOK HERE
CALL IFCRL2
CALL GMOJFO ;WRITE MODE
JRST BAKOUT
CALL PROVOL ;MAKE SURE WE HAVE A VOLID IF NEEDED
CALL LINE1A ;SET UP NICE HEADER TO USER
TYPE STRING ;SET BY LINE1A
TYPE CRLF ;FINISH THE LINE
TXZ F,F.GOT1 ;DIDN'T GET A FILE YET
CALL SETLST ;SET UP THE LIST FILE IF WANTED
SETZM LSTFIL ;FAILED, GIVE UP THE LIST FILE
MOVE P5,NFJFN ;GET AOBJN COUNT FOR JFNS
;LOOP OVER JFNS, MENTIONING ONES THAT DIDN'T MAKE IT
JFNLOP: SETOM CURREN ;NO PAGE NUMBER FOR ^A YET
MOVE T2,JF2LST(P5)
TRNN T2,1B18 ;ERROR CODE (6xxxxx) OR JFN?
JRST REALFL ;REAL FILE
WARN <> ;MENTION NO FILE AND GO ON
HRLI T2,.FHSLF
CALL LSTERC ;TYPE LAST ERROR
TYPE [ASCIZ/ - /]
MOVE T2,JFNLST(P5)
CALL TYJFNS
TYPE CRLF
JRST JFNLPE
REALFL: SETZM LSTDIR ;NO LAST DIRECTORY SEEN YET
MOVEI T1,.WLJFN ;SEE IF <IN> IS WITHIN <OUT>
MOVE T2,JF2LST(P5)
HRRZ T3,JFNLST(P5)
MOVEM T3,JFN
WILD% ;IF IT IS, REAL DIR INFO IS MEANINGFUL
TXNN T1,WL%DIR!WL%DEV ;DISK/DIRECTORY THE SAME?
JRST NODIRI ;YES, WE WILL SAVE
TXNN F,F.DDIR ;DO WE INTEND TO WRITE DIR RECORDS?
JRST NODIRQ ;NO - NO REASON TO WARN
WARN <Directory specifications differ - not saving directory info on:
>
CALL GDIRNA
TYPE INDIR
NODIRQ: TXOA F,F.NDIR ;SAY "<IN> NOT WITHIN <OUT>"
NODIRI: TXZ F,F.NDIR ;<IN> IS WITHIN <OUT>
NODIRS: MOVE T1,JFNLST(P5) ;FETCH IN JFN
;Here to loop over a wild jfn, T1 has the jfn.
SKIPN T2,INIJFN ;IS THERE AN INITIAL JFN ACTIVE?
JRST OKTSFL ;NO, TAKE WHAT WE GET
SETOM INIFLG ;TELL ^A WE ARE SCANNING OVER THINGS
SCNINI: HRRZ T3,T1 ;YES, DO THE TEST FOR INITIAL SPEC
MOVEI T1,.WLJFN
WILD%
JUMPE T1,FININI ;MATCHED
MOVE T1,JFNLST(P5) ;GET JFN TO STEP
GNJFN% ;STEP ON TO NEXT VICTIM
ERJMPR ENDU ;END OF THE WILD JFN, SET UP FOR NEXT
JRST SCNINI
FININI: HRRZ T1,T2 ;OK, TIME TO DROP AND CLEAR INIJFN
CALL DRPUFN
SETZM INIJFN ;AND TIME TO TAKE FILES
SETZM INIFLG ;TELL ^A WE ARE DONE SCANNING
CALL IFCRL2
TYPE <[ASCIZ/[Starting from /]>
MOVE T2,T3
CALL TYJFNS
TYPE CBCR
OKTSFL: TXNN F,F.DDIR ;DO WE WANT DIRECTORY INFO?
JRST DIRELP ;NO, SKIP SCAN DIRECTORY CODE
;..
;Scan to find directories and dump them to tape
;..
MOVE T2,JFNLST(P5) ;PICK UP JFN
MOVX T3,1B2+1B5+JS%PAF;WANT STR:<DIR>
HRROI T1,OUTSPC ;HERE FOR THE MOMENT
JFNS%
MOVX T1,RC%AWL+RC%EMO;GET DIR NUMBER OF FIRST DIR SEEN
HRROI T2,OUTSPC
RCDIR% ;..
JSERRD <RCDIR> ;CODING ERROR, HERE OR MONITOR
TXNE T1,RC%NOM ;NO MATCH IS AN ERROR
JRST DIRELP ;NO DIRECTORIES QUALIFY!
DIRLOP: MOVEM T3,DMPNUM ;HERE WITH DIR # (IN T3) TO BE DONE
SETZM DIRBUF
MOVE T2,[XWD DIRBUF,DIRBUF+1]
BLT T2,DIRBUF+777
TXNN F,F.NDIR ;NOT WHEEL OR USER DATA NOT WANTED?
TXNN F,F.PRIV
JRST DMPUS1 ;YES, DON'T DUMPER DIR INFO
AOS DIRDMD ;OK, WRITING ANOTHER DIRECTORY
MOVEI T1,DIRBUF+CDSG ;SET UP DIRBUF TO RECEIVE SUB GROUPS
MOVEM T1,DIRBUF+.CDCUG
MOVEI T1,DIRBUF+CDUG ;SET UP DIRBUF TO RECEIVE USER GROUPS
MOVEM T1,DIRBUF+.CDUGP
MOVEI T1,DIRBUF+CDDG ;SET UP BUFFER TO RECEIVE DIR GROUPS
MOVEM T1,DIRBUF+.CDDGP
MOVEI T1,UGLEN ;LENGTH OF BUFFERS FOR GROUPS
MOVEM T1,DIRBUF+CDUG
MOVEM T1,DIRBUF+CDDG
MOVEM T1,DIRBUF+CDSG
HRROI T1,DIRBUF+UHACT ;POINT TO ACCOUNT STRING SPACE
MOVEM T1,DIRBUF+.CDDAC
MOVEI T1,CD.LEN ;CURRENT MAX SIZE
MOVEM T1,DIRBUF+.CDLEN
MOVE T1,DMPNUM
MOVEI T2,DIRBUF
MOVE T3,[POINT 7,DIRBUF+UHPSW]
GTDIR%
JSERRD <Can't get directory info>
MOVE T2,[-DIRBUF] ;REDUCE POINTERS TO OFFSETS
ADDM T2,DIRBUF+.CDUGP;FOR USER GROUP INFORMATION BLOCKS
ADDM T2,DIRBUF+.CDDGP;SO WE CAN JUST ADD OFFSET IN LATER
ADDM T2,DIRBUF+.CDCUG;..
MOVEI T2,UHPSW ;SET PASSWORD OFFSET
MOVEM T2,DIRBUF+.CDPSW
MOVEI T2,UHACT ;SET POINTER TO ACCOUNT STRING
MOVEM T2,DIRBUF+.CDDAC
DMPUS1: TXON F,F.GOT1 ;FIRST TAPE WRITE TIME?
CALL [CALL INIREC ;YES, SET UP FOR IT
JRST BGNHEA]
HRROI T1,DIRBUF+UHNAM ;POINT TO NAME BUFFER
MOVE T2,DMPNUM
DIRST%
ERJMPS .+1
HRROI T1,-DIRECT
MOVEM T1,TAPHEA+.TYP
MOVEI T1,TAPHEA
MOVEI T2,DIRBUF
CALL ADDREC
ADVDIR: MOVE T3,DMPNUM
HRROI T2,OUTSPC
MOVX T1,RC%STP+RC%AWL+RC%EMO
RCDIR%
TXNN T1,RC%NMD ;ALL DONE?
JRST DIRLOP ;NO, GO DO NEXT
DIRELP: MOVE T1,JFNLST(P5)
TXO T1,GN%DIR!GN%NAM!GN%EXT ;SAY "ALL THINGS CHANGED" (1ST TIME)
MOVEM T1,SCNJFN
SETZM OUTDRS ;DON'T HAVE OUTDIR YET
;..
;Here to start actually dumping files
;..
FILLOP: MOVE T1,SCNJFN
TXNN T1,GN%DIR!GN%STR ;DID THE INPUT DIR CHANGE?
JRST NODIRC ;NO, SO OUTPUT CAN'T CHANGE!
SETOM DDOFLG ;TELL DMPFIL WE HAVE A NEW <INPUT>
SETZM DMPNUM ;DON'T KNOW THE DIR INPUT NUMBER YET
SETZM INDIR
MOVE T2,DMPFLG ;GET DUMPING FLAGS
TXNN T2,D.COL ;COLLECTION?
JRST TSTDIC
;If doing collection, we must see if "archive-expired-files" is desired for this
; directory. Discovering that is tedious.
CALL GDIRNM ;SET UP INDIR AND DMPNUM (DIR# INTO T1)
MOVEI T2,.CDMOD+1
MOVEM T2,DIRINF+.CDLEN ;HOW MUCH WE NEED
MOVEI T2,DIRINF
SETZ T3, ;NO PASSWORD (WE ARE WHEEL)
GTDIR%
ERJMPS TSTDIC
MOVE T4,DIRINF+.CDMOD ;DECIDE IF ARCH'ING-ONLINE-EXPIRED FILES
MOVX T3,D.AOEF ;AND TURN THIS ON OR OFF
ANDCAM T3,DMPFLG
TXNE T4,CD%DAR
IORM T3,DMPFLG
;Here we isolate the output directory string if it has changed
TSTDIC: MOVE Q1,JF2LST(P5) ;SEE IF OUTPUT DSK:<DIR> CAN EVER CHANGE
TXNE Q1,GJ%DEV!GJ%DIR ;??
JRST MAYCHN ;YES, GO FIGURE
SKIPE LSTDIR ;IT CANT, DO WE HAVE IT ALREADY?
JRST NODIRC ;YES, SO DON'T BOTHER
MAYCHN: CALL GOFDRS ;NO, MUST FIGURE FOR TEST AND DMPFIL
SKIPN LSTJFN ;ARE WE DOING A LIST FILE?
JRST NODIRC ;NO, SO SKIP THE LISTFILE CONTORTIONS
TXNN Q1,GJ%DEV!GJ%DIR ;CAN OUTPUT DSK:<DIR> CHANGE?
JRST [AOS LSTDIR ;NO, MAKE LSTDIR NONZERO
JRST GDDIRC] ;AND GO ON (NEEDN'T COMPARE/COPY TO LSTDIR)
HRROI T1,OUTDIR ;COMPARE NEW DSK:<DIR> TO OLD ONE
HRROI T2,LSTDIR
CALL STCMPC ;..
JUMPE T3,NODIRC ;SAME, DON'T DO ANYTHING
PUSH P,LSTDIR ;DIFFERENT, SAVE THIS
CALL STCOPY ;MAKE THEM THE SAME
POP P,T1 ;WAS THERE ANYTHING THERE?
TLNE T1,-1 ;IF NOT, NO ENDUSR TO DO
CALL ENDUSR ;CLOSE OFF THE LAST DIRECTORY
GDDIRC: CALL BEGUSR ;BEGINNING OF DIRECTORY STUFF
NODIRC: CALL DMPFIL ;CHECK FILE FOR DUMPING, AND DUMP IF OK
SETOM CURREN ;FOR ^A - FILE NOT YET GOING
MOVE T1,JFNLST(P5) ;GET JFN TO STEP
GNJFN% ;STEP ON TO NEXT VICTIM
ERJMPR ENDU ;END OF THE WILD JFN, SET UP FOR NEXT
MOVEM T1,SCNJFN ;SAVE FLAGS SO WE KNOW IF A DIR CHANGED
JRST FILLOP ;ADVANCED, GO DO NEXT FILE
;Come to ENDU with the GNJFN error code in T1. If it isn't GNJFX1 (No more
; files), the user needs to be told and we need to abort.
ENDU: CAIE T1,GNJFX1 ;NO MORE FILES?
JSERRD <Can't step to next file>,BAKOUT,JRST
SKIPE LSTFIL ;DOING A LIST FILE?
CALL ENDUSR ;YES, FINISH LAST DIRECTORY
TXNE F,F.FILT+F.DIRT ;FILE OR DIRECTORY MODE?
TXNN F,F.GOT1 ;YES, GET ANYTHING YET?
JRST JFNLPE ;NOT BOTH TRUE
CALL SAVTXT ;YES, WE WANT A <CRLF> AFTER EACH JFN
MOVEI T1,TR.FDT
IDPB T1,T2 ;SAY EITHER FILE OR DIRECTORY
HRROI T1,CRLF
CALL CSTR
MOVEM T2,TREBUF(Q1) ;STORE END POINTER
;MOVEI T3,TR.END
IDPB T3,T2 ;STORE END BYTE IN CASE WE DONT OVERWRITE
JFNLPE: AOBJN P5,JFNLOP ;ADVANCE TO NEXT JFN
;Done with all jfns. Clean up and stop.
SETZM OKIAE ;INTERRUPTS NOT WELCOME
SETZM JFN ;GET RID OF THIS
TXNN F,F.GOT1 ;DID WE GET ANYTHING?
JRST [WARN <No files dumped>
JRST DRPDMP] ;NO, GO CLEAN UP
CALL FINTAP ;YES, FINISH UP THE TAPE
SKIPN UNLFLG
JRST NUNLED
IFMT .+2
CALL UNLOAD
CALL MTCLS
NUNLED: SKIPN ARCCNT ;ANY ARCHIVAL PASS2 NEEDED?
SKIPA T4,DMPFLG ;NO, HOW ABOUT INCREMENTAL PASS2?
TDZA T4,T4 ;NEED ARCHIVAL PASS2 - 0 FLAGS THIS
TXNE T4,D.FINC!D.INC ;TEST FOR INCREMENTAL, SKIP IF UNNEEDED
SKIPA T1,LSTJFN ;NEED A PASS2, SKIP TO CHECKPOINT LIST FILE
JRST NPASS2 ;NO PASS2 OF ANY KIND NEEDED
MOVEM T4,TMP ;SAVE THE VALUE INDICATING KIND OF PASS2
JUMPE T1,NCHKLF ;IF NO LIST FILE, NO CHECKPOINT NEEDED
TXO T1,CO%NRJ ;CHECKPOINT, DON'T RELEASE
CLOSF%
ERJMPS .+1
MOVE T1,LSTJFN ;OK, REOPEN FOR FINAL STATS
CALL OPNLST ;..
JFCL ;LIST FILE DIDN'T REOPEN
NCHKLF: SKIPN TMP ;0 FOR ARCHIVAL, NONZERO FOR INCREMENTAL
CALL PASS2A ;DO ARCHIVAL. THIS ALWAYS GIVES +2
CALL PASS2I ;DO INCREMENTAL
NPASS2: SELECT LS.TTY+LS.LST ;LS.LST IGNORED IF LSTJFN IS 0, SO THIS WORKS
TYPE [ASCIZ/
Total files dumped: /]
MOVE T2,TOTFIL
MOVE T3,[NO%LFL+NO%OOV+^D10(6)]
CALL NUMOUT
TYPE [ASCIZ/
Total pages dumped: /]
MOVE T2,TOTCNT
CALL NUMOUT
SKIPN T2,DIRDMD
JRST DRPDMP
TYPE [ASCIZ/
Directories dumped: /]
CALL NUMOUT
TYPE CRLF
DRPDMP: SELECT LS.TTY
CALL ENDLIS
CALL DMPJFS
MOVX T1,.FHSLF
RUNTM%
SUB T1,DMPTIM
FLTR T2,T1
FDVR T2,[1000.0]
TYPE [ASCIZ/
CPU time, seconds: /]
CALL FLTOUT
JRST CMDEND
;Here to drop the jfns we had open
DMPJFS: SKIPN P5,NFJFN
RET
DRPJFL: SKIPE T1,JFNLST(P5)
CALL DRPJFA ;TOSS THE JFN
SETZM JFNLST(P5)
SKIPE T1,JF2LST(P5)
TRNE T1,1B18 ;ERROR CODE, NOT JFN?
JRST DRPJFE
CALL DRPJFA ;TOSS THE JFN
DRPJFE: SETZM JF2LST(P5)
AOBJN P5,DRPJFL
DRPJFF: SETZM NFJFN
RET
BEGUSR: SETZM USRCNT
SETZM NOFILS
SELECT LS.LST ;OUTPUT TO LIST FILE ONLY
TYPE CRLF2
TYPE OUTDIR
TYPE CRLF2
SELECT LS.TTY
RET
ENDUSR: SELECT LS.LST ;OUT TO LIST FILE ONLY
TYPE CRLF
MOVEI T2,FLCOL ;OUT TO THE FILE COLUMN
CALL TABOUT
SKIPN T2,NOFILS
JRST [TYPE [ASCIZ/No files/]
JRST EENDUS]
CALL DECOUT
TYPE [ASCIZ/ file/]
CAIE T2,1
TYPCHR "s"
TYPE [ASCIZ/, /]
MOVE T2,USRCNT
CALL DECOUT
TYPE [ASCIZ/ page/]
CAIE T2,1
TYPCHR "s"
EENDUS: TYPE CRLF
SELECT LS.TTY
RET
;Here to see if the current file is a candidate for dumping and DUMP IT TO TAPE.
DMPFIL: MOVE T1,JFN
MOVSI T2,.FBLEN
MOVEI T3,FDB ;GET FILE FDB
GTFDB%
JSERRD <>,.+1
MOVE T2,FDB+.FBCTL ;GET FILE FLAGS
SKIPN T3,DMPFLG ;GET DUMP FLAGS. IF NONE, NORMAL SAVE...
JRST NODPOB ;SO OBEY FB%NOD
TXNN T3,D.INC+D.FINC ;FULL OR INCREMENTAL?
TXZ T2,FB%NOD ;NO, ARCHIVE-TYPE SAVE, IGNORE NODUMP
NODPOB: TXNE T2,FB%DIR!FB%NXF!FB%NEX!FB%DEL!FB%TMP!FB%NOD;REASONS NOT TO SAVE
JRST SKIPDP ;REJECTED
MOVE T1,FDB+.FBCRE ;FETCH MODIFICATION DATE
CAMG T1,MBTAD ;NOT 'BEFORE'?
CAMGE T1,MSTAD ;NOT 'SINCE'?
JRST SKIPDP ;REJECT
MOVE T1,FDB+.FBWRT ;GET WRITE DATE
CAMG T1,WBTAD ;BEFORE
CAMGE T1,WSTAD ;SINCE
JRST SKIPDP ;REJECT
CAMGE T1,FDB+.FBREF
MOVE T1,FDB+.FBREF ;GET LATEST OF (READ, WRITE)
CAMG T1,ABTAD ;BEFORE
CAMGE T1,ASTAD ;SINCE
JRST SKIPDP ;REJECT
MOVE T1,DMPFLG
TXNN T1,D.FINC ;FULL INCREMENTAL? SKIP THIS CHECK
TXNN T1,D.INC ;NORMAL INCREMENTAL ONLY DOES NEXT BIT
JRST INCROK
HLRE T3,FDB+.FBBK0 ;GET TAPE COUNT AND FLAG
JUMPL T3,INCROK ;IF INCOMPLETELY DUMPED, MUST SAVE
HLRZ T2,FDB+.FBCNT ;GET # OF WRITES TO THIS FILE
HRRZ T4,FDB+.FBBK0 ;GET WRITE COUNT AT LAST SAVE
CAIN T2,(T4) ;SAME WRITE COUNT AS LAST SAVE?
CAIGE T3,(T1) ;YES, SAVED ENOUGH TIMES?
JRST INCROK ;TEST FAILS, MUST SAVE FILE
JRST SKIPDP
INCROK: SETZM ARCGST ;SAY NO ARCF INFO YET
TXNN T1,D.COL!D.MIG!D.ARC ;ARCH/MIG/COLLECTION RUN?
JRST DUMPME ;NO, NO MORE TESTS, GO DUMP
CALL ARCTST ;TEST FOR ARCHIVING CRIETRIA
JRST SKIPDP
;We have decided to dump the file.
;Get final bits of info and write file to tape
DUMPME: MOVE Q1,FDB+.FBHDR ;GET LENGTH
ANDI Q1,777 ;JUST THE LENGTH, PLEASE
HRROI T2,FDB(Q1) ;POINTER FOR GFUST STRING
MOVE T1,JFN
HRLI T1,.GFAUT ;GET AUTHOR
GFUST%
ERJMPS [SETZM (T2)
MOVE T1,JFN
JRST .+1]
ADDI Q1,10 ;ADVANCE FOR LAST WRITER
HRLI T1,.GFLWR
HRROI T2,FDB(Q1)
GFUST%
ERJMPS [SETZM (T2)
JRST .+1]
MOVE T1,JFN
MOVX T2,.ARGST
ADDI Q1,10 ;ADVANCE FOR ARCF% INFO
MOVEI T3,FDB(Q1)
MOVE T4,ARCGST ;DO WE HAVE THE ARCHIVING INFO ALREADY?
MOVEM T3,ARCGST ;YEA OR NEA, IT WILL END UP HERE
JUMPN T4,[ ;YES - BLT IT IN
HRL T3,T4
MOVEI T4,.ARPSZ(T3)
BLT T3,(T4)
JRST ARCIDN] ;END UP WITH ARCGST POINTING TO NEW PLACE
ARCF% ;NO - MUST GET
ERJMPS [SETZM (T3)
JRST .+1]
ARCIDN: ADDI Q1,.ARPSZ+1 ;IF MORE WERE STORED IT WOULD GO HERE
MOVEM Q1,ENDFDB ;REMEMBER WHERE IT ENDS
MOVE T1,JFN ;FETCH THE (NON-WILD) JFN
MOVX T2,OF%RD+OF%PDT ;BUT NOT OF%RDU, SINCE WE WANT TO SEE THE ERROR
OPENF% ;OPEN IT UP
OPENIN: ERJMPR OPNFRR ;CAN'T, TEST ERROR
JRST OPENOK ;GOT IT FIRST TRY
OPNFRR: CAIN T1,OPNX2 ;IGNORE NONEXISTANT FILES
JRST SKIPDP ;..
CAIN T1,OPNX31 ;OFFLINE FILES ARE OK..
JRST OPENOK ;SO ACT AS IF THIS WORKED
IFG FTVERS-4,<
CAIN T1,OPNX9 ;KEPT BECAUSE OF THAW-ACCESS READER?
JRST TRYTHW ;MAYBE, GO TRY
>
OPNCRR: WARN <Can't read >
CALL TYJFN ;TYPE FILENAME JFN'D IN JFN
CALL LSTERD ;SAY WHY
TYPE CRLF
JRST SKIPDP
IFG FTVERS-4,<
TRYTHW: MOVE T1,JFN ;TRY AN UNRESTRICTED READ!
MOVX T2,OF%RD+OF%RDU+OF%PDT
OPENF%
ERJMPR OPNCRR ;STILL WON'T WORK, QUIT
WARN <File > ;OK, BUT TELL USER THIS MAY CAUSE PROBLEMS
CALL TYJFN1
TYPE [ASCIZ/ needed to be opened UNRESTRICTED/]
>
OPENOK: TXON F,F.GOT1 ;WE FINALLY HAVE A FILE
CALL [CALL INIREC ;SO SET UP FOR OUTPUT
JRST BGNHEA] ;AND PUT UP THE SAVESET HEADER
CALL GOFNAM ;GENERATE THE OUTPUT NAME
AOS NOFILS ;INC NUMBER OF FILES THIS DIRECTORY
AOS TOTFIL ;AND GENERAL TOTAL
MOVE T1,DMPFLG ;ARCHIVE/COLLECTION/MIGRATION?
TXNE T1,D.COL!D.MIG!D.ARC
CALL ARC1 ;YES, GO SET ARCHIVE-TYPE INFO
HRROI T1,OUTSPC ;GET FULL OUTPUT FILESPEC
HRROI T2,FDBBUF ;PUT INTO FILE HEADER REC
CALL CSTRB
MOVE T1,T2 ;APPENDING TO FDBBUF
CALL GOFPAT ;GOFPAT ADDS ;Pnnnnnn;Afoobar;T as needed
SETZ T2,
IDPB T2,T1 ;TIE OFF STRING
;Stuff for FILES and DIRECTORIES
TXNN F,F.DIRT+F.FILT ;ARE WE DOING THEM?
JRST NOFIDR ;NO, SKIP ALL THIS
CALL SAVTXT ;SET UP TO SAVE TEXT, SET UP Q1, T2
SKIPE DDOFLG ;FIRST TIME THIS DIRECTORY?
TXNN F,F.DIRT ;CARE ABOUT DIRECTORIES?
JRST [TXNN F,F.FILT;NOT DOING DIRECTORY. DOING FILES?
JRST NOFIDR ;NOT DOING ANYTHING
JRST JFTYPE] ;WILL DO FILES
;At the beginning of a new directory. We need to put the output for
; the "DIRECTORIES" command up.
SETZM DDOFLG ;ONCE PER NEW INPUT DIRECTORY
HRROI T1,[BYTE(7) TR.DIR," "]
CALL CSTRB
TXNN F,F.NDIR ;WILL <OUTPUT> EQUAL <INPUT>?
JRST USRSAM
PUSH P,T2 ;SAVE THE BYTE POINTER
CALL GDIRNA ;GET THE INCOMING DIRECTORY NAME
POP P,T2 ;RESTORE IT
HRROI T1,INDIR ;FETCH INDIR
CALL CSTRB
HRROI T1,[ASCIZ/ (as) /]
CALL CSTRB
USRSAM: HRROI T1,OUTDIR
CALL CSTRB
HRROI T1,CRLF
CALL CSTR
TXNN F,F.FILT ;FILES AS WELL?
JRST FINFDT ;NO, CLOSE OFF STRING
JFTYPE: HRROI T1,[BYTE(7) TR.FIL," "," "," ",0]
CALL CSTRB ;ADD FILE START AND SPACES
MOVE T1,T2 ;JFNS WANTS IT IN T1
MOVE T2,JFN ;STORE FILENAME FOR "FILES" COMMAND
MOVE T3,[JFNSAL]
JFNS%
MOVE T2,T1
;Make at least a token attempt to avoid typing "(as) filename"
MOVE T3,DMPFLG ;SEE IF ARCHIVE/COLLECT/MIGRATION/INCREMENTAL
TXNE T3,D.INC!D.COL!D.ARC!D.MIG ;IS INPUT FILENAME ALWAYS = OUTPUT?
JRST NOOUSP ;YES, DON'T ADD OUTPUT SPEC
TXNE F,F.NDIR ;OK, IS OUTPUT WILD OR = INPUT?
JRST NEEDAS ;NO, MUST TYPE NEW NAME
MOVE T3,JF2LST(P5) ;FETCH THE OUTPUT WILDS
TXC T3,GJ%NAM!GJ%EXT!GJ%VER ;INVERT FOR SINGLE TEST...
TXNN T3,GJ%NAM!GJ%EXT!GJ%VER ;WERE THEY ALL ON?
JRST NOOUSP ;ALL WERE ON - SKIP THE (as)
NEEDAS: MOVE T2,T1 ;APPEND TO JFNS OUTPUT
HRROI T1,[ASCIZ/ (as) /]
CALL CSTRB
HRROI T1,OUTSPC ;THE OUTPUT FILENAME
CALL CSTR
JRST FINFDT ;AND DONE
NOOUSP: SETZ T1,
IDPB T1,T2
FINFDT: MOVEM T2,TREBUF(Q1) ;SO WE CAN APPEND TO IT LATER
MOVEI T1,TR.END ;IN CASE WE DON'T
IDPB T1,T2
NOFIDR: TXNE F,F.CHKS
CALL [SETZM CHKCN0 ;SET UP TO CHECKSUM THE FILE
SETZM LSTPGE ;TRACK PAGE NUMBER
JRST FILSZE] ;NEED FILE SIZE, SET IT UP
HRLZ T1,TOTFIL ;SET UP FILE NUMBER FOR HEADER
TXO T1,PG.NFN ;SET HISTORICAL BIT
MOVEM T1,TAPHEA+.PAGNO;STORE IN HEADER
HRROI T1,-FILEST ;SET UP A FILE HEADER
MOVEM T1,TAPHEA+.TYP
MOVEI T1,TAPHEA ;TO HEADER
MOVEI T2,FDBBUF ;AND TO 1000 WORD DATA
CALL ADDREC ;AND WRITE FILE HEADER TO TAPE
MOVE T1,VOLID6
MOVEM T1,ORGTAP ;SAVE TAPE FILE WAS STARTED ON
SKIPN LSTJFN ;LIST FILE?
JRST NOFLLI ;NO, SKIP THIS
SELECT LS.LST ;YES, WRITE TO IT
IFN FTMAIL,<
SKIPE MAILFL ;DOING A MAIL FILE?
TYPE [ASCIZ/*S/] ;SO WE CAN READ THE LIST FILE BACK AT NEED
>
MOVEI T2,FLCOL
CALL TABOUT ;GET TO THE FILE COLUMN
TYPE OUTSPC ;WHERE WE STORED THE OUTPUT FILENAME
SELECT LS.TTY
NOFLLI: SETZM FFREE ;NO HOLE YET
SETZB T1,CURREN ;AT FIRST PAGE
JRST DMPIN
DMPPGS: SOSLE PBHOLD ;ANY MORE TO PROCESS?
JRST GNFPIN ;YES, DO THE NEXT PAGE
DMPIN: CAMGE T1,FFREE ;AT THE BRINK OF A HOLE (OR DON'T KNOW)?
JRST KWNPS ;NO, SO CURREN HAS THE NEXT FILE PAGE #
HRL T1,JFN ;DETERMINE NEXT FILE PAGE #
FFUFP% ;..
ERJMPS ENDFIL ;NO MORE PAGES OR FILE NOT REALLY OPEN
HRRZM T1,CURREN ;OK, WE HAVE THE ADDR OF THE NEXT PAGE
KWNPS: MOVEI T2,PBSIZ ;FIGURE PAGE WE WILL READ TO, PLUS ONE
HRRZS T1 ;NEED JUST PAGE NUMBER
ADD T2,T1 ;WARNING: RESULT CAN BE .GT. 0,,-1
CAMGE T2,FFREE ;IS THERE A HOLE BEFORE THEN (OR DON'T KNOW)?
JRST KHISTW ;HOLE IS FURTHER ON, DON'T LOOK FOR IT
HRLZS T1 ;FFFFP WANTS PAGE # IN LF
HRR T1,JFN
FFFFP% ;FIND FIRST FREE PAGE (HOLE)
JSERRD <> ;DOESN'T HAPPEN
CAIGE T1,0 ;-1 MEANS NO HOLE (FILE AT MAX SIZE)..
SKIPA T1,[1,,0] ;SO SAY HOLE IS AT MAXPAGE + 1
HRRZS T1 ;CUT TO PAGE NUMBER
MOVEM T1,FFREE ;AND STORE FIRST FREE PAGE AHEAD
SUB T1,CURREN ;HOW MANY CAN WE GET?
CAILE T1,PBSIZ ;MORE THAN WE CAN TAKE?
KHISTW: MOVEI T1,PBSIZ ;YES, TAKE OUR MAX
MOVEM T1,PBHOLD ;THAT'S WHAT WE ARE GOING TO TAKE
MOVE T3,T1 ;INTO T3 FOR PMAP%
TXO T3,PM%CNT+PM%RD+PM%PLD ;ITS A COUNT, READ ACCESS, AND PRELOAD
MOVE T2,[.FHSLF,,PAGPAG] ;INTO THIS FORK, PAGPAG
MOVE T1,CURREN ;FILE PAGE AS MENTIONED
HRL T1,JFN
PMAP% ;FETCHEM!
JSERRD <>
MOVE T1,CURREN ;GET CURRENT PAGE NUMBER
SKIPA T2,[PAGBUF] ;THIS IS WHERE PAGPAG STARTS
GNFPIN: MOVE T2,WRDPNT
HRRM T1,TAPHEA+.PAGNO ;STORE PAGE NUMBER
MOVEI T3,1000(T2) ;GET ADDRESS OF NEXT PAGE FOR NEXT TIME
MOVEM T3,WRDPNT ;STORE
SETZM TAPHEA+.TYP ;RECORD TYPE 0 (DATA)
MOVEI T1,TAPHEA ;T1/ RECORD HEADER, T2/ DATA PAGE
CALL ADDREC ;OUT TO TAPE
TXNE F,F.CHKS ;WANT CHECKSUM?
CALL CHKSFF ;YES, DO IT
AOS USRCNT ;PAGES THIS DIRECTORY
AOS TOTCNT ;TOTAL PAGES
AOS T1,CURREN ;ADVANCE TO NEXT PAGE
TLNN T1,-1 ;UNLESS THERE ISN'T ONE (AT 0,,-1)
JRST DMPPGS
ENDFIL: SETO T1,
MOVE T2,[.FHSLF,,PAGPAG]
MOVE T3,[PM%CNT+PBSIZ]
PMAP%
MOVE T4,DMPFLG
TXNN T4,D.FINC!D.INC ;SOME SORT OF INCREMENTAL?
JRST NOINCR
;Update .FBBK0 if doing incrementals
;Format of .FBBK0: qB0+tape_writes,,filewrites_at_last_save
; where q is 1 if incompletely dumped.
;This code will set .FBBK0 to:
;LH: Number of times THIS version of the file has been written to tape (less
; this save, which we add in at the end of PASS 2 for this run)
; Also, 1B0 is set (meaning PASS 2 should note this file)
;RH: How many times this version was modified when it was saved this time.
; If this is different at the next incremental, we know the file has been
; modified in place and needs to be saved n more times.
HLRZ T2,FDB+.FBCNT ;GET NUMBER OF WRITES-ON-DISK
MOVE T3,FDB+.FBBK0 ;HOW MANY WRITES-ON-DISK AT LAST SAVE?
CAIE T2,(T3) ;IF THE SAME, DON'T RESTART "TIMES SAVED"
MOVE T3,T2 ;DIFFERENT - SAY SAVED 0 TIMES (LH OF .FBBK0)
TXO T3,1B0 ;SAY HALF-SAVED (2ND PASS NEEDED)
MOVE T1,JFN
HRLI T1,.FBBK0(CF%NUD);CHANGE .FBBK0, DON'T FORCE UPDATE
SETO T2,
CHFDB%
ERJMPS .+1
ADD T3,[1B0+1B17] ;APPEAR AS IF SAVED OK IN TAPE FDB
MOVEM T3,FDB+.FBBK0 ;ABOVE CLEARS 1B0 AND INCREMENTS THE COUNT
MOVE T3,ORGTAP
MOVEM T3,FDB+.FBBK1
SKIPE SUPMRK ;TRY TO RECORD TAPE WE STARTED SAVING THIS FILE
JRST NOINCA ;ON, UNLESS WE KNOW WE CAN'T
MOVE T1,JFN
HRLI T1,.FBBK1(CF%NUD);CHANGE .FBBK1, NO UPDATE
CHFDB%
ERJMPR FALSMK ;NOT ALL MONITORS ALLOW THIS
JRST NOINCA
FALSMK: CAIN T1,CFDBX2
SETOM SUPMRK ;THIS MONITOR DOESN'T ALLOW, SO DON'T TRY
JRST NOINCA
NOINCR: HRRZS FDB+.FBBK0 ;NO INCREMENTAL, JUST CLEAR TAPE_SAVE_COUNT
NOINCA: MOVE T1,JFN
TXO T1,CO%NRJ ;DROP THE FILE, KEEP THE JFN
CLOSF%
ERJMPS .+1
SKIPN LSTJFN
JRST NDMFLN
SELECT LS.LST
MOVEI T2,WTCOL
CALL TABOUT
MOVE T2,FDB+.FBWRT
CALL TADOUT
MOVEI T2,SZCOL
CALL TABOUT
HRRZ T2,FDB+.FBBYV
CALL DECOUT
TXNE F,F.CHKS ;DOING CHECKSUM?
CALL PRTCSM ;FINE, PRINT IT
TYPE CRLF
SELECT LS.TTY
NDMFLN: MOVE T1,[FDB,,FDBBUF];FOR LORD ONLY KNOWS WHAT REASON,..
MOVE T2,ENDFDB ;THE FILE TRAILER REC HAS A DIFFERENT
BLT T1,FDBBUF(T2) ;FORMAT THAN THE FILE LEADER, SO WE HAVE
MOVEI T1,FDBBUF+1(T2) ;TO SHIFT EVERYTHING UP
SETZM (T1) ;CLEAR THE REST
HRLI T1,1(T1)
MOVSS T1
BLT T1,FDBBUF+777
;FOR THE "FILES" COMMAND
TXNN F,F.FILT
JRST NOFILT
CALL SAVTXT ;WE WANT TO <CRLF> AT OUTPUT TIME
HRROI T1,[BYTE(7)TR.FIL,.CHCRT,.CHLFD,0]
CALL CSTR
MOVEM T2,TREBUF(Q1)
MOVEI T1,TR.END
IDPB T1,T2
NOFILT: HRROI T1,-FILEEN ;OUTPUT THE FILE TRAILER
MOVEM T1,TAPHEA+.TYP ;WRITING FILE TRAILER
MOVEI T1,TAPHEA
MOVEI T2,FDBBUF
JRST ADDREC
SKIPDP: CALL TSTINT
JRST BAKOUT
IFG REEVAL*<FTVERS-5>,<
TXNE F,F.GOT1 ;ANY OUTPUT YET?
SKIPN DMPCHA ;ANYTHING WANTING TO GO OUT?
RET ;NO OUTPUT PENDING, QUIT
CALL CHKBLK ;TAPE DRIVE IDLE?
JUMPN T3,CPOPJ ;..?
JRST DOOUT ;YES, RETURN THROUGH DOOUT
>
IFLE REEVAL*<FTVERS-5>,<
RET
>
;FLAGS AND COMMAND STUFF FOR DUMP
;NONE OF THESE SHOULD HURT REGISTERS BEYOND T1-T4 and F
;THESE RETURN TO DUMPPF
$UNLSW: SETOM UNLFLG
JRST DUMPPF
$NINC: TXO F,F.NDIR ;INHIBIT USER DATA
JRST DUMPPF
$ARC: MOVX T1,D.ARC
JRST SDMPSW
$COL: MOVX T1,D.COL
JRST SDMPSW
$FINC: MOVX T1,D.FINC
TXO F,F.DDIR ;THIS TAKES DIRECTORY DATA
JRST SDMPSW
$INC: MOVEI T2,1 ;ASSUME ONE
TXNN T1,CM%SWT ;SWITCH TERMINATOR? (DOES A VALUE FOLLOW?)
JRST $INC2
DMOVE T1,[EXP CMDBLK,INCINB]
CALL PARSE
JSERRD <>,NOCMD,JRST
$INC2: SKIPG T1,T2 ;LEGAL?
ERROR <Tape count must be greater than zero>
TDNE T1,[-D.INC-1] ;LEGAL VALUE?
MOVEI T1,D.INC ;TOO BIG, GO FOR BIGGEST
TXO F,F.DDIR ;THIS WANTS DIRECTORY DATA
JRST SDMPSW
$MIG: MOVX T1,D.MIG
;JRST SDMPSW
SDMPSW: TXNN F,F.PRIV ;ALLOWED TO DO THIS?
JRST OPRERR ;ERROR, NEED OPR PRIVES FOR THESE
SKIPE DMPFLG ;ANYTHING ALREADY SET?
ERROR <Switch combination illegal>
MOVEM T1,DMPFLG
CALL SETSTP
JRST DUMPPF
;Enter with T1/ DMPFLGs - set SAVETP for ADDREC
SETSTP: SETZ T4,
TXNE T1,D.COL
MOVSI T4,(1B2)
TXNE T1,D.ARC
MOVSI T4,(2B2)
TXNE T1,D.MIG
MOVSI T4,(3B2)
MOVEM T4,SAVETP ;STORE THIS FOR ADDREC
RET
DMPINB: <.CMSWI>B8+DM2INB
EXP DMPSWI
DMPSWI: NDSWTB,,NDSWTB
CTB $ARC, <ARCHIVE>, CM%INV
CTB $COL, <COLLECT>, CM%INV
CTB $FINC, <FULL-INCREMENTAL>
CTB $INC, <INCREMENTAL:>
CTB $MIG, <MIGRATE>, CM%INV
CTB $NINC, <NOINCREMENTAL>
CTB $UNLSW, <UNLOAD>
NDSWTB==.-DMPSWI-1
DM2INB: <.CMFIL>B8
INCINB: <.CMNUM>B8+CM%SDH+CM%DPP+CM%HPP
^D10
-1,,[ASCIZ/The number of tapes each file must be on/]
-1,,[ASCIZ/1/]
CCFINB: <.CMCMA>B8+.+1 ;COMMA
<.CMCFM>B8+.+1 ;CONFIRM
<.CMFIL>B8+CM%SDH+CM%HPP ;OR FILE
BLOCK 1
-1,,[ASCIZ/filename to use on tape/]
CCINB: <.CMCMA>B8+.+1 ;COMMA
<.CMCFM>B8 ;OR CONFIRM
;Support for DUMP
;BGNHEA starts the tape with the "SAVESET start" record.
BGNHEA: TXNE F,F.FILT+F.DIRT ;IF DOING ANY REPORTING, START WITH <CRLF>
TYPE CRLF
SKIPA T1,[-SAVEST]
;CONHEA writes a continued tape header out and does the normal
; things needed when starting a tape
CONHEA: HRROI T1,-CONTST
STHEAD: MOVEM T1,TAPHEA+.TYP ;PUT IN HEADER TYPE
MOVEI T1,CURFMT
MOVEM T1,SSNBUF+SV.FMT;FORMAT NUMBER IN
MOVE T1,BGNTAD ;PICK UP THE STARTING DATE
MOVEM T1,SSNBUF+SV.TAD;IN IT GOES
MOVE T1,VOLID6 ;MOVE IN THE VOLID
MOVEM T1,SSNBUF+SV.VOL;..
MOVEI T1,.EDIT
MOVEM T1,SSNBUF+SV.EDT;REMEMBER WHICH VERSION WROTE THIS
MOVEI T1,SV.MSG
MOVEM T1,SSNBUF+SV.PNT;POINTER TO SAVESET NAME IN
MOVEI T1,TAPHEA ;NOW POINT TO HEADER
MOVEI T2,SSNBUF ;AND PAGE WITH SAVESET NAME
JRST ADDREC ;IT IN GOES
;GOFNAM creates the outgoing filename based on JFN and JF2LST(P5).
; Result to OUTSPC
GOFNAM: CALL GOFDIR ;GET STR:<DIR>, RETURN PNTR IN T1 TO END
MOVEM T1,OUTFLS ;SAVE NAME POINTER
MOVE T2,JF2LST(P5) ;CHECK MOST COMMON CASE
TXC T2,GJ%NAM+GJ%EXT+GJ%VER ;COMP TO TEST IF ALL ON
TXNN T2,GJ%NAM+GJ%EXT+GJ%VER ;ALL OFF NOW?
JRST [MOVE T2,JFN ;YES, DO REST FROM INPUT JFN
MOVX T3,1B8+1B11+1B14+JS%PAF ;NAME, EXT, VER WITH PUNCTUATION
JFNS% ;STRING IT OUT
RET] ;AND LEAVE FAST
MOVX T4,GJ%NAM ;NAME
MOVX T3,1B8+JS%PAF
CALL GOFJNS
MOVX T4,GJ%EXT ;EXTENSION
MOVX T3,1B11+JS%PAF
CALL GOFJNS
MOVX T4,GJ%VER ;GENERATION #
MOVX T3,1B14+JS%PAF
;JRST GOFJNS ;GET GEN # AND RETURN FROM GOFNAM
GOFJNS: TDNN T4,JF2LST(P5) ;OUTPUT * HERE?
SKIPN T2,JF2LST(P5) ;NO, USE OUTPUT FIELD
HRRZ T2,JFN ;PICKUP INPUT FIELD
JFNS%
RET
;Gens the output STR:<DIR> and stores it in OUTDIR and OUTSPC.
; Returns OUTDRS pointing to the end of the string in OUTSPC (and also in
; T1). If OUTDRS is nonzero, it assumes it was already called and returns
; it in T1. If calling at GOFDRS, it always sets up OUTDIR, OUTSPC, and
; OUTDRS regardless of the value of OUTDRS.
GOFDIR: SKIPE T1,OUTDRS ;ALREADY KNOWN?
RET ;YES, FORGET IT
GOFDRS: HRROI T1,OUTDIR
MOVX T4,GJ%DEV+GJ%UNT;DEVICE
MOVX T3,1B2+JS%PAF
CALL GOFJNS ;DO JFNS
MOVX T4,GJ%DIR ;DIRECTORY
MOVX T3,1B5+JS%PAF
CALL GOFJNS
HRROI T1,OUTDIR
HRROI T2,OUTSPC
CALL CSTRB
MOVEM T2,OUTDRS
MOVE T1,T2
RET
;Get File Protection, Account string, and ;T
GOFPAT: TXNE F,F.INTR ;INTERCHANGE MODE?
JRST GOFPT1 ;YES, DON'T USE TAPE PROTECTION
MOVX T4,GJ%PRO ;PROTECTION FIELD
MOVX T3,1B17+JS%PAF
TXNE F,F.RPRO ;USE SYSTEM DEFAULT?
CALL GOYJNS ;NO, USE OURS
GOFPT1: MOVX T4,GJ%TFS ; ;T
MOVX T3,<JS%TMP+JS%PAF>
CALL GOXJNS ;GET ;T
MOVEM T1,OUTACS ;REMEMBER WHERE ACCOUNT STARTS
MOVX T4,GJ%ACT ;ACCOUNT
MOVX T3,1B20+JS%PAF
TXNE F,F.RACC ;USE SYSTEM DEFAULT?
CALL GOXJNS ;NO-- GET SPECIFIED VALUE
RET
GOXJNS: TXNE F,F.INTR ;INTERCHANGE MODE?
TDNE T4,JF2LST(P5) ;YES-- BUT IS OUTPUT SPECIFIED?
JRST .+2 ;OUTPUT SPECIFIED OR NOT INTERCHANGE-- OK
RET ;INTERCHANGE MODE AND NO OUTPUT SPEC-- USE SYSTEM DEFAULT
GOYJNS: TDNE T4,JF2LST(P5) ;OUTPUT SPECIFIED HERE?
SKIPN T2,JF2LST(P5) ;YES, USE OUTPUT FIELD
HRRZ T2,JFN ;PICKUP INPUT FIELD
JFNS%
RET
;Make sure the CURRENT buffer is set up to type text at the time when it is
; deleted. Return the pointer to write to in T2. If RELPGT is called to
; kill the buffer, text set up for here is typed out. Used by DMPFIL, DMPUSR.
;This returns Q1 pointing to the current buffer header (ie, contains CURBLK)
SAVTXT: MOVE Q1,CURBLK ;FIND CURRENT BUFFER
SKIPE T2,TREBUF(Q1) ;ANY TEXT STORED IN "TYPE WHEN DEL'ING" YET?
RET ;YES, RETURN WHERE TO APPEND TO
MOVE T2,Q1 ;NO
ADD T2,BUFFRE ;FIND OUT WHERE IT GOES
SETZM (T2) ;MAKE SURE NOTHING THERE YET
HRLI T2,(POINT 7) ;BYTE POINTER
MOVEM T2,TRPBUF(Q1) ;STORE START OF STRING
MOVEM T2,TREBUF(Q1) ;AND WHERE TO ADD TO
RET
;Get file size for checksumming purposes
FILSZE: MOVEI T4,FDB
FILSZA: LDB T1,[POINT 6,.FBBYV(T4),11]
MOVEI T2,44 ;BITS IN A WORD
IDIV T2,T1 ;BYTES IN A WORD
MOVE T3,.FBSIZ(T4) ;BYTES IN FILE
IDIV T3,T2 ;WORDS IN FILE
CAIE T4,0 ;SKIP IF NO REMAINDER
ADDI T3,1
IDIVI T3,1000 ;PAGES IN FILE
MOVEM T3,FPGCNT ;FILE PAGE COUNT
MOVEM T4,RMRPGE ;REMAINDER PAGE
RET
;Here for checksum of page. Call with T2 pointing at the page, and
; TAPHEA+.PAGNO set up (Ie, call after ADDREC)
CHKSFF: MOVEM T2,SUMTMP
TXNE F,F.CSEQ ;SKIP IF NOT SEQUENTIAL CHECKSUM
JRST SEQCSM ;DO SEQUENTIAL CHECKSUM
HRRZ T4,TAPHEA+.PAGNO;GET PAGE #
SUB T4,LSTPGE ;SEE IF HOLE
SOJLE T4,PCHKS1 ;JUMP IF NO HOLE
MOVNI T2,(T4) ;YES, GET -PAGE #
HRL T2,T4 ;MAKE IT PAGE #,,-PAGE #
HRROI T3,T2 ;POINT AT T2, ONE WORD
CALL CHKSOM ;CHECKSUM 1 WORD
PCHKS1: MOVSI T3,-1000 ;SETUP AOBJN POINTER TO WHOLE PAGE
HRR T3,SUMTMP
CALL CHKSOM ;CHECKSUM FILE BUFFER
HRRZ T1,TAPHEA+.PAGNO;GET PAGE #
MOVEM T1,LSTPGE ;STORE
RET ;DONE WITH PAGE
;HERE FOR SEQUENTIAL CHECKSUM
SEQCSM: SOSGE FPGCNT ;DECREMENT WHOLE PAGE CONT
JRST SEQCS1 ;NO WHOLE PAGES LEFT
MOVSI T3,-1000 ;WORDS TO CHECKSUM
HRR T3,SUMTMP
JRST CHKSOM ;CHECKSUM PAGE
SEQCS1: SKIPN T3,RMRPGE ;GET REMAINDER TO CHECK
RET ;NOTHING TO CHECK
MOVNS T3 ;NEGATE WORDS TO CHECK
HRLZS T3 ;...
HRR T3,SUMTMP ;POINT AT BUFFER
SETZM RMRPGE ;DON'T CHECK AGAIN
;JRST CHKSOM ;DO CHECKSUM OF LAST PAGE
;Here to checksum words pointed to by T3 (aobjn word)
CHKSOM: MOVE T4,CHKCN0
CHKSM1: ROT T4,1
ADD T4,(T3)
AOBJN T3,CHKSM1 ;LOOP ON WORD COUNT
MOVEM T4,CHKCN0
RET
;Print the checksum to the list file
PRTCSM: MOVEI T2,CSCOL ;CHECKSUM COLUMN
PRTCS2: CALL TABOUT ;TAB TO CHECKSUM
HLRZ T2,CHKCN0
HRRZ T3,CHKCN0
ADD T3,T2 ;MAKE IT 18-BITS WORTH
HLRZ T2,T3 ;...
ADDI T2,(T3) ;...
MOVE T3,[NO%LFL+NO%ZRO+^D8(6)]
CALL NUMOUT
TXNN F,F.CSEQ ;SKIP IF SEQUENTIAL CHECKSUM
TYPE [ASCIZ/ P/] ;FLAG AS BY-PAGES CHECKSUM
RET
;Archive specific stuff
ARCTST: MOVE T2,FDB+.FBCTL
TXNE T2,FB%OFF ; File offline?
RET ; Yes, skip it
MOVE T4,DMPFLG
TXNN T4,D.ARC
JRST ARCTS1 ; No, must be Migration/Collection
MOVE T2,FDB+.FBBBT
TXNN T2,AR%RAR ; Archive requested?
RET ; No, skip it
JRST ARCTS3 ; Yes, go on with check
ARCTS1: MOVE T2,FDB+.FBBBT
TXNE T2,AR%RIV ; Migration request?
JRST ARCTS3 ; Explict request, cont. with test
TXNE T4,D.COL
TXNE T2,AR%RAR ; Archive requested already?
RET ; Yes, skip it
HLRZ T2,FDB+.FBNET ; Get online expiration
HLRZ T1,BGNTAD ; Get day at start of COLLECTION run
CAIGE T1,(T2) ; File expired?
RET ; No (& does have exp. date)
JUMPN T2,ARCTS2 ; Expired date if non-zero--dump it
MOVE T1,FDB+.FBCRE ; Interval, find most recent date
CAMG T1,FDB+.FBCRV
MOVE T1,FDB+.FBCRV
CAMG T1,FDB+.FBWRT
MOVE T1,FDB+.FBWRT
CAMG T1,FDB+.FBREF
MOVE T1,FDB+.FBREF
HRRZ T2,FDB+.FBNET ; Get the interval
HLRZS T1
ADD T2,T1 ; Form expiration date
HLRZ T1,BGNTAD ; Get day at start of COLLECTION run
CAIG T1,(T2) ; Expired?
RET ; No, skip it
ARCTS2: TXNN T4,D.AOEF ;ARCHIVE ONLINE EXPRIED FILES?
JRST ARCTS3 ;NO
CALL NSETS ;SET ARSETS TO # OF TIMES PUT ON TAPE
JUMPN T1,ARCTS3 ;FINE, SKIP ON
MOVE T1,JFN ;ARCHIVE IT
MOVEI T2,.ARRAR
MOVEI T3,.ARSET
ARCF%
ERJMPS CPOPJ
RET ;OK, MARKED FOR ARCHIVE, RETURN
ARCTS3: CALL NSETS ;HOW MANY TIMES ARCHIVED? INTO T1
MOVE T2,FDB+.FBBBT
TXNE T2,AR%1ST ;IF AR%1ST ON, IGNORE INVALID TAPE INFO
JUMPG T1,[SOS T1,ARSETS;CORRECT ARSETS FOR IGNORED SET
JRST @.+1]
JRST @[EXP CPOPJ1, ARCONE, CPOPJ](T1)
;Check for the 2nd tape being the same as the first, if so, don't archive the
; file to the same tape. Defeating this check does no good, as ARCF% checks
; as well.
ARCONE: MOVE T2,ARCGST ;WHERE THE ARCHIVE INFO IS (FROM NSETS)
MOVE T2,.ARTP1(T2) ;FOR 2ND RUN, CHECK FIRST TAPE NAME
CAME T2,VOLID6 ;1ST TAPE # = 2ND TAPE #?
JRST CPOPJ1 ;NO, OK TO DUMP
RET ;YES, DEFER DUMP TILL ANOTHER TAPE
;NSETS WILL COUNT UP THE NUMBER OF TIMES A FILE'S BEEN ARCHIVED TO TAPE (0,1,2)
; This also sets up ARCINF/ARCGST at need.
NSETS: SKIPE T2,ARCGST ;WHERE THE ARCF% INFO FOR THIS FILE IS
JRST NSETSS ;..
MOVE T1,JFN ;OH. WELL, LET'S GET IT NOW
MOVX T2,.ARGST
MOVEI T3,ARCINF
ARCF%
JSERRD <NSETS> ;BETTER NOT HAPPEN
NSETSA: MOVEI T2,ARCINF
MOVEM T2,ARCGST
NSETSS: SETZB T1,ARSETS ;ASSUME NONE
SKIPE .ARTP1(T2) ;FIRST ONE THERE?
AOS T1,ARSETS ;YES, NOTE THAT
SKIPE .ARTP2(T2) ;HOW ABOUT THE 2ND TAPE?
AOS T1,ARSETS ;THAT ONE TOO
RET
;FOR ARCHIVE/COLL./MIG. RUN, SET TAPE INFO AND AR%1ST
;Call with DUMP flags (DMPFLG) in T1
ARC1: SETZM ARSSTB+.AROFL ; Set up block
MOVX T2,AR%ARC ; Flag archive?
TXNE T1,D.ARC
MOVEM T2,ARSSTB+.AROFL; Yes
MOVE T3,TOTFIL ;SET UP THE SAVESET,,FILENUMBER WORD
HRL T3,ARCTSN ;.. INTO T3
MOVE T1,VOLID6 ;STORE VOLID HERE...
MOVE T4,ARCGST ;AND POINT TO ARCF INFO IN FDB TAPE RECORD
SKIPE ARSETS ;SET BY CALL TO ARCTST. FIRST ARCHIVE RUN?
JRST ARCP2 ;NO
ARCP1: MOVX T2,AR%O1 ;YES, IN 1ST TAPE SLOTS
IORM T2,ARSSTB+.AROFL;FLAG FIRST RUN
MOVEM T1,ARSSTB+.ARTP1;STORE VOLID NAME
MOVEM T3,ARSSTB+.ARSF1;AND SAVESET,,FILE #
MOVEM T1,.ARTP1(T4) ;AND STORE IN TAPE ARCF BLOCK AS THOUGH..
MOVEM T3,.ARSF1(T4) ;..THE ARCF WORKED OK
JRST ARCFR
ARCP2: MOVX T2,AR%O2
MOVEM T2,ARSSTB+.AROFL;FLAG SECOND RUN
MOVEM T1,ARSSTB+.ARTP2;STORE VOLID NAME
MOVEM T3,ARSSTB+.ARSF2;AND SAVESET,,FILE #
MOVEM T1,.ARTP2(T4) ;AND STORE IN TAPE ARCF BLOCK AS THOUGH..
MOVEM T3,.ARSF2(T4) ;..THE ARCF WORKED OK
ARCFR: SETZM ARSSTB+.ARODT
MOVE T1,JFN
CALL NXTINC ;NEXT INCREMENTAL SHOULD SEE CHANGE
HRLI T1,.FBBBT ;SET AR%1ST IN .FBBBT
MOVX T2,AR%1ST ;TO MARK ARC./COL./MIG. FOR THIS FILE
MOVE T3,T2 ;IN PROGRESS
CHFDB%
ERJMPS ARC1ER
ARC1A: MOVEI T2,.ARSST ;CODE FOR SET ARCHIVE STATUS
MOVEI T3,ARSSTB ;ARG BLOCK FOR .ARSST
ARCF% ;SET ARCHIVE STATUS
ERJMPS ARC1ER
MOVX T2,AR%1ST+AR%RAR+AR%RIV ;WRITE FDB ON TAPE AS IF THE ARCHIVE
ANDCAM T2,FDB+.FBBBT ;RUN HAD COMPLETED SUCCESSFULLY!
AOS T2,ARCCNT ;WE DID ANOTHER ONE, COUNT IT FOR PASS2A
SOJN T2,CPOPJ ;IF NOT 1ST TIME, DONE
HRRZ T2,T1 ;IT IS, REMEMBER THE FILENAME FOR PASS2A
MOVE T3,[JFNSAL] ;ALL CHARACTISTICS
HRROI T1,FSTARC ;TO FSTARC
JFNS%
RET ;NOW PASS2A KNOWS WHERE TO START
ARC1ER: WARN <Can't set Archive status (>
CALL LSTERR
TYPE [ASCIZ/) on /]
JRST TYJFN
PASS2I: MOVE P5,NFJFN
CALL IFCRL2
TYPE [ASCIZ/ Starting Incremental Pass 2
/]
PASSIB: MOVE T2,JF2LST(P5) ;HAUL OUT PARSE ONLY JFN
TRNE T2,1B18 ;ERROR, NOT REAL?
JRST PASSIE ;FINE, SKIP IT
HRROI T1,STRING ;WHERE TO STORE
MOVE T3,[JFNSAL] ;ALL ATTRIBUTES
JFNS% ;GET THE NAME WRITTEN
MOVX T1,GJ%OLD+GJ%IFG+GJ%XTN
MOVEM T1,GTJBLK+.GJGEN
MOVX T1,G1%IIN
MOVEM T1,GTJBLK+.GJF2
MOVE T1,[.NULIO,,.NULIO]
MOVEM T1,GTJBLK+.GJSRC
HRROI T2,STRING
MOVEI T1,GTJBLK
GTJFN%
JSERRD <PASS2I>,BAKOUT
MOVEM T1,P2JFN
PASSIS: HRRZ T1,P2JFN
MOVE T2,[XWD 1,.FBBK0]
MOVEI T3,T3
GTFDB%
JUMPGE T3,PASSIN
ADD T3,[1B0+1B17] ;CLEAR DUMP-IN-PROGRESS, INC TAPE COUNT
MOVSI T2,-1 ;GET MASK FOR BITS TO CHANGE
HRLI T1,.FBBK0(CF%NUD) ;NO UPDATE DIRECTORY
CHFDB%
PASSIN: MOVE T1,P2JFN
GNJFN%
ERJMPS PASSIE
JRST PASSIS
PASSIE: AOBJN P5,PASSIB
TYPE [ASCIZ/ End of Pass 2./]
RET
;Do the archival pass2. This is done at the end of the Archive saveset
; (also Collection/Migration.) The Incremental pass2 is done elsewhere.
;Always gives a +2 return
PASS2A: HRROI T2,FSTARC ;FIRST FILE ARCHIVED, PLEASE
MOVX T1,GJ%OLD+GJ%XTN
MOVEM T1,GTJBLK+.GJGEN
MOVX T1,G1%IIN
MOVEM T1,GTJBLK+.GJF2 ;INCLUDE INVISIBLES
MOVE T1,[.NULIO,,.NULIO]
MOVEM T1,GTJBLK+.GJSRC
MOVEI T1,GTJBLK
GTJFN%
ERJMPS [MOVX T1,GJ%OLD+GJ%IFG+GJ%XTN
;CAN'T. START FROM THE BEGINNING...
MOVEM T1,GTJBLK+.GJGEN;ALLOWING WILDCARDS
GTJFN%
JSERRD <PASS2A>,P2DON1 ;THAT'S ABSURD
JRST .+1]
HLL T1,JFNLST+0 ;GIVE IT SAME WILDNESS AS INPUT JFN
MOVEM T1,P2JFN ;SAVE IT BY NAME
;The above works because we have restricted the legal wildcarding in the input
; jfn enough to MAKE it work.
CALL IFCRLF
TYPE [ASCIZ/ Archival Pass 2 started
/]
MOVE T4,T1 ; Keep bits returned by GNJFN
SCNLU1: HRRZS T1 ; Clear bits for GTFDB
MOVE T2,[1,,.FBBBT] ;GET FLAG BITS
MOVEI T3,T2 ; INTO T2
GTFDB%
ERJMPS SCNLU2
MOVEM T2, FDB+.FBBBT ;YES, SAVE FLAG BITS
TXNN T2,AR%1ST ;ARCH./COLL. IN PROGRESS FOR THIS FILE?
JRST SCNLU3 ;NO, NOTHING TO DO HERE
HRRZ T1,P2JFN
MOVEI T2,.ARGST ;GET TAPE INFO
MOVEI T3,ARCINF ;INTO ARCINF
ARCF%
JSERRD <>,SCNLU3
MOVEM T3,ARCGST
MOVE T3,NVOLID
MNYATP: MOVE T2,VOLID6(T3) ; TAPE ID OF CURRENT TAPE
CAME T2,ARCINF+.ARTP1; THERE AS TAPE 1?
CAMN T2,ARCINF+.ARTP2;OR AS TAPE 2?
JRST DOFXBK ; YES, DO FIXUP
SOJGE T3,MNYATP ;NO, MAYBE ANOTHER TAPE?
JRST SCNLU3 ; NOT OF THIS RUN--SKIP IT
DOFXBK: CALL ARFXBK ;NOTE ARCHIVE RUN COMPLETED FOR FILE
SCNLU2: SOSG ARCCNT ;GOT THEM ALL?
JRST P2DON1 ;IF SO, QUIT OUT
SCNLU3: MOVE T1,P2JFN
GNJFN% ;STEP JFN
ERJMPS P2DON1 ;ALL DONE IF NO MORE
JRST SCNLU1
P2DON1: HRRZ T1,P2JFN
RLJFN% ;THROUGH WITH PASS 2 JFN
JFCL
P2DONE: TYPE [ASCIZ/ Pass 2 completed.
/]
JRST CPOPJ1 ;*ALWAYS* GIVE +2
ARFXBK: MOVE T1,P2JFN
CALL NXTINC ;TRY TO INSURE NEXT SAVE/INCR GETS IT
HRLI T1,.FBBBT(CF%NUD);SET AR%1ST TO ZERO
MOVX T2,AR%1ST ;CLEAR JUST THIS BIT (NXTINC DOES T3/ 0)
CHFDB%
JSERRD <ARFXBK>
ANDCAM T2,FDB+.FBBBT
CALL NSETSA ;DETERMINE ARSETS= #SETS ARCH INFO
CAIE T1,2 ;2ND RUN?
RET ;NO, DONE
MOVE T3,FDB+.FBBBT ; Get backup bits
TXNE T3,AR%NDL ; Delete on disk not allowed?
JRST ARFXB1 ; Right, skip delete
MOVX T1,DF%CNO!DF%NRJ;Delete disk contents only
HRR T1,P2JFN
DELF%
ERJMPS [MOVX T2,AR%NDL
IORM T2, FDB+.FBBBT
JRST .+1]
ARFXB1: MOVE T1,P2JFN ;GET JFN
MOVX T2,.ARRAR ;CODE FOR SET/CLEAR ARCH REQUESTS
MOVE T4,FDB+.FBBBT
TXNE T4,AR%RIV
MOVEI T2,.ARRIV ; Migration request
MOVEI T3,.ARCLR ; Clear it
ARCF%
ERJMPS .+1
IFN FTINVI,<
TXNN T4,AR%NDL ;FLUSH NOT ALLOWED?
TXNN T4,AR%RAR ; User request the archive?
JRST NOINVS
MOVE T1,P2JFN
HRLI T1,.FBCTL
MOVX T2,FB%INV ; Change invisible bit
MOVE T3,T2
CHFDB% ;FLUSHED & USER REQUESTED ARCHIVE
ERJMPS .+1 ;FAILURE SHOULD NOT BE DISASTROUS
NOINVS: >
IFE FTUSAG,<
RET
>
IFN FTUSAG,<
CALL USAINI ; Init USAGE block here
HRRZ T1,P2JFN
MOVE T2,[1,,.FBBBT]
MOVEI T3,STRING ;GET THIS FILES .FBBBT INTO STRING
GTFDB% ;GET ENTIRE FDB FOR THIS
MOVE T4,DMPFLG
MOVX T1,.UTARC ;ASSUME ARCHIVAL
TXNE T4,D.MIG ;MIGRATION
MOVX T1,.UTMIG
TXNE T4,D.COL ;COLLECTION
MOVX T1,.UTCOL
HRRM T1,USABLK ; Store entry type
HRRZ T1,STRING ;Get # pages that were in the file
MOVEM T1,USABLK+10
MOVEI T1,ARCINF ; Point to tape info blk
CALL USATAP ; And spray it into the USAGE blk
LDB T2,[POINT 7,STRING,17] ;GET REASON OFFLINE
MOVEM T2,USABLK+26 ; Add reason code to blk
HRRZ T2,P2JFN ; JFN of file in question
HRROI T1,USASTR ; Structure of the file
MOVX T3,1B2
JFNS%
HRROI T1,USADIR
MOVX T3,1B5
JFNS%
MOVE T1,T2 ; JFN
HRROI T2,USAACT ; Account of the file
GACTF%
JRST GDONBE ;FAILED, OH WELL
JRST GDONBE ;WORKED, FINE
MOVEM T2,USABLK+2 ;NUMERIC RESULT, SAY SO
MOVX T2,US%IMM
IORM T2,USABLK+1
GDONBE: MOVE T1,[POINT 7,USASTR]
CALL ASCSIX ;CONVERT TO 6BIT
MOVEM T2,USASSI
MOVEI T1,.USENT
MOVEI T2,USABLK
USAGE%
ERJMPS .+1
RET
USAINI: MOVE T1,[VUSABL,,USABLK]
BLT T1,USABLK+NUSABL-1
RET
;Drop tape info into USAGE blk. T1 should point to ARCF style block.
USATAP: MOVE T2,.ARTP1(T1) ;TAPE 1 ID
MOVEM T2,USABLK+12
HLRZ T2,.ARSF1(T1) ;SAVESET NUMBER (TSN)
MOVEM T2,USABLK+14
HRRZ T2,.ARSF1(T1) ;FILE NUMBER (TFN)
MOVEM T2,USABLK+16
MOVE T2,.ARTP2(T1) ;TAPE 2 ID
MOVEM T2,USABLK+20
HLRZ T2,.ARSF2(T1)
MOVEM T2,USABLK+22
HRRZ T2,.ARSF2(T1)
MOVEM T2,USABLK+24
RET
VUSABL: USENT. (.-.,1,0) ; Type to be filled in, version
USACT. (USAACT,,^D39) ; Account string
USSSI. (USASSI) ; Structure name
USDIR. (USADIR,,^D39) ; Directory name
USUSG. (.-.,US%IMM,6) ; # pages 000000-999999
USTP1. (.-.,US%IMM,6) ; Tape 1 ID
USTS1. (.-.,US%IMM,4) ; Tape 1 saveset #
USTF1. (.-.,US%IMM,6) ; Tape 1 tape file #
USTP2. (.-.,US%IMM,6) ; Tape 2 ID
USTS2. (.-.,US%IMM,4) ; Tape 2 saveset #
USTF2. (.-.,US%IMM,6) ; Tape 2 tape file #
USRSN. (.-.,US%IMM,1) ; Reason offline line code
>
;Call with JFN in T1. Tries to insure file is picked up on next incremental.
NXTINC: PUSH P,T1 ;SAVE JFN
HRLI T1,.FBBK0(CF%NUD);NO IMMEDIATE UPDATE
MOVSI T2,377777 ;RESET COUNT OF TIMES TAPED..
SETZ T3, ;TO ZERO
CHFDB%
ERJMP .+1 ;OH WELL
POP P,T1 ;RESTORE JFN AND LEAVE
RET
SUBTTL Tape Output
;Here with a pointer to a header block in T1 and a 1000 word data buffer in T2.
; This adds the record represented by the above two pointers to the output
; list.
;Call INIREC once before calling this.
;ADDREC and friends all assume that MTJFN and friends are set up and valid.
; ie, they just take the JFN from MTJFN and don't call GMTJFN unless they
; run out of tape. Returns T1 and T2 as pointers to Header and 1000 word buffer
; and T3 as number of logical records that can still fit in this physical
; record.
;ADDREC maintains the value of INFILE
ADDREC: DMOVEM T1,ADDTMP
CALL TSTINT
JRST BAKOUT ;ABORTING!
TXO F,F.NORD+F.BLKF ;MAYN'T READ OR CHANGE BLOCKING FACTOR
SKIPG BLKCNT ;TIME FOR A NEW BUFFER YET?
CALL ADDCHI ;YES, ADD CURRENT BUFFER TO CHAIN & DO OUTPUT
MOVE T1,ADDTMP ;POINTER TO HEADER BLOCK
TXNN F,F.INTR ;IF INTERCHANGE, LET ICONCV DO SEQUENCE NUMBERS
TXNE F,F.NSEQ ;SEQEUNCING IN EARNEST?
TDZA T4,T4 ;NO SEQUENCE NUMBER IF N.SEQ OR F.INTR
AOS T4,WRISEQ ;DO NORMAL SEQUENCING
MOVEM T4,.SEQ(T1) ;PUT IN THE SEQUENCE NUMBER
MOVE T4,TAPENO ;GET THE TAPE NUMBER
HRL T4,SAVENO ;GET THE SAVESET NUMBER
OR T4,SAVETP ;AND THE SAVESET TYPE
MOVEM T4,.TAPNO(T1) ;PUT IT ALL IN
DMOVE T3,ADDTMP ;POINT TO HEADER & DATA
SETZM .CHKSM(T3) ;NO CHECKSUM YET
MOVN T1,.TYP(T3)
MOVEM T1,LASTYP ;STORE FOR DEBUGGING
CAIN T1,FILEST ;IF A CONTST WOULD REQUIRE A BOGUS FILEST..
SETOM INFILE ;MARK THE FACT
CAIN T1,FILEEN ;ENDING FILE?
SKIPGE .PAGNO(T3) ;NOT IF CONTINUED FLAG LIT
TRNA
SETZM INFILE ;CLEAR THE FLAG
TXNE F,F.INTR ;INTERCHANGE DOES IT DIFFERENTLY
JRST [CALL DMPICO
JRST WRINTR] ;RECORD TRANSLATED, GO DECREMENT COUNT TO 0
IFN FTCHKS,<
MOVX T1,FL.HIS
>
IFE FTCHKS,<
IF1,<PRINTX DUMPERs previous to v500 cannot read the tapes this DUMPER writes>
MOVX T1,FL.NCK+FL.HIS
>
MOVEM T1,.FLAG(T3) ;SET HIST. FLAGS (& NO CHECKSUM HERE IF NEEDED)
IFN FTCHKS,<
CALL CHKSUM ;COMPUTE CHECKSUM
SETCAM T1,.CHKSM(T3) ;STORE RESULT
>
HRLZ T3,T3
HRR T3,BLKPNT ;T3/ POINTER TO DATA,,WHERE IT GOES
MOVEI T4,5(T3) ;WHERE TO STOP
BLT T3,(T4) ;IN GOES THE HEADER
MOVEI T3,1(T4)
HRL T3,ADDTMP+1 ;T3/ POINTER TO 1000 WORD DATA,, WHERE IT GOES
MOVEI T4,777(T3) ;WHERE TO STOP
BLTING: BLT T3,(T4) ;IN GOES THE 1000 WORD DATA
ADDI T4,1
MOVEM T4,BLKPNT ;WHERE NEXT DATA WOULD GO
WRINTR: SOS T3,BLKCNT ;LESS ONE LOG RECORD, RETURN # LEFT
DMOVE T1,ADDTMP ;RETURN WHERE HEADER, 1000 BFR IN T1,T2
RET ;RECORD STORED, GO ON
;Here to set up a new phys. record (and dump one already set up, if any).
ADDCHI: SKIPN CURBLK ;DO WE HAVE A RECORD?
JRST NOTDMP ;NO, GET GET A RECORD AND GO BACK
CALL ADDCHA ;ADD NEW PHYS. REC. ONTO THE CHAIN
IFG <REEVAL>*<FTVERS-5>,< ;;ONLY IF REEVAL .GT. 1 & V6 OR LATER MONITOR
AOS BFRCNT
AOS BFRCNI
CALL CHKBLK ;WOULD OUTPUT BLOCK NOW?
JUMPE T3,IDLE ;NO. WE BLEW IT. GO DO SOME OUTPUT.
;DRIVE IS STILL BUSY. GOOD.
SOSLE SAFECT ;SHOULD WE JUST BLOCK?
JRST NOTDMP ;SHOULD BE ABLE TO SQUEEZE ANOTHER BUFFER
MOVE T1,BFRCNT
IDIVI T1,REEVAL ;THE REEVAL-TH BUFFER?
JUMPN T2,NOMEM ;NO
MOVX T1,<1B1>
MOVEM T1,BFRCNI ;THIS REPRESENTS BRAVERY
JRST DODMP ;WE'D BETTER DO I/O NOW
IDLE: MOVE T1,BFRCNI ;HOW MANY CAUSED AN IDLE?
SUBI T1,1
MOVEM T1,SAFECT ;THAT MANY SHOULD BE SAFE
NOMEM: SETZM BFRCNI ;AND START COUNTING AGAIN
> ;END IFG REEVAL
DODMP: CALL DOOUT ;WRITE OUT A PHYSICAL RECORD
SKIPN EOTLCK
TXNN F,F.EOT ;OUT OF TAPE?
JRST NOTDMP ;NO, RUN ON NORMALLY
;Here when, after writing a record, we discover that we are very near
; the end of the tape. It's time to write a "to next tape" record and
; put up the next tape if possible.
ATEOT: SETOM EOTLCK ;SAY DOING THIS CODE (F.EOT MEANINGLESS)
HRLZ T1,ADDTMP ;TUCK HEADER AWAY
HRRI T1,SAVHEA
BLT T1,SAVHEA+NHEAD-1
CALL WAITFN ;MAKE SURE LSTDMP GETS WRITTEN
SKIPE T1,LSTDMP ;AND DELETE IT
CALL RELPGT
SETZM LSTDMP ;..
PUSH P,ENDPNT ;SAVE CHAIN HEAD AND TAIL, STARTING NEW CHAIN
PUSH P,DMPCHA ;NEW CHAIN CONTAINS TONEXT
PUSH P,WRISEQ ;SAVE SEQ
PUSH P,ADDTMP
PUSH P,ADDTMP+1 ;SAVE HEADER POINTERS
TXO F,F.NSEQ
SETZM DMPCHA ;SAY "EMPTY CHAIN"
HRROI T1,-TONEXT
MOVEM T1,TAPHEA+.TYP ;RECORD OF TYPE "TO NEXT TAPE"
MOVEI T1,TAPHEA
MOVEI T2,SCRBUF
CALL ADDREC ;ADD THE "TO NEXT TAPE" RECORD
CALL FILBLK ;ADD FILLERS, STOP TAPE
HRROI T1,-TAPEEN ;FOR READAHEAD AND OLD DUMPERS
MOVEM T1,TAPHEA+.TYP
MOVX T1,PG.CON!PG.NFN;"TO NEXT TAPE" & "NO FILE #" FOR OLD DUMPER
MOVEM T1,TAPHEA+.PAGNO
MOVEI T1,TAPHEA
MOVEI T2,SSNBUF
CALL ADDREC ;ADD RECORD PRESERVING OUR VALUE IN .FLAG
CALL FILBLK
IFLAB NOEOTW ;IF LABELED, DON'T WRITE EOT
CALL WRIEOF ;EOF AND..
CALL WRIEOF ;EOF AGAIN FOR EOT (FOR OTHER SOFTWARE)
NOEOTW: SKIPE LSTJFN ;GOT A LIST FILE?
CALL NTLIST ;YES, DO STUFF FOR NEXT TAPE
AOS T1,NVOLID ;HOW MANY EXTRA VOLIDS? FOR PASS2A
MOVE T2,VOLID6
MOVEM T2,VOLID6(T1) ;COPY INTO SLOT
CALL NXTTAP ;GET THE NEXT TAPE UP! (CHANGES MANY THINGS)
CALL GMOJFO ;INSURE WE GOT A TAPE OF SOME KIND
JRST BAKOUT ;WE CAN'T - VERY BAD!
CALL MTBOT ;AT BEGINNING OF NEW TAPE
MOVE T1,MTJFN ;FOR GETVOL
;**;[540] INSERT 1 LINE AT NOEOTW:+12.L DSW 4/28/86
SKPMTA ;[540] DON'T GET VOLID IF ASSIGNED TAPE
CALL GETVOL ;DISCOVER NEW VOLUME NAME
CALL PROVOL ;MAKE SURE WE HAVE ONE
CALL ANEWT ;ANNOUNCE NEW TAPE UP
CALL CONHEA ;WRITE THE CONTINUED TAPE HEADER
SKIPN INFILE ;NEED A BOGUS FILEST HERE?
JRST NOFILB
HRROI T1,-FILEST
MOVEM T1,TAPHEA+.TYP ;YES, SET ONE UP
MOVX T1,PG.CON!PG.NFN
MOVEM T1,TAPHEA+.PAGNO;SAY CONTINUED
MOVEI T1,TAPHEA ;..
MOVEI T2,FDBBUF ;IF INFILE=-1, THIS SHOULD STILL BE CORRECT
CALL ADDREC ;WRITE IT
NOFILB: CALL FILBLK ;PAD THE RECORD, DUMP IT
TXZ F,F.NSEQ ;BACK TO NORMAL SEQUENCE NUMBERING
POP P,ADDTMP+1
POP P,ADDTMP ;RESTORE HEADER/BUFFER POINTERS
POP P,WRISEQ ;BACK TO NORMAL SEQUENCE NUMBER
POP P,DMPCHA ;NOW CONTINUE THE OLD CHAIN
MOVSI T1,SAVHEA ;RESTORE SAVED HEADER
HRR T1,ADDTMP
MOVEI T2,NHEAD-1(T1)
BLT T1,(T2) ;..
TXNE F,F.INTR ;IF INTERCHANGE, DON'T FIX TAPE NUMBERS
JRST EFIXTN ;..
MOVX T3,FL.NCK ;CHANGING CHECKSUMS, SET THIS
SKIPA T1,DMPCHA ;FOR EACH ELEMENT IN THE CHAIN
FIXTPN: MOVE T1,NXTBUF(T1) ;(FOR NEXT ELEMENT)
JUMPE T1,EFIXTN ;IF IT EXISTS...
MOVEM T1,FIXTMP ;SAVE IT FOR ADVANCING LATER
MOVE T2,WRIBKF ;AND FOR EACH LOG. BUFFER IN EACH ELEMENT..
FTAPNO: AOS DATAST+.TAPNO(T1) ;UP THE TAPE NUMBER
IORM T3,DATAST+.FLAG(T1) ;TURN OFF CHECKSUMMING
SETZM DATAST+.CHKSM(T1) ;CLEAR FOR GOOD MEASURE
ADDI T1,NHEAD+1000 ;AND ADVANCE TO NEXT LOG. BUFFER
SOJG T2,FTAPNO ;AND WHEN NO MORE LOGICAL BUFFERS
MOVE T1,FIXTMP ;RESTORE THE ELEMENT
JRST FIXTPN ;AND TRY TO ADVANCE TO THE NEXT ONE
EFIXTN: POP P,ENDPNT
SETZM EOTLCK ;EOT GONE NOW
;AND CONTINUE CALL TO GET THE NEW BUFFER FOR CALLER
NOTDMP: MOVE T1,BUFPAG ;# OF PAGES NEEDED TO HOLD A PHYS. RECORD
CALL GETPGS
JRST DODMP ;NO MEMORY, START WRITING BUFFERS
MOVEM T2,CURBLK ;THE BLOCK WE ARE WORKING ON NOW
ADDI T2,DATAST
MOVEM T2,BLKPNT ;WHERE TO START STORING DATA FOR TAPE
MOVE T1,WRIBKF ;NUMBER OF LOG. RECORDS THAT WILL FIT
MOVEM T1,BLKCNT
RET
ADDCHA: MOVE T2,CURBLK ;TAKE THE BLOCK WE JUST FINISHED
SKIPN DMPCHA ;ARE THERE BUFFERS QUEUED?
JRST ADDCH1 ;NO, GO SET DMPCHA AND ENDPNT
MOVE T3,ENDPNT ;GET THE END POINTER
MOVEM T2,NXTBUF(T3) ;AND ADD NEW BLOCK IN
JRST .+2 ;GO SET ENDPNT
ADDCH1: MOVEM T2,DMPCHA
MOVEM T2,ENDPNT ;NEW BLOCK IS THE END POINT
SETZM CURBLK ;WE HAVE NO CURRENT BLOCK NOW
RET
;These write the first buffer on the list (DMPCHA) out. Errors are handled.
; They return when the buffer is queued for output, with the buffer so queued
; in T1. This deletes buffers that have gotten out to tape safely.
DOOUT: SKIPA T2,[DM%NWT+RECCMD]
DOOUB: MOVEI T2,RECCMD
SKIPN T1,DMPCHA ;SET UP TO WRITE 1ST QUEUED BUFFER
RET ;CHAIN IS EMPTY; WHY WERE WE CALLED?
ADDI T1,DATAST-1 ;POINTER TO THE DATA, LESS ONE
HRRM T1,RECCMD ;THE LH HAS THE NEG. COUNT ALREADY
TXO F,F.NBOT ;NOT AT BOT ANYMORE
MOVE T1,MTJFN
DUMPO%
ERJMPR WRIERR ;SOMETHING WENT WRONG SOMEWHERE
IGNERR: MOVE T1,DMPCHA ;GET ENTRY JUST DUMPED
EXCH T1,LSTDMP ;STORE AS LAST DUMPED; GET LAST DUMPED
CAIE T1,0 ;WAS THERE A LAST DUMPED RECORD?
CALL RELPGT ;YES, IT'S SAFELY OUT TO TAPE, DELETE IT
;Note RELPGT, not REPLGS. The only difference is that, if there is any
; "type me at delete time" text in the buffer, it gets typed.
MOVE T1,DMPCHA ;NOW ADVANCE DMPCHA ONE
MOVE T2,NXTBUF(T1) ;..
MOVEM T2,DMPCHA ;..
SETZM FILIOC ;SAY "DID SOME TAPE OUTPUT"
RET ;AND DONE
WRIERR: CALL TSTINT ;TRYING TO STOP?
JRST BAKOUT ;HE ABORTED
CAIN T1,DUMPX3 ;CAN'T PROCESS REQUEST?
ERROR <Not enough monitor space for this BLOCKING-FACTOR>
CAIN T1,OPNX8 ;OFFLINE?
JRST OFFLIN ;GO HANDLE
PUSH P,T1 ;SAVE THE ERROR CODE
CALL XGDSTS ;STATUS INTO T2
POP P,T1 ;GET CODE BACK
TXNE T2,MT%ILW ;WRITE ON WRITE LOCKED DRIVE?
JRST WRIPRO ;YES, GO HANDLE
TXNE T2,MT%DVE ;OFFLINE?
JRST OFFLIN
TXNE T2,MT%EOT ;EOT WARNING?
JRST EOTWRN ;YES, REMEMBER THE WARNING
TXNE T2,MT%DAE ;DEVICE/DATA ERROR THAT WAY
JRST DATERR
TXNE T2,MT%NSH
ERROR <Illegal data mode or density for this controller>
;**;[543] Change one line at EOTWRN:-1: DEE 20-NOV-86
JSERRD <Fatal DUMPO% error>,BAKOUT,JRST ;[543]DON'T IGNORE DUMPO ERROR
EOTWRN: CALL CLRERR
TXON F,F.EOT ;FLAG WE'VE SEEN THIS
JRST DOOUB ;IT'S NEW, REDO LAST REQUEST
JRST IGNERR ;WE KNOW ALREADY, JUST GO ON
OFFLIN: CALL OFFLNE
JRST ERRGO
;**;[544]Change one line at OFFLNE:+1L DEE 2-24-87
;**;[546]Change 1 line at OFFLNE:1L DEE 1-APR-87
;**;[547]Add one line at OFFLNE:+1L DEE 2-Apr-87
;**;[553] Rework OFFLNE: DEE 28-Aug-88
OFFLNE: CALL CLRERR
WARN <> ;[553] Need a % sign
;**;[555] Change one line at OFFLNE+2 GAS 20-Sep-88
HRROI T1,[ASCIZ/Tape went offline or encountered device error/] ;[555]
JRST TRYAGA
WRIPRO: IFMTA WRLMTA ;MTA WE HANDLE OURSELVES
ERROR <Tape is write protected.
>,.+1
TYPE [ASCIZ\ DISMOUNT tape and MOUNT it again with /WRITE-ENABLE\]
JRST BAKOUT ;HIGHLY FATAL
WRLMTA: HRROI T1,[ASCIZ/Tape is WRITE-PROTECTED/]
CALL TRYAGA
JRST ERRGO
ERRGO: CALL CLRERR
SKIPN T1,LSTDMP
MOVE T1,DMPCHA
JRST ERRGO2
DATERR: CALL CLRERR ;STOP TAPE, CLEAR ERRORS
SKIPN T1,LSTDMP ;REDO THE LAST BUFFER
MOVE T1,DMPCHA ;THERE ISN'T ONE? THEN VERY FIRST ATTEMPT FAILED
WARN <Data write error in record >
MOVE T2,DATAST+.SEQ(T1)
CALL DECOUT
AOS T2,ERRCNT(T1) ;HOW MANY TIMES HAS THIS FAILED?
MOVEI T3,^D14
TXNE F,F.EOT ;BEFORE OR AFTER PHYS EOT?
MOVEI T3,^D4 ;AFTER, ALLOW LESS RETRIES
CAIL T2,(T3) ;BAD PROBLEMS WRITING TAPE?
JRST [WARN <Excessive retries in writing record, continuing...>
JRST DOOUT] ;ASSUME ONE WILL BE READABLE, AND GO ON
ERRGO2: ADDI T1,DATAST-1 ;BUILD THE IOWD STUFF
HRRM T1,RECCMD
MOVE T2,[DM%NWT+RECCMD]
MOVE T1,MTJFN ;OK, WRITE THE FAILED RECORD
DUMPO%
ERJMPR WRIERR ;TRY AGAIN, THEN
JRST DOOUT ;AND TRY TO GET CHAIN GOING AGAIN
;Here to get next tape
NXTTAP: AOS TAPENO
NXTTPE: CALL IFCRL2
TYPE <[ASCIZ/ [ At End of tape /]>
;**;[538] At NXTTPE:+2L, Replace 2 lines with 9 SM 31-Jan-86
MOVE T2,TAPENO ;[538] Set up to type old tape number
SUBI T2,1 ;[538] Account for increment above
CALL DECOUT ;[538] Spew it
SKIPN VOLID ;[538] Do we have a real volid?
JRST TYNVOL ;[538] No, no need to type it
TYPE [ASCIZ/ (/] ;[538] Yes, paren it so it stands out
TYPE VOLID ;[538] type it
TYPCHR ")" ;[538] close paren
TYNVOL: TYPE [ASCIZ/ at /] ;[538] OK, lead in to current time
SETO T2,
CALL TADOUT
TYPE <[ASCIZ/ ] /]>
SETZM REASEQ
SETZM LSTSEQ
SETZM WRISEQ
SETZM REABKF
IFMTA NXTTPR
TYPE <[ASCIZ/[ Requesting next tape volume ]/]>
NXTTPR: DISPAT NXTMTA,NXTUMT,NXTLMT ;MTA, UNLABELED MT, LABELED MT
NXTMTA: CALL UNLMTA ;UNLOAD THE CURRENT TAPE
PUSH P,OPNFOR ;REMEMBER MODE OPENED IN
CALL DRPTAP ;CLOSE CURRENT TAPE
CALL REQMTA ;GET THE NEW TAPE REQUESTED
JRST [TXNE F,F.ABT
JRST BAKOUT
JRST NXTTPR] ;CAN'T GET NEW TAPE
POP P,OPNREQ ;RESTORE MODE AS REQUEST
CALL GMOJFQ ;AND REOPEN THE WAY IT WAS
JRST [TXNE F,F.ABT ;DID USER ABORT?
JRST BAKOUT ;YES, JUST BUGOUT
JRST NXTTPR] ;CAN'T!
JRST NVURFS ;CLEAR ERROR AND RETURN
NXTLMT: MOVE T1,OPNFOR ;OPEN FOR READ OR WRITE?
TXNN T1,OF%WR ;..?
JRST NVURFS ;READ, JUST GO ON, VOL SWITCH IS AUTOMATIC
MOVEI T3,[EXP 2,.VSFLS] ;DO THE VOL SWITCH WE DEFFERED
JRST NXTQMT
NXTUMT: MOVEI T3,[EXP 3,.VSMRV,1] ;ARG LIST TO GET TO NEXT VOLUME
NXTQMT: MOVE T1,MTJFN ;GET JFN
MOVEI T2,.MOVLS ;VOLUME-SWITCH MTOPR FUNCTION CODE
MTOPR%
JSERRD <Can't switch to next tape volume>,MTCLS
NVURFS: CALL MTBOT
TYPE CRLF
JRST CLRERR ;CLEAR ERRORS AND RETURN
;Set up before calling ADDREC for the first time this command.
INIREC: MOVEI T1,1006 ;SIZE OF DUMPER RECORD
TXNE F,F.INTR
MOVEI T1,1040 ;INTERCHANGE RECORDS ARE LARGER
IMUL T1,WRIBKF
MOVN T2,T1
HRLZM T2,RECCMD ;-SIZE OF PHYS. RECORD,,0
ADDI T1,DATAST+1 ;HOW BIG A BUFFER DO WE NEED?
MOVEI T2,1(T1) ;POINT TO UNUSED SPACE IN BUFFER
MOVEM T2,BUFFRE ;SAVE FOR USE WITH STRINGS
LSH T1,-9 ;DIVIDE BY 1000 FOR PAGE COUNT
ADDI T1,1 ;AND ONE TO COVER REMAINDER
MOVEM T1,BUFPAG ;STORE NUMBER OF PAGES FOR USE WITH GETPGS
MOVX T1,<1B1> ;LARGE POSITIVE NUMBER
MOVEM T1,BFRCNI ;INIT THE "OUTPUT CLEVERNESS" CODE
SETZM EOTLCK ;NOT AFTER EOT
SETZM CURBLK ;NO CURRENT BUFFER YET
SETZM LSTDMP ;NO LAST BUFFER
SETZM BLKCNT ;NO LOG. REC'S MADE YET
CALL KILCHN
TXO F,F.NORD ;MAY NOT READ UNTIL REWIND NOW
SETZM BFRCNT ;SAY NONE OUTPUT YET
SETZM NVOLID ;NO EXTRA VOLIDS KNOWN YET
SETZM FILIOC ;SAY NO FILES EXAMINED YET
MOVE T1,REASEQ ;GET A SEQUENCE NUMBER THAT ISN'T LIKE PREVIOUS
CAMGE T1,WRISEQ
MOVE T1,WRISEQ ;TAKE MAX(REASEQ,WRISEQ,LSTSEQ)
CAMGE T1,LSTSEQ
MOVE T1,LSTSEQ
JUMPE T1,IN2REC ;FIRST REC# CAN BE 1
ADDI T1,MAXBKF+1 ;INSURE GREATER THAN LAST RECORD, AND..
TRO T1,0777 ;ROUND UP BY 1000, LESS 1
IN2REC: MOVEM T1,WRISEQ ;THIS IS INCREMENTED BEFORE USE
RET
;Here to fill out the current record with null records and dump the whole
; chain. This should return with the tape fully written and stopped.
FILBLK: SKIPN BLKCNT ;IS THE CURRENT RECORD FULL?
JRST ADDCUR ;FINE, ADD IT IF IT EXISTS
HRROI T1,-FILL
MOVEM T1,TAPHEA+.TYP ;HEADER OF TYPE FILL
FILBL2: MOVEI T1,TAPHEA ;POINTER TO FILLER RECORD
MOVEI T2,SCRBUF ;MEANINGLESS PAGE ADDRESS
CALL ADDREC ;PUT IT IN
JUMPG T3,FILBL2 ;GO UNTIL FULL
ADDCUR: SKIPE CURBLK ;IS THERE A CURRENT BLOCK?
CALL ADDCHA ;ADD IT IN
DMPREM: SKIPN T1,DMPCHA ;ANYTHING IN THE CHAIN?
JRST FILDNE ;NO, FINISH UP
CALL TSTINT
JRST BAKOUT
CAMN T1,ENDPNT ;ABOUT TO WRITE THE LAST RECORD?
JRST DMPFNL ;YES, DIFFERENT
CALL DOOUT ;OUT THE NEXT IN THE LIST
JRST DMPREM
DMPFNL: CALL DOOUB ;BLOCK FOR THE LAST WRITE
MOVE T1,ENDPNT
CALL RELPGT ;LAST RECORD SAFELY ON TAPE, KILL IT.
SETZM DMPCHA ;CHAIN IS EMPTY
FILDNE: SETZM CURBLK ;NO CURRENT BLOCK
SKIPE T1,LSTDMP
CALL RELPGS
SETZM LSTDMP
RET
SUBTTL Tape Input
;GETREC returns T1/ addr of header T2/ addr of 1000 word buffer T3/ positive
; record type. +1 always (dispatches to BAKOUT on serious errors).
;The following flags are used here:
; F.NORD - no reading is done (dispatch to GETOUT); F.INTR - convert from
; BACKUP mode; F.BACK - reading backwards, errors are different;
; F.FAKE - set internally, fake record made up; F.NSEQ - no checksumming done
; F.NVOL - no volume switching done, return TONEXT if seen.
; If reading backwards, TAPEEN and TONEXT are ignored.
SKPREC: TXZ F,F.FAKE
GETREC: CALL TSTINT ;INTERRUPT? GO HANDLE
JRST BAKOUT ;USER DECIDED TO ABORT
TXNE F,F.NORD ;IS READING OK?
JRST [CALL IFCRL2 ;NO, ABORT THE COMMAND
TYPE [ASCIZ/ End of tape./]
JRST GETOUT] ;THIS IS QUITE LIKE BAKOUT
SKIPN REABKF ;FIRST TIME?
JRST FIRREA ;YES, GO DO FIRST READ
SOSGE BLKCNT ;ANY MORE RECORDS IN THIS BUFFER?
JRST ADVCHI ;GO IN A PHYS RECORD
MOVE T4,BLKPNT ;GET THE CURRENT POINTER
MOVEM T4,CURHEA ;SAVE
TXNE F,F.FAKE
JRST [SETZM BLKCNT ;ONLY ONE LOG. RECORD HERE
JRST NORINR] ;AND ITS NEVER INTERCHANGE FORMAT
IFN FTIND,<
TXNE F,F.36MD ;INDUSTRY MODE CONVERSION NEEDED?
CALL W36CNV ;YES, GO TO IT
>
TXNN F,F.INTR ;INTERCHANGE MODE?
JRST NORINR ;NO, FINE
TXNN F,F.CIRC ;YES, GOT A CONVERTED BUFFER ALREADY?
JRST [CALL INTDMC ;NO, DO THE %$#@?! CONVERSION NOW
JRST ADVCHI ;NEED NEXT BUFFER
JRST SKPREC] ;GOT IT, REPROCESS
NORINR: MOVEI T4,6(T4) ;NO, GET ADDRESS OF DATA...
MOVEM T4,CURDAT ;STORE IT
MOVEI T4,1000(T4) ;AND ADVANCE THE POINTER THIS WAY
MOVEM T4,BLKPNT
MOVE T1,CURHEA ;FETCH OUR HEADER
MOVN T2,.TYP(T1) ;FETCH THE TYPE
CAIL T2,0
CAILE T2,MAXTYP ;LEGAL?
JRST [WARN <Bad record type>
CALL ANNSEQ
JRST SKPREC]
MOVEM T2,LASTYP
JRST @[EXP CHKCKS,SVSETC,FILSTC,OLDNXT,TAPSTP,CHKCKS
EXP SVSETA,TAPFIL,JMPTAP](T2)
SVSETA: PUSH P,T1
MOVE T1,MTJFN
;**;[540] INSERT 1 LINE AT SVSETA:+2.L DSW 4/28/86
SKPMTA ;[540] DON'T GET VOLID IF ASSIGNED TAPE
CALL GETVOL ;MAKE SURE WE KNOW THIS
POP P,T1
;Here on a SAVESET header read
SVSETC: MOVE T3,CURDAT
MOVE T4,SV.FMT(T3) ;FETCH FORMAT NUMBER
TLNN T4,-1 ;CHECK FOR LEGALITY
CAIGE T4,4 ;..
JRST [WARN <Illegal value for FORMAT, assuming 4>
MOVEI T4,4
JRST .+1]
MOVEM T4,FORMAT ;SAVE IT
MOVE T3,CURHEA
MOVE T3,.TAPNO(T3)
HRRZM T3,TAPENO ;SAVE TAPE NUMBER
HLLZ T4,T3 ;COPY TO GET SAVE TYPE BITS
TLZ T4,077777 ;CLEAR SAVESET NUMBER
MOVEM T4,SAVETP ;STORE SAVEST TYPE
LDB T4,[POINT 15,T3,17]
MOVEM T4,SAVENO ;SAVESET NUMBER
CAIE T4,0 ;0 MEANS MUNDANE TAPE TYPE
MOVEM T4,ARCTSN ;ARCHIVE SAVESET NUMBER, LAST SEEN
JRST CHKCKS
;Here on a FILEST. We copy the filename to LSTSEN for ^A.
FILSTC: MOVEI T3,LSTSEN
HRL T3,CURDAT
BLT T3,LSTSEN+FDBOFF-1
JRST CHKCKS
;Here on a FILL. It could be an EOF mark (F.EOF lit), meaning end of saveset,
; or it could be trash, meaning the rest of the record is null.
TAPFIL: TXNE F,F.EOF ;EOF?
JRST CHKCKS ;YES, PASS IT BACK (IT'S SAVEEN)
TOSREC: SETZM BLKCNT ;NO, REST OF RECORD IS TRASH
JRST SKPREC ;SO TOSS IT
;Here on a tape end record - back up to before it
TAPSTP: TXNE F,F.BACK ;READING BACKWARDS?
JRST TOSREC ;YES, FINE, GO ON
SKIPGE .PAGNO(T1) ;IS THIS A KIND OF TONEXT?
JRST OTHNXT ;YES, TREAT IT AS SUCH
TXO F,F.NORD ;NO, NO MORE READS
DMOVEM T1,GEITMP ;SAVE T1 AND T2
CALL WAITFN ;WAIT TILL WE HIT END RECORDS
IFLAB NOBACK ;IF LABELED, THE READ PUT US 'TWEEN EOF+EOT
CALL BACKSP ;NOT, BACK OVER EXTRA RECORD
CALL BACKSP ;BACK OVER TAPPEN RECORD
NOBACK: DMOVE T1,GEITMP
JRST CHKCKS ;RESTORE T1 AND T2
;Here on a File end record - old DUMPERs did TONEXT this way
OLDNXT: SKIPL .PAGNO(T1) ;SEE IF "CONTINUE" LIT
JRST CHKCKS ;NO, GO ON
OTHNXT: MOVEI T2,TONEXT ;YES, ITS A TONEXT RECORD
MOVEM T2,LASTYP
;Here on a TONEXT record - either return record or get next tape
JMPTAP: TXNE F,F.BACK ;READING BACKWARDS?
JRST TOSREC ;YES, IGNORE THIS UTTERLY
TXZN F,F.NVOL ;DID HE SAY "DON'T VOLSWITCH?"
JRST UPTAPE ;NO, GO TO IT
;Here after processing by record type
CHKCKS: TXZE F,F.EOF ;SEE EOF THAT TIME?
TXOA F,F.OEOF ;YES, SAY LAST WAS EOF
TXZ F,F.OEOF ;NO, SAY NOT
TXZE F,F.FAKE
JRST GETRET ;ITS A FAKE RECORD, SKIP THE REST
MOVE T1,CURHEA
MOVE T4,.TAPNO(T1) ;DO WE KNOW THE TAPE NUMBER?
SKIPG TAPENO
HRRZM T4,TAPENO ;WE DO NOW
IFN FTCHKS,<
PAT04A: DMOVE T3,CURHEA ;GET CURHEA AND CURDAT
MOVE T1,.FLAG(T3) ;WAS THIS RECORD CHECKSUMMED?
TXNN F,F.BACK+F.INTR+F.NSEQ ;NO CHECKSUM WHEN BACKING UP OR INTR.
TXNE T1,FL.NCK ;OR ASKED NOT TO BY WRITER OF TAPE
JRST GETRET ;SKIP CHECKSUM
CALL CHKSUM ;DO THE CHECKSUM
JUMPE T1,GETRET ;0 IF OK
WARN <Bad checksum>
CALL ANNSEQ ;ANNOUNCE ERROR
>
GETRET: CALL TSTINT ;HANDLE ^E INTERRUPT
JRST BAKOUT ;ABORTED!
DMOVE T1,CURHEA ;GET ADDRESSES
MOVE T3,LASTYP ;AND TYPE
RET ;AND DONE
;First time code. We purposely read a record with a huge count to force a
; "wrong count" error, since that way we can determine the record size. This
; tells us if it's a DUMPER tape, BACKUP tape, or nonsense tape, and also gives
; us the blocking factor. We also try to deal with bypassed labels on tapes
; here. An error on reading the 1st record is bad news, since so much depends
; on it, hence we have separate error routines for this part.
FIRREA: MOVEI T1,<DATAST+1+MAXBKF*1006>/1000+1
;NUMBER OF PAGES FOR MAX RECORD
CALL GETPGS ;GET THAT MANY
JRST NOFREE ;NOT POSSIBLE
EXCH T2,DMPCHA ;STORE THE BUFFER LOCATION
SKIPN T1,T2 ;WAS THERE AN OLD CHAIN?
JRST FIRRE2 ;NO, FINE
CALL RELPGS ;YES! NEEDS DELETING
JUMPN T1,.-1 ;CHASE CHAIN
FIRRE2: MOVE T2,DMPCHA ;GET NEW BUFFER LOCATION
ADD T2,[-MAXBKF*1006-1,,DATAST-1] ;GET THE IOWD FOR THE FIRST READ
MOVEM T2,RECCMD ;STORE FOR DUMPI
MOVEI T3,1(T2) ;ADDRESS OF FIRST BUFFER HEADER
MOVEM T3,CURHEA ;STORE FOR USE IN CASE OF ERROR, ETC.
IN1REC: TXO F,F.NBOT ;WON'T BE AT BOT SOON
MOVE T1,MTJFN
MOVEI T2,RECCMD ;IOWD LIST ADDRESS, NO OVERLAP
MOVEI T4,[EXP NS1ERR,OF1ERR,IN1ERR,EF1ERR,ET1ERR,NE1ERR,GETSIZ,NE1ERR]
;T4 IS THE ERROR VECTOR
DUMPI% ;WE *WANT* AN ILLEGAL LENGTH ERROR HERE!
TPWAIT: ERJMPR REAERR ;GO PROCESS THE ERROR (JUMP VIA T4)
JRST ILCERR ;WHAT WE GOT ISN'T WRITTEN BY DUMPER
;These are the error condition handlers for the very first DUMPI% done for
; a tape.
OF1ERR: CALL OFFLNE
JRST IN1REC
NE1ERR: JSERRD <Unexpected tape reading error>,BAKOUT,JRST
EF1ERR: CAIGE T3,0 ;DID REAERR CALL CLRERR?
CALL CLRERR ;NO, LETS DO IT NOW
JRST IN1REC ;AND TRY TO IGNORE
ET1ERR: CAIGE T3,0 ;HAVE WE CLEANED UP?
CALL CLRERR ;NO, DO IT NOW
TXNN F,F.BACK
ERROR <EOT on first record, try a REWIND> ;NO, BOMB OUT
CALL IFCRLF ;FIRST READ WAS SKIP BACK AT BOT
TYPE [ASCIZ/ Beginning of tape./] ;SAY AT BOT
JRST GETOUT ;AND DIE GRACEFULLY
IN1ERR: TXNN T2,MT%IRL ;ALSO WRONG LENGTH, THE ERROR WE WANT?
JRST ILCERR ;NO, THE COUNT IS BAD
TXO F,F.DERR ;SAY TO REPORT ERROR AFTER NEXT DUMPI
JRST GETSIZ ;HANDLE THE ERROR WE WANTED NOW
NS1ERR: MOVSI T2,1006 ;NOT ENOUGH SPACE
ADDB T2,RECCMD ;SO TRY A SMALLER READ, AND COMPLAIN
WARN <Not enough Monitor space for first read, trying smaller buffer>
JUMPL T2,IN1REC ;IF ITS STILL A LEGAL REQUEST, TRY AGAIN
JSERRD <>,BAKOUT,JRST ;COMPLAIN AND DIE
GETSIZ: SKIPN T1,TRNCNT ;FETCH THE NUMBER OF WORDS GOTTEN
JRST ILCERR
IDIVI T1,1000+NHEAD ;A DUMPER RECORD?
JUMPE T2,ISDMPR ;IF 0, YES, GO USE
MOVE T1,TRNCNT
IDIVI T1,1000+NIHEAD
JUMPN T2,ILTAPS
CAIN T1,1
JRST INTRIN
ERROR <INTERCHANGE tapes of BLOCKING-FACTORs other than 1 are illegal>
ILTAPS: MOVE T1,@CURHEA ;ITS NOT! TEST FOR LABELED TAPE/BYPASS
BYPASS: AND T1,[BYTE(8) 177,177,177]
CAME T1,[BYTE(8)"H","D","R"]
CAMN T1,[BYTE(8)"V","O","L"] ;SOME SORT OF LABELED TAPE HEADER?
JRST LABBYP
CAME T1,[BYTE(8)"E","O","F"]
JRST ILCERR
LABBYP: TXNN F,F.PRIV ;AH! ARE WE A WHEEL??
ERROR <Illegal to read a labeled tape this way> ;NO! LET'S DIE.
TXOE F,F.ILAB
JRST WEKNOW
WARN <This is a labeled tape with labels passed>
TYPE [ASCIZ/
?This represents a security violation on most systems, and a condition that
DUMPER is NOT guaranteed to handle well.
/]
WEKNOW: CALL CLRERR ;CLEAR ERRORS
JRST IN1REC ;HE SAID GO ON
ILCERR: TYPE [ASCIZ/
?This doesn't appear to be a DUMPER or BACKUP tape (bad record length.)
Type <CR> to rewind the tape and try again. /]
CALL RDLINI
CALL CLRERR
CALL REWCV
JRST IN1REC
INTRIN: TXON F,F.INTR ;IS INTERCHANGE SET?
WARN <This appears to be a BACKUP tape, turning on INTERCHANGE mode.>
INTROK: MOVEI T1,1
MOVEI T2,1040
JRST ISOK1R
ISDMPR: TXZE F,F.INTR
WARN <This appears to be a DUMPER tape, turning off INTERCHANGE mode.>
MOVE T2,T1
IMULI T2,1006
ISOK1R:
IFN FTIND,<
TXNE F,F.36MD ;INDUSTRY 36 BIT MODE?
JRST [IMULI T2,9 ;YES, NEED 9/8THS THE SPACE
LSH T2,-3 ;DIVI BY 8
JRST .+1]
>
MOVEM T1,REABKF
MOVEM T1,WRIBKF ;IF WE WRITE THIS TAPE, KEEP SIZE
MOVN T3,T2
HRLZM T3,RECCMD ;SET UP FOR FUTURE INPUT
IDIVI T2,1000
CAIE T3,0
ADDI T2,1
MOVEM T2,BUFPAG
MOVE T1,CURHEA
HRRZ T1,.TAPNO(T1)
MOVEM T1,TAPENO
SETZM REASEQ ;NO LAST SEQUENCE NUMBER
SETZM WRISEQ
JRST ADVCHF
ADVCHD:
IFN FTDEB,<
WARN <[DEBUG] Duplicate record read and being skipped: >
MOVE T2,T3
CALL DECOUT
>
ADVCHI: TXZ F,F.CIRC ;NO LONGER TRUE
SKIPN T1,DMPCHA ;GET OLD BUFFER
JRST [MOVE T1,BUFPAG;THERE ISN'T ONE!
CALL GETPGS ;MAKE A FAKE PREVIOUS RECORD
JRST NOFREE ;FATAL
MOVEM T2,DMPCHA ;TO START THE CHAIN WITH
HRROI T3,-FILL;SET UP A "FILLER" RECORD
CALL DMYREC ;MAKE IT A DUMMY RECORD
CALL LOSSEQ ;LOSE THE SEQUENCE NUMBER
JRST STAREC] ;OK, GO GET NEXT BUFFER FOR REAL STUFF
MOVE T2,DATAST+.SEQ(T1) ;GET OLD SEQUENCE NUMBER, LAST BUFFER
MOVEM T2,REASEQ ;SAVE FOR DUPLICATE CHECK
CALL RELPGS ;DELETE
MOVEM T1,DMPCHA ;NEW CURRENT BUFFER
ADVCHF:
STAREC: SKIPN DMPCHA ;ANYTHING PREVIOUS?
JRST ADVCHI ;NO, PUT IN A FAKE RECORD PREVIOUS
MOVE T1,BUFPAG
CALL GETPGS
JRST NOFREE ;CAN'T HAPPEN
MOVE T1,DMPCHA
MOVEI T3,DATAST(T1) ;GET ADDR OF BFR ABOUT TO BE CONFIRMED
MOVEM T3,CURHEA ;SAVE (FOR ANNSEQ MOSTLY)
MOVEM T2,NXTBUF(T1) ;NEXT BUFFER CREATED AND LINKED
ADDI T2,DATAST-1 ;POINT TO WHERE DATA SHOULD GO
HRRM T2,RECCMD ;COUNT ALREADY IN LH
REDMPI: MOVE T2,[DM%NWT+RECCMD]
MOVE T1,MTJFN
MOVEI T4,[EXP NOSRRR,OFLRRR,DATRRR,EOFRRR,EOTRRR,NMORRR,SIZRRR,UNXRRR]
DUMPI% ;CONFIRM LAST & START THE NEXT PHYS REC
ERJMPR REAERR ;HANDLE ERROR VIA T4
TXZE F,F.DERR ;DO WE HAVE A DATA ERROR TO REPORT?
JRST DATRRR ;YES, SAY SO
RETREC: MOVE T1,REABKF
MOVEM T1,BLKCNT
INTRE2: MOVE T2,DMPCHA ;RETURN THE CURRENT RECORD POINTER
ADDI T2,DATAST
MOVEM T2,BLKPNT ;READY TO GO
TXNE F,F.BACK+F.FAKE+F.NSEQ ;BACKING UP? OR FAKE? IGNORE SEQ #'S
JRST GETREC
TXNN F,F.INTR ;INTERCHANGE? SEQUENCE IS ELSEWHERE
SKIPA T1,.SEQ(T2) ;SEQUENCE IN DUMPER HEADR
MOVE T1,G$SEQ(T2) ;SEQUENCE IN INTERCHANGE HEADER
JUMPE T1,SEQOK ;IF 0, ACCEPT ANYTHING
SKIPN T3,REASEQ ;DO WE HAVE AN EXPECTATION?
JRST SEQOK ;NO, TAKE ANYTHING
CAMN T1,T3 ;DUPLICATE RECORD?
JRST ADVCHD ;YES, TOSS RECORD!
CAMG T1,T3 ;SAVESET NUMBERS DO *NOT* DECREASE
JRST SEQNOK ;SO CATCH THAT NOW
;Of course, they *could* when we read/write a new tape. But that causes MTBOT
; to be called, and that resets REASEQ.
ADD T3,REABKF ;WHAT SHOULD THE NEW VALUE BE?
TXNN F,F.INTR ;INTERCHANGE, TAKE ANYTHING
CAMN T1,T3 ;THE CORRECT VALUE?
JRST SEQOK ;FINE
MOVN T3,.TYP(T2) ;NO, BUT THAT'S OK FOR SAVEST, CONTST
CAIE T3,SAVEST
CAIN T3,CONTST
JRST SEQOK
SEQNOK: WARN <Sequence error, > ;OH WELL
MOVE T2,T1 ;TYPE THE LAST SEEN
CALL DECOUT
TYPE [ASCIZ/ after /]
MOVE T2,REASEQ
CALL DECOUT
SEQOK: MOVEM T1,REASEQ
JRST GETREC ;OK
NOSRRR: JSERRD <>,BAKOUT,JRST
OFLRRR: CALL OFFLNE
JRST REDMPI
;Data error code follows. We get here after REAERR, which for this error
; guarantees that the tape has stopped. This means that both DMPCHA and
; its sucessor point at tape buffers. Check to see if the sequence number
; is the same for both, ie, we knew about this bad spot on the tape when we
; wrote it and wrote a dup record. If we did, toss the current record and
; advance, just as if the bad record had been all read. If the numbers differ,
; it's a problem, and it gets reported.
DATRRR: CALL CLRERR
MOVE T1,DMPCHA
MOVE T3,NXTBUF(T1)
MOVE T2,DATAST+.SEQ(T1)
CAMN T2,DATAST+.SEQ(T3)
JRST ADVCHI ;DUP, TOSS OLD RECORD
WARN <Unrecovered data error>
CALL ANNSEQ
JRST RETREC ;OH, WELL, RETURN ERROR'D RECORD
EOFRRR: HRROI T3,-SAVEEN ;RETURN SAVESET END
CALL DMYREC
JRST EOIRRR
EOTRRR: CALL CLRERR ;TOSS ERRORS
HRROI T3,-TAPEEN
CALL DMYREC
EOIRRR: SKIPN T2,NXTBUF(T1) ;DOES THE NEXT RECORD EXIST?
JRST RETREC ;NO, FINE
SETZM NXTBUF(T1) ;YES, ITS MEANINGLESS, TOSS IT
MOVE T1,T2
CALL RELPGS
JRST RETREC ;DONE. MAYN'T READ PAST EOT
FAKREC: HRROI T3,-FILL ;SEND A FILLER RECORD
CALL DMYREC
JRST REDMPI ;GO TRY DUMPI AGAIN
DMYREC: MOVE T1,DMPCHA ;GET BUFFER TO BE RETURNED
TXO F,F.FAKE
SETZM DATAST+.SEQ(T1) ;NO SEQUENCE NUMBER
SETZM DATAST+.PAGNO(T1);NO FLAGS IN .PAGNO
SETZM DATAST+.FLAG(T1);NO FLAGS AT ALL
MOVEM T3,DATAST+.TYP(T1) ;LOAD IN TYPE AS FIRST RECORD
RET
NMORRR: JSERRD <Can't switch to next tape volume>,BAKOUT,JRST
SIZRRR: CAIGE T3,0
CALL CLRERR ;CLEAR ERRORS IF REAERR DIDN'T
MOVE T1,DMPCHA
MOVE T1,DATAST(T1) ;FETCH FIRST WORD
AND T1,[BYTE(8)177,177,177]
CAME T1,[BYTE(8)"H","D","R"]
CAMN T1,[BYTE(8)"V","O","L"]
PAT03A: TXNN F,F.PRIV
JRST .+2
JRST FAKREC ;GOT A LABEL RECORD, RETURN FILLER
WARN <Bad physical record length>
CALL ANNSEQ ;BAD RECORD
JRST FAKREC ;RETURN FILLER
UNXRRR: WARN <Unexpected tape read error>
CALL ANNSEQ
TYPE [ASCIZ/ - /]
CALL LSTERO
CALL CLRERR
JRST BAKOUT
;Tape input, what to do with a TONEXT record
UPTAPE: CALL KILCHN
UPTAP2: CALL NXTTPE ;FETCH NEXT TAPE PLEASE
CALL GMOJFI ;MAKE SURE WE GOT IT
JRST [TXNE F,F.ABT
JRST BAKOUT
JRST UPTAP2] ;WE DIDN'T - TRY AGAIN
SETZM BLKCNT ;SAY NO LOGICAL BUFFERS
SETZM BUFPAG ;SAY TAPE NEVER READ
PUSH P,TAPENO ;SAVE CURRENT TAPE NUMBER
;This should guarantee that tapes in a set with different charactistics can
; be read. Of course that's a terrible idea, but it should be allowed.
GETRRR: CALL GETREC ;YES, RECURSION
CAIE T3,SAVEST ;QUIETLY ALLOW THIS
CAIN T3,CONTST ;BUT HOPE FOR THIS
JRST GETRR2 ;OK, GOT ONE OR THE OTHER
PAT01A: ERROR <Tape does not start with a CONTINUED SAVESET, as expected>
PAT01B: JRST GETRRR
GETRR2: CALL GANEWT
POP P,T1
PAT02A: MOVEI T2,1(T1) ;GET EXPECTED TAPE NUMBER
CAMN T2,TAPENO ;NEW TAPE NUMBER CORRECT?
JRST GETRET ;YES, RETURN FROM OUTER GETREC
MOVEM T1,TAPENO ;NO, CORRECT EXPECTATION & POSSIBLY TRY AGAIN
IFMTA BADUPT
ERROR <Tape number is incorrect (wrong tape mounted)>
BADUPT: WARN <Tape number is incorrect (wrong tape mounted)>
CALL UNLMTA
HRROI T1,[ASCIZ/Put up the correct tape/]
CALL TRYAGA
JRST UPTAPE
SUBTTL Tape I/O support
IFG <REEVAL>*<FTVERS-5>,<
;Returns the result in T3. 1=drive busy, 0=drive idle
CHKBLK: MOVE T1,MTJFN
MOVEI T2,.MOIRB
MTOPR%
ERJMPS [SETZ T3, ;PROBABLY DEV OFF LINE OR SOMETHING
RET]
RET
>
;Wait for current tape activity to stop
WAITFN: SKIPE OPNFOR ;TAPE ISN'T MOVING IF NOT OPEN
SKIPN T1,MTJFN ;OR JFN'D
RET ;SO QUIT
MOVEI T2,.MONOP
MTOPR%
ERJMPS .+1 ;CAN'T, FINE
RET
;Here with error code (from ERJMPR) in T1 and error vector pointer in T4.
; leap off accoring to error. Come here by JRST. This sets TRNCNT to the
; number of words transferred if MT%IRL is true (length error).
;This returns T3/ -1 if XGDSTS wasn't called, or the count of transferred
; bytes in T3 if it was.
REAERR: SETO T3,
CAIN T1,DUMPX3
JRST @0(T4) ;NO MONITOR SPACE FOR BLOCKING FACTOR
CAIN T1,OPNX8
JRST @1(T4) ;OFFLINE
CAIE T1,GJFX52
CAIN T1,IOX24
JRST @4(T4) ;EOT
CAIN T1,MREQ16
JRST @5(T4) ;CAN'T SWITCH TO NEXT TAPE
CAIN T1,IOX4
JRST REAEOF ;EOF
CAIE T1,IOX5 ;TEST FOR REAL ERROR
JRST @7(T4) ;NONE! WHY ARE WE HERE?
CALL XGDSTS
HLRZS T3
MOVEM T3,TRNCNT ;NUMBER OF WORDS TRANSFERRED
;**;[555] Add two lines at REAERR+17. lines GAS 20-Sep-88
TXNE T2,MT%DVE ;[555] Check device error first
JRST @1(T4) ;[555] Yes, device error
TXNE T2,MT%DAE
JRST @2(T4) ;DATA ERROR
TXNE T2,MT%IRL
JRST @6(T4) ;WRONG LENGTH
;**;[555] Delete two lines at REAERR+22. lines GAS 20-Sep-88
TXNN T2,MT%EOF
JRST @7(T4) ;UNKNOWN
REAEOF: CAIGE T3,0 ;DID WE CALL CLRERR (XGDSTS?)
CALL XGDSTS ;NO, DO IT NOW
TXO F,F.EOF ;WE HAVE EOF (END OF SAVESET)
IFLAB REAEO2 ;ON LABELED TAPES, 2 EOFS DON'T COUNT
TXZN F,F.OEOF ;2 IN A ROW?
JRST @3(T4) ;JUST EOF SO FAR
JRST @4(T4) ;2ND IN A ROW - EOT
REAEO2: TXZE F,F.OEOF ;2ND IN A ROW ON LABELED TAPE?
WARN <Empty saveset seen on tape> ;WORTH A WARNING
TXNN T2,MT%EOT ;DISPATCH ON TRUTH
JRST @3(T4) ;MERE EOF
JRST @4(T4) ;EOT
;CLRERR is actually just like XGDSTS, but it preserves T2
CLRERR: PUSH P,T2
CALL XGDSTS
POP P,T2
RET
;Returns JFN in T1 and status in T2
XGDSTS: SETZ T2,
SKIPN T1,MTJFN
RET ;JUST GO BACK
GDSTS% ;GET ERROR BITS
;**;[549]Change one line at XGDSTS:+4L DEE 1-MAR-88
ERJMP XGDBAD ;[549] Can't - some problem
PUSH P,T2 ;SAVE STATUS BITS
TXZN T2,MT%EOT!MT%DVE!MT%DAE
JRST XGDST1
DOJSS SDSTS%, .+1
XGDST1: MOVEI T2,.MOCLE
DOJSS MTOPR%, .+1 ;CLEAR ERROR FLAGS
POP P,T2
RET
;**;[549] Add new routine XGDBAD: at XGDST1:+5L DEE 1-MAR-88
;[549] HERE IF GDSTS% FAILED - BIG PROBLEM, SO CLEAN UP AS BEST
;WE CAN AND START OVER
XGDBAD: MOVEI T2,.MOCLE ;[549] Try to do what we came here for
DOJSS MTOPR%, .+1 ;[549] Clear error flags
POP P,T2 ;[549] Restore
ERROR <Can't get tape drive status>,PANIC ;[549] Bomb out
;FINTAP writes the end of tape information.
; It first dumps out the current chain (DMPCHA).
FINTAP: CALL FILBLK ;END GETS A PHYS. BLOCK TO ITSELF
IFLAB FINLAB ;LABELED TAPES ARE GROUCHY AND SPECIAL
FIN2: MOVX T1,-TAPEEN
MOVEM T1,TAPHEA+.TYP
MOVEI T1,TAPHEA
MOVEI T2,SSNBUF ;LAST SAVESET INFO (FOR INTERCHANGE)
CALL ADDREC
CALL FILBLK ;WRITE OUT CHAIN
CALL WRIEOF
CALL WRIEOF
CALL WAITFN
CALL BACKSP
CALL BACKSP
CALL BACKSP ;BACK OVER END RECORDS
JRST FINIWR
FINLAB: CALL WRIEOF
CALL WRIEOF
FINIWR: CALL KILCHN
TXO F,F.NORD
RET
;Write EOF
WRIEOF: SKIPN T1,MTJFN
RET
MOVEI T2,.MOEOF
MTOPR%
JSERRD <>,BAKOUT
RET
;Backspace a record
BACKSP: SKIPN T1,MTJFN
RET
MOVEI T2,.MOBKR
MTOPR%
JSERRD <Can't backspace>,BAKOUT
;JRST LOSSEQ
;Here to remember the highest reading sequence number seen so far on this tape,
; but to have no expectation for the next thing read.
LOSSEQ: SETZ T2,
EXCH T2,REASEQ
CAMLE T2,LSTSEQ
MOVEM T2,LSTSEQ
RET
;Forwardspace a record. Returns T1/ tape jfn.
FWRDSP: SKIPN T1,MTJFN
RET
MOVX T2,.MOFWR
MTOPR%
JSERRD <>,BAKOUT
JRST LOSSEQ
;Announce the record number (For GETREC)
ANNSEQ: MOVE T2,CURHEA
MOVE T2,.SEQ(T2)
TYPE [ASCIZ/, record /]
SKIPN JFN
JRST DECOUT
CALL DECOUT
TYPE [ASCIZ/, /]
JRST CFNFIL
;T3 contains the header address, T4 the 1000 word buffer. Ret with T1
; containing the checksum.
CHKSUM: DMOVEM T3,CHKTMP
HRLI T3,-6
HRLI T4,-1000
SETZ T1,
JCRY0 .+1
COMCH1: ADD T1,0(T4)
JCRY0 [AOJA T1,.+1]
AOBJN T4,COMCH1
COMCH2: ADD T1,0(T3)
JCRY0 [AOJA T1,.+1]
AOBJN T3,COMCH2
CAMN T1,[-1]
SETZ T1,
DMOVE T3,CHKTMP
RET
IFN FTIND,<
;CONVERT THE BUFFER AT CURHEA IN PLACE (FOR INDUSTRY MODE (F.36MD))
W36CNV: PUSH P,Q1
MOVE T2,CURHEA
HRLI T2,(POINT 8)
MOVE T3,T2
HRLI T3,(POINT 4)
MOVEI Q1,1006*9/2
W36C1: ILDB T4,T2 ;ONE SOURCE BYTE...
ROT T4,-4 ; ... BECOMES TWO DEST BYTES
IDPB T4,T3
ROT T4,4
IDPB T4,T3
SOJG Q1,W36C1
POP P,Q1
RET
>
;Here during a SAVE to see if a VOLID is needed, and if so, if it is available.
; If it isn't, the user is prompted.
PROVOA: TXOA T1,D.ARC ;MAKE SURE WE PASS THIS TEST
PROVOL: MOVE T1,DMPFLG ;MOUNTED TAPE, SHOULD HAVE IT
SKPMTA ;SKIP IF MTA
SKIPN VOLID6 ;MAKE SURE
VOLNRL: TXNN T1,D.ARC+D.MIG+D.COL ;IF NOT TRUE, VOLID ISN'T NEEDED
RET ;HERE IF HAVE VOLID6 OR DON'T NEED IT
;Here we have to prompt for the volid - probably an unlabeled tape
REQVOL: MOVEM P,TRAPSP
ASKVOL: MOVEI T1,[
SETZM TRAPTO
MOVE P,TRAPSP
CALL TSTINT
JRST BAKOUT
JRST ASKVOL]
MOVEM T1,TRAPTO
HRROI T1,[ASCIZ/Provide a VOLID for the tape: /]
HRROI T2,STRING
MOVEI T3,VOLBLK
CALL QUEST
MOVEM P,REQTMP
VOLPRS: MOVE P,REQTMP
SETZM ATOM2
DMOVE T1,[EXP VOLBLK,TXTINB]
CALL PARSE
JSERRD <>,ASKVOL,JRST
MOVEI T2,CONINB
CALL PARSE
ERROR <Not comfirmed>,ASKVOL
SETZM TRAPTO
HRROI T1,ATOM2
CALL ASCSIX
JUMPE T2,ASKVOL
MOVEM T2,VOLID6
HRROI T1,ATOM2
HRROI T2,VOLID
JRST CSTR
SUBTTL SKIP command
;Skip some number of savesets (forward or backward)
$SKIP: GUIDES <NUMBER OF SAVESETS>
DMOVE T1,[EXP CMDBLK,SKPINB]
CALL PARSE
JSERRD <>,NOCMD
MOVE Q1,T2
CONFIRM
SETOM OKIAE ;ALLOW INTERRUPTS
CALL GMOJFI
JRST BAKOUT
SETZM BLKCNT ;FORCE TAPE READ
TXO F,F.NSEQ ;SEQUENCE NUMBERS, ETC. SHOULD BE IGNORED
JUMPLE Q1,SKPBAC
CALL GETREC
IFLAB SKPLFR ;LABELED TAPES ARE A TAD DIFFERENT
CAIN T3,SAVEST ;FIRST REC A SAVESET?
AOJA Q1,SKPFRF ;YES, TYPE BUT DON'T COUNT
SKPFRD: CAIN T3,TAPEEN ;EOT?
JRST [TYPE [ASCIZ/ End of tape./]
JRST SKPFIN]
CAIE T3,SAVEST
JRST SKPFR1
SKPFRF: CALL TYPHDR
SOJLE Q1,SKPUNF
SKPFR1: SETZM BLKCNT
CALL GETREC
JRST SKPFRD
SKPUNF: CALL BACKSP ;FIX FOR READAHEAD
CALL BACKSP
JRST SKPFIN
SKPLFR: CAIN T3,SAVEST
CALL TYPHDR
SKPL2: CALL GETREC
SETZM BLKCNT
CAIN T3,SAVEEN
JRST SKPLEF
CAIN T3,TAPEEN
JRST SKPFIN
CAIN T3,SAVEST
CALL TYPHDR
JRST SKPL2
SKPLEF: SOJG Q1,SKPL2
TYPE [ASCIZ/ Positioned after above saveset/]
JRST SKPFIN
SKPBAC: SKPNLB ;SKIP IF NOT LABELED
ERROR <Can't backspace Labeled tapes> ;LABELED CAN'T DO THIS
MOVE T1,MTJFN
MOVX T2,.MOSDR ;SET TO READ BACKWARDS
MOVEI T3,1
MTOPR%
JSERRD <>
TXO F,F.BACK
TXZ F,F.NORD+F.EOF ;GOING BACKWARDS, SO EOT DOESN'T MATTER
SKPBK1: CALL XGDSTS ;SEE IF AT BOT
TXNE T2,MT%BOT+MT%EOT
JRST SKPBOT ;YES, JUST STOP
SETZM BLKCNT
CALL GETREC
MOVE T3,LASTYP
CAIE T3,SAVEST
JRST SKPBK1
CALL TYPHDR
AOJLE Q1,SKPBK1
CALL WAITFN
CALL XGDSTS ;SEE IF AT BOT
TXNN T2,MT%BOT+MT%EOT
JRST RAHEF
SKPBOT: CALL IFCRL2
TYPE [ASCIZ/ Beginning of tape./]
CALL MTBOT
SKIPA T1,MTJFN
RAHEF: CALL FWRDSP ;FIX FOR READ AHEAD, RET T1/ TAPE JFN
SKPBCK: MOVX T2,.MOSDR
SETZ T3,
MTOPR%
JSERRD <>
SKPFIN: TXZ F,F.NSEQ+F.BACK
SETZM REASEQ ;NO IDEA WHAT SHOULD COME NEXT
JRST CMDFIN
TYPHDR: CALL IFCRLF
MOVE T2,CURDAT
SKIPN T1,SV.PNT(T2)
MOVEI T1,SV.MSG
ADDI T1,(T2)
SKIPN (T1)
JRST [TYPE [ASCIZ/UNNAMED saveset /]
JRST TYPHD2]
TYPE [ASCIZ/Saveset "/]
TYPE <(T1)>
TYPE [ASCIZ/" /]
TYPHD2: MOVEM T3,TMP
SKIPE T2,SV.TAD(T2)
CALL TADOUT
MOVE T3,TMP
TYPE CRLF
RET
SKPINB: <.CMNUM>B8+CM%DPP
^D10
BLOCK 1
-1,,[ASCIZ/1/]
SUBTTL Restore, Retrieve, Check
;Retrieve parsing and setup
RETRIE: TXNN F,F.PRIV
JRST OPRERR ;MUST BE PRIVED
GUIDES <FILES>
TXO F,F.RETR+F.FILT ;RETRIEVE, AND ASSUME FILES MODE
TXZ F,F.CHCK+F.SARC+F.GOT1 ;NONE OF THESE
HRROI T1,[ASCIZ/DSK*/]
HRROI T2,[ASCIZ/*/]
MOVX T3,GJ%OFG
CALL SETWLD
DMOVE T1,[EXP CMDBLK,LO2INB]
CALL PARSE
ERROR <Illegal file specification>,NOCMD
CALL RPSJFN
MOVEM T2,JFNLST ;ONLY 1 POSSIBLE
SETZM JF2LST ;..
CONFIRM
TXZE F,F.INTR
TYPE [ASCIZ/Turning off INTERCHANGE mode. /]
TXZE F,F.CREA
TYPE [ASCIZ/Turning off CREATE mode./]
RETSET: CALL QSRINI ;HELLO QUASAR
CALL MTCLS ;DROP WHATEVER WE HAVE
SETZM VOLID6 ;WE DON'T HAVE A TAPE ANYMORE
SETZM BDTCNT ;SAY NO BAD TAPE VOLIDS YET
SETZM TOTFIL ;FILES RETRIEVED
SETZM TOTCNT ;PAGES RETRIEVED
CALL SETLST ;SET UP LIST FILE IF DESIRED
SETZM LSTFIL ;CAN'T
MOVSI Q1,-1 ;RETRIEVE ONLY HAS ONE FILESPEC
MOVEM Q1,NFJFN ;FOR TSTNAM
JRST RETLP
LATER: CALL RETFAI
RETLP: TXNN F,F.PRIV ;PARANOIA CHECK
JRST BAKOUT
CALL NXTRET ;FETCH REQUEST FROM QUASAR
JRST ENDRET ;ALL DONE
MNTRIG: CALL MNTRET ;GET THE TAPE & OPEN IT
JRST LATER ;CAN'T
SKIPE ABTFLG ;QUASAR REQUEST ABORT?
JRST [CALL ABTRET ;YES, BAG IT
JRST RETLP]
RETLDS: SKIPGE .ARODT(P5)
SKIPA T1,.ARSF1(P5)
MOVE T1,.ARSF2(P5)
HLRZM T1,RETSVN
HRRZM T1,RETFLN ;GET FILE AND SAVESET NUMBERS
;Find out if we need to rewind this tape
MOVE T1,RETSVN
CAMGE T1,ATSAVE ;ARE WE AT/AFTER THE DESIRED SAVE?
JRST REWRET ;YES, JUST REWIND
CAME T1,ATSAVE ;AT IT OR IS IT BEYOND?
JRST NRWRET ;ITS AHEAD - JUST GO ON
MOVE T1,RETFLN ;AT IT - IS THE FILE AHEAD OR PAST?
CAMLE T1,ATFILE ;.. IF AHEAD, SKIP THE REWIND
JRST NRWRET ;..
REWRET: CALL REWCV ;BACK TO BOT
CALL KILCHN ;LOSE ANY READAHEAD
NRWRET: TXO F,F.NVOL ;WE'LL HANDLE VOLSWITCHES, PLEASE
RETFLS: CALL GETREC
CAIN T3,TAPEEN ;END OF TAPE?
JRST RETENT ;YES, GO HANDLE
CAIN T3,TONEXT ;NEXT TAPE NEEDED?
JRST [CALL NXTRTT ;YES, GO FETCH AND SET UP
JRST RETFLS] ;AND GO ON
SKIPN T4,SAVENO
JRST RETFLS ;NOT AN ARCHIVAL SAVESET
MOVEM T4,ATSAVE ;REMEMBER WHAT SAVESET AT
SETOM ATFILE ;NO FILE NUMBER YET
CAME T4,RETSVN ;GOT THE RIGHT SAVESET NUMBER?
JRST [MOVE T1,RETSVN ;NO
CAIE T1,1 ;1 IS OK (OLD DUMPERS DID THIS)
CAIG T4,(T1) ;GONE PAST?
JRST RETFLS ;NO, READ ON
HRROI P1,[ASCIZ/Missing required Saveset/]
JRST LATER]
CAIE T3,FILEST ;BEGINNING OF FILE?
JRST RETFLS ;NO, GO AGAIN
LDB T4,[POINT 15,.PAGNO(T1),17]
MOVEM T4,ATFILE ;STORE FILE NUMBER
CAME T4,RETFLN ;GOT IT?
JRST [CAMG T4,RETFLN ;NO, PAST IT?
JRST RETFLS ;NO, READ ON
HRROI P1,[ASCIZ/File missing from Saveset/]
JRST LATER]
HRRO T1,CURDAT ;POINT TO FILENAME FOR SANITY CHECK
HRROI T4,STRING
MOVEI T2,";"
CALL CPYDLM
SETO T3,
ADJBP T3,T4
SETZ T2,
DPB T2,T3
HRROI T2,STRING
HRROI T1,FILNM(P5) ;POINT TO REQUESTED FILE
CALL STCMPC
JUMPE T3,RETFNO ;0 IF THE SAME
;This condition can happen - tape,saveset,file#s have been wrong in some
; versions of DUMPER. Or, maybe just a renamed archived file.
WARN <Filename on tape is not the same as requested file,
Tape file name: >
HRRO T1,CURDAT
TYPEAT T1
TYPE [ASCIZ/
File requested: /]
TYPE FILNM(P5)
IFE FTASKR,< ;;FTASKR=0, ask the operator for advice
HRROI T1,[ASCIZ/Wrong file found, retrieve anyway? /]
CALL YESNO
JUMPE T2,REJECR
>
IFG FTASKR,< ;;FTASKR=1, retrieve in all cases
TYPE [ASCIZ/
-- retrieving anyway/]
>
IFL FTASKR,< ;;FTASKR=-1, reject attempt in all cases
JRST REJECR
>
RETFNO: CALL RETFIL ;GOTCHA! RETRIEVE FILE AND RELEASE
JRST RETLP
RETENT: HRROI P1,[ASCIZ/ At end of tape, requested file not found/]
JRST LATER ;REQUEUED OR LOST IT, GO GET NEXT
REJECR: CALL IFCRL2
TYPE [ASCIZ/ File will not be retrieved./]
HRROI P1,[ASCIZ/Wrong file seen/]
JRST LATER
RETFAI: CALL FALFIL ;TYPE OUT REQUEST FILE NAME
SKIPGE .ARODT(P5)
JRST [CALL WASHO2 ;TOTAL LOSS, DECLARE IT SO
JRST RELREQ] ;AND SAY "DONE"
GTAD%
TXO T1,%EQUFT ;MAYBE ON OTHER TAPE, GO TRY
WARN <Requeuing >
TYPE FILNM(P5)
REQSIL: SETZM NXTRTP ; Current block now invalid
PUSH P,P1
CALL ZIPMSS ; Setup to send
MOVE T2,[REQ.SZ,,.QOREQ]
MOVEM T2,.MSTYP(P1) ; Length, type
MOVE T2,TPTSK ; External task
MOVEM T2,REQ.IT(P1) ; Internal task name
MOVEM T1,REQ.IN(P1) ; Timestamp
HRLI T2,.ARTP1(P5) ; COPY TAPE INFO FROM
HRRI T2,REQ.IN+1(P1) ; TO
BLT T2,REQ.IN+1+.ARSF2(P1) ; Copy in tape info
MOVE P1,[REQ.SZ,,QSRMSS]
CALL SNDQSR ; Send it to QUASAR
POP P,P1
RET
ENDRET: SKIPE T1,MYPID
CALL RELPID ;DROP QUASAR DIAOLGUE
CALL UNLOAD
CALL ENDLIS ;CLOSE OUT ANY LIST FILE
CALL MTCLS
PAT08A: JRST LODENT ;AND ACT LIKE RESTORE ENDING
;Errors that occur in here are the type that can't be fixed by trying the other
; tape.
RETFIL: HRROI T1,FILNM(P5)
MOVEI T2,">"
HRROI T4,OUTSPC
CALL CPYDLM
HRROI T1,[ASCIZ/RETRIEVAL.TEMP;T/]
MOVE T2,T4
CALL APPSTR
SETZM JFN
HRROI T2,OUTSPC
MOVX T1,GJ%FOU+GJ%SHT
GTJFN%
ERJMPS NOTMPR
MOVEM T1,JFN
MOVX T2,OF%WR
OPENF%
ERJMPS NOTMPR
TXO F,F.NVOL
CALL PLOP ;CALL DOWN FILE INTO JFN
JRST NORETR ;CAN'T!
SKIPE ABTFLG
JRST [MOVE T1,JFN ;ABORTED. TOSS FILE.
TXO T1,CZ%ABT
CLOSF%
ERJMPS ABTRET
JRST ABTRET]
MOVX T1,GJ%OLD+GJ%XTN
MOVEM T1,RETBLK+.GJGEN
MOVEI T1,RETBLK
HRROI T2,FILNM(P5)
GTJFN%
ERJMPS NORETR ;GIVE UP
EXCH T1,JFN ;SAVE NEW JFN, GET OLD
TXO T1,CO%NRJ ;CLOSE RETAINING JFN
HRRZ T3,T1 ;JFN IN T3 FOR ARCF
CLOSF% ;..
ERJMPS .+1 ;SNH
MOVE T1,JFN ;NEW JFN IN T1
MOVX T2,.ARRST ;DO THE RETRIEVE FUNCTION
ARCF% ;WHOMP!
ERJMPR RETNON ;PROBABLY ON LINE ALREADY
HRLI T1,.FBBK0(CF%NUD)
MOVSI T2,-1
SETZ T3, ;CLEAR "TIMES SAVED"
DOJSS CHFDB%, .+1
MOVE T3,T1 ;JFN TO T3
GTAD% ;GET "NOW"
EXCH T1,T3 ;JFN IN T1, DATE IN T3
SETO T2, ;CHANGE ENTIRE WORD
HRLI T1,.FBREF ;TO SAY LAST REF'D NOW
DOJSS CHFDB%, .+1
HRRZS T1
RLJFN%
ERJMPS .+1
SETZM JFN
CALL IFCRL2
SKIPN LSTJFN
JRST NOLSFR
IFN FTMAIL,<
SKIPN MAILFL
JRST NOMLSF
SELECT LS.LST
TYPE [ASCIZ/*R/]
>
NOMLSF: SELECT LS.TTY+LS.LST
NOLSFR: TYPE [ASCIZ/ /]
TYPE FILNM(P5) ;ALWAYS TYPE FILENAME
TYPE CRLF
SELECT LS.TTY
IFN FTUSAG,<
CALL USAINI ; Init USAGE block
MOVX T1,.UTRET ; Is a retrieval
HRRM T1,USABLK ; Insert type
MOVE T1,CURDAT
MOVE T2,FDBFFF+.FBBBT(T1) ; Get # pages returned online
HRRZM T2,USABLK+10 ; Put it in the blk
LDB T2,[POINT 3,T2,17]
MOVEM T2,USABLK+26 ; Put reason it was offline in blk
ADD T1,AUTTMP ;SET UP BY PLOP/FILDWN
ADDI T1,FDBFFF+20
CALL USATAP ; Do tape info
HRROI T1,USADIR ; User who requested retrieval
MOVE T2,TPRQUS
DIRST%
ERJMPS .+1 ; Maybe files only or something similiar
MOVEI T1,TPACT ; Account for this
MOVEM T1,USABLK+2
HRROI T1,TAPNAM
HRROI T4,USASTR
MOVEI T2,":"
CALL CPYDLM
SETO T1,
ADJBP T1,T4
SETZ T2,
DPB T2,T1
CALL GDONBE ;FINISH UP THE USAGE AND DO IT
>
CALL RELREQ
RET
RETNON: MOVEM T1,STRING ;SAVE ERROR CODE FOR A MOMENT
HRRZ T1,T3
RLJFN% ;DROP JFN IN T3
ERJMPS .+1
MOVE T1,STRING ;GET ERROR CODE BACK
HRROI P1,[ASCIZ/ File is already on-line/] ;ASSUME THIS ERROR
CAIE T1,ARCFX9 ;AM I RIGHT?
NORETR: CALL BADOFP
JRST RETNOG
NOTMPR: HRROI T1,[ASCIZ/Can't open retrieval .TEMP file /]
HRROI T1,STRING
CALL CSTRB
MOVE T1,T2
CALL BADOF2 ;ADD ERROR MESSAGE
RETNOG: CALL WASHOU ;BLOW AWAY
CALL RELREQ ;AND RETURN AS UNACCEPTABLE
SKIPN T1,JFN
RET
SETZM JFN
TXO T1,CZ%ABT
CLOSF%
ERJMPS [MOVE T1,JFN
RLJFN%
ERJMPS .+1
JRST .+1]
RET
;Here if we plow into a TONEXT tape record during a retrieval. Only
; Retrieval should be lighting F.NVOL before calling PLOP, so that should
; be the only way to get here outside of RETFIL. We mount the next tape
; with an eye towards doing it the way we did last time, ie,
NXTRTT: IFLAB AUTOGO ;LABELED TAPES JUST KEEP GOING
SKIPN MNTDSG ;DID WE MOUNT A TAPE THIS WAY (QUASAR?)
JRST [CALL NXTTAP ;NO, DO A NORMAL NEXT TAPE
JRST AUTOGO]
CALL UNLOAD ;LOSE MOUNTED TAPE
CALL IFCRL2
TYPE <[ASCIZ/ [Need to mount next retrieval tape]
Provide the volid of the next retrieval tape in the set./]>
NXTNFN: SETZM VOLID6
CALL REQVOL
HRROI T1,ATOM2
CALL ASCSIX
MOVE Q1,T2
CALL MNTNXT
JRST NXTNFN
AUTOGO: AOS TAPENO
CALL MTBOT
CALL GETREC ;SKIP FIRST RECORD
CAIE T3,SAVEST
CAIN T3,CONTST
TXOA F,F.NVOL
JRST AUTOGO
IFMTA CPOPJ
CALL GETVOL ;LEARN THE NEW VOLID
RET
;CHECK starts here and uses RESTORE code where possible.
CHECK: GUIDES <ALL TAPES FILES>
CONFIRM
TXO F,F.CHCK
TXZ F,F.RETR+F.SARC
MOVSI T1,-1
MOVEM T1,NFJFN ;NOT QUITE TRUE, ACTUALLY
JRST CHCKST
;Just like RESTORE, but default to "accept any filename match"
TRANSF: TXO F,F.WILD
;JRST RESTOR
;Restore parsing
RESTOR: GUIDES <TAPE FILES>
TXZ F,F.CHCK+F.RETR ;NOT CHECK OR RETRIEVE
PAT06A: TXZ F,F.SARC ;DEFAULT: TAPE INFORMATION OK
MOVSI Q1,-MAXJFN
TXNN F,F.INTR+F.WILD ;DO WE NEED DEFAULTS?
CALL GETCON ;YES, GET CONNECTED STR:<DIR>
JRST LOADNF ;AND START GETTING FILES
LOADCT: AOBJN Q1,LOADNF ;DID LAST FILE FIT?
ERROR <JFN list overflow>,NOCMD
LOADNF: TXNE F,F.INTR+F.WILD ;INTERCHANGE MEANS WILD DISK ALWAYS
JRST [HRROI T1,[ASCIZ/DSK*/] ;OR HE JUST WANTS DSK*:<*>
JRST LDWDIR]
DMOVE T1,CONSTR ;NONINTERCHANGE, PICK UP DEFAULTS
TXNE F,F.PRIV ;PRIVED?
LDWDIR: HRROI T2,[ASCIZ/*/] ;YES, WILD DIRECTORY DEFAULT
MOVX T3,GJ%OFG ;THIS WILL BE PARSE ONLY
CALL SETWLD ;SET UP THE DEFAULTS
DMOVE T1,[EXP CMDBLK,LODINB] ;SWITCHES OR FILESPEC PARSE
LDFILO: CALL PARSE
ERROR <Not a Switch or a file specification>,NOCMD
CAIE T3,.CMSWI ;SWITCH?
JRST LOADFL ;NO, HANDLE FILE
HRRZ T2,(T2)
JRST (T2) ;DISPATCH ON SWITCH
LODINB: <.CMSWI>B8+LO2INB
EXP LODTAB
LO2INB: <.CMFIL>B8
LODTAB: LODLEN,,LODLEN
TB NOARC, <NOTAPE-INFORMATION>
TB LOARC, <TAPE-INFORMATION>
LODLEN=.-LODTAB-1
NOARC: TXOA F,F.SARC
LOARC: TXZ F,F.SARC
DMOVE T1,[EXP CMDBLK,LO2INB]
JRST LDFILO
LDEINB: <.CMFIL>B8+CM%SDH+CM%HPP+LD2INB
BLOCK 1
-1,,[ASCIZ/file group descriptor/]
LD2INB: <.CMCMA>B8+CONINB
LOADFL:
IFN FTEXAC,<
SKIPN EXACT ;EXACT MODE?
JRST LODFL2 ;NOT EXACT MODE, TAKE AS IS
HRRZ T1,T2 ;DROP THE COMND% JFN
RLJFN% ;..
ERJMPS .+1
MOVE T1,GTJBLK+.GJGEN
HRRM T1,EXABLK+.GJGEN
DMOVE T1,GTJBLK+.GJDEV ;GIVE GTJFN THE SAME DEFAULTS
DMOVEM T1,EXABLK+.GJDEV
DMOVE T1,GTJBLK+.GJNAM
DMOVEM T1,EXABLK+.GJNAM
MOVEI T1,EXABLK ;DO AGAIN, WITH G1%SLN LIT, SO
HRROI T2,ATOM ;WE CAN FORCE NON-EXPANSION OF
GTJFN% ;LOGICAL NAMES
JSERRD <Can't re-GTJFN file for EXACT mode> ;WHY?
MOVE T2,T1
> ;END IFN FTEXAC
LODFL2: CALL RPSJFN
MOVEM T2,JFNLST(Q1) ;SAVE JFN
SETZM JF2LST(Q1) ;ASSUME SAME OUTPUT
GUIDES <TO>
CALL OFNAME
MOVX T2,GJ%OFG
HLLM T2,GTJBLK+.GJGEN
MOVX T2,.GJNHG
TXNE F,F.SSA
HRRM T2,GTJBLK+.GJGEN
DMOVE T1,[EXP CMDBLK,LDEINB]
CALL PARSE ;GET FILENAME, COMMA, OR CONFIRM
ERROR <Illegal file specification>;MANAGED TO MISS THEM ALL
CAIN T3,.CMCMA ;COMMA?
JRST LOADCT ;INCREMENT AND GO 'ROUND AGAIN
CAIN T3,.CMCFM ;CONFIRM?
JRST LOADST ;YES, DONE PARSING
CALL RPSJFN ;FILESPEC, SAVE THE JFN
CALL CHKDSK
JRST MBDERR ;DISK ONLY
MOVEM T1,JF2LST(Q1) ;SAVE THE JFN IN THE LIST TOO
DMOVE T1,[EXP CMDBLK,LD2INB] ;NEED COMMA OR CONFIRM
CALL PARSE
ERROR <Not a comma or a confirm>,NOCMD
CAIE T3,.CMCFM ;WHICH?
JRST LOADCT ;COUNT AND GO 'ROUND AGAIN
LOADST: MOVNI Q1,1(Q1)
HRLZM Q1,NFJFN ;SAVE THE COUNT
CHCKST: TXZ F,F.GOT1
HLRO T1,NFJFN
MOVNM T1,STOPLD ;# OF JFNS TO MATCH
SETZM SAVENO ;NO SAVESET NUMBER
SETZM TAPENO ;TAPE NOT KNOWN
SETZM LSTDIR ;LAST DIRECTORY LOADED INTO NOT KNOWN
SETZM TOTFIL ;NO FILES YET
SETZM TOTCNT ;NO PAGES YET
SETZM DIRDMD ;NO DIRECTORIES YET
SETZM TOTSKP ;NOTHING SKIPPED YET
SETZM TOTDEL ;NOTHING DELETED YET
SETZM PASWDC ;PASSWORD CREATE ERRORS GAIN IMMED. HALT
SETOM OKIAE ;INTERRUPTS OK NOW
CALL GMOJFI ;TAPE FOR READING
JRST BAKOUT ;OH WELL
CALL GETREC ;GET FIRST RECORD
CAIE T3,SAVEST ;SAVESET OR CONTINUED SAVESET?
CAIN T3,CONTST ;..?
SKIPA T1,SAVENO ;YES, MIGHT BE ARCHIVAL, TEST
JRST RSTPOK ;ITS NOT - WIERD!
JUMPE T1,FSTSSH
TXNN F,F.PRIV
JRST [CALL REWCV
ERROR <May not read from this saveset without WHEEL or OPR>]
TXNE F,F.CHCK ;CHECK OPERATION?
JRST FSTSSH ;YES, ALLOW WITHOUT COMPLAINT
WARN <This tape is a Virtual disk tape. It should not be used to
restore files. This action may violate system security.>
HRROI T1,[ASCIZ/Are you sure you should do this? /]
CALL YESNO
JUMPE T2,BAKOUT ;DECIDED AGAINST THIS
FSTSSH: CALL TYPHDR
HUNTIN: SKIPG STOPLD
JRST LODENT ;ZERO IF NONE LEFT
CALL GETREC
RSTPOK: CAIN T3,SAVEEN
JRST LODENT
CAIE T3,SAVEST ;NEXT SAVESET START
CAIN T3,TAPEEN ;OR END OF TAPE
JRST LODENT ;BOTH MEAN END, SO DONE
CAIN T3,DIRECT
JRST [TXNN F,F.CHCK;CHECKING? DON'T CREATE
TXNN F,F.CREA;CREATING DIRECTORIES?
JRST HUNTIN ;IGNORE IT
JRST CREADR] ;CREATE AND GO ON
CAIE T3,FILEST
JRST HUNTIN
HRROI T2,LSTSEN ;GET POINTER TO NAME (SET BY GETREC)
TXNE F,F.CHCK
JRST DFCHCK ;CHECK GOES ELSEWHERE
CALL TSTNAM ;MATCH ANYTHING?
JRST [RLJFN%
JRST HUNTIN ;NO
JRST HUNTIN]
MOVEM T1,JFN ;^A WILL SEE THIS, OH WELL
MOVE T1,JFNLST(T4) ;GET BITS ON INPUT JFN, TO SEE IF WILD
TXNN F,F.RETR ;RETRIEVAL SHOULDN'T WORRY ABOUT THIS
TXNE T1,GJ%DEV+GJ%UNT+GJ%DIR+GJ%NAM+GJ%EXT+GJ%VER
JRST NOLWIL ;SOMETHING IS WILD IN IT, OR DOING RETRIEVAL
HRRZS T1 ;THIS JFN CAN GO AWAY, SINCE NOTHING ELSE
RLJFN% ;CAN MATCH IT IN THIS SAVESET
ERJMPS .+1
SETZM JFNLST(T4) ;ZERO ITS SLOT
SOS STOPLD ;ONE LESS JFN TO CARE ABOUT
NOLWIL: TXNE F,F.INTR
JRST NOINDT ;INTERCHANGE CANT CHECK DATES
MOVE T3,CURDAT ;GET POINTER INTO DATA
MOVE T1,FDBOFF+.FBCRE(T3);CHECK CREATION DATES
CAMG T1,MBTAD
CAMGE T1,MSTAD
JRST NOLOAD
MOVE T1,FDBOFF+.FBWRT(T3);WRITE DATES
CAMG T1,WBTAD
CAMGE T1,WSTAD
JRST NOLOAD
CAMGE T1,FDBOFF+.FBREF(T3)
MOVE T1,FDBOFF+.FBREF(T3)
CAMG T1,ABTAD
CAMGE T1,ASTAD
JRST NOLOAD
NOINDT: TXNN F,F.FILT ;WANT FILENAME TYPEOUT?
JRST NFTTYP ;NO
HRROI T1,FILNAM ;STORE TAPE FILENAME HERE
MOVE T2,JFN
MOVE T3,[JFNSAL]
JFNS%
NFTTYP: MOVE P5,MATCH ;GOFNAM WANTS THIS IN P5
CALL GOFNAM ;GEN OUTPUT NAME TO OUTSPC
CALL GOFPAT ;THESE WANT JFN SET UP
SETZ T1,
EXCH T1,JFN ;LOSE OLD JFN
RLJFN%
JFCL
TXNE F,F.SSA ;SUPERCEDE ALWAYS?
JRST JUSTJF ;NO, GO GET OUTPUT JFN
MOVE T1,OUTFLS ;POINT AT FILENAME
SETZ T4, ;COPY NOWHERE
MOVEI T2,"."
CALL CPYDLM ;GET PAST FILENAME
CALL CPYDLM ;GET PAST EXTENSION
ILDB T4,T1 ;GET NEXT CHARACTER
MOVEM T1,OUTGEN
MOVEM T4,GEITMP ;STORE CHARACTER
DELLOP: DPB T3,T1 ;STORE A NULL
MOVX T1,GJ%OLD+GJ%XTN;SET UP TO FIND ANY
MOVEM T1,RETBLK+.GJGEN
MOVEI T1,RETBLK
HRROI T2,OUTSPC ;..
GTJFN% ;ANY WITH THIS NAME?
ERJMPS [DPB T4,OUTGEN;NO, RESTORE GENERATION
JRST JUSTJF] ;AND GO LOAD
MOVEM T1,JFN ;REMEMBER THIS
DPB T4,OUTGEN ;RESTORE GENERATION
TXNE F,F.SSN ;SUPERCEDE NEVER?
JRST SKPLOD ;YES, COUNT AS SKIPPED AND GO ON
MOVSI T2,.FBWRT+1
MOVEI T3,FDB
GTFDB%
ERJMPS SKPLOD
MOVE T3,CURDAT ;POINT TO TAPE FDB
MOVE T2,FDB+.FBWRT ;FETCH FILE LAST WRITE
CAML T2,FDBOFF+.FBWRT(T3);COMPARE WITH TAPE DATE
JRST SKPLOD ;REASON NOT TO LOAD
HLRZ T2,FDB+.FBGEN ;GET ON-DISK GENERATION
HLRZ T3,FDBOFF+.FBGEN(T3) ;GET TAPE GENERATION
CAML T3,T2 ;DOES TAPE FILE HAVE A HIGHER GEN?
JRST DRKJFN ;YES, FINE
WARN <Deleting >
CALL TYJFN1 ;TYPE JFN IN T1
TYPE [ASCIZ/ while superseding.
/]
MOVE T1,JFN
DELF%
ERJMPS .+2 ;OH WELL
AOS TOTDEL
SETZ T3,
MOVE T1,OUTGEN
MOVE T4,GEITMP
JRST DELLOP
LDTRYF: CAIE T1,GJFX44 ;ACCOUNT STRING MISMATCH
CAIN T1,VACCX0 ;ACCOUNT INVALID
SKIPA T4,OUTACS ;ONE OF THEM, POINT TO ACCOUNT STRING
JRST LODNOT ;NOPE, GO COMPLAIN
SETZ T2,
IDPB T2,T4 ;CLOBBER ACCOUNT STRING
WARN <Using system default account for >
TYPE OUTSPC
JRST JUSTJF
DRKJFN: RLJFN% ;GOING TO USE THE TAPE FILE
JFCL
JUSTJF: MOVE T1,OUTDRS
ILDB T2,T1
PUSH P,T2 ;PRESERVE THIS
SETZ T2,
DPB T2,T1 ;AND DESTROY FOR CHECK
MOVEM T1,GEITMP ;SAVE THIS FOR A MOMENT
HRROI T1,OUTSPC
HRROI T2,LSTDIR
CALL STCMPC
JUMPE T3,SAMEAS
CALL STCOPY
CALL IFCRL2
TYPE [ASCIZ/ Loading files into /]
TYPE LSTDIR
TYPE CRLF
SAMEAS: POP P,T2
DPB T2,GEITMP
SETOM CURREN ;TELL ^A NO PAGE NUMBER YET
MOVX T1,GJ%XTN+GJ%FOU
MOVEM T1,RETBLK+.GJGEN
MOVEI T1,RETBLK
HRROI T2,OUTSPC ;SET UP TO WRITE FILE
GTJFN% ;..
ERJMPR LDTRYF ;SOME ERRORS WE CAN FIX
MOVEM T1,JFN
MOVX T2,OF%WR
OPENF%
ERJMPS LODNOT ;CAN'T LOAD THIS FILE
TXNN F,F.FILT ;TYPE FILENAME(S)?
JRST NLFTYP
CALL IFCRLF ;GET AGAINST THE LEFT MARGIN
TYPE [ASCIZ/ /] ;2 SPACES
TYPE FILNAM
TYPE [ASCIZ/ to /]
TYPE OUTSPC
NLFTYP: CALL PLOP
JRST LODNOT ;FAILED TO LOAD
TXNE F,F.SARC!F.INTR ;SUPRESS TAPE INFO? OR NO ARCF INFO POSSIBLE?
JRST [MOVE T1,JFN ;YES, CLOSE UP AND FINISH NOW
SETZM JFN
CLOSF% ;..
ERJMPS LODNOT ;THIS CLOSF SHOULDN'T FAIL
JRST RESTOK] ;ON TO NEXT
CALL ARCFIX ;DO ARCF TAPE INFO STUFF, AND CLOSE FILE
JRST DNELDF ;MAYN'T DO OFFLINE FILES THIS WAY
MOVE T1,JFN ;RELEASE JFN (ARCFIX CLOSF'D)
SETZM JFN
RLJFN% ;FINISH THE FILE
ERJMPS .+1 ;NOT A PROBLEM
RESTOK: TXNE F,F.FILT
TYPE <[ASCIZ/ [OK]
/]>
DNELDF: MOVE T3,LASTYP ;CONTINUE SCAN
JRST RSTPOK
DFCHCK: SETZM JFN
MOVX T1,GJ%SHT+GJ%OLD
GTJFN%
ERJMPS [WARN <File >
TYPE @CURDAT
TYPE [ASCIZ/ not checked/]
CALL LSTERD
TXO F,F.GOT1
JRST SKPDAT]
MOVEM T1,JFN
SKPDAT: CALL GETREC ;SKIP DATA
JUMPE T3,SKPDAT ;..
CAIN T3,FILEEN
JRST CHKFDB
CAIE T3,CONTST
CAIN T3,FILEST
JRST SKPDAT
CALL UNEXTY ;ODD RECORD, COMPLAIN
MOVE T3,LASTYP
CAIE T3,SAVEEN ;MAYBE MISSING FILEEN
JRST SKPDAT
WARN <Probably missing a file ending record>
JRST CHKFDB ;SO FAKE IT AND HOPE
CHKFDB: SKIPN T1,JFN ;GOT A FILE?
JRST CHKDON ;NO, JUST FINISH
MOVSI T2,.FBLN0
MOVEI T3,FDBBUF
GTFDB%
ERJMPS .+1
MOVE T2,CURDAT
CALL FILDWN ;SETS UP P1 AND T2 FOR US
JFCL ;ALWAYS SKIPS FOR US
MOVEM T2,AUTTMP ;STORE POINTER TO AUTHOR
MOVE T2,CURDAT
;ADDI T2,FDBFFF
HRRZM T2,INDEX
CHKFDL: MOVE T1,FDBBUF(P1)
XOR T1,@INDEX ;COMPARE WORDS
AND T1,CKMASK(P1) ;BUT CHECK ONLY CERTAIN BITS
TXNE F,F.INTR ;INTERCHANGE MODE?
AND T1,ICMASK(P1) ;YES, FEWER BITS PERTINENT
JUMPN T1,FDBERR ;JUMP IF COMPARED BITS DIFFERENT
CHKFD0: AOS INDEX
AOBJN P1,CHKFDL
TXNE F,F.INTR ;SKIP IF NOT INTERCHANGE FORMAT
JRST CHKDON ;DON'T CHECK AUTHOR & LAST WRITER
HRR T1,JFN ;JFN OF FILE
HRLI T1,.GFAUT ;FUNCTION IS GET AUTHOR
HRROI T2,STRING ;STORE STRING HERE
GFUST%
ERJMPS [SETZM STRING
JRST .+1]
HRROS T2,AUTTMP
HRROI T1,STRING
CALL STCMPC
JUMPE T3,CHKST2
WARN <File author differs for file >
CALL TYJFN
TYPE CRLF
TXO F,F.GOT1
CHKST2: HRR T1,JFN
HRLI T1,.GFLWR ;GET LAST WRITER
HRROI T2,STRING
GFUST%
ERJMPS [SETZM STRING
JRST .+1]
HRROI T1,STRING ;LAST WRITER
HRROS T2,AUTTMP
ADDI T2,10
CALL STCMPC
JUMPE T3,CHKDON
WARN <File last-writer differs for file >
CALL TYJFN
TXO F,F.GOT1
TYPE CRLF
CHKDON: SKIPN T1,JFN
JRST SCANON
SETZM JFN
RLJFN%
ERJMPS .+1
SCANON: MOVE T3,LASTYP
JRST RSTPOK ;GO CHECK NEXT FILE
FDBERR: WARN <Difference in >
TXO F,F.GOT1
MOVE T3,FDBNAM(P1)
CALL SIXOUT
FDBER9: TYPE [ASCIZ/ of file /]
CALL TYJFN
TYPE CRLF
JRST CHKFD0
LODNOT: WARN <Not loading >
TYPE OUTSPC
CALL LSTERD
JRST NOLOAD
SKPLOD: AOS TOTSKP
NOLOAD: SKIPE T1,JFN ;ANY JFN LEFT?
CALL DRPJFA
SETZM JFN ;YES, DROP
JRST HUNTIN
LODENT: SETZM OKIAE ;NO INTERRUPTS NOW
CALL IFCRL2
TXNN F,F.CHCK ;CHECK DOESN'T USE JFNLST/JF2LST
CALL DMPJFS ;TOSS JFNS IN JFNLST/JF2LST
TXNE F,F.RETR
JRST LODSTN
MOVE T3,LASTYP
CAIN T3,SAVEEN ;STOP ON SAVESET END?
JRST LODSTS ;YES, DON'T BACKUP
CAIE T3,SAVEST ;STOP ON SAVESET BEGIN?
JRST LODSTT ;NO, MAYBE AT END OF TAPE
CALL BACKSP ;YES, BACKUP OVER READAHEAD
CALL BACKSP ;BACKSPACE TO SAVESET START
LODSTS: TYPE [ASCIZ/ End of Saveset./]
JRST LODSTN
LODSTT: CAIE T3,TAPEEN
JRST LODSTM
TYPE [ASCIZ/ End of Tape./]
LODSTN: CALL KILCHN
SETZM LSTSEN ;NO MORE LAST SEEN FILE
LODSTM: TYPE CRLF
TXNE F,F.CHCK
JRST CHKEND
MOVE T3,[NO%LFL+NO%OOV+^D10(6)]
SKIPN T2,TOTFIL
JRST [TXNN F,F.RETR
JRST NOFLSR
TYPE [ASCIZ/ No files Retrieved/]
JRST CMDEND]
TYPE [ASCIZ/
Total files restored: /]
CALL NUMOUT
TYPE [ASCIZ/
Total pages restored: /]
MOVE T2,TOTCNT
CALL NUMOUT
NOFLSR: TXNE F,F.RETR ;RETRIEVAL?
JRST CMDEND ;THE REST DOESN'T APPLY
SKIPN T2,DIRDMD
JRST TNODRC
TYPE [ASCIZ/
Directories created: /]
CALL NUMOUT
SKIPG T2,PASWDC
JRST TNODRC
TYPE [ASCIZ/
Encryption errors: /]
CALL NUMOUT
TNODRC: SKIPN T2,TOTSKP
JRST TNOFSK
TYPE [ASCIZ/
Files skipped: /]
CALL NUMOUT
TNOFSK: SKIPN T2,TOTDEL
JRST CMDEND
TYPE [ASCIZ/
Number of files deleted: /]
CALL NUMOUT
JRST CMDEND
CHKEND: TXNN F,F.GOT1
TYPE [ASCIZ/ No differences seen./]
JRST CMDEND
PLOP: SKIPE ABTFLG ;FOR RETRIEVE
JRST CPOPJ1 ;ACT AS IF FINISHED OK (WE FIX THIS LATER)
CALL GETREC
JUMPN T3,CKFEND
HRLI T2,PAGBUF ;PAGBUF=PAGPAG*1000
MOVSS T2
MOVEI T3,777(T2)
BLT T2,(T3)
HRRZ T2,.PAGNO(T1)
MOVEM T2,CURREN
HRL T2,JFN
MOVE T1,[.FHSLF,,PAGPAG]
MOVX T3,PM%RWX
PMAP%
ERJMPS CPOPJ
AOS TOTCNT
JRST PLOP
CKFEND: CAIN T3,FILEEN
JRST FILDWN
CAIE T3,CONTST ;CONTINUED SAVESET, FINE
CAIN T3,FILEST ;IGNORE THIS
JRST PLOP
CAIE T3,TONEXT
JRST TRWNE
CALL NXTRTT ;RETRIEVAL DOES THIS
JRST PLOP
TRWNE: CALL UNEXTY ;COMPLAIN AND GO ON
JRST PLOP
UNEXTY: WARN <Unexpected tape record type >
MOVE T2,T3
CALL DECOUT
TYPE [ASCIZ/, ignoring./]
RET
;RESTORE, RETRIEVE - come here to fix FDB
;CHECK - come here to set up P1 (AOBJN FDB length) and T2 (pointer to author)
; Return +2 if all OK (F.CHCK set will always return +2)
FILDWN: SETOM CURREN
TXNN F,F.INTR ;INTERCHANGE?
SKIPN P1,FDBFFF+.FBHDR(T2) ;NO, GET FDB SIZE
MOVEI P1,.FBLN0 ;INTERCHANGE OR NO SIZE, ASSUME THIS SIZE
ANDI P1,777
MOVEM P1,AUTTMP
CAILE P1,.FBLN0 ;MAKE SURE LESS THAN OUR MAX
MOVEI P1,.FBLN0 ;STRANGE. USE OUR MAX
MOVNS P1
HRLZS P1 ;AOBJN'D
MOVEI T4,FDBFFF(T2) ;POINT TO DATA
TXNE F,F.CHCK ;CHECKING?
JRST FILDCK ;YES, JUST GET INFORMATION
FIXFDB: MOVE T1,JFN ;GET JFN
MOVE T3,(T4) ;GET VALUE TO SET
TXNN F,F.PRIV ;PICK WHICH VALUES TO TRY TO SET
SKIPA T2,NWMASK(P1)
MOVE T2,MASK(P1)
TXNE F,F.INTR ;INTERCHANGE TAPE?
MOVE T2,ICMASK(P1) ;YES, SET DIFFERENT BITS
JUMPE T2,FIXFDE ;NO BITS IN MASK?
HRL T1,P1 ;NO, WE HAVE SOMETHING TO SET
TXO T1,CF%NUD ;DON'T GO TO DISK FOR THIS
CHFDB%
JSERRD <>,.+1
FIXFDE: ADDI T4,1
AOBJN P1,FIXFDB
MOVE T4,CURDAT ;SET UP FOR INVISIBILITY
MOVE T1,JFN
HRLI T1,.FBCTL
MOVX T2,FB%INV
TXNN F,F.RETR!F.INTR ;ARE WE RETRIEVING? OR INTERCHANGE MODE?
SKIPA T3,FDBFFF+.FBCTL(T4) ;NO, GET ACCORDING TO OLD STATE
SETZ T3, ;YES, CLEAR ALWAYS
DOJSS CHFDB%, .+1 ;TRY IT
FILDCK: TXNE F,F.INTR ;INTERCHANGE MODE?
JRST NOWRTR ;YES, DON'T SET AUTHOR
MOVE T2,FORMAT ;FORMAT MATTERS HERE
CAIGE T2,6 ;V6 AND LATER - BASED ON FDB SIZE
JRST [HRROI T2,FDBFFF+.FBLN0(T4)
JRST AUTGT]
MOVEI T2,FDBFFF(T4)
ADD T2,AUTTMP ;OFFSET FROM ABOVE
AUTGT: TXNE F,F.CHCK
JRST NOWRTR
HRROS T2
MOVE T3,T2
HRLI T1,.SFAUT ;SET UP FOR AUTHOR STRING
DOJSS SFUST%, NOWRTR
TXNN F,F.PRIV ;NEED PRIVES TO SET WRITER
JRST NOWRTR
HRLI T1,.SFLWR
HRROI T2,10(T3)
DOJSS SFUST%, .+1
NOWRTR: AOS TOTFIL ;ASSUME IT MAKES IT
JRST CPOPJ1
;Here to put in tape (ARCF) info
ARCFIX: MOVE P1,CURDAT ;POINTER TO DATA BUFFER
;ADDI P1,FDBFFF ;POINT TO FDB
TXNE F,F.PRIV ;EL PRIVO?
JRST ARCFX1 ;YES, IGNORE SPECIAL TESTS
MOVE T2,.FBCTL(P1) ;GET ARCHIVE AND OFFLINE STATUS
TXNN T2,FB%ARC+FB%OFF;ARCHIVED OR OFFLINE?
JRST ARCFX1 ;NO TO BOTH
TXNE T2,FB%OFF ;OFFLINE?
JRST FLUSHL ;YES, ILLEGAL WITHOUT PRIVS - FLUSH ATTEMPT
JRST ARCNOT
ARCFX1: MOVE T1,JFN
TXO T1,CO%NRJ
CLOSF%
ERJMPS .+1
TXNN F,F.PRIV ;GOT PRIVS?
JRST CPOPJ1 ;NO, CAN'T DO ARCF STUFF SO DON'T TRY
HLLZ T4,.FBBBT(P1) ; Get archive bits
TXZ T4,AR%1ST ; This has been done already
JUMPE T4,ARCFI1 ; None set, skip this part
HRRZ T1,JFN ; JFN for this file
MOVEI T2,.ARRAR ; Request for archive
MOVEI T3,.ARSET ; Set it
TXNE T4,AR%NDL ; No flush please?
TXO T3,AR%NDL ; Yes, flag that
TXNE T4,AR%RAR ; Was it requested?
ARCF% ; Yes, reset that
ERCAL ARCFF
MOVEI T2,.ARRIV
MOVEI T3,.ARSET
TXNE T4,AR%RIV ; Involuntary request?
ARCF% ; Yes
ERCAL ARCFF
MOVEI T2,.ARNAR
MOVEI T3,.ARSET
TXNE T4,AR%NAR ; Resist archive?
ARCF% ; Yes,
ERCAL ARCFF
MOVEI T2,.AREXM
TXNE T4,AR%EXM ; Exempt from archiving?
ARCF% ; Yes, set that
ERCAL ARCFF
;**;[554] Add 7 lines and some comments at ARCFI1: DEE 12-AUG-88
;[554] For ARCHIVed files, a tape written by 4.1 DUMPER will have
;[554] 30 FDB words, 10 words for author name, 10 words for last
;[554] writer, then 7 words of archive information. A tape written
;[554] by 6.0 DUMPER has 37 words of FDB, then the author, last writer,
;[554] and archive information. So, check the tape format so we account
;[554] for the correct number of words from FDB-start when looking for
;[554] the archive information.
ARCFI1: MOVEI T4,20(P1) ;[554] Account for author and last writer strings
MOVE T2,FORMAT ;[554] See what format we are (4.1 saves only 30 FDB words)
CAIN T2,4 ;[554] Well?
IFSKP.
ADD T4,AUTTMP ;[554] Not format 4, FDB length is here
ELSE.
ADDI T4,.FBLN0 ;[554] Length of "old" FDB (30) is here
ENDIF.
SETZ T2, ; No flags yet
SKIPE .ARTP1(T4) ; 1st tape exist?
TXO T2,AR%O1 ; Yes, set that
SKIPE .ARTP2(T4) ; 2nd tape exist?
TXO T2,AR%O2 ; 2nd exists
JUMPE T2,CPOPJ1 ; Neither tape there, skip this
MOVE T3,.FBCTL(P1)
TXNE T3,FB%OFF ; Was it offline?
TXO T2,AR%OFL ; Yes, do that too
TXNE T3,FB%ARC ; Was it archived?
TXO T2,AR%ARC ; Yes, do that too
MOVEM T2,.AROFL(T4) ; Put bits into block
HRRZ T1,JFN
MOVEI T2,.ARSST ; Set the status
MOVE T3,T4
ARCF% ; Set it
ERCAL ARCFF
JRST CPOPJ1 ; Done here
ARCFF: WARN <ARCF failure on >
TYPE OUTSPC
JRST LSTERD
FLUSHL: MOVE T1,JFN
TXO T1,CZ%ABT
SETZM JFN
CLOSF%
ERJMPS .+1
WARN <Not loading >
TYPE OUTSPC
TYPE [ASCIZ/ - WHEEL or OPR needed for OFFLINE files/]
RET
ARCNOT: WARN <Not setting Archive information for >
TYPE OUTSPC
MOVE T1,JFN
TXO T1,CO%NRJ
CLOSF%
ERJMPS .+1
JRST CPOPJ1
CREADR: MOVE T4,T2 ;POINTER TO TAPE DATA
SKIPN .CDNUM(T4) ;INFORMATION PRESENT?
JRST HUNTIN ;NO, IGNORE
SKIPN T2,JF2LST ;HAVE OUTPUT DEFAULT?
JRST LODUSD ;GET NAME FROM TAPE (OR DSK:)
HRROI T1,OUTDIR
HRRZS T2 ;JFN ONLY
MOVX T3,<1B2+JS%PAF>
JFNS% ;GET DEVICE NAME:
LODUSA: MOVEI T2,"<" ;OPEN BRACKET
IDPB T2,T1 ;STASH
MOVE T2,T1 ;SETUP OUTPUT PNTR IN B
MOVE T1,[POINT 7,UHNAM(T4)] ;BEG OF NAME ON TAPE
LODUS1: ILDB T3,T1 ;YES - LOCATE DIRECTORY NAME
CAIE T3,"<"
JRST LODUS1 ;LOOP TILL OPEN BRACKET FOUND
LODUS2: ILDB T3,T1 ;GET CHAR IN NAME
CAIE T3,">" ;LOOK FOR CLOSE BRACKET OR NULL
JUMPN T3,[IDPB T3,T2 ;COPY CHAR IN NOT NULL
JRST LODUS2]
MOVEI T3,">" ;TERMINATE DIRECTORY NAME
IDPB T3,T2
SETZ T3, ;ADD NULL TO STRING
IDPB T3,T2 ;...
HRRO T2,T4
ADDM T2,.CDPSW(T4) ;SET PASSWORD STRING ADDRESS
SKIPE .CDLEN(T4) ;CHECK FOR LENGTH
ADDM T2,.CDDAC(T4) ;SET DEFAULT ACCOUNT ADDRS
MOVX T1,RC%EMO ;CHECK FOR ALREADY EXISTING DIR
HRROI T2,OUTDIR ;...
RCDIR%
ERJMPS NEWDCR ;ERROR, ASSUME DOESN'T EXIST
TXNN T1,RC%NOM!RC%AMB;EXISTS?
HRRM T3,.CDNUM(T4) ;YES - USE EXISTING NUMBER
NEWDCR: HLLZ P3,.CDLEN(T4) ;THIS WILL BE T2
HRR P3,T4 ;ADDRESS OF BLOCK IN RH
TXO P3,CD%LEN+CD%PSW+CD%LIQ+CD%PRV+CD%MOD+CD%LOQ+CD%NUM+CD%FPT
TXO P3,CD%DPT+CD%RET+CD%UGP+CD%DGP ;BITS ALWAYS ON
TXZ P3,CD%LLD
IFG FTVERS-5,<
TXO P3,CD%SDQ+CD%CUG+CD%DAC+CD%PPN ;These may get turned off
>
IFLE FTVERS-5,<
TXO P3,CD%SDQ+CD%CUG+CD%DAC ;These may get turned off
>
MOVE P4,.CDLEN(T4) ;GET LENGTH FOR BLOCK
HRRZ T1,P4 ;INTO T1 (AND P4)
CAIG T1,0
HRRI P4,CD.LEN ;0 IS A BAD IDEA
IFG FTVERS-5,<
TXO P4,CD%NSQ+CD%PEN+ CD%NED+CD%FED+CD%PED+CD%PMU
;LATTER MAY GET OFF'D IF THEY CAUSE ERRORS
TXZ P4,CD%NCE+CD%RNA;NOT CD%NCE or CD%RNA yet
>
IFLE FTVERS-5,<
TXO P4,CD%NSQ+CD%NED+CD%FED
TXZ P4,CD%NCE
>
IFG FTVERS-5,<
MOVE T2,FORMAT ;GET FORMAT NUMBER
CAIG T2,4 ;PRE-PASSWORD ENCRYPTION VERSION?
SETZM .CDPEV(T4) ;YES, MAKE ENCRYPTION VERSION # ZERO
CAIL T1,.CDPPN
SKIPN .CDPPN(T4)
TXZ P3,CD%PPN
CAIL T1,.CDPED
SKIPN .CDPED(T4)
TXZ P4,CD%PED
CAIL T1,.CDPMU
SKIPN .CDPMU(T4)
TXZ P4,CD%PMU
>
CAIL T1,.CDSDQ ;DOES IT HAVE THIS?
SKIPN .CDSDQ(T4)
TXZ P3,CD%SDQ
CAIL T1,.CDCUG ;In general, check the FDB length to see if
SKIPN .CDCUG(T4) ; it is long enough to have foo. If not,
TXZ P3,CD%CUG ; turn off the bits that imply foo is
CAIL T1,.CDDAC ; available.
SKIPN .CDDAC(T4)
TXZ P3,CD%DAC
CAIL T1,.CDDFE
SKIPN .CDDFE(T4)
TXZ P4,CD%FED
CAIL T1,.CDDNE
SKIPN .CDDNE(T4)
TXZ P4,CD%NED
MOVEI T2,777
ANDM T2,.CDCUG(T4) ;TOSS OUT ANY GARBAGE
ADDM T4,.CDCUG(T4) ;AND OFFSET POINTERS PROPERLY
ANDM T2,.CDUGP(T4)
ADDM T4,.CDUGP(T4)
ANDM T2,.CDDGP(T4)
ADDM T4,.CDDGP(T4)
CREAGA: MOVEM P4,.CDLEN(T4)
MOVE T2,P3 ;SET UP ABOVE
HRROI T1,OUTDIR ;LOCATION OF DIRECTORY TO CREATE
CRDIR%
ERJMPR LODUS9 ;CHECK LOSAGE
TYPE OUTDIR
TYPE [ASCIZ/ created
/]
AOS DIRDMD
JRST HUNTIN
LODUSD: MOVE T1,[POINT 7,OUTDIR] ;INIT POINTER
MOVE T2,[POINT 7,UHNAM(T4)]
LODUSE: ILDB T3,T2 ;GET A CHAR
JUMPE T3,LODUSF ;NO DEVICE - USE DSK:
IDPB T3,T1 ;COPY CHARACTER
CAIE T3,":" ;COLON?
JRST LODUSE ;NO - GET MORE
JRST LODUSA ;YES - DONE
LODUSF: MOVE T3,[ASCII "DSK:"]
MOVEM T3,OUTDIR ;V2 OR EARLIER - USE DSK:
MOVE T1,[POINT 7,OUTDIR,27]
JRST LODUSA ;PROCEED
;Here on CRDIR% failure - check reason and try again if correctable
LODUS9: MOVE T2,T1
CAIE T2,ARGX27 ;OFF-LINE EXPIRATION LIMIT?
JRST CREDE0
TXZE P4,CD%FED
JRST CRETR2
JRST CREERR
CREDE0: CAIE T2,CRDIX2 ;ILLEGAL NUMBER?
CAIN T2,CRDIX8
TRNA
JRST CREDE1
SETZM .CDNUM(T4)
TXZE P3,CD%NUM
JRST CRETR2
JRST CREERR
CREDE1: CAIE T2,PPNX1 ;BAD PPN?
JRST CREDE2
IFG FTVERS-5,<
TXZE P3,CD%PPN
JRST CRETR2
>
JRST CREERR
CREDE2: CAIE T2,CRDI16 ;INVALID USER GROUPS?
JRST CREDE3
TXZE P3,CD%UGP!CD%CUG
JRST CRETR2
JRST CREERR
CREDE3: CAIE T2,CRDI24
CAIN T2,CRDI22 ;CD%SDQ TO BLAME?
TRNA
JRST CREDE4
TXZE P3,CD%SDQ
JRST CRETR2
JRST CREERR
CREDE4:
IFG FTVERS-5,<
CAIE T2,CRDI27 ;TEST FOR SERIOUS PASSWORD PROBLEMS
CAIN T2,CRDI26 ;..
JRST PASLST
CAIE T2,CRDI28 ;..
JRST CREDE5 ;SOME OTHER ERROR, OK
PASLST: TXZN P4,CD%PED+CD%PMU ;IF WE RETRY, FLIP OFF ENCRYPT BITS
JRST CREERR ;ALREADY TRIED THAT, FAIL COMPLETELY
PAT09A: SKIPE PASWDC ;HAVE WE SEEN THIS BEFORE AND OK'D IT?
JRST CRETRP ;YES, GO ON WITHOUT LONG ERROR MESSAGE
ERROR <Problem with password in Creation of directory >
TYPE OUTDIR ;SCREAM BLOODY 'ELL. THIS COULD BE SERIOUS.
TYPE [ASCIZ/
Error is: /] ;EXPLAIN PROBLEM
CALL LSTERO ;..
TYPE [ASCIZ/
Attempting to Continue will probably restore files correctly, but the
directory itself may have no usable password (LOGIN may be impossible).
CONTINUE ONLY IF this is acceptable for all subsequent directory creations.
If you Continue, DUMPER will give the standard TOPS-20 error message for
each occurance of a password problem in this RESTORE, but not stop.
RESET if possibly garbled passwords are not acceptable./]
HALTF% ;DON'T GO ON UNLESS ASKED
CRETRP: AOS PASWDC ;REMEMBER THIS SO WE DON'T ASK AGAIN
JRST CRETR2 ;DO RETRY CODE WITHOUT ENCRYPT BITS
>
CREDE5: CAIE T2,CRDI13 ;QUOTA?
JRST CREERR
TXZN P3,CD%LIQ+CD%LOQ
JRST CREERR
;JRST CRETR2
CRETR2: WARN <Failed to create >
TYPE OUTDIR
HRROI T1,[ASCIZ/
error is: /]
CALL LSTERO
TYPE [ASCIZ/ - RETRYING
/]
JRST CREAGA
CREERR: TXON P4,CD%NCE ;LAST DITCH EFFORT - TRY THIS
JRST CRETR2
CRETFL: ERROR <Directory >,.+1
TYPE OUTDIR
TYPE [ASCIZ/ not created/]
CALL LSTERD
TYPE CRLF
JRST HUNTIN ;TRY TO CONTINUE
SUBTTL Print command
PRINT: GUIDES <DIRECTORY OF TAPE ONTO FILE>
SETZM PRIFLG ;NO PRINT OPTION FLAGS YET
MOVX T1,GJ%NEW
MOVEM T1,GTJBLK+.GJGEN
SETZM GTJBLK+.GJDEV
SETZM GTJBLK+.GJDIR
SETZM GTJBLK+.GJNAM
HRROI T1,[ASCIZ/LST/]
MOVEM T1,GTJBLK+.GJEXT
PRINTR: DMOVE T1,[EXP CMDBLK,PRIINB]
CALL PARSE ;GET OUTPUT FILENAME
JSERRD <>,NOCMD
CAIE T3,.CMSWI
JRST PRINTJ
HRRZ T2,(T2)
JRST (T2)
PRINTJ: CALL RPSJFN
CALL CHKJFN
TLNE T3,-1 ;ILLEGAL IN ANY WAY?
ERROR <Illegal PRINT file choice>,NOCMD
SETZM PRITTY
CAIN T3,.DVTTY
SETOM PRITTY
CONFIRM
CALL OPNLSF ;OPEN LIST FILE, 1ST PAGE
JRST NOCMD
MOVE T1,PRIFLG
TXNN T1,P.FAST ;DOING A FAST PRINTING?
JRST PRINTK ;NO
MOVSI T1,(1B0) ;YES. SET PAGE COUNT TO -INFINITY TO..
MOVEM T1,LSTLIN ;MAKE SURE NO LIST FILE PAGING OCCURS
PRINTK: SETOM OKIAE ;INTERRUPTS HO
CALL GMOJFI ;GET TAPE FOR READING
JRST NOCMD
TXO F,F.NVOL ;WE WANT TO HANDLE THIS OURSELF
PRILOP: SELECT LS.TTY ;GETREC MAY NEED THE TERMINAL
CALL GETREC
PRILO2: SELECT LS.LST ;TALK TO LIST FILE
MOVE Q3,PRIFLG ;GIVE EACH ROUTINE THE PRINT FLAGS IN Q3
JRST @[EXP DATAPR,SAVSPR,FILBPR,FILEPR,TAPNPR
EXP DIREPR,CONTPR,PRILOP,TONEPR](T3)
; These are: Data record, Saveset beginning, File header, File trailer, EOT,
; Directory record, Continued Saveset beginning, Saveset end, Next tape record
TONEPR: TXO F,F.NVOL ;THIS GOT TURNED OFF, PUT IT BACK ON
TYPE [ASCIZ/
End of tape /]
MOVE T2,TAPENO
CALL DECOUT
TYPE [ASCIZ/, Saveset continued on next tape
/]
MOVE T1,LSTJFN
TXO T1,CO%NRJ ;CLOSE WITHOUT LOSS OF JFN
CLOSF%
ERJMPS .+1 ;SNH
SELECT LS.TTY ;UPTAPE MIGHT WANT THE TTY
CALL UPTAPE
MOVE T1,LSTJFN
CALL OPNLST ;OK, CONTINUE THE LIST FILE
JFCL
MOVE T3,LASTYP ;GET RECORD TYPE THAT UPTAPE READ
TXNN Q3,P.FAST
JRST PRILO2 ;UPTAPE DOES A GETREC FOR US
MOVSI T1,(1B0)
MOVEM T1,LSTLIN ;OPNLST SET THIS. RESET IT FOR /FAST
JRST PRILO2
CONTPR:
SAVSPR: HRLZ T1,CURDAT ;FROM LAST RECORD IN
HRRI T1,SSNBUF ;TO NORMAL SAVESET BUFFER
BLT T1,SSNBUF+777 ;COPY IT IN
SKIPE PRITTY ;PRINTING TO A TTY?
JRST SAVSP2 ;YES. DON'T TYPE SAVESET HEADER
SELECT LS.TTY ;NO, LET USER SEE SAVESET HEADER
CALL LINE1A ;SET UP STRING WITH A HEADER
TYPE STRING
TYPE CRLF
SELECT LS.LST
SAVSP2: MOVE T1,PRIFLG ;IN "FAST" MODE?
TXNE T1,P.FAST ;..?
JRST SAVSPF ;YES
SETOM LSTLIN ;FORCE NEW PAGE HEADER, WHICH HAS..
JRST PRILOP ;THE NEW SAVESET INFO
SAVSPF: TYPE CRLF2 ;FAST MODE, JUST DO A FAST HEADER, NO <FF>,
CALL LINE1A ;JUST WITH GENERAL TAPE INFO
CALL LINE1B
JRST PRILOP
DIREPR: TYPE [ASCIZ/
DDB for /]
TYPE UHNAM(T2)
IFG FTVERS-5,<
MOVE T1,.CDLEN(T2) ;GET LENGTH OF DDB
ANDI T1,377 ;DISCARD ANY OTHER INFO
CAIGE T1,.CDPEV ;DOES IT HAVE PASSWORD ENCRYPTION INFO?
JRST PRILOP ;NO, DONE
PUSH P,.CDPEV(T2) ;SAVE THIS FOR A MOMENT
MOVEI T2,DDCOL
CALL TABOUT
TYPE [ASCIZ/PEV: /]
POP P,T2 ;OK, GET ENCRYPTION NUMBER
CALL DECOUT
>
JRST PRILOP
FILBPR: MOVE Q1,T2 ;SAVE THE DATA POINTER
MOVE T1,CURHEA
SKIPGE .PAGNO(T1) ;CONTINUED FILE?
TYPE [ASCIZ/
File Continued from previous reel/]
TYPE CRLF
MOVEI T2,FLCOL
TXNE Q3,P.FAST
MOVEI T2,FFLCOL
CALL TABOUT
MOVE T2,Q1
HRLI T2,(POINT 7)
DIRF1: ILDB T1,T2
CAIE T1,";" ;END OF GENERATION? DONE
JUMPN T1,DIRF1
SETZ T1,
DPB T1,T2
HRRO T2,Q1 ;POINTER TO FILENAME
TYPEAT T2 ;DO IT
TXNN F,F.CHKS ;ANY CHECKSUMMING?
JRST PRILOP ;NO, AND THE REST IS DONE BY FILEPR
SETZM CHKCN0 ;SET UP FOR CHECKSUMMING
SETZM LSTPGE
MOVEI T4,FDBOFF(Q1) ;POINT T4 TO FDB INFO FOR FILSZA
CALL FILSZA ;CALC SIZE
JRST PRILOP
DATAPR: TXNN F,F.CHKS
JRST PRILOP ;IF NOT CHECKSUMMING, IGNORE DATA
MOVE T1,CURHEA
MOVE T1,.PAGNO(T1) ;CHKSFF EXPECTS THIS IN TAPHEA+.PAGNO
MOVEM T1,TAPHEA+.PAGNO;DON'T DISAPPOINT IT
MOVE T2,CURDAT
CALL CHKSFF
JRST PRILOP
FILEPR: MOVE Q1,T2 ;DATA POINTER
MOVEI T2,WTCOL
TXNE Q3,P.FAST
MOVEI T2,FWTCOL
CALL TABOUT
MOVE T2,.FBWRT(Q1)
CALL TADOUT
MOVEI T2,SZCOL
TXNE Q3,P.FAST
MOVEI T2,FSZCOL
CALL TABOUT
HRRZ T2,.FBBYV(Q1)
CALL DECOUT
TXNN F,F.CHKS
JRST PRILOP
MOVEI T2,CSCOL
TXNE Q3,P.FAST
MOVEI T2,FCSCOL
CALL PRTCS2
JRST PRILOP
TAPNPR: TYPE [ASCIZ/
End of Tape./]
SELECT LS.TTY
CALL ENDLIS
JRST CMDFIN
PRIFST: MOVX T1,P.FAST
IORM T1,PRIFLG
JRST PRINTR
PRIINB: <.CMOFI>B8+CM%DPP+PR2INB
BLOCK 2
-1,,[ASCIZ/TTY:/]
PR2INB: <.CMSWI>B8
EXP PRITAB
PRITAB: PRILEN,,PRILEN
[ASCIZ/FAST/],,PRIFST
PRILEN=.-PRITAB-1
SUBTTL MAIL command
IFN FTMAIL,<
MAIL: TXNN F,F.PRIV ;ENABLED?
JRST OPRERR ;NO, GO AWAY
GUIDES <from list file>
DMOVE T1,[EXP CMDBLK,MAIINB]
CALL PARSE
JSERRD <>,NOCMD,JRST
CALL RPSJFN
CONFIRM
HRRZ T1,T2
MOVEM T1,MALJFN
MOVE T2,[7B5+OF%RD]
OPENF%
JSERRD <Can't read LIST file>
MOVX T1,G1%IIN ;SET UP FOR LATER GTJFN
MOVEM T1,GTJBLK+.GJF2 ;ALLOW INVISIBLE FILES
MOVE T1,[.NULIO,,.NULIO] ;ENTIRE FILENAME FROM T2
MOVEM T1,GTJBLK+.GJSRC
SETZM LSTDIR
SCNFIL: MOVE T1,MALJFN
SCNFIA: BIN%
ERJMPS MALEOF ;EOF? GO FINISH
CAIE T2,.CHCRT ;SKIP END OF LINE STUFF
CAIN T2,.CHLFD
JRST SCNFIA
CAIE T2,"*" ;"*" MEANS SOMETHING TO DO
JRST TOSLI2 ;NO, SKIP THIS LINE
BIN%
ERJMPS MALEOF
HRROI T1,[ASCIZ/The following have been saved by DUMPER/]
CAIE T2,"S"
HRROI T1,[ASCIZ/The following have been restored by DUMPER/]
MOVEM T1,MALBLK+1 ;SUBJECT FIELD
MOVE T1,MALJFN
SKPWHI: BIN%
ERJMPS MALEOF
CAIE T2,.CHTAB
CAIN T2," "
JRST SKPWHI
MOVE T3,[POINT 7,STRING] ;FOR FULL FILENAME
IDPB T2,T3
RINFIL: BIN% ;COPY FILENAME OUT
ERJMPS MALEOF
CAIN T2,"V"-100 ;'WARE OF ^V
JRST [IDPB T2,T3
BIN%
ERJMPS MALEOF
IDPB T2,T3
JRST RINFIL]
CAIN T2," " ;USUALLY TERMINATES ON <SPACE>
JRST GOTFIL
CAIE T2,.CHCRT ;ALLOW FOR <TAB>, <CR> TOO
CAIN T2,.CHTAB
JRST GOTFIL
IDPB T2,T3 ;PART OF A FILENAME, COPY IT
JRST RINFIL
GOTFIL: HRROI T1,CRLF
MOVE T2,T3
CALL CSTR
HRROI T1,STRING
SETZB T4,MALTO ;COPY NOWHERE
MOVEI T2,74 ;OPEN ANGLE
CALL CPYDLM
SETZM NUMDOT ;REMEMBER WHERE EACH DOT IS
MOVE T4,[POINT 7,MALTO]
CPYDIR: ILDB T3,T1
JUMPE T3,NOUSRN
IDPB T3,T4
CAIN T3,76
JRST ECPDIR
CAIE T3,"."
JRST CPYDIR
AOS T3,NUMDOT
MOVEM T4,DOTLOC-1(T3)
JRST CPYDIR
ECPDIR: SETZ T3,
DPB T3,T4
HRROI T2,MALTO
CALL CHKUSR
JRST OKUSRN ;OK IF NO SKIP
SOSGE T1,NUMDOT
JRST NOUSRN
MOVE T4,DOTLOC(T1)
JRST ECPDIR
NOUSRN: SETZM MALTO ;TRY TO GET MAIL ADDRESS FROM LAST WRITER
MOVX T1,GJ%OLD+GJ%XTN
MOVEM T1,GTJBLK+.GJGEN
HRROI T2,STRING
MOVEI T1,GTJBLK
GTJFN%
ERJMPS TOSLIN ;CAN'T?!
IFN FTLWR,<
HRLI T1,.GFLWR
>
IFE FTLWR,<
HRLI T1,.GFAUT
>
HRROI T2,MALTO
GFUST%
MLEXKL: HRRZS T1
RLJFN%
ERJMPS .+1
OKUSRN: SKIPN LSTDIR ;DO WE HAVE AN OLD MAIL ADDRESS TO CHECK?
JRST FIRMAL ;NO, THIS IS THE FIRST MAIL TRIED
HRROI T1,MALTO ;CHECK FOR SAMENESS
HRROI T2,LSTDIR
CALL STCMPC
JUMPE T3,EQUSNS ;SAME IF 0
SNDFUL: CALL GOMAIL ;HERE IF TIME TO SEND A BUFFERFUL OUT
TRNA
FIRMAL: CALL MLINIT
HRROI T1,MALTO ;COPY NEW USERNAME
HRROI T2,LSTDIR ;TO HERE FOR COMPARES AND SENDS
CALL CSTR
MOVE T1,[POINT 7,FILNMS] ;INIT POINTER TO WHERE FILENAMES GO
MOVEM T1,FILNMM ;..
MOVEM T1,MALBLK+2 ;THIS WILL BE THE SUBJECT TEXT
EQUSNS: MOVE T2,FILNMM ;SET UP TO ADD NEW FILENAME TO BUFFER
HRREI T1,-FILNMS-170(T2) ;IS BUFFER FULL (170 WORDS USED?)
JUMPG T1,SNDFUL ;YES, GO DUMP AND SET UP ANOTHER BUFFER
HRROI T1,STRING
CALL CSTRB
MOVEM T2,FILNMM ;STORE POINTER BACK FOR NEXT APPEND
TOSLIN: MOVE T1,MALJFN ;FROM MAIL INPUT FILE
TOSLI2: SETZ T2, ;TO NOWHERE
MOVEI T3,377777 ;ALLOW FOR LOTS OF CHARACTERS
MOVEI T4,.CHLFD ;AND READ UNTIL <LF>
SIN% ;GO
ERJMPS MALEOF ;CERTAINLY EOF
JRST SCNFIL ;OK, GET NEXT LINE
MALEOF: CLOSF%
ERJMPS .+1
SETZM MALJFN
SKIPE LSTDIR
CALL GOMAIL
CALL MLDONE ;FINISH OUT MAIL
JRST CMDEND
GOMAIL: TYPE [ASCIZ/
/]
TYPE LSTDIR
TYPE CRLF
TYPEAT MALBLK+2
DOMAIL: HRROI T3,LSTDIR
MOVEM T3,MALBLK+0
MOVEI T1,MALBLK
MOVEI T2,.MLNFL
JRST MLTLST
MAIINB: <.CMIFI>B8+CM%DPP
BLOCK 2
-1,,LSTFIL
>
SUBTTL Terminal and List file output
;Terminal and list file, etc I/O subroutines
;Get text to proper places (Terminal, list file, etc). OUTMSG if the pointer
; passed could be anything, including null. OUTMSS if the pointer certainly
; contains some sort of pointer. OUTMSA if the pointer is PSOUT% legal.
; OUTMTT if the string is in STRING.
; TYPE and TYPEAT come here. Enter with T1 on the stack.
OUTMSG: JUMPE T1,OUTMS3 ;NULL POINTER OR CHARACTER? NOOP IF SO.
OUTMSS: TLNE T1,-1 ;POINTER OR CHARACTER?
JRST OUTMSA ;POINTER, GO USE
OUTMSC: HRLZM T1,OUTMSX ;CHARACTER. TUCK INTO STORAGE..
SKIPA T1,[POINT 7,OUTMSX,10] ;AND FETCH A POINTER TO IT
OUTMTT: HRROI T1,STRING ;WHERE CALLER WROTE STRING
OUTMSA: MOVEM T1,OUTMST ;STORE THE POINTER TO THIS TEXT
PUSH P,T4 ;SAVE T4
MOVE T4,LSTFLG ;ARE WE WRITING THIS ANYWHERE?
TXNE T4,LS.TTY ;OUT TO PRIMARY OUTPUT?
PSOUT% ;YES
TXNE T4,LS.LST
SKIPN T1,LSTJFN ;FETCH LIST JFN
JRST OUTMSD ;NOT AVAILABLE, FINE
PUSH P,T2
PUSH P,T3
MOVE T3,LSTLIN
AOSN T3 ;IF -1, REQUESTING A HEADER
CALL FSTPGN ;GIVE IT
MOVE T2,OUTMST ;POINTER TO TEXT
SETZ T3, ;GO UNTIL NULL SEEN
SOUT% ;WRITE TO LIST FILE
ERJMPS NOLSTF
SKIPGE T3,LSTPOS ;DID CALLER ALREADY FIGURE LSTPOS FOR US?
JRST [MOVNS T3 ;YES, JUST SET IT RIGHT
JRST CNTSP2]
MOVE T1,OUTMST
TLC T1,-1 ;UPDATE LSTPOS
TLCN T1,-1
HRLI T1,(POINT 7)
CNTSPC: ILDB T2,T1
JUMPE T2,CNTSP2
CAIN T2,.CHCRT
JRST [SETZ T3,
JRST CNTSPC]
CAIN T2,.CHLFD
JRST PAGTST ;<LF> DONE BELOW
CAIN T2,.CHTAB
JRST [TRO T3,7
AOJA T3,CNTSPC]
CAIGE T2," "
ADDI T3,1 ;ASSUME CTRL CHARS ARE 2 WIDE (^x)
AOJA T3,CNTSPC
PAGTST: AOS T4,LSTLIN
CAIL T4,PAGLIN ;LINES/PAGE
CALL FSTPGN ;NEED A PAGE HEADER
JRST CNTSPC ;NOT A NEW PAGE YET, GO ON
FSTPGN: PUSH P,T1
MOVE T1,LSTJFN ;SET UP TO OUT A ^L
MOVEI T2,.CHFFD
BOUT%
ERJMPS .+1
IFN FTCKPN,<
MOVE T1,LSTJFN
TXO T1,CO%NRJ ;CHECKPOINT THE FILE
DOJSS CLOSF%, .+1
HRRZS T1
MOVE T2,[7B5+OF%APP]
DOJSS OPENF%, .+1
>
CALL LINE1A ;OUTPUT FIRST HEADER LINE
CALL LINE1B ;..
CALL LINE2 ;OUTPUT SECOND HEADER LINE
POP P,T1
RET
;LINE1A/B and LINE2 are not as symeterical as the names make them appear.
; LINE1A doesn't touch the line counts, hence
; is useful for to-the-terminal output. LINE2 assumes LINE1A was called and
; does things like setting the line count for the list file.
;Set up STRING to contain a savest header
LINE1A: HRROI T2,STRING ;COPY LINE INTO STRING
HRROI T1,[ASCIZ/
DUMPER tape #/]
CALL CSTRB
MOVE T1,TAPENO
CALL NOUTB
SKIPN SSNBUF+SV.TAD ;IS THERE A DATE?
JRST NODATL
HRROI T1,[ASCIZ/, /]
CALL CSTRB
CALL ODTIMB
NODATL: HRROI T1,[ASCIZ/. /]
CALL CSTRB
SKIPN T1,SAVETP
JRST NOSPCL
LDB T1,[POINT 3,T1,2];COPY THE TYPE BITS OVER
HRRO T1,[
[ASCIZ/ COLLECTION save /]
[ASCIZ/ ARCHIVE save /]
[ASCIZ/ MIGRATION save /] ]-1(T1)
CALL CSTRB
NOSPCL: SKIPN T4,SSNBUF+SV.PNT
MOVEI T4,SV.MSG
SKIPN SSNBUF(T4)
JRST NONAME
HRROI T1,[ASCIZ/ "/]
CALL CSTRB
HRROI T1,SSNBUF(T4)
CALL CSTRB
HRROI T1,[ASCIZ/"/]
CALL CSTRB
NONAME: SKIPN VOLID
RET
HRROI T1,[ASCIZ/ volid /]
CALL CSTRB
HRROI T1,VOLID
JRST CSTR
LINE1B: SKIPN T1,LSTJFN
RET
HRROI T2,STRING
SETZ T3,
SOUT%
ERJMPS .+1
RET
LINE2: HRROI T2,[ASCIZ/
Filename Last write date/]
CALL LSTSOT
HRROI T2,[ASCIZ/ Pages Checksum Page #/]
CALL LSTSO2
AOS T2,LSTPGN ;UP AND OUT IT
CALL LSTDEC
HRROI T2,CRLF2 ;BLANK LINE OUTPUT
CALL LSTSOT ;THIS ALSO ZEROS T3 FOR US
MOVEI T1,3
MOVEM T1,LSTLIN
RET
LSTDEC: MOVEI T3,^D10
MOVE T1,LSTJFN
NOUT%
ERJMPS .+1
RET
LSTSOT: SETZ T3,
MOVE T1,LSTJFN
LSTSO2: SOUT%
ERJMPS .+1
RET
CNTSP2: MOVEM T3,LSTPOS
POP P,T3
POP P,T2
OUTMSD: POP P,T4
OUTMS3: POP P,T1
RET
;Error while writing list file - end the list file
NOLSTF: CALL ENDLIS
MOVX T4,LS.LST ;SAY NO MORE LIST FILE
ANDCAM T4,LSTFLG
CALL ANNERR ;ANNOUNCE ERROR
TYPE [ASCIZ/?Error writing LIST file, list file ended
/] ;RECURSION!
SETZ T3,
JRST CNTSP2
TADOUT: PUSH P,T1
JUMPE T2,[HRROI T1,[ASCIZ/(Never)/]
JRST OUTMSA]
MOVX T3,OT%NSC+OT%NCO+OT%SCL
HRROI T1,STRING
ODTIM%
ERJMPS .+1
JRST OUTMTT
;Here with a number in T2 to output. DECOUT loses T3. DECOUT & NUMOUT
; act identically to TYPE (it calls OUTMSG). NUMOUT can be treated
; exactly like NOUT% in terms of radixs and flags.
DECOUT: MOVEI T3,^D10 ;RADIX 10
NUMOUT: PUSH P,T1 ;MOSTLY BECAUSE OUTMSA WANTS IT
HRROI T1,STRING
NOUT%
ERJMPS OUTMTT
JRST OUTMTT
;here with a number in T2 to output as floating point, as xxxx.yy
FLTOUT: PUSH P,T1 ;FOR OUTMSA
HRROI T1,STRING
MOVX T3,FL%ONE+FL%PNT+FL%OVL+2B17+4B23+2B29
FLOUT%
ERJMPS OUTMTT
JRST OUTMTT
;Does everything INICHR does, but types out a message as well.
INIMSG: CALL INICHR
PUSH P,T1
JRST OUTMSG
;Here to CR as needed and type out a dollarsign or space as a message
; leadin (depending on whether we are on a pseudoterminal or not).
INICHR: CALL IFCRLF
PUSH P,T1
MOVEI T1," "
TXNE F,F.SUBJ
MOVEI T1,"$"
JRST OUTMSC
;TABOUT only works for the list file (because OUTMSG only follows the line
; position of the list file)
; Give it the column to get to in T2. This always outputs at least 1 space.
TABOUT: PUSH P,T1 ;BECAUSE OUTMSA WANTS THAT
MOVE T1,[POINT 7,TABTMP] ;A PLACE TO WRITE TO
MOVE T3,LSTPOS ;FIND OUT WHERE WE ARE
MOVEM T3,LSTTMP ;SAVE IT
MOVEI T4,.CHTAB ;PREPARE TO WRITE SOME TABS
TRZ T3,7 ;FIGURE THE EFFECT OF THE FIRST TAB
ADDI T3,8 ;..
TABITH: IDPB T4,T1 ;IN GOES THE TAB
CAIL T3,(T2) ;FAR ENOUGH?
JRST TTOFAR ;YES, MAYBE TOO FAR
MOVEM T3,LSTTMP ;TAB WAS OK, REMEMBER WHERE WE ARE
ADDI T3,8 ;SIMULATE THE NEXT TAB
JRST TABITH ;AND GO DO IT
TTOFAR: CAIG T3,(T2) ;DID WE GO TOO FAR?
JRST TOKOUT ;NO, JUST RIGHT, FINISH UP
MOVEI T4," " ;TOO FAR, OVERWRITE LAST TAB WITH SPACE
DPB T4,T1 ;..
AOS T3,LSTTMP ;ACCOUNT FOR SPACE
TSPOUT: CAIL T3,(T2) ;ENOUGH SPACES?
JRST TOKOUT ;YES, FINISH UP
IDPB T4,T1 ;NO, SPACE GOES IN
AOJA T3,TSPOUT ;ADVANCE THE COUNT AND GO ON
TOKOUT: MOVNM T3,LSTPOS ;TELL OUTMSA WE FIGURED THE LENGTH FOR IT
SETZ T4, ;NULL TO END
IDPB T4,T1 ;..
HRROI T1,TABTMP ;THE STRING WE WROTE
JRST OUTMSA ;GETS WRITTEN NOW
;Here to set up the list file
SETLST: SKIPE LSTJFN
JRST LSTAGA
SKIPN LSTFIL ;LIST FILE REQUESTED?
JRST CPOPJ1
HRROI T2,LSTFIL
MOVX T1,GJ%SHT
GTJFN%
ERJMPS NOLISK
OPNLSF: SETZM LSTPGN ;PAGE 0
OPNLST: MOVE T2,[7B5+OF%APP]
DOJSS OPENF%, NOLISF
HRRZM T1,LSTJFN
LSTAGA: SETOM LSTLIN ;LINE -1 MEANS FORCE A HEADER
SETZM LSTPOS ;COLUMN 0
JRST CPOPJ1
NOLISF: HRRZS T1
RLJFN%
ERJMPS .+1
NOLISK: JSERRD <Can't set up list file>,.+1,JRST
RET
;Here to close out the list file
ENDLIS: SKIPE T1,LSTJFN ;LIST FILE HERE?
CLOSF% ;YES, CLOSE IT
ERJMPS .+1
SETZM LSTJFN
RET
;Here when switching tapes with list file open
NTLIST: PUSH P,LSTFLG ;YES, SAVE LIST FLAGS,..
SELECT LS.LST ;AND OUT TO LIST ONLY
TYPE [ASCIZ/
End of Tape /] ;NOTE ON LIST FILE WHERE TAPE ENDED
MOVE T2,TAPENO
CALL DECOUT
TYPE [ASCIZ/, continuing...
/]
POP P,LSTFLG ;RESTORE THIS
SETOM LSTLIN ;NEXT OUTPUT STARTS A NEW PAGE
RET
SUBTTL Information routines
;Information subroutines
;SETWLD sets the GTJFN block to *.*.* including invisible files
;Pass in T1/ pointer to structure (no colon) and T2/ pointer to
; directory string (no punctuation), and T3/ flags for .GJGEN
SETWLD: DMOVEM T1,GTJBLK+.GJDEV;SET .GJDEV AND .GJDIR
MOVE T1,[.PRIIN,,.PRIOU] ;PRIMARY INPUT AND OUTPUT
MOVEM T1,GTJBLK+.GJSRC
MOVX T1,G1%IIN ;FIND INVIS FILES, DON'T EXPAND LOGICALS
MOVEM T1,GTJBLK+.GJF2
HRRI T3,.GJALL ;DEFAULT VERSION TO *
MOVEM T3,GTJBLK+.GJGEN
HRROI T1,[ASCIZ/*/] ;GET WILDCARD STRING
MOVEM T1,GTJBLK+.GJNAM;DEFAULT NAME TO FULL WILDCARD
MOVEM T1,GTJBLK+.GJEXT;AND EXTENSION
RET
;TAKES Q1/ index into JFNLST and sets GTJBLK accordingly
OFNAME: MOVE T2,JFNLST(Q1)
MOVSI T4,-NFLDS
TXNN F,F.WILD ;DEFAULT TO CONNECTED DIRECTORY ALWAYS?
JRST OFNAM1 ;NO, SET UP NORMALLY
SETZM GTJBLK+.GJDEV ;MAKE SURE THESE ARE NULL
SETZM GTJBLK+.GJDIR ;..
ADD T4,[2,,2] ;AND SKIP THE SETUP OF STR:<DIR>
OFNAM1: HRRO T1,FLDOFN(T4)
SETZM (T1)
HLRZ T3,FLDOFN(T4)
CAIE T3,0
MOVEM T1,GTJBLK(T3)
MOVE T3,FLDOF2(T4)
JFNS%
AOBJN T4,OFNAM1
RET
FLDOFN: .GJDEV,,DEFSTR
.GJDIR,,DEFDIR
.GJNAM,,DEFNAM
.GJEXT,,DEFEXT
0,,DEFGEN
NFLDS=.-FLDOFN
FLDOF2: EXP 1B2,1B5,1B8,1B11,1B14
;Here to open a JFN on the default file in GTJBLK. Returns +2 with
; the JFN in T1, or +1 if failing.
GDEFFL: SETZ T2, ;JUST USE DEFAULTS
GDEFFD: PUSH P,GTJBLK+.GJSRC ;SAVE THIS
MOVE T1,[.NULIO,,.NULIO] ;LEAVE USER OUT OF THIS
MOVEM T1,GTJBLK+.GJSRC ;SET SOURCE, DEST TO NULL
MOVEI T1,GTJBLK ;GET ADDRESS OF GTJGN BLOCK
GTJFN% ;SYNTHESIZE JFN
ERJMPS [SETZB T1,T2
JRST GDEFFA] ;FAILED
MOVE T2,T1 ;RETURN IT IN T2 AND T1
GDEFFA: POP P,GTJBLK+.GJSRC
JUMPN T1,CPOPJ1
RET
;CHKMTD just like CHKJFN, but skips if device is any MT/MTA
CHKMTJ: PUSH P,MTAUNT ;CALLER MIGHT CARE
SETOM MTAUNT ;BUT WE DON'T
CALL CHKJFN
POP P,MTAUNT
CAIN T3,.DVMTA
JRST CPOPJ1
RET
;Just like CHKJFN, but skips if device is DISK or unknown
CHKDSK: CALL CHKJFN
JUMPE T3,CPOPJ1 ;T3 = 0 MEANS DISK
TLNE T3,(1B2) ;T3/ 1B2 MEANS NO SUCH DEVICE (OFFLINE DISK)
JRST CPOPJ1
RET
;CHKJFN does a DVCHR% on the JFN in T2. It returns the following:
; T1/ JFN passed in
; T2/ device charactistics word or 0 if illegal
; T3/ device type (from T2) or 1B1 if its our magtape drive, or 1B2 if illegal
CHKJFN: PUSH P,T2
HRRZ T1,T2
DVCHR%
ERJMPS CHKJF2
HRRE T1,T3 ;MAY WANT UNITS, STORE THEM
LDB T3,[POINT 9,T2,17] ;GET THE DEVICE TYPE IN T3
SKIPN MTJFN ;DO WE HAPPEN TO HAVE A DRIVE OPEN?
JRST CHKJF3 ;NO, DON'T CHECK IF ITS REALLY OUR DRIVE
CAIN T3,.DVMTA ;MAGTAPE?
CAME T1,MTAUNT ;*OUR* MAGTAPE?
JRST CHKJF3
MOVSI T3,(1B1) ;1B1 MEANS ITS OUR DRIVE
JRST CHKJF3 ;ITS OUR DRIVE, RETURN
CHKJF2: MOVSI T3,(1B2) ;ILLEGAL, 1B2
SETZ T2,
CHKJF3: POP P,T1 ;JFN IN T1
RET
;Put connected str and directory into place and return pointers to them
; in CONSTR and CONDIR.
GETCON: SETZM CONSTR ;CLEAR THIS IN CASE OF FAILURE
SETZM CONDIR ;AND THIS TOO
SETO T1,
HRROI T2,.JIDNO ;GET DIRECTORY NUMBER
MOVEI T3,T3 ;INTO T3
GETJI%
ERJMPS CPOPJ ;DOESN'T HAPPEN
MOVE T2,T3 ;MOVE TO T2 FOR DIRST%
HRROI T1,CONBUF ;POINT TO STORAGE
DIRST% ;STORE CONNECTED STRUCTURE AND DIRECTORY
ERJMPS CPOPJ ;CAN'T (UNLIKELY)
SKIPN CONBUF ;MAKE SURE WE GOT SOMETHING
RET ;DIDN'T, VERY STRANGE
MOVE T1,[POINT 7,CONBUF] ;GET POINTER TO THE STRING
MOVEM T1,CONSTR ;WHERE THE STRUCTURE NAME STRING STARTS
GETCN1: ILDB T2,T1 ;READ NEXT CHARACTER
CAIE T2,":" ;END OF DEVICE?
JRST GETCN1 ;NO, KEEP GOING
SETZ T3, ;YES, GET A NULL
DPB T3,T1 ;OVERWRITE COLON TO TERMINATE DEVICE
IBP T1 ;SKIP PAST ANGLE BRACKET
MOVEM T1,CONDIR ;REMEMBER POINTER TO DIRECTORY
GETCN2: ILDB T2,T1 ;SEARCH FOR END OF DIRECTORY
CAIE T2,">" ;FOUND ENDING PUNCTUATION?
JRST GETCN2 ;NO, KEEP GOING
DPB T3,T1 ;REPLACE BRACKET WITH NULL
RET ;DONE
;Get <input> directory number of not already known
GDIRNM: SKIPE T1,DMPNUM
RET
CALL GDIRNA
HRROI T2,INDIR
MOVX T1,RC%EMO
RCDIR%
ERJMPS .+1
MOVEM T3,DMPNUM
MOVE T1,T3
RET
;Get <input> if not already known
GDIRNA: SKIPE INDIR
RET
MOVE T2,JFN
MOVX T3,1B2+1B5+JS%PAF
HRROI T1,INDIR
JFNS%
RET
TYJFN: SKIPA T2,JFN
TYJFN1: MOVE T2,T1
TYJFNS: MOVE T3,[JFNSAL]
TYJFNF: HRROI T1,STRING
JFNS%
ERJMPS CPOPJ
PUSH P,T1
JRST OUTMTT ;TYPE STRING
;Acts like CSTRB, except T1/ number to output (decimal)
NOUTB: EXCH T1,T2
MOVEI T3,^D10
DOJSS NOUT%, .+1
EXCH T1,T2
RET
;ODTIM that acts like CSTRB - it gets the time from SSNBUF
ODTIMB: MOVE T1,T2
MOVE T2,SSNBUF+SV.TAD
MOVX T3,OT%NSC+OT%NCO+OT%SCL+OT%DAY
DOJSS ODTIM%, .+1
MOVE T2,T1
RET
;Copy string and back up T2 on exit. Return last character in T3.
CSTRB: CALL CSTR
BACKT2: SETO T3,
ADJBP T3,T2
MOVE T2,T3
LDB T3,T2
RET
;Copy string T1 to T4 until null or char in T2 seen. This obeys ^V!
CPYDLM: TLCE T1,-1
TLCN T1,-1
HRLI T1,(POINT 7)
TLC T4,-1 ;TLC ONLY, SO T4/ 0 COPIES NOWHERE
TLCN T4,-1
HRLI T4,(POINT 7)
CPYDL2: ILDB T3,T1
IDPB T3,T4
JUMPE T3,CPOPJ
CAIE T3,(T2)
JRST CPYDL3
SETZ T3,
IDPB T3,T4
RET
CPYDL3: CAIE T3,"V"-100
JRST CPYDL2
ILDB T3,T1
IDPB T3,T4
JRST CPYDL2
;Compare strings ref'd by T1 and T2; ret T3/ 0 if the same.
STCMPC: TLCE T1,-1
TLCN T1,-1
HRLI T1,(POINT 7)
TLCE T2,-1
TLCN T2,-1
HRLI T2,(POINT 7)
STCM1: ILDB T4,T1
ILDB T3,T2 ;GET CHARS TO TEST
CAIE T3,(T4) ;SAME?
SKIPA T3,T1 ;NO, RETURN T3 NONZERO
JUMPN T3,STCM1
RET
;Here to make two strings the same after STCMPC said they weren't. This
; expects T1,T2,T4 to not be touched since STCMPC.
STCOPY: DPB T4,T2
JUMPE T4,CPOPJ
JRST CSTRA
;More string copy stuff. Takes T1 and T2 as the from and to, and returns
; T3 as 0.
APPSTR: SETO T3,
ADJBP T3,T2
MOVE T2,T3 ;DESTINATION BACKED UP BY 1
CSTR: TLCE T1,-1
TLCN T1,-1
HRLI T1,(POINT 7)
TLCE T2,-1
TLCN T2,-1
HRLI T2,(POINT 7)
CSTRA: ILDB T3,T1
IDPB T3,T2
JUMPN T3,CSTRA
RET
;Pointer to an ASCIZ string in T1, SIXBIT of first 6 characters back in T2
ASCSIX: TLCE T1,-1
TLCN T1,-1
HRLI T1,(POINT 7)
MOVE T3,[POINT 6,T2]
SETZ T2,
ASCSI1: ILDB T4,T1
JUMPE T4,CPOPJ
CAIG T4,"z"
CAIG T4," "
JRST ASCSI1
CAIL T4,"a"
CAILE T4,"z"
TRNA
SUBI T4,"a"-"A"
SUBI T4," "
IDPB T4,T3
TRNN T2,77
JRST ASCSI1
RET
;Convert integer volid number (in T1) to sixbit of digits (in T1).
NSVOL: MOVE T2,T1 ;COPY INTEGER TO T2
SETZ T1,
NSVOL1: IDIVI T2,12 ;DIVIDE BY 10
IORI T1,20(T3) ;PLUNK IN THE SIXBIT'D DIGIT
ROT T1,-6 ;AND PUT IN PROPER PLACE
JUMPN T2,NSVOL1 ;LOOP UNTIL NO DIGITS LEFT
RET
;Output sixbit string in T3. Hurts T2 and T3
SIXOUT: PUSH P,T1
CALL C6TO7
DMOVEM T2,STRING
JRST OUTMTT
;Take sixbit word in T3, returns asciz string in T2 and T3
C6TO7: SETZ T2, ;PREPARE TO CONVERT TO ASCIZ
JUMPE T3,CPOPJ ;IF NONE, ALREADY CONVERTED, SO TO SPEAK
JRST V6TO7B
V6TO7: LSH T2,1 ;ROOM FOR ASCII BIT (OR, MAKE LEFT JUSTIFIED)
TLNE T2,774K ;DONE? (ANYTHING IN 1ST BYTE?)
JRST V6TO7D ;YES, GO STORE
V6TO7B: LSHC T2,6 ;FETCH NEXT 6BIT BYTE INTO T2
TRNE T2,77 ;IS IT REAL?
ADDI T2," " ;YES, CONVERT TO ASCII
JRST V6TO7
V6TO7D: JUMPE T3,CPOPJ ;IS 6TH BYTE NONEXISTANT?
LSH T3,-1 ;NO, NEEDS CONVERTING
ADD T3,[BYTE(7) " ",0]
RET
;Skip if string at T2 is NOT a valid username
CHKUSR: MOVX T1,RC%EMO
RCUSR%
ERJMPS CPOPJ1
TXNN T1,RC%NOM
JRST CPOPJ
JRST CPOPJ1
;Type new volid and time
GANEWT: MOVE T1,MTJFN
CALL GETVOL
;**;[548] Add 7 lines at ANEWT:+1L DEE 28-JAN-88
ANEWT: TYPE <[ASCIZ/ [ Beginning tape /]>
MOVE T2, TAPENO ;[548] Get the tape number
CALL DECOUT ;[548] Print it
SKIPN VOLID ;[548] Is there a volume-id?
JRST ANEWTU ;[548] Guess not
TYPE [ASCIZ/ (/] ;[548] Yes, put it in parens
TYPE VOLID ;[548] Print it
TYPCHR ")" ;[548] Close paren
ANEWTU: TYPE [ASCIZ/, at /]
SETO T2, ;DO CURRENT TIME
CALL TADOUT ;..
TYPE SPCBCR
RET
SUBTTL Memory management
;Memory management subroutines and friends
;Here we set up the values we need to make the memory manager routines run
; quickly. MAPEND is the offset from MAPFRE to the last word in the map.
; LBIINI is the value that last word is set to to indicate what pages are
; available in that last set of 36. The last word always flags at least
; one pair of pages (or it wouldn't be needed).
MAPEND=NUMPAG/^D36 ;OFFSET TO LAST WORD IN MAP
%%C==<NUMPAG-<<NUMPAG/^D36>*^D36>> ;NUMBER OF BITS USED IN LAST WORD -1
LBIINI==1B0 ;BUILD VALUE TO INIT LAST WORD WITH
REPEAT %%C,< LBIINI== <LBIINI_<-1>>!<1B0> > ;..
;Call here to set up the memory manager.
SETPGS: SETOM MAPFRE
MOVE T1,[MAPFRE,,MAPFRE+1]
BLT T1,MAPFRE+MAPEND-1 ;MARK PAGES FREE SANS LAST SET
MOVX T1,LBIINI ;VALUE LAST WORD GETS
MOVEM T1,MAPFRE+MAPEND;INIT LAST SET SPECIALLY
SETO T1,
MOVE T2,[.FHSLF,,FRESPC]
MOVE T3,[PM%CNT!NUMPAG]
PMAP%
ERJMPS .+1
RET
;Here to get a buffer (a set of contiguous pages) for any purpose.
;Enter with T1/ # of pages needed. Return +2 with T2/ address of buffer
; or +1 if can't get pages
GETPGS: CAIG T1,0
ERROR <GETPGS called with trash>,SPRREQ
MOVEM T1,GETTMP
GETPGA: SETZ T1,
GETPG1: SKIPE MAPFRE(T1)
JRST GETSCN
CAIGE T1,MAPEND ;AT END OF MAP?
AOJA T1,GETPG1 ;NO, KEEP LOOKING
RET ;NO PAGES AVAILABLE
GETSCN: MOVE T2,T1 ;GEN. A BIT POINTER TO FIRST WORD..
ADD T2,[POINT 1,MAPFRE];WITH AN AVAILABLE PAGE
IMULI T1,^D36
MOVEI T3,NUMPAG
SUBI T3,(T1) ;THE NUMBER OF BITS TO CHECK
FNDCLU: SOJL T3,CPOPJ ;NO MORE BITS TO CHECK, FAILED
ILDB T1,T2 ;IS THIS PAGE AVAILABLE?
JUMPE T1,FNDCLU ;0 MEANS TAKEN
MOVEM T2,GE2TMP ;SAVE POINTER TO POSSIBLE CANDIDATE
MOVE T4,GETTMP ;GET NUMBER OF PAGES NEEDED
MEACLU: SOJE T4,GOTCLU ;IF GOT ENOUGH, DONE
SOJL T3,CPOPJ ;END OF POSSIBILITIES? DONE.
ILDB T1,T2
JUMPN T1,MEACLU ;IF AVAILABLE, KEEP GOING
JRST FNDCLU ;NOT LONG ENOUGH. KEEP LOOKING.
GOTCLU: SETO T1, ;BACK UP POINTER 1 FOR IDPB
ADJBP T1,GE2TMP
MOVEM T1,GE2TMP
MOVE T2,GETTMP ;# OF PAGES WANTED
IDPB T4,T1 ;WRITE 0'S
SOJG T2,.-1 ;..
MOVEI T2,FRESPC+NUMPAG;CAL. WORD ADDRESS
SUBI T2,(T3)
MOVE T3,GETTMP
SUBI T2,(T3)
LSH T2,9
MOVE T4,GE2TMP ;T3/ SIZE AND T4/ POINTER INTO MAPFRE
DMOVEM T3,SIZBUF(T2) ;STORE INTO SIZBUF AND PNTBUF
SETZM NXTBUF(T2) ;NO NEXT YET
SETZM TRPBUF(T2) ;NO SUCH POINTER YET
SETZM TREBUF(T2)
SETZM ERRCNT(T2) ;NO ERRORS ON WRITE YET
CPOPJ1: AOS (P)
CPOPJ: RET
;RELPGT is just like RELPGS, except it types text pointed to by TRPBUF
; if nonzero. This is for SAVE, which may have to type directory and
; filenames.
RELPGT: SKIPE T2,TRPBUF(T1) ;NO TEXT AT ALL?
CAMN T2,TREBUF(T1) ;OR BEGINNING=END?
JRST RELPGS ;NO TEXT, JUST DO RELPGS
RELP2: ILDB T3,T2 ;FETCH COMMAND BYTE
JRST @[EXP RELPGS,TYFILE,TYDIRE,TYALLW,TYFLDR](T3)
TYFLDR: TXNN F,F.FILT+F.DIRT
TYFILE: TXNE F,F.FILT ;FILES MODE?
TYALLW: TYPEAT T2
JRST TTSCNO
TYDIRE: TXNE F,F.DIRT ;DIRECTORY MODE?
TYPEAT T2
TTSCNO: ILDB T3,T2 ;FIND THE NULL
JUMPN T3,TTSCNO
JRST RELP2
;Enter with word address of buffer to free up
RELPGS: PUSH P,NXTBUF(T1) ;SAVE THE NEXT BUFFER ADDRESS
DMOVE T2,SIZBUF(T1) ;T2/ SIZE AND T3/ POINTER
JUMPLE T2,RELPG1 ;IF PAGE IS DELETED ALREADY, SKIP ON
SETOB T1,SIZBUF(T1) ;A SOURCE OF 1'S, AND CLEAR SIZE
IDPB T1,T3
SOJG T2,.-1
RELPG1: POP P,T1 ;RETURN ADDRESS OF NEXT BUFFER
RET
;This returns the percentage of freespace currently used
PRCUSE: SETZB T2,T4 ;CLEAR COUNT AND INDEX
CUPAG: MOVE T1,MAPFRE(T4) ;COUNT FREE PAGES IN THE MEMORY MANAGER
MOVN T3,T1
TDZE T1,T3 ;2'S COMPLEMENT MAGIC
SOJA T2,.-2 ;WE WANT A NEGATIVE COUNT
CAIGE T4,MAPEND ;END OF MAP?
AOJA T4,CUPAG ;NO, NEXT PIECE
ADDI T2,NUMPAG ;MAKE A POS. COUNT OF USED PAGES
JUMPE T2,CPOPJ ;IF NONE, DON'T BOTHER
IMULI T2,^D100 ;CONVERT TO A PERCENTAGE
IDIVI T2,NUMPAG
CAIE T3,0
ADDI T2,1 ;A REMAINDER IS GOOD ENOUGH REASON TO ROUND UP
RET
SUBTTL Parsing subroutines
;Parsing subroutines
;KEYWRD parses a keyword. Give it T1/ command block and T2/ addr of table.
; It returns as PARSE does (+1, +2).
KEYWRD: MOVEM T2,KEYINB+1
MOVEI T2,KEYINB
;JRST PARSE
; Sucessful parse returns usual flags in T1, usual stuff in T2, the
; type of block in T3, and the first block,,matching block in T4.
; Bad parse returns +1, good +2
;EOF at parse time causes a bop back to command processing. This should
; be IMPOSSIBLE during the ^E commands, and if it happens all nell will
; break loose (since we go reset the stack).
PARSE: COMND%
HITME: ERJMPR PAREOF
TXNE T1,CM%NOP
RET ;DIDN'T PARSE
MOVE T4,T3
HRRZS T3
LDB T3,[POINT 9,(T3),8]
JRST CPOPJ1
PAREOF: CAIN T1,DESX3 ;DID WE LOSE THIS JFN?
JRST [MOVEI T1,TAKSTR ;YES, ASSUME ^C/START
MOVEM T1,TAKSTK ;BLOW AWAY COMMAND STACK
MOVE T1,[.PRIIN,,.PRIOU] ;AND TALK TO TERMINAL
MOVEM T1,CMDBLK+.CMIOJ
JRST PANIC]
CAIE T1,IOX4 ;EOF?
JSERRD <Can't parse command>,PANIC,JRST ;NO, COMPLAIN
CALL TAKEOF ;ASSUME EOF, DROP A COMMAND LEVEL
JSERRD <Parse error>,PANIC,JRST ;IF THERE ISN'T A TAKE FILE, WEIRD
JRST PANIC ;IN ANY CASE, RESTART
;Here with a message pointer in T1 - type the message, wait for a <CR>, and
; return. ^E interrupts looked for (and a CONTINUE means no <CR> needed).
TRYAGA: CALL TSTINT
JRST BAKOUT
CALL INIMSG
TYPE [ASCIZ/, type <CR> to try again. /]
;JRST RDLINI
;RDLINI checks for a ^E interrupt first and handles it
; (going to BAKOUT on an ABORT). Ret +1.
; ^E will try to do good things here, but no promise can be given.
RDLINI: CALL TSTINT ;CHECK FOR INTERRUPT REQUEST
JRST BAKOUT
MOVEI T1,RDLINF
MOVEM T1,TRAPTO
HRROI T1,LINBUF
MOVE T2,[RD%BRK+RD%BEL+RD%RAI+NLINB*5]
SETZ T3,
RDTTY%
ERJMPS RDLINF
MOVEI T2,.CHCRT ;TIE OFF LINE IN CASE ESC OR ^Z
IDPB T2,T1
MOVEI T2,.CHLFD
IDPB T2,T1
RDLINF: SETZM TRAPTO
CALL TSTINT
JRST BAKOUT
RET
;Here to push the JFN in T2 and the address of the "delete jfn" routine
; on the reparse stack.
RPSJFN: MOVEI T1,RPSJFD
HRL T1,T2
;JRST RPSMEM
;Here to save something on the reparse stack. This stack is used when
; a command gets reparsed and things like JFNs need tossing out.
RPSMEM: EXCH T1,RPSSTK ;SAVE DATA, GET STACK POINTER
PUSH T1,RPSSTK ;PUT DATA ON REPARSE STACK
EXCH T1,RPSSTK ;GET T1 BACK, PUT STACK POINTER AWAY AGAIN
RET
;Here to get something off the reparse stack. +1 ret with something in T1,
; +2 with nothing on stack anymore.
RPSGET: EXCH T2,RPSSTK
TLNN T2,-1 ;EMPTY STACK?
AOSA (P) ;YES, SKIP RETURN
POP T2,T1
EXCH T2,RPSSTK
RET
UNDO: CALL RPSGET
JRST GOUNDO ;RH OF T1 HAS THE ADDR OF A ROUTINE TO CALL
RET ;NOTHING LEFT TO UNDO
GOUNDO: CALL (T1) ;GO DO ROUTINE
JRST UNDO ;GO UNTIL REPARSE STACK EMPTY
JRST UNDO ;IN CASE OF A SKIP RETURN
DRPJF2: SKIPA T1,T2 ;DROP THE JFN IN T2
RPSJFD: HLRZS T1 ;DROP THE JFN IN THE LF OF T1
;Here to drop the JFN in T1 as though we never touched it
DRPJFN: JUMPE T1,CPOPJ ;IF NO JFN, FINE
DRPJFA: GTSTS% ;IS THE JFN OPEN AT ALL?
JUMPL T2,DRPOFN ;IF SO, CLOSF%
DRPUFN: DOJSS RLJFN%, DRPOFN ;IF NOT, RLJFN%, IF FAILS, CLOSF%
RET
DRPOFN: HRLI T1,(CZ%ABT+CZ%NUD)
CLOSF% ;THIS JFN NEVER HAPPENED
ERJMPS .+1
RET
;Parse a particular, common type of token. These are common enough to
; warrant routines.
;CALL to confirm. Skip ret if all OK.
CONFRM: DMOVEM T1,1(P)
MOVEM T3,3(P)
DMOVE T1,[EXP CMDBLK,CONINB]
COMND%
ERJMPR PAREOF
TXNE T1,CM%NOP
ERROR <Not confirmed>,CPOPJ
MOVE T3,3(P)
DMOVE T1,1(P)
JRST CPOPJ1
;Here with a word address of a string to guide with in T1. Skip if OK.
GUIDE: HRROM T1,GUIINB+.CMDAT
DMOVEM T2,1(P)
DMOVE T1,[EXP CMDBLK,GUIINB]
COMND%
ERJMPR PAREOF
TXNE T1,CM%NOP
ERROR <Illegal guide word>,CPOPJ
DMOVE T2,1(P)
JRST CPOPJ1
;GET time/date from user, into T1
GETTAD: DMOVE T1,[EXP CMDBLK,GTDINB]
CALL PARSE
ERROR <Illegal date/time given>,CPOPJ
MOVE T1,T2
CONFIRM
JRST CPOPJ1
;YESNO returns -1 for YES and 0 for NO in T2. It uses QUEST, and it checks
; for ^E (and does BAKOUT). Give it T1/ pointer to question text.
YESNO: MOVEM P,TRAPSP
MOVEM T1,QYNPMT
MOVEI T1,YSQUIT ;ON AN INTERRUPT, TRAP TO YSQUIT
MOVEM T1,TRAPTO
SETOM QYNVAL ;IF INTERRUPTED/CONTINUED, ASSUME YES
YESNO2: MOVE T1,QYNPMT
HRROI T2,STRING
MOVEI T3,QYNBLK
CALL QUEST
MOVEM P,QYNTMP
QYNRPS: MOVE P,QYNTMP
CALL TSTINT
JRST BAKOUT
DMOVE T1,[EXP QYNBLK,QYNINB]
CALL PARSE
JRST BADYEN
MOVE T2,(T2)
HRREM T2,QYNVAL
DMOVE T1,[EXP QYNBLK,CONINB]
CALL PARSE
JRST BADYEN
TRNA
YSQUIT: MOVE P,TRAPSP
SETZM TRAPTO
CALL TSTINT
JRST BAKOUT
MOVE T2,QYNVAL
RET
BADYEN: TXNN F,F.SUBJ ;SUBJOB?
ERROR <Just need a YES or NO here> ;NO. ?ERROR IS OK.
JRST YESNO2 ;IN ANY CASE ASK AGAIN
;QUEST takes the following:
; T1/ byte pointer to text to ask
; T2/ word address of some scratch space to build a prompt string
; T3/ address of COMND% block to use for prompting
;it returns with the init for prompting done and the address of the comnd
; block in T1. Also turns on Question mode and meddles the OUTMSG flags.
QUEST: PUSH P,T3
HRROM T2,.CMRTY(T3) ;SET PROMPT LOCATION
MOVX T3,<BYTE(7)" ">
TXNE F,F.SUBJ
MOVX T3,<BYTE(7)"$">
MOVEM T3,(T2)
HRLI T2,(POINT 7,0,6)
CALL CSTR
MOVE T1,LSTFLG
MOVEM T1,LSTTMP
SELECT LS.TTY
POP P,T1
MOVEI T2,INIINB
COMND%
ERJMPS .+1
MOVE T1,(P)
RET
;Info for the parsing routines
;These commands are not possible at the ^E caused prompt
CM1LST: CM1LEN,,CM1LEN
CTB ARCHIV, <ARCHIVE>
CTB CHECK, <CHECK>
CTB $EOT, <EOT>
CTB LEAVE, <EXIT>
IFN FTIND,<
CTB $INDMD, <INDUSTRY>, CM%INV
>
CTB $INTER, <INTERCHANGE>
IFN FTMAIL,<
CTB MAIL, <MAIL>
>
CTB MIGRAT, <MIGRATE>
CTB PRINT, <PRINT>
CTB LEAVE, <QUIT>, CM%INV
CTB RESTOR, <RESTORE>
CTB RETRIE, <RETRIEVE>
CTB $REW, <REWIND>
CTB DUMP, <SAVE>
CTB $$SET, <SET>
CTB $SKIP, <SKIP>
CTB $TAPE, <TAPE>
CTB TRANSF, <TRANSFER>
CTB $UNL, <UNLOAD>
CM1LEN=.-CM1LST-1
; These commands are only possible at the ^E caused prompt
CM2LST: CM2LEN,,CM2LEN
CTB $ABORT, <ABORT>
CTB $CONT, <CONTINUE>
CM2LEN=.-CM2LST-1
; These commands are possible at any time
CMCLST: CMCLEN,,CMCLEN
CTB $AB4, <ABEFORE>
CTB $ACC, <ACCOUNT>
CTB $ASI, <ASINCE>
CTB $B4, <BEFORE>
CTB $CSUM, <CHECKSUM>
CTB $CREAT, <CREATE>
CTB $DEN, <DENSITY>
CTB $LDIR, <DIRECTORIES>
IFN FTEXAC,<
CTB EXACTM, <EXACT>
>
CTB $LFIL, <FILES>
CTB $FMT, <FORMAT>
CTB TYPHLP, <HELP>
CTB $INISP, <INITIAL>
CTB $LIST, <LIST>
CTB $MB4, <MBEFORE>
CTB $MSI, <MSINCE>
CTB $NO, <NO>
CTB $PAR, <PARITY>
CTB $PRO, <PROTECTION>
CTB $SIL, <SILENCE>
CTB $SINCE, <SINCE>
CTB $SSNAM, <SSNAME>
CTB $SUP, <SUPERSEDE>
CTB $TAKE, <TAKE>
CMCLEN=.-CMCLST-1
QYNINB: <.CMKEY>B8
EXP QYNLST
QYNLST: 2,,2
TB 0, <NO>
TB -1, <YES>
CM1INB: <.CMKEY>B8+CMCINB
EXP CM1LST
CMCINB: <.CMKEY>B8
EXP CMCLST
CM2INB: <.CMKEY>B8+CM3INB
EXP CMCLST
CM3INB: <.CMKEY>B8
EXP CM2LST
;Some parsing tokens
FICINB: <.CMCFM>B8+FILINB
FILINB: <.CMFIL>B8
GTDINB: <.CMTAD>B8+GT2INB
CM%IDA+CM%ITM
GT2INB: <.CMTAD>B8
CM%IDA
INIINB: <.CMINI>B8
CONINB: <.CMCFM>B8
TXTINB: <.CMTXT>B8
MTAINB: <.CMDEV>B8
NUMINB: <.CMNUM>B8
^D10
SUBTTL Error support
;ERROR and special output routines.
;ANNERR is good to call when you hit an error. If you are in a TAKE file,
; it <CRLF>s at need and types the failing command back to the user. It
; makes sure the next output starts at the margin and clears the input
; buffer.
ANNERR: DMOVEM T1,IFCTMP
MOVX T1,.CTTRM
RFMOD%
TXZE T2,TT%OSP ;CLEAR ^O
SFMOD%
CFIBF%
CALL WHERE
JRST .+2 ;FROM FILE
JRST IFCRL2 ;FROM TERMINAL
MOVEM T1,INPTMP
CALL IFCRL2
TYPE [ASCIZ/?In command /]
TYPE BFFR ;TYPE COMMAND
CALL IFCRL2
TYPE [ASCIZ/?In file /]
MOVE T2,INPTMP
CALL TYJFNS
JRST IFCRL2 ;DO IFCRLF, RESTORING CALLER'S AC'S
CRLFEN: DMOVEM T1,IFCTMP
MOVEI T1,.PRIOU
DOBE%
RFPOS%
ADD T2,IFCTMP
HRRZS T2
CAIGE T2,^D80
JRST NOCRLF
JRST YSCRLF
IFCRLF: DMOVEM T1,IFCTMP
IFCRL2: MOVEI T1,.PRIOU
DOBE%
RFPOS%
TRNE T2,-1
YSCRLF: TYPE CRLF
NOCRLF: DMOVE T1,IFCTMP
RET
;WHERE skips if the commands are coming in from .PRIIN
; The current input JFN is returned in T1
WHERE: HLRZ T1,CMDBLK+.CMIOJ ;GET THE INPUT SOURCE
CAIN T1,.PRIIN ;PRIMARY INPUT?
AOS (P) ;YES, SKIP RET
RET
LSTERR: TLCE T1,-1 ;ANY LEADER STRING BEYOND "?"
TLCN T1,-1
HRLI T1,(POINT 7)
MOVEI T2,2 ;POINT TO 2ND CHARACTER
ADJBP T2,T1
LDB T2,T2 ;FETCH
TYPEAT T1
CAIE T2,0 ;JUST ONE CHAR (IE, "?") ?
LSTERD: TYPE [ASCIZ/ - /] ;IF YES, DON'T TYPE THIS
JRST LSTERO
;HERE WITH THE ERROR CODE (OR -1 FOR LAST) IN RH OF T2
LSTERC: HRRZ T1,T2 ;IS IT -1 (LAST ERROR)?
CAIE T1,-1 ;..
JRST LSTERK ;NO, SOMETHING EXPLICIT
LSTERO: MOVX T1,.FHSLF ;IT IS; WHAT WAS LAST ERROR?
GETER%
HRRZ T1,T2 ;IS IT GJFX3 (NO MORE JFNS?)
LSTERK: CAIE T1,GJFX3
JRST SOMERR
TYPE [ASCIZ/No more JFNs available
Please use fewer file specifications in this command/]
RET
SOMERR: SETZM STRING
HRROI T1,STRING
HRLI T2,.FHSLF
SETZ T3,
ERSTR%
JFCL
JFCL
TYPE STRING
RET
FNDERR: PUSH P,T2
MOVX T1,.FHSLF
GETER%
HRRZ T1,T2
POP P,T2
RET
NOFREE: ERROR <No freespace>,SPRREQ
SPRREQ: TYPE [ASCIZ/
Please submit an SPR detailing what you did./]
JRST BAKOUT
SUBTTL QUASAR routines
;Set up to work with Quasar - get PIDs and set quotas, and say hello
;Some QUASAR routines herein are called at interrupt level. These do
; not use WARN or similiar macros, as they tend to destroy things best
; left alone. If a routine is using raw PSOUTs to do output, it probably
; has a good reason.
QSRINI: SETZM NXTRTP ; No next
SETZM RETFIN
SETZM ABTFLG
SETZM MYPID
CALL GQPID ;GET QUASAR'S PID IN QSRPID
GJINF% ; GET JOB #
MOVEM T3,PD1BLK+1
DMOVE T1,[EXP 3,PD1BLK]
MUTIL%
ERJMPS [WARN <Failed to set PID quota for DUMPER>
JRST .+1]
DMOVE T1,[EXP 3,PD2BLK]
MUTIL%
ERJMPS [ERROR <Unable to create a PID for DUMPER>]
MOVE T3,MYPID
MOVEM T3,PD3BLK+1
MOVEM T3,PD4BLK+1
DMOVE T1,[EXP 3,PD3BLK]
MUTIL%
ERJMPS [ERROR <Unable to set DUMPER PID on interrupt channel>]
DMOVE T1,[EXP 3,PD4BLK]
MUTIL%
ERJMPS [WARN <Unable to set send/receive quotas to 30>
JRST .+1]
TDZA T1,T1
GDBYE: MOVX T1,HEFBYE ; SAY GOOD-BYE
HELLO: HRLI T1,%%.QSR ; Internal version,,flags
CALL ZIPMSS ; Setup for sending
MOVEM T1,HEL.FL(P1) ; Version and flags
MOVE T2,[HEL.SZ,,.QOHEL] ; HELLO MSG
MOVEM T2,.MSTYP(P1) ; Drop in length & type
MOVE T2,[SIXBIT /DUMPER/]
MOVEM T2,HEL.NM(P1) ; Program name
MOVE T2,[1,,1] ; 1 object type, 1 concurrent job
MOVEM T2,HEL.NO(P1)
MOVX T2,.OTRET ; Which is a retrieval
MOVEM T2,HEL.OB(P1) ; Object type
MOVE P1,[HEL.SZ,,QSRMSS]
;JRST SNDQSR ; SEND IT
SNDQSR: SETZM PDB
MOVEI T2,PDB ; WHERE TO BUILD PDB
PUSH T2,MYPID ; SENDER'S PID
PUSH T2,QSRPID ; RECEIVER'S PID
PUSH T2,P1 ; WHERE ACTUAL MSG IS
MOVEI T1,.IPCFP+1 ; PDB LENGTH
MOVEI T2,PDB
MSEND% ; SEND MSG
ERJMPS [HRROI T1,[ASCIZ/%SNDQSR failed/]
PSOUT%
RET]
RET
; Here to receive a message; P1 HAS ADDR OF DATA
RCVQSR: MOVEI T2,PDB-1
PUSH T2,[IP%CFB] ;DO NOT BLOCK
PUSH T2,[0] ; SENDER'S PID
PUSH T2,MYPID
PUSH T2,[1000,,QSRMSR]
RCVQS1: MOVEI T1,4
MOVEI T2,PDB
MRECV% ; READ IT
ERJMPR [CAIN T1,IPCFX2;No more messages
RET ;Go and DEBRK
MOVX T1,IP%CFV ; SAY PAGE MODE
MOVEM T1,PDB+.IPCFL
MOVE T1,[1000,,<QSRMSR/1000>]
MOVEM T1,PDB+.IPCFP
JRST RCVQS1]
MOVEI P1,QSRMSR ; Point to RECEIVed message
MOVE T1,PDB+.IPCFS ; GET SENDER'S PID
CAME T1,QSRPID ; MATCH QUASAR'S?
JRST RCVQSR ;NO, TRASH
JRST CPOPJ1
NXTRET: SKIPE P5,NXTRTP ; Next request ready for us?
JRST NXTRE1 ;yes. go do the request
SKIPE RETFIN ;DONE?
RET ;yes, return to caller
IFG WAITTM,< ;;Only if willing to time the wait
MOVE T1,[.FHSLF,,.TIMEL]
MOVX T2,WAITTM*^D60*^D1000 ;wait WAITTM minutes for galaxy to answer
MOVEI T3,TIMCHN
TIMER% ;SET UP THE TIMER CHANNEL
ERJMPS [WARN <Can't time QUASAR wait>
JRST NOTIME]
MOVX T1,.FHSLF ;on the timer channel
MOVX T2,1B<TIMCHN>
AIC%
>
NOTIME: SKIPE NXTRTP ; Did a message just come in
JRST WAITIN ;Yes
TXO F,F.WAIT
WAIT% ; No, wait until QUASAR gets to us
WAITIN: JFCL ; Race insurance
TXZ F,F.WAIT ; Make sure this is off
IFG WAITTM,<
MOVE T1,[.FHSLF,,.TIMBF]
HRLOI T2,377777 ;POSITIVE INFINITY
TIMER%
ERJMPS .+1
MOVX T1,.FHSLF ; Turn off the timer channel
MOVX T2,1B<TIMCHN>
DIC%
>
SKIPN RETFIN
SKIPN P5,NXTRTP ; Make sure we've a copy of the ptr
RET ; No more to do
NXTRE1: HRROI T2,FILNM(P5) ; Point to file name
CALL TSTNAM ; Ok?
JRST [ RLJFN%
JFCL
CALL REFUSE ; Don't want this one
JRST NXTRET] ; Try again
RLJFN%
JFCL
MOVX T1,GJ%OLD+GJ%XTN;GET FLAGS
MOVEM T1,RETBLK+.GJGEN;SET IN BLOCK
MOVEI T1,RETBLK ; Use blk with invisible etc.
HRROI T2,FILNM(P5) ; Point to name
GTJFN%
ERJMPR NXTRE2 ;GTJFN FAILED
MOVSI T2,.FBLN0 ;GET ENTIRE FDB
MOVEI T3,FDB
GTFDB%
MOVE T2,T1 ;COPY JFN
HRROI T1,STRING ;SET TO BUILD STR:<DIR>, FOR RCDIR
MOVX T3,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF>
JFNS%
MOVE T1,T2 ;COPY JFN BACK
RLJFN% ;DUMP JFN
JFCL
MOVE T3,FDB+.FBCTL ;GET CONTROL WORD
TXNN T3,FB%OFF ; File offline?
JRST [CALL RELREQ ;YES, RELEASE RETRIEVAL REQUEST
JRST NXTRET] ; Try again
MOVX T1,RC%EMO ;MATCH EXACTLY
HRROI T2,STRING ;POINTER TO STR:<DIR>
RCDIR%
MOVE T1,T3 ;COPY DIRECTORY NUMBER
GTDAL% ;GET DISK ALLOCATION
HRRZS FDB+.FBBBT ;OFFLINE FILE SIZE
ADD T2,FDB+.FBBBT ;ADD REQUESTED FILE SIZE
CAMLE T2,T1 ;ENOUGH WORKING QUOTA?
JRST [HRROI P1,[ASCIZ/ Insufficient disk quota to RETRIEVE file./]
JRST NXTRE3] ;TELL USER AND GET NEXT REQUEST
JRST CPOPJ1
NXTRE2: CAIN T1,GJFX16 ;INVALID DEVICE?
JRST [WARN <Structure not mounted, skipping file > ;YES
TYPE FILNM(P5)
CALL REFUSE ;REQUEUE THE REQUEST
JRST NXTRET] ;GET NEXT RETRIEVAL REQUEST
CALL BADOFP ;SOME OTHER ERROR, COMPOSE MESSAGE
NXTRE3: CALL WASHOU ;TELL USER AND REQUESTOR
CALL RELREQ ;RELEASE THE RETRIEVAL REQUEST
JRST NXTRET
BADOFP: HRROI T1,STRING
BADOF2: HRLOI T2,.FHSLF
SETZ T3,
ERSTR%
JFCL
JFCL
HRROI P1,STRING
RET
;Here with P1 pointing to an error string and P5 pointing to the
; retrieval block. Say we can't retrieve.
FALFIL: JUMPE P1,CPOPJ
WARN <Failed to restore >
TYPE FILNM(P5)
TYPE [ASCIZ/ because:
/]
TYPEAT P1
RET
; Here to report terrible failure to requestor
; Error message ptr in P1. Call WASHO2 if FALFIL already done.
WASHOU: CALL FALFIL
WASHO2: TYPE [ASCIZ/
File will not be Retrieved./]
SETZM GTJBLK ;ZERO GTJFN ARG BLOCK
MOVE T1,[GTJBLK,,GTJBLK+1]
BLT T1,GTJBLK+.GJBFP
MOVX T1,GJ%OLD+GJ%XTN
MOVEM T1,GTJBLK+.GJGEN;OLD FILE, LONG GTJFN BLOCK
MOVX T1,G1%IIN
MOVEM T1,GTJBLK+.GJF2 ;INCLUDE INVISIBLE FILES
MOVE T1,[.NULIO,,.NULIO]
MOVEM T1,GTJBLK+.GJSRC;JUST USE STRING
MOVEI T1,GTJBLK ;GET ARG BLOCK ADDRESS
HRROI T2,FILNM(Q1) ;GET POINTER TO FILESPEC
GTJFN% ;GET JFN ON FILE
ERJMPS CPOPJ
MOVEI T2,.ARRFL
DOJSS ARCF%, .+1 ;SET AR%RFL (RETRIEVE FAILED) IN FDB
RLJFN% ;DUMP JFN
JFCL
RET
;Enter with pointer to filename to test in T2
; returns parse only filespec in T1 and gives +2 if OK to Load, and sets
; MATCH to the index into JFNLST and JF2LST of the matching entry.
;Also returns RH T4 as index
TSTNAM: MOVX T1,GJ%OFG+GJ%SHT;SET TO PARSE NAME
GTJFN%
ERJMPS CPOPJ
PUSH P,T1
MOVE T4,NFJFN ;SCAN ALL SPECS GIVEN TO LOAD
TSTNA3: SKIPN T2,JFNLST(T4) ;JFN STILL HERE?
JRST TSTNA4
HRRZ T3,0(P) ;GET CURRENT FILE JFN
MOVEI T1,.WLJFN
WILD% ;FIND DIFFERENCES BETWEEN THE SPECS
TXNE F,F.INTR ;INTERCHANGE?
TXZ T1,WL%DEV!WL%DIR;YES, DSK/DIR DON'T MATTER
TXNE T1,WL%DEV!WL%DIR!WL%NAM!WL%EXT!WL%GEN ;ANY MISMATCHES?
JRST TSTNA4
HRRZM T4,MATCH
SETZM OUTDRS ;FORCE GOFNAM, IF CALLED, TO USE THIS
POP P,T1
JRST CPOPJ1
TSTNA4: AOBJN T4,TSTNA3 ;YES, STEP TO NEXT FILESPEC
POP P,T1 ;DONE ALL FILESPECS, FAILED TO MATCH ANY
RLJFN%
ERJMPS .+1
RET
; Here to say "no thanks" to QUASAR's choice of retrieve requests
REFUSE: GTAD% ; Get timestamp
MOVE T2,TPBLK+.ARODT
TXNE T2,%EQUFT ; Using alternate tape?
TXO T1,%EQUFT ; Yes, send it back that way
JRST REQSIL
; Here to ACK a message
DOACK: MOVE T2,.MSCOD(P1) ; Get ack code
MOVEM T2,.MSCOD+ACKBLK
PUSH P,P1
MOVE P1,[MSHSIZ,,ACKBLK]
CALL SNDQSR ; Send it
POP P,P1
RET
; Here to say we're done with a request block
RELREQ: SETZM NXTRTP ; Nothing there now
CALL ZIPMSS ; Setup to send
MOVE T2,[REL.SZ,,.QOREL] ; Set to release the one we've done
MOVEM T2,.MSTYP(P1) ; Length and type
MOVE T2,TPTSK ; Include the task name
MOVEM T2,REL.IT(P1) ; Internal task name
MOVE P1,[REL.SZ,,QSRMSS]
JRST SNDQSR ; Send the release
; Here to abort current retrieval; Assumes retrieval described by
; info in TPBLK
ABTRET: WARN <Retrieve aborted>
SETZM ABTFLG
JRST RELREQ ; Tell QUASAR we're "done"
; Here to release PID in T1
RELPID: MOVEM T1,PDB+1
MOVEI T1,.MUDES ; Delete the PID
MOVEM T1,PDB
MOVEI T1,2
MOVEI T2,PDB
MUTIL%
ERJMPS [WARN <Can't release PID>
JRST .+1]
SETZM MYPID
SETZM QSRPID ; Forget about QUASAR too
RET
;Here to clear send page & set up P1 pointing to it
ZIPMSS: SETZM QSRMSS
MOVE P1,[QSRMSS,,QSRMSS+1]
BLT P1,QSRMSS+777 ; Clear the entire page
MOVEI P1,QSRMSS
RET
GQPID: SETZM QSRPID
DMOVE T1,[EXP 3,PD0BLK]
MUTIL%
ERJMPS [ERROR <Can't get QUASAR's PID>]
RET
RETTYF: SKIPE P5,NXTRTP
TYPE FILNM(P5)
RET
;Get the tape needed for the retrieval request
MNTRET: SKIPGE .ARODT(P5)
SKIPA T1,.ARTP1(P5)
MOVE T1,.ARTP2(P5)
TLNN T1,-1
CALL NSVOL ;CONVERT TO SIXBIT IF NECESSARY
MOVE Q1,T1 ;COPY VOLID TO A SAFE PLACE
CAMN Q1,VOLID6 ;DO WE HAVE THE TAPE UP ALREADY?
JRST [CALL GMOJFI
JRST .+1 ;CAN'T, CLOSE AND DROP AND TRY AGAIN
JRST CPOPJ1] ;YES, JUST RETURN
SKIPG T1,BDTCNT ;DO WE HAVE ANY KNOWN UNAVAILABLE TAPES?
JRST NOBADT ;NO, SO TRY IT
BDTSCN: CAMN Q1,BDTLST-1(T1) ;YES, IS THIS ONE KNOWN UNAVAILABLE?
JRST TPEUNA ;YES! DON'T EVEN TRY
SOJG T1,BDTSCN ;CHECK WHOLE LIST
NOBADT: CALL KILCHN ;TAPE OK. LOSE ANY OLD READAHEAD
CALL MTCLS ;OK, CLOSE WHATEVER WHAT WE NOW HAVE
CALL UNLOAD ;AND DROP
MNTNXT: SETZM FRCSET ;NEVER INSIST ON DENSITY SETTINGS IN RETRIEVAL
MOVEI T1,.SFMTA
TMON% ;TAPE DRIVE ALLOCATION ENABLED?
JUMPN T2,RETTA3 ;YES, CALL FOR TAPE MOUNT THRU QUASAR
CALL IFCRL2
TYPE [ASCIZ/Please mount tape /]
MOVE T3,Q1 ;GET VOLID
CALL SIXOUT
HRROI T1,[ASCIZ/ Is this tape available? /] ;Might have snapped
CALL YESNO
JUMPN T2,[
CALL GMOJFI ;SAID YES, GET TAPE SPEC
JRST MNTRET ;CAN'T
;**;[538] MNTNXT:+7L Replace 1 line (from edit 534) with 2 SM 31-Jan-86
MOVE T3,Q1 ;[538] DOVOLS STORES VOLID6, VOLID FROM T3
CALL DOVOLS ;[538] SET THEM
JRST CPOPJ1]
RETTA2: MOVE T1,BDTCNT
CAIL T1,BDTMAX
JRST RETTAA
HRROI T1,[ASCIZ/Should I ask about this tape anymore in this run? /]
CALL YESNO
JUMPN T2,RETTAA
AOS T1,BDTCNT
MOVEM Q1,BDTLST-1(T1)
RETTAA: HRROI P1,[ASCIZ/Tape currently unavailable/]
RET
TPEUNA: HRROI P1,[ASCIZ/Request on a tape known unavailable/]
RET
RETTA3: CALL MREQ ;SEND MOUNT REQUEST AND GET ANSWER
JRST [HRROI T1,[ASCIZ/Try for same tape again? /]
CALL YESNO
JUMPN T2,RETTA3 ;WANTS TO TRY AGAIN
JRST RETTA2] ;DON'T TRY AGAIN
CALL GMOJFI
JRST RETTA2
CALL REWCV
JRST CPOPJ1
SUBTTL Mounting code
;Enter with Q1 as sixbit/volname/
MREQ: CALL IFCRLF
TYPE <[ASCIZ/[Mounting tape volume /]>
MOVE T3,Q1
CALL SIXOUT
TYPE CBCR
DMOVE T1,[EXP .MURSP,.SPQSR] ;GET PID OF REAL QUASAR
DMOVEM T1,MPDB
MOVEI T1,3 ;ARG BLOCK LENGTH
MOVEI T2,MPDB ;ARG BLOCK ADDRESS
MUTIL% ;GET PID INTO MPDB+.IPCFR
JSERRD <Can't get QUASAR's PID>
; BUILD IPCF MOUNT MESSAGE FOR QUASAR
; (MESSAGE LENGTH AND MOUNT-REQUEST ENTRY LENGTH FILLED IN LATER)
MOVE Q3,[IOWD 1000,MBUF] ;GET STACK POINTER
MOVSI T2,-TMSKSZ ;GET AOBJN POINTER TO SKELETON
PUSH Q3,TMSKEL(T2) ;TRANSFER SKELETON WORD TO MESSAGE
AOBJN T2,.-1 ;LOOP UNTIL ALL OF SKELETON IS MOVED
PUSH Q3,[2,,.TMVOL]
PUSH Q3,Q1 ;CREATE VOLID ENTRY IN IPCF MESSAGE
; NOW FIX UP THE COUNT FIELDS IN THE IPCF MESSAGE
HRRZ T1,Q3 ;GET ADDRESS OF LAST WORD OF MESSAGE
SUBI T1,MBUF-1 ;COMPUTE SIZE OF MESSAGE
STOR T1,MS.CNT,MBUF+.MSTYP ;STORE IN GALAXY HEADER
SUBI T1,.MMHSZ ;COMPUTE SIZE OF MOUNT ENTRY
STOR T1,AR.LEN,MBUF+.MMHSZ ;STORE IN MOUNT ENTRY LENGTH FIELD
MOVEI T1,MBUF+.MMHSZ+.MEHSZ ;POINT AT FIRST SUBENTRY
TMX2: AOS MBUF+.MMHSZ+.MECNT ;COUNT THIS SUBENTRY
LOAD T2,AR.LEN,(T1) ;GET SIZE OF SUBENTRY
ADD T1,T2 ;POINT AT NEXT SUBENTRY
CAIGE T1,(Q3) ;ANOTHER SUBENTRY?
JRST TMX2 ;YES, CONTINUE SCAN
; SEND IPCF MESSAGE TO QUASAR
MOVEI T2,MPDB-1 ;SET UP PDB FOR MSEND
PUSH T2,[IP%CPD+IP%CFV] ;FLAGS
PUSH T2,[0] ;SENDER'S PID (WILL BE CREATED)
ADJSP T2,1 ;RECEIVER'S PID FILLED IN ALREADY
PUSH T2,[1000,,<MBUF_-9>] ;PACKET DESCRIPTOR
MOVEI T1,4 ;GET SIZE OF PDB
MOVEI T2,MPDB ;GET ADDRESS OF PDB
MSEND% ;SEND REQUEST TO QUASAR
JSERRD <Could not send IPCF mount request>
; MOUNT MESSAGE HAS BEEN SENT, NOW RECEIVE THE REPLY
MOVE T1,MPDB+.IPCFS
MOVEM T1,MPDB+.IPCFR ;SET RECEIVER'S PID
MREQ2: SETZM MPDB+.IPCFL
MOVE T1,[1000,,MBUF]
MREQ3: MOVEM T1,MPDB+.IPCFP ;POINTER TO MESSAGE BUFFER
MOVEI T1,.IPCFC+1 ;PDB LENGTH
MOVEI T2,MPDB ;PDB ADDRESS
MRECV% ;RECEIVE MESSAGE
ERJMPR [CAIE T1,IPCF16 ;ERROR BECAUSE OF WRONG DATA MODE?
ERROR <Error receiving mount response> ;NO
MOVX T1,IP%CFV ;YES, TRY THIS
MOVEM T1,MPDB+.IPCFL ;STORE FLAGS
MOVE T1,[1000,,MBUF/1000] ;GET POINTER FOR NON-PAGE-MODE
JRST MREQ3] ;TRY AGAIN
MOVE T1,MPDB+.IPCFC
TXNN T1,SC%WHL+SC%OPR;IS SENDER LEGIT?
JRST MREQ2 ;NO, TRY AGAIN
LOAD Q3,MS.TYP,MBUF+.MSTYP ;GET MESSAGE TYPE
JN MF.FAT,MBUF+.MSFLG,CKMNT1 ;JUMP IF MOUNT FAILED
CAIE Q3,.QOMNA ;IS IT A RESPONSE TO MOUNT REQUEST?
JRST MREQ2 ;NO, IGNORE IT
CALL MRKPID ;DELETE MOUNTING PID
MOVEI T1,[ 1
.MNRDV,,CKMDV]
CALL SCNMBK ;SUCCESSFUL MOUNT, GET DESIGNATOR
MOVE T1,MTDSG
CALL SETMNT ;REMEMBER I HAVE MOUNTED A TAPE
HRROI T1,MTDEV ;DESTINATION STRING POINTER
MOVE T2,MTDSG
DEVST% ;CONVERT DESIGNATOR TO STRING
JSERRD <Can't get tape name>
MOVEI T2,":"
IDPB T2,T1 ;BUILD FILESPEC
SETZ T2,
IDPB T2,T1
CALL CHKMTD ;GET JFN AND TAPE INFO AND CHECK IT
ERROR <Mount not acceptable>
TYPE <[ASCIZ/[Volume /]>
MOVE T3,Q1 ;GET VOLID
CALL SIXOUT
TYPE [ASCIZ/ mounted/]
TYPE CBCR
JRST CPOPJ1 ;ALL OK
CKMDV: MOVE T1,1(T1) ;GET DESIGNATOR
MOVEM T1,MTDSG ;STORE IT
ASND% ;ASSIGN MT DEVICE TO THIS JOB
JFCL
RET
; MOUNT FAILED
CKMNT1: CALL MRKPID ;DELETE MOUNTING PID
CAIN Q3,MT.TXT ;TEXT MESSAGE?
JRST [ MOVEI T1,MBUF+.OHDRS+ARG.DA ;YES, GET ADDRESS OF TEXT
JRST CKMTX] ;TYPE ERROR MESSAGE AND TAKE +1 RETURN
MOVEI T1,[2
.MNREC,,CKMEC
.MNRTX,,CKMTX]
JRST SCNMBK ;ANALYZE REPLY AND RETURN +1
CKMTX: HRRO Q1,T1 ;GET STRING POINTER TO TEXT
TYPE [ASCIZ/
Additional information - /]
TYPEAT Q1
TYPE CRLF
RET
CKMEC: MOVE Q1,(T1) ;GET ERROR CODE
TYPE [ASCIZ/
?Cannot mount tape, /]
MOVEI T1,.PRIOU
MOVE T2,Q1 ;GET ERROR CODE
HRLI T2,.FHSLF ;APPEASE ERSTR WITH FORKHANDLE
SETZ T3, ;NO LIMIT
ERSTR% ;TYPE ERROR MESSAGE
JFCL
JFCL
RET
; ROUTINE TO DELETE MOUNTING PID IN MPDB+.IPCFR
MRKPID: MOVEI T1,.MUDES
MOVEM T1,MPDB+1 ;BUILD MUTIL ARGUMENT BLOCK
MOVEI T1,2 ;ARG BLOCK LENGTH
MOVEI T2,MPDB+1 ;ARG BLOCK ADDRESS
MUTIL% ;DESTROY THE PID I USED TO DO THE MOUNT
JFCL
RET
; SETMNT - SET OR CLEAR CURRENTLY-MOUNTED TAPE
; THIS APPLIES ONLY TO TAPES THAT DUMPER HAS MOUNTED VIA QUASAR
; A/ MT DEVICE DESIGNATOR OR 0 TO CLEAR
SETMNT: PUSH P,T1 ;SAVE NEW DESIGNATOR
CALL MTCLS
SKIPE T1,MNTDSG ;HAVE DESIGNATOR CURRENTLY?
RELD% ;YES, DUMP IT
JFCL
POP P,MNTDSG ;SET NEW DESIGNATOR
; CREATE OR DELETE LOGICAL NAME FOR MOUNTED TAPE
MOVEI T1,.CLNJ1 ;ASSUME DELETING LOGICAL NAME
SKIPE T2,MNTDSG ;SETTING NEW DEVICE?
JRST [ HRROI T1,MTDEV;YES
DEVST% ;COMPOSE LOGICAL NAME
JFCL ; DEFINITION STRING
MOVEI T2,":"
IDPB T2,T1
SETZ T2,
IDPB T2,T1
MOVEI T1,.CLNJB;SET TO CREATE LOGICAL NAME
JRST .+1]
HRROI T2,[ASCIZ/RETRVL/] ;LOGICAL NAME = RETRVL:
HRROI T3,MTDEV ;POINTER TO DEFINITION, MTn:
CRLNM% ;CREATE OR DELETE LOGICAL NAME
JFCL
RET
; SKELETON IPCF MESSAGE FOR TAPE MOUNT
TMSKEL: 0,,.QOMNT ;GLX HEADER - LENGTH,,TYPE
0 ;GLX HEADER - FLAGS
0 ;GLX HEADER - ACK CODE
0 ;MOUNT MESSAGE FLAGS
SIXBIT/RETRVL/ ;MOUNT REQUEST NAME
1 ;MOUNT ENTRY COUNT
0,,.MNTTP ;MOUNT ENTRY LENGTH,,TYPE
0 ;MOUNT ENTRY FLAGS
0 ;SUBENTRY COUNT (FILLED IN LATER)
2,,.TMSET ;SETNAME SUBENTRY
SIXBIT/RETRVL/
2,,.TMDRV ;DRIVE-TYPE SUBENTRY
.TMDR9
4,,.TMRMK
ASCIZ/RETRIEVAL TAPE/
TMSKSZ==.-TMSKEL ;LENGTH OF SKELETON
; SCNMBK - SCAN REPLY TO MOUNT REQUEST AND CALL BLOCK-PROCESSORS
; A/ ADDRESS OF BLOCK-TYPE/PROCESSOR-ADDRESS LIST
; RETURNS +1: ALWAYS
SCNMBK: PUSH P,Q1
MOVE Q1,MBUF+.OARGC ;GET # OF BLOCKS IN LIST
MOVEI Q2,MBUF+.OHDRS ;GET ADDRESS OF FIRST BLOCK
MOVE Q3,T1 ;COPY CALLER'S LIST ADDRESS
SCNMB1: SOJL Q1,[POP P,Q1
RET] ;EXIT IF NO MORE BLOCKS TO SCAN
MOVEI T1,1(Q2) ;GET ADDRESS OF DATA IN BLOCK
HRRZ T2,(Q2) ;GET BLOCK TYPE CODE
HLRZ T3,(Q2) ;GET BLOCK LENGTH
ADD Q2,T3 ;POINT Q2 AT NEXT BLOCK
MOVN T3,(Q3) ;GET NEGATIVE # OF LIST ENTRIES
MOVSS T3 ;MOVE TO LEFT HALF FOR AOBJN POINTER
HRRI T3,1(Q3) ;MAKE POINTER TO CALLER'S LIST
SCNMB2: HLRZ T4,(T3) ;GET TYPE CODE FROM LIST
CAMN T2,T4 ;DOES IT MATCH THE CODE FOR THIS BLOCK?
JRST [ HRRZ T4,(T3) ;YES, GET PROCESSOR ROUTINE ADDRESS
CALL (T4) ;INVOKE PROCESSOR
JRST SCNMB1] ;GO SCAN NEXT BLOCK
AOBJN T3,SCNMB2 ;CONTINUE LIST SCAN
JRST SCNMB1 ;UNRECOGNIZED BLOCK TYPE, IGNORE IT
SUBTTL Interchange code (to DUMPER)
;From BACKUP to DUMPER
; Enter with T4/ address of buffer. Ret +1 if no data yielded, +2 with
; DMPCHA chain changed to include converted buffers. This code assumes
; the DMPCHA points to the record block to be converted, and that it
; contains only one record.
INTDMC: SETZM BLKCNT
MOVE T4,DMPCHA ;POINT TO BUFFER TO GET FIXED
SKIPLE T1,DATAST+G$TYPE(T4) ;GET BUFFER TYPE, SHOULD BE .GT. 0
CAILE T1,T$MAX ;AND ALL ARE .LE. T$MAX
JRST ILLINR
XCT [RET ;TYPE T$LBL, IGNORE
JRST T%BEG ;T$BEG, BEGINNING OF SAVESET
RET ;T$END, IGNORE
JRST T%FIL ;T$FIL, FILE DATA
RET ;T$UFD, IGNORE
JRST T%EOV ;T$EOV, END OF VOLUME
RET ;T$COM, IGNORE
JRST T%CON ;T$CON, CONTINUED SAVESET
]-1(T1)
ILLINR: WARN <Illegal INTERCHANGE record type seen, ignored>
RET
;End of volume
T%EOV: MOVEI T1,1
MOVEM T1,BLKCNT
MOVEI T1,<DATAST+1006>/1000+1
CALL GETPGS
JRST NOFREE ;CAN'T HAPPEN
MOVEM T2,INTCHA
ADDI T2,DATAST
HRROI T1,-TONEXT
CALL INCREC
JRST INTRET
T%CON: PUSH P,[-CONTST]
JRST .+2
;Interchange saveset record comes here
T%BEG: PUSH P,[-SAVEST]
MOVEI T1,1
MOVEM T1,BLKCNT ;THIS WILL CREATE ONE RECORD
MOVEI T1,<DATAST+1006>/1000+1 ;THESE NEED ONE RECORD (2 PAGES)
CALL GETPGS
JRST NOFREE
MOVEM T2,INTCHA ;WHERE THE BUFFER LIVES
ADDI T2,DATAST ;POINT TO HEADER
POP P,T1
CALL INCREC ;MAKE UP A DUMMY HEADER AT T2
ADDI T2,6
MOVEI T1,CURFMT
MOVEM T1,SV.FMT(T2)
MOVE T4,DMPCHA
MOVE T1,DATAST+S$DATE(T4)
MOVEM T1,SV.TAD(T2)
ADDI T4,DATAST+NIHEAD
SVFIND: SKIPN T1,(T4)
JRST INTRET ;RETURN INTERCHANGE RECORD
HLRZS T1
CAIN T1,O$SSNM
JRST SVFIN2
HRRZ T1,(T4)
ADDI T4,(T1)
JRST SVFIND
SVFIN2: MOVEI T1,SV.MSG
MOVEM T1,SV.PNT(T2)
HRROI T1,1(T4)
HRROI T2,SV.MSG(T2)
CALL CSTR
JRST INTRET
T%FIL: MOVE T4,DMPCHA ;POINT TO OLD RECORD
MOVE T2,DATAST+G$FLAG(T4) ;FETCH FLAGS
SETZ T1, ;FOR 'NUMBER OF RECORDS WE WILL NEED'
TXNE T2,GF$SOF ;FILEHEADER?
ADDI T1,1 ;YES, THAT TAKES A RECORD
TXNE T2,GF$EOF ;FILETRAILER?
ADDI T1,1 ;YES, THAT TAKES A RECORD
SKIPLE DATAST+G$SIZ(T4) ;ANY DATA?
ADDI T1,1 ;YES, THAT TAKES A RECORD
MOVEM T1,BLKCNT
JUMPE T1,CPOPJ ;IF NO RECORDS NEED CREATING, LEAVE NOW
IMULI T1,1006
ADDI T1,DATAST+777 ;HOW MANY WORDS DO WE NEED? PLUS A PAGE
LSH T1,-9 ;IDIV BY 1000 FOR PAGES
CALL GETPGS
JRST NOFREE
MOVEM T2,INTCHA
ADDI T2,DATAST ;POINT TO WHERE FIRST HEADER WILL GO
MOVEM T2,CURHEA
;IS IT A FILE HEADER?
MOVE T4,DMPCHA
ADDI T4,DATAST
MOVE T1,G$FLAG(T4)
TXNN T1,GF$SOF ;SEE IF FILE HEADER
JRST T%FIES ;NO, CHECK FOR DATA
HRROI T1,-FILEST
CALL INCREC ;SET UP HEADER FOR FILE START
ADD T4,[-F$NND,,NIHEAD] ;NEG SIZE OF NONDATA AREA,,POINTER TO DATA
T%FIL2: HLRZ T1,(T4) ;GET TYPE
PUSH P,T4 ;SAVE T4 IN CASE WE JUMP
MOVE T2,CURHEA ;FOR INTNAM AND INTFIL
CAIN T1,O$NAME ;NAME?
JRST INTNAM ;GO DO (RETURN TO T%FILQ)
CAIN T1,O$FILE ;ATTRIBUTES?
JRST INTFIL ;GO DO (RETURN TO T%FILQ)
T%FILQ: POP P,T4
T%FIEB: HRRZ T1,(T4) ;GET BLOCK SIZE
HRLS T1 ;IN BOTH HALVES
ADD T4,T1 ;SKIP LAST BLOCK
JUMPG T4,T%FIEA ;.GT. 0 MEANS END OF ALL BLOCKS
SKIPE (T4) ;SEE IF DONE
JRST T%FIL2 ;NO, KEEP GOING
T%FIEA: MOVE T2,CURHEA ;WHERE THAT LAST RECORD BEGAN
ADDI T2,1006 ;SKIP ON TO POSSIBLE NEXT
MOVEM T2,CURHEA
T%FIES: MOVE T4,DMPCHA
SKIPG DATAST+G$SIZ(T4) ;ANY DATA HERE?
JRST T%CKEN ;NO, MAYBE AN END OF FILE RECORD THOUGH
SETZ T1, ;DATA IS RECORD TYPE 0
CALL INCREC ;SET UP THE HEADER
MOVEI T1,DATAST+NIHEAD(T4) ;POINT TO DATA
ADD T1,DATAST+G$LND(T4) ;PLUS ANY OFFSET
HRLZS T1 ;IS THE "FROM" FOR THE BLT
HRRI T1,6(T2) ;"CURDAT" IS THE "TO" FOR THE BLT
HRRZ T3,T1 ;CALC THE "UNTIL"
ADD T3,DATAST+G$SIZ(T4) ;BY ADDING NUMBER OF WORDS
;**;[556] Add one line at T%FIES:+10L DEE 27-SEP-88
MOVEM T3,LDLCOP ;[556] save last data location copied to
BLT T1,-1(T3) ;COPY DATA
MOVE T1,DATAST+F$RDW(T4) ;GET WORD NUMBER OF DATA
LSH T1,-9
MOVEM T1,.PAGNO(T2) ;PUT INTO HEADER
ADDI T2,1006
T%CKEN: MOVE T1,DATAST+G$FLAG(T4) ;FETCH FLAGS AGAIN
TXNN T1,GF$EOF ;ENDING RECORD?
JRST INTRET ;NO, SO DONE, GO RETURN THE RECORD(S) CREATED
;**;[556] Add 13 lines and some comments at T%CKEN:+3 DEE 27-SEP-88
;[556] We have an ending record. Find the even page boundary, which is the
;[556] end of the buffer. Check to see if we filled the buffer with data.
;[556] If not, zero out the rest so we don't leave trash
;[556] in it, which can be confusing if a shorter record following hasn't
;[556] over-written stuff left in the buffer from a longer record.
MOVE T1,LDLCOP ;[556] What was the last data location used?
ANDI T1,777000 ;[556] Get even page boundary
ADDI T1,PAGSIZ-1 ;[556] Get end of this page
CAMG T1,LDLCOP ;[556] Did we fill the page with data? (unlikely, but possible)
IFSKP. ;[556] No, so pad with nulls
MOVE P2,LDLCOP ;[556] Get loc after last data
ADDI P2,1 ;[556] ...
SETZM @P2 ;[556] Start nulls here
HRL T3,P2 ;[556] Switch beginning loc to LH
ADDI P2,1 ;[556] Get destination loc
HRR T3,P2 ;[556] Destination end here
BLT T3,(T1) ;[556] T1 has end of buffer
ENDIF. ;[556] Done
HRROI T1,-FILEEN
CALL INCREC ;YES, SET UP FILE ENDING RECORD
ADD T2,[ICFDB,,6] ;FROM ICFDB TO "CURDAT"
MOVEI T1,.FBLN0-1(T2) ;COPY FDB DATA IN
BLT T2,(T1)
;JRST INTRET
;Here to replace the buffer at DMPCHA with the buffer at INTCHA, and return +2
; with F.CIRC lit.
INTRET: MOVE T1,INTCHA
MOVEI T3,DATAST(T1)
MOVEM T3,BLKPNT
EXCH T1,DMPCHA ;MAKE NEW BUFFER BEGINNING OF CHAIN
PUSH P,DATAST+G$SEQ(T1) ;SAVE OLD SEQUENCE NUMBER
CALL RELPGS ;DELETE OLD BUFFER
MOVE T4,DMPCHA
MOVEM T1,NXTBUF(T4) ;MAKE OLD NEXT THE NEW NEXT
POP P,DATAST+.SEQ(T4);AND COPY SEQUENCE NUMBER IN
TXO F,F.CIRC
JRST CPOPJ1
INTNAM: MOVX T1,<POINT 7>
ADDI T1,6(T2) ;POINT TO WHERE FILENAME GOES
MOVEI T2,.FCDIR
CALL SCNBF ;FIND DIRECTORY BLOCK
JRST TFIL3 ;NONE
HRLI T2,(POINT 7)
MOVEM T2,INTTMP ;SAVE PTR TO IT
MOVEI T2,"<" ;DO DIR PUNCTUATION
IDPB T2,T1
TFIL32: ILDB T2,INTTMP
JUMPE T2,TFIL31 ;END ON NULL
CAIN T2,"," ;PPN SEPARATOR?
MOVEI T2,"-" ;YES, TRANSLATE
IDPB T2,T1
JRST TFIL32
TFIL31: MOVEI T2,">"
IDPB T2,T1 ;CLOSE DIR PUNCT
TFIL3: MOVEI T2,.FCNAM
CALL SCNBF ;FIND NAME BLOCK
JRST TFIL4 ;NONE
EXCH T2,T1
HRROS T1
CALL CSTRB
MOVE T1,T2
TFIL4: MOVEI T2,"."
IDPB T2,T1 ;PUNCTUATE EXTENSION
MOVEI T2,.FCEXT
CALL SCNBF ;FIND EXTENSION BLOCK
JRST TFIL5 ;NONE
EXCH T1,T2
HRROS T1
CALL CSTRB
MOVE T1,T2
TFIL5: MOVEI T2,"."
IDPB T2,T1 ;PUNCTUATE GENERATION
MOVEI T2,.FCGEN
CALL SCNBF ;FIND GEN
JRST [SETZ T2, ;NONE, LOSE THE DOT
DPB T2,T1
JRST T%FILQ] ;NONE
EXCH T1,T2
HRROS T1
MOVEM T1,INTTMP ;SAVE PTR TO GEN STRING
CALL CSTR
MOVE T1,INTTMP ;GET PTR TO GEN STRING
MOVEI T3,^D10
NIN% ;CONVERT GEN TO NUMBER
ERJMPS .+1
MOVE T1,CURHEA
HRLM T2,NHEAD+FDBOFF+.FBGEN(T1)
JRST T%FILQ
;ROUTINE TO SCAN NAME BLOCK LOOKING FOR SPECIFIED SUB-BLOCK
;T2/ DESIRED BLOCK TYPE
;T4/ PTR TO BLOCK
;RETURN +2,
;T2/ PTR TO DATA
SCNBF: PUSH P,T4
MOVN T3,(T4) ;GET LENGTH OF BLOCK
HRL T4,T3 ;SET LIMIT
AOBJN T4,.+1 ;STEP PAST HEADER
SCNBF1: HLRZ T3,(T4) ;GET SUB-BLOCK TYPE
CAIN T3,(T2) ;REQUESTED ONE?
JRST [MOVEI T2,1(T4);YES, RETURN PTR TO DATA
POP P,T4
JRST CPOPJ1]
HRRZ T3,(T4) ;BUMP SUB-BLOCK
HRL T3,T3
ADD T4,T3
SKIPE (T4) ;END OF DATA?
JUMPL T4,SCNBF1 ;JUMP UNLESS END OF BLOCK
POP P,T4
RET ;TYPE NOT FOUND
;ATTRIBUTE BLOCK
INTFIL: MOVEI T3,1(T4) ;POINT TO DATA PORTION
MOVE T1,A$WRIT(T3) ;COPY ITEMS - WRITE DATE
MOVEM T1,NHEAD+FDBOFF+.FBWRT(T2)
MOVE T1,A$BSIZ(T3)
DPB T1,[POINT 6,NHEAD+FDBOFF+.FBBYV(T2),11]
SKIPN T2,T1
MOVEI T2,^D36
MOVEI T1,^D36
IDIV T1,T2
PUSH P,T1 ;SAVE RESULT
MOVE T2,CURHEA
MOVE T1,A$LENG(T3)
MOVEM T1,NHEAD+FDBOFF+.FBSIZ(T2)
POP P,T2
ADDI T1,-1(T2) ;ROUND UP
IDIV T1,T2 ;WORDS IN FILE
ADDI T1,777 ;ROUND UP
IDIVI T1,1000 ;FULL PAGES IN FILE
MOVE T2,CURHEA
HRRM T1,NHEAD+FDBOFF+.FBBYV(T2)
MOVSI T1,NHEAD+FDBOFF(T2)
HRRI T1,ICFDB
BLT T1,ICFDB+.FBLN0-1;SAVE FDB FOR EOF
JRST T%FILQ
INCREC: SETZM .SEQ(T2)
MOVEM T1,.TYP(T2) ;PUT IN TYPE
MOVX T1,FL.HIS+FL.NCK ;FLAGS - SAY NO CHECKSUM
MOVEM T1,.FLAG(T2) ;..
MOVE T1,TAPENO ;GET CURRENT TAPE NUMBER
MOVEM T1,.TAPNO(T2) ;PUT IT IN (NO FLAGS, 0 SAVESET, ETC.)
RET
SUBTTL Interchange code (To BACKUP)
;Come here with BLKPNT pointing at enough space for an Interchange record
; and ADDTMP pointing at a record header and 1000word data buffer.
DMPICO: DMOVEM Q1,ICOTMP ;SAVE Q1 AND Q2
MOVE Q1,BLKPNT
MOVEI T1,1(Q1) ;CLEAR DEST BUFFER
HRL T1,Q1
SETZM -1(T1)
BLT T1,NIHEAD+1000-1(Q1)
MOVE Q2,ADDTMP ;POINTER TO INPUT BUFFER
HRRZ T1,.TAPNO(Q2)
MOVEM T1,G$RTNM(Q1)
MOVX T1,GF$NCH ; - FLAGS, NO CHECKSUM
MOVEM T1,G$FLAG(Q1)
MOVN T1,.TYP(Q2)
JRST @[EXP ICODAT,ICOTPH,ICOFLH,ICOFLT,ICOTPT
EXP ICOCNX,ICOTPC,ICOCNX,ICOEOV](T1)
; There are: Data, Saveset start, file start, file end, tape end,
; user data, cont. saveset, filler, to next tape
;STANDARD RETURNS
ICOCNY: AOS T1,WRISEQ ;COMPUTE NEXT SEQ NUMBER
MOVEM T1,G$SEQ(Q1) ;LEAVE IT IN BUFFER
ICOCNX: DMOVE Q1,ICOTMP ;RESTORE Q1,Q2
RET
;END OF VOLUME (TO NEXT TAPE)
ICOEOV: MOVX T1,T$EOV
JRST ICOTP1
;TAPE TRAILER
ICOTPT: MOVX T1,T$END ;SAVESET END
JRST ICOTP1 ;SAME AS HEADER
;CONTINUED TAPE HEADER
ICOTPC: MOVX T1,T$CON
JRST ICOTP1
;TAPE HEADER
ICOTPH: MOVX T1,T$BEG ;SAVESET BEGIN
ICOTP1: MOVEM T1,G$TYPE(Q1)
MOVE Q2,ADDTMP+1 ;ADDRESS OF DATA
MOVE T1,SV.TAD(Q2)
MOVEM T1,S$DATE(Q1)
MOVX T1,BKFMT ;BACKUP FORMAT VERSION
MOVEM T1,S$FMT(Q1)
;S$BVER, S$MON, S$SVER, S$DEV, S$MTCH NOT PROVIDED
SKIPN T1,APRID
JRST [MOVEI T1,.APRID
GETAB%
ERJMPS NOAPRI
MOVEM T1,APRID
JRST .+1]
MOVEM T1,S$APR(Q1)
NOAPRI: HRROI T2,NIHEAD+1(Q1) ;DEST FOR SAVESET NAME
HRROI T1,SV.MSG(Q2)
CALL CSTR
SUBI T2,NIHEAD-1(Q1) ;COMPUTE NUMBER WORDS USED
HRLI T2,O$SSNM
MOVEM T2,NIHEAD(Q1) ;SETUP ONE-WORD HEADER
HRRZM T2,G$LND(Q1) ;NOTE SIZE OF NON-DATA AREA
JRST ICOCNY ;RETURN VALID BUFFER
;DATA RECORD
ICODAT: MOVX T1,T$FIL ;TYPE CODE
MOVEM T1,G$TYPE(Q1)
MOVEI T1,1000 ;ASSUME FULL PAGE OF DATA HERE UNLESS...
CAMLE T1,ICOLEN ;NOT THAT MUCH LEFT IN FILE
MOVE T1,ICOLEN ;USE WHATEVER IS LEFT
MOVEM T1,G$SIZ(Q1) ;SET DATA WORD COUNT THIS RECORD
MOVNS T1
ADDM T1,ICOLEN ;UPDATE REMAINING COUNT
MOVE Q2,ADDTMP
HRRZ T1,.PAGNO(Q2) ;GET THE PAGE NUMBER
LSH T1,9 ;MAKE A WORD
MOVEM T1,F$RDW(Q1)
HRLZ T1,ADDTMP+1
HRRI T1,NIHEAD(Q1)
BLT T1,NIHEAD+1000-1(Q1)
JRST ICOCNY ;RETURN BUFFER
ICOFLT: MOVX T1,T$FIL
MOVEM T1,G$TYPE(Q1)
MOVX T1,GF$EOF
IORM T1,G$FLAG(Q1) ;YES, NOTE THIS IS THE LAST RECORD OF FILE
JRST ICOCNY
;FILE HEADER
ICOFLH: MOVX T1,T$FIL ;RECORD TYPE
MOVEM T1,G$TYPE(Q1)
MOVEI T1,F$NND ;NOTE SIZE OF NON-DATA AREA THIS RECORD
MOVEM T1,G$LND(Q1)
MOVX T1,GF$SOF ;FLAGS - START OF FILE
IORM T1,G$FLAG(Q1)
MOVEI T4,NIHEAD+1(Q1) ;BEG OF AREA FOR FILENAME
MOVE T1,[O$NAME,,F$NND/2]
MOVEM T1,-1(T4)
MOVE Q2,ADDTMP+1 ;POINTER TO DATA SECTION
MOVE T1,Q2
HRLI T1,(POINT 7)
ILDB T2,T1
CAIE T2,"<"
JRST .-2
MOVX T2,.FCDIR ;INDICATE DIR BLOCK
HRLM T2,(T4)
MOVEI T2,">"
CALL ICOFHC ;COPY DIRECTORY STRING
MOVX T2,.FCNAM ;INDICATE NAME BLOCK
HRLM T2,(T4)
MOVEI T2,"."
CALL ICOFHC ;COPY NAME STRING
MOVX T2,.FCEXT
HRLM T2,(T4) ;INDICATE EXT BLOCK
MOVEI T2,"."
CALL ICOFHC ;COPY EXT STRING
MOVX T2,.FCGEN ;INDICATE GENERATION BLOCK
HRLM T2,(T4)
SETZ T2,
CALL ICOFHC ;COPY GENERATION STRING
MOVEI T4,NIHEAD+F$NND/2+1(Q1) ;BEG OF AREA FOR ATTRIBUTES
MOVE T1,[O$FILE,,F$NND/2]
MOVEM T1,-1(T4)
MOVE T1,FDBOFF+.FBWRT(Q2)
MOVEM T1,A$WRIT(T4) ;COPY WRITE DATE
MOVEI T1,LN$AFH ;THIS THE LENGHT?
MOVEM T1,A$FHLN(T4) ;SET LENGTH
LOAD T2,FB%BSZ,FDBOFF+.FBBYV(Q2) ;GET FILE BYTE SIZE
JUMPE T2,[ ;IF BYTE SIZE IS ZERO, USE 36
LOAD T1,FB%PGC,FDBOFF+.FBBYV(Q2) ;GET PAGE COUNT
LSH T1,9 ;GET ACTUAL SIZE IN WORDS
MOVEM T1,FDBOFF+.FBSIZ(Q2) ;AND USE AS FILE BYTE COUNT
MOVEI T2,^D36 ;GET BYTE SIZE
JRST .+1]
MOVEM T2,A$BSIZ(T4)
MOVEI T1,^D36
IDIV T1,T2 ;COMPUTE ACTUAL BYTES/WD
MOVE T2,FDBOFF+.FBSIZ(Q2) ;GET FILE BYTE COUNT
MOVEM T2,A$LENG(T4) ;SET BYTE COUNT
IDIV T2,T1 ;CONVERT BYTE COUNT TO 36-BIT BYTES
CAIE T3,0 ;REMAINDER?
ADDI T2,1 ;YES, ACCOUNT FOR PARTIAL WORD
MOVEM T2,ICOLEN ;KEEP LOCAL COUNT
MOVEM T2,A$ALLS(T4) ;USE IT AS ALLOCATION ALSO
MOVX T1,.DMIMG ;USE STANDARD MODE
MOVEM T1,A$MODE(T4)
JRST ICOCNY
;LOCAL ROUTINE TO COPY FILESPEC STRING
; T1/ SOURCE STRING POINTER
; T2/ TERMINATING CHAR
; T4/ DEST ADDRESS
; returns T4 set up for next time
ICOFHC: PUSH P,T4 ;SAVE BLOCK ADDRESS
ADD T4,[POINT 7,1] ;CREATE DEST STRING POINTER
ICOFH2: ILDB T3,T1
CAIN T3,"V"-100
JRST [IDPB T3,T4
ILDB T3,T1
IDPB T3,T4
JRST ICOFH2]
CAIN T2,(T3)
JRST ICOFH3
IDPB T3,T4
JRST ICOFH2
ICOFH3: SETZ T3,
IDPB T3,T4
MOVEI T3,(T4) ;WHICH WORD DID STRING END IN?
POP P,T2 ;GET ADDRESS OF BLOCK BEGINNING
SUBI T3,-1(T2) ;GET BLOCK LENGTH
HRRM T3,(T2) ;AND STORE
MOVEI T4,1(T4) ;SET UP FOR NEXT TIME
RET
SUBTTL Random data
;Useful asciz constants and other such things
CRLF2: ASCIZ/
/ ;ACTUALLY CR-LF-LF
CRLF: ASCIZ/
/
CBCR: ASCIZ/]
/
SPCBCR: ASCIZ/ ]
/
;Masks and such for CHECK, RESTORE, RETRIEVE
MASK: 0
FB%PRM+FB%NOD+FB%FCF ; CTL (FB%INV IS SPECIAL-CASED)
0 ; EXL
0 ; ADR
0 ; PRT
-1 ; CRE
0 ; OLD AUTHOR WRITER WORD
0 ; GEN
0 ; ACT
777717,,0 ; BYV
-1 ; SIZ
-1 ; CRV
-1 ; WRT
-1 ; REF
-1 ; CNT
-1 ; BK0
0 ; BK1
0 ; BK2
AR%1ST+AR%WRN ; BBT
0 ; NET
-1 ; USW
0 ; GNL
0 ; NAM
0 ; EXT
0 ;.FBLWR POINTER
0 ; TDT
0 ; FET
0 ; TP1
0 ; SS1
0 ; TP2
0 ; SS2
IFN .-MASK-.FBLEN,<PRINTX ** FDB MASK ARRAY SIZE WRONG **>
;**;[550] Change one line at NWMASK: + 1L DEE 5-APR-88
NWMASK: 0
FB%TMP+FB%PRM+FB%NOD+FB%FCF+FB%NDL ;[550] (FB%INV IS SPECIAL-CASED)
0
0
0
0
0
0
0
777717,,0
-1
-1
-1
-1
0
0
0
0
0
0
-1
0
0
0
0 ;.FBLWR POINTER WORD
0 ; TDT
0 ; FET
0 ; TP1
0 ; SS1
0 ; TP2
0 ; SS2
IFN .-NWMASK-.FBLEN,<PRINTX ** FDB NWMASK ARRAY SIZE WRONG **>
;FDB MASK FOR INTERCHANGE MODE RESTORE
ICMASK: 0 ;FBHDR
0 ;FBCTL
0 ;FBEXL
0 ;FBADR
0 ;FBPRT
0 ;FBCRE
0 ;FBAUT
0 ;FBGEN/FBDRN
0 ;FBACT
007700,,0 ;FBBYV
-1 ;FBSIZ
0 ;FBCRV
-1 ;FBWRT
0 ;FBREF
0 ;FBCNT
REPEAT 3,<0> ;FBBK0-FBBK2
0 ; BBT
0 ; NET
0 ;FBUSW
0 ;FBGNL
0 ;FBNAM
0 ;FBEXT
0 ;FBLWR
0 ; TDT
0 ; FET
0 ; TP1
0 ; SS1
0 ; TP2
0 ; SS2
IFN .-ICMASK-.FBLEN,<PRINTX ** FDB ICMASK ARRAY SIZE WRONG **>
;FDB MASK FOR CHECK
CKMASK: 0 ;FBHDR
FB%TMP+FB%PRM+FB%NOD+FB%INV+FB%FCF ;FBCTL
0 ;FBEXL
0 ;FBADR
0,,-1 ;FBPRT
-1 ;FBCRE
0 ;FBAUT
0 ;FBGEN/FBDRN
0 ;FBACT
777717,,0 ;FBBYV
-1 ;FBSIZ
-1 ;FBCRV
-1 ;FBWRT
-1 ;FBREF
-1 ;FBCNT
REPEAT 3,<0> ;FBBK0-FBBK2
0 ; BBT
-1 ; NET
-1 ;FBUSW
0 ;FBGNL
0 ;FBNAM
0 ;FBEXT
0 ;FBLWR
0 ; TDT
-1 ; FET
0 ; TP1
0 ; SS1
0 ; TP2
0 ; SS2
IFN .-CKMASK-.FBLEN,<PRINTX ** FDB CKMASK ARRAY SIZE WRONG **>
FDBNAM: SIXBIT /HEADER/
SIXBIT /.FBCTL/
SIXBIT /.FBEXT/
SIXBIT /.FBADR/
SIXBIT /.FBPRT/
SIXBIT /.FBCRE/
SIXBIT /.FBAUT/
SIXBIT /.FBVER/
SIXBIT /.FBACT/
SIXBIT /.FBBYV/
SIXBIT /.FBSIZ/
SIXBIT /.FBCRV/
SIXBIT /.FBWRT/
SIXBIT /.FBREF/
SIXBIT /.FBCNT/
SIXBIT /.FBBK0/
SIXBIT /.FBBK1/
SIXBIT /.FBBK2/
SIXBIT /.FBBBT/
SIXBIT /.FBNET/
SIXBIT /.FBUSW/
SIXBIT /.FBGNL/
SIXBIT /.FBNAM/
SIXBIT /.FBEXT/
SIXBIT /.FBLWR/
SIXBIT /.FBTDT/
SIXBIT /.FBFET/
SIXBIT /.FBTP1/
SIXBIT /.FBSS1/
SIXBIT /.FBTP2/
SIXBIT /.FBSS2/
;Off the listing to punch literals
LITS: XLIST
LIT
LIST
;Done!
VARS: VAR ;SHOULD BE NULL
;***** NO CODE OR DATA AFTER THIS POINT PLEASE! *****
ENDPRG:
IF2,<IFN <VARS-ENDPRG>,<
PRINTX %Variables defined via # should reside in TMPVAR:
> >
PURGE %%C
END <VECLEN,,VECT>
COMMENT `
DUMPER - a bit of philosophy
For those who feel that DUMPER takes too long to run, consider the
following pointers.
1. The first is simple - insofar as it is possible, run DUMPER at
times of low system usage. Not only will DUMPER not compete against users
for the CPU and disk channels, but DUMPER will be able to keep the tape
drive spinning nearer its top speed. Experiment with the SET BLOCKING
command to determine what value gives you the best balance of CPU use,
realtime speed, and tape.
2. Avoid the use of LIST, FILES, DIRECTORIES, and INTERCHANGE commands
whenever possible. These all use extra CPU and do extra I/O to the terminal
or disk, hence slowing DUMPER down.
3. If possible, EXPUNGE directories before saving them.
4. Consider changing the conditional flags in DUMPER to drop
functionality you don't need. If you don't use USAGE records, turn off
FTUSAG, for example. Especially consider turning off FTCHKS.
Giving REEVAL a value above 1 turns on the output optimization code.
This may cause DUMPER to use more CPU when saving, so most sites will want
it off. However, long saves *may* take slightly less wallclock time with it
on. The code endeavours to figure out about how long a DUMPO% takes, and
tries to avoid blocking based on that. The value of REEVAL is the number of
DUMPO%s done before DUMPER reevaluates how many buffers it can create
before a DUMPO% finishes, so if you use it, set REEVAL fairly high (>150).
However, there is little getting past this: DUMPER has to look at
every file in the filespec you give it during a SAVE. This is often every
file on a structure. It is unavoidable that the act of stepping a jfn over
so many files is going to consume the CPU. Attempts have been made to
minimise the impact, but DUMPER will slow your system down. `
COMMENT `
On transporting files between systems
Different versions of DUMPER have written records differently. This
may cause problems for people writing tapes to take between systems. The
simplest way around this is to write tapes in INTERCHANGE mode, which is a
format readable by all DUMPERs, and also TOPS-10's BACKUP program.
This solution is not perfect. Interchange mode does not perfectly
transmit all file attributes, and it is slower that normal DUMPER
operation. Of course, one could always send a copy of the newest DUMPER to
another system, using Interchange mode if need be, and then use that to
transfer files.
`
COMMENT `
Of interest to MAINTAINERS
Caution: error handling in this program is a bit strange.
If an error occurs, DUMPER will generally dispatch off to either
BAKOUT or NOCMD to clean up and prompt again. If a user does a ^E, then
types a command that causes an error, jumping to BAKOUT will almost
certainly destroy whatever the interrupted command was doing. In putting in
a new ERROR or JSERRD or anything similiar, be very careful in deciding
whether to dispatch off to NOCMD or BAKOUT. In general, fast commands that
can't be interrupted (ie, don't light OKIAE), should always go to NOCMD on
an error. File and tape moving commands that cannot be gotten to from the
^E prompt can safely go to BAKOUT, and probably should, as these tend to
map pages in freespace that will need cleaning out.
This is a special case of the general situation, which can be summed
up thusly: "If we get here during an interrupted command we are in a lot of
trouble." The commands that can (or cannot) be done at the ^E caused
prompt, as well as those that can be done at any time, are carefully
assigned. Anything that moves tape or disturbs the memory manager is a BAD
idea at the ^E prompt.
Old DUMPERs used record offset 1 (now .FLAG) for a "page access" word.
In all cases it was set to a canned value on write and ignored on read.
This not being very useful, the word has been usurped for a flag word in
tape version 6. However, the bit values of H.HIST must never be used as
flags, since old DUMPERs always set them.
Record type 7 WHEN WRITTEN ON TAPE is always a Filler record and
implies that the rest of the physical record can be discarded. GETREC does
not pass these records back. If GETREC does return record type 7, it is the
SAVEEN (end of saveset) record. Be careful of the difference. SAVEEN
records are generated by reading into an EOF.
Current record header format:
.CHKSM checksum of entire record. Ignore if FL.NCK is set in .FLAG
.FLAG flags (FL.???). FL.HIS is always set for historical reasons.
.TAPNO <STYP>B2 + <SavesetNumber>B17+<TapeNumber>
.PAGNO <OLDFLG>B1 + <FileNumber>B17 + <PageNumberInFile>
.TYP negated record type
.SEQ sequence number (usually increases by one)
STYP = 0 Normal Save, 1 Collection, 2 Archival, 3 Migration
OLDFLG = 1B0 on an old style tape in a TAPEEN record if it isn't *really*
the end of the file, but in fact means to go to the next tape.
The Saveset number is only filled in in Archival/Collection/Migration
savesets.
If, on reading a tape, a sequence number does not increase, but stays
the same or goes down (on tapes with more than one logical record per
physical record), an error was encountered while writing the tape that
didn't show up while reading it. The second physical record is ignored.
Caution: This code can be built to run on Monitors 4, 5 or 6. It was
written for 6, and hence makes much use of the ERJMPR and ERJMPS
instructions. V5 and previous monitors don't have them, so they are
simulated when necessary. Simulating ERJMPR is easy. ERJMPS is less
trivial, as AC's have to be saved before ERJMP clobbers them. This is done
by the DOJSS macro, which does jsys%/ERJMPS for V6 and saves AC's and uses
ERCAL for V5. Some code doesn't care if the ERJMPS touches T1, and these
have an explicit ERJMPS (opdef'd to an ERJMP for V5) after them. In those
cases where it really does matter that the ERJMPS not disturb the AC's,
DOJSS is used. Use *CARE* in adding ERJMPS to the code!
Labels of the form PATnnx, where nn is a two digit number and x is any
letter, are useful locations for JFCLs, TRNAs, and JRSTs, for patching
functionality or sanity checks in or out. A customer who has a saveset
continuation tape that somehow got written with the wrong tape number might
want to change the instruction at PAT02A to a TRNA, for example.
`
COMMENT `
Tape format
Tapes are a group of Savesets, ended by a end-of-tape record (either
TONEXT, indicating the data continued on another tape, or TAPEEN, meaning
end of all data).
They are written as
saveset sequence
EOF (on some types of tapes)
saveset sequence
EOF (on some types of tapes)
...
TAPEEN or TONEXT
EOF
EOF (logical EOT)
Where a saveset sequence consists of
Saveset header (SAVEST)
File header (FILEST) | for each
File data (DATA) |for each page of data | file in the
File trailer (FILEEN) | saveset.
A TONEXT record can occur at ANY point, indicating the next tape is
needed to read the next record. The next tape will start with a CONTST
record (continued saveset).
And also: old tapes will have a FILEST record after a CONTST record if
mid-file, which should be ignored; and FILEEN tapes with PG.CON set in
.PAGNO are treated as TONEXT records (and are handled that way by GETREC).
Any physical record on tape is made up of 1-15 logical records (always
the same number of records per phys. record for any given tape). SAVEST,
CONTST and TAPEEN records are always the first in their physical records
(previous physical records being padded with FILLER records if needed to
accomplish this).
`