Trailing-Edge
-
PDP-10 Archives
-
BB-4172H-BM
-
4-1-sources/reaper.mac
There are 27 other files named reaper.mac in the archive. Click here to see a list.
; UPD ID= 25, FARK:<5-WORKING-SOURCES.UTILITIES>REAPER.MAC.4, 2-Jun-82 23:14:53 by TILLSON
;Edit 132 - Set prohibit on MAIL.TXT
; UPD ID= 22, FARK:<5-WORKING-SOURCES.UTILITIES>REAPER.MAC.3, 20-May-82 17:10:22 by TILLSON
;Edit 131 - Fix PEON: parsing
; UPD ID= 21, FARK:<5-WORKING-SOURCES.UTILITIES>REAPER.MAC.2, 18-May-82 12:09:26 by TILLSON
;Edit 130 - Fix error handling after RCDIR%
;<5.UTILITIES>REAPER.MAC.2, 28-Oct-81 15:35:28, EDIT BY GRANT
;Change major version to 5
; UPD ID= 219, FARK:<4-WORKING-SOURCES.UTILITIES>REAPER.MAC.3, 25-Sep-80 14:01:08 by SCHMITT
;Edit 104 - Do not print INFO messages through ERROUT
; - Never output to .CTTRM rather .PRIOU
; - Change Version numbers to be decimal
; UPD ID= 198, FARK:<4-WORKING-SOURCES.UTILITIES>REAPER.MAC.2, 9-Sep-80 11:47:28 by SCHMITT
;EDIT 103 - MAKE DOFET GET CORRECT LENGTH OF FDB
;<4.UTILITIES>REAPER.MAC.13, 3-Jan-80 15:28:52, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;<4.UTILITIES>REAPER.MAC.12, 27-Nov-79 06:55:58, EDIT BY R.ACE
;TCO 4.2580 - MAKE STACK LARGER
;<4.UTILITIES>REAPER.MAC.11, 19-Oct-79 16:59:32, EDIT BY DBELL
;TCO 4.2538 - FIX DOTRM9 TO STOP IF EXACTLY AT DIRECTORY QUOTA
;<4.UTILITIES>REAPER.MAC.10, 18-Oct-79 11:32:00, EDIT BY DBELL
;TCO 4.2530 - PREVENT MAIL.TXT.1 FROM BEING MIGRATED
;<4.UTILITIES>REAPER.MAC.9, 13-Sep-79 10:52:26, EDIT BY DBELL
;TCO 4.2464 - DO CONFIRM FUNCTION IN LIST COMMAND
;<HURLEY.CALVIN>REAPER.MAC.11, 21-Mar-79 12:56:39, EDIT BY HURLEY.CALVIN
; Cause an ERSTR whenever ERROUT is called
;<CALVIN>REAPER.MAC.8, 19-Mar-79 11:28:17, EDIT BY CALVIN
; Cause BEGIN command to be ignored if user is NOT WHEEL
;<JC>REAPER.MAC.3, 16-Mar-79 14:22:07, EDIT BY CALVIN
; Don't print "%%No period specified..." if TRIM run or not WHEEL
; Print some info at top of peon's output about "this would have happened"
; Build map of files already done so TRIM won't multiply list files
;<4.UTILITIES>REAPER.MAC.6, 6-Mar-79 14:11:56, EDIT BY BLOUNT
; REMOVE .FBCRE FROM AGE TABLE SO THAT RESTORING THE DISK
; DOESN'T MAKE ALL FILES SEEM TO BE RECENT
;<4.UTILITIES>REAPER.MAC.5, 5-Mar-79 13:22:55, EDIT BY HURLEY.CALVIN
; remove possibility of "online expiration reached" message happening
; (repeat 0'd out the code which prints it - also, put in an age limit
; of 5 years. No files can exist older than that.
;<4.UTILITIES>REAPER.MAC.4, 1-Feb-79 12:47:30, EDIT BY HURLEY.CALVIN
; Add a call to DOERST in DOPERI so reason for the error is printed
;<4.UTILITIES>REAPER.MAC.3, 1-Feb-79 12:20:06, EDIT BY HURLEY.CALVIN
; REPEAT 0 out online expiration code; Make sure no bogus .FBTDT's occur
; by checking FDB length in $GTFDB; Use AND not OR in DOFLS1 to determine
; if file may have file contents deleted (Both tapes must exist)
;<4.UTILITIES>REAPER.MAC.2, 24-Jan-79 14:32:44, EDIT BY KIRSCHEN
; Correct bug in DOPERI routine - RET instead of JRST DOPER3 if no online exp
;<ARC-DEC>REAPER.MAC.7, 27-Nov-78 08:44:49, EDIT BY CALVIN
; Install checking for already existing tape ID's before migrating again
;<ARC-DEC>REAPER.MAC.11, 9-Nov-78 10:25:14, EDIT BY CALVIN
; Install tape counting logic
;<ARC-DEC>REAPER.MAC.7, 3-Nov-78 13:50:45, EDIT BY CALVIN
; Cause DOFET to discard tape info if file expires and is currently online
; Created REAPER from BBN's ARCHIV program.
TITLE Reaper
SUBTTL Policy module for involuntary migration
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1978,1979,1980 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH MONSYM,MACSYM
SALL
.REQUIRE ARMAIL
EXTERN MLINIT,MLTOWN,MLDONE,.MLOFL,.MLNFL
F=0 ; Flags
T1=1
T2=2
T3=3
T4=4
JFNSTK=5
DIRPGS=6 ; Pages collected on a directory
COUNT=10
P=17
PERWRN=^D14 ; Warn users 2 weeks in advance of FDB purge
TAB==11
NPDL==200 ; # OF WORDS IN STACK
NFILMX==^D8000 ; # files we can know about
NTAPES==^D1000*2 ; # tapes we can remember
%FREE==50000 ; Where free space starts
NJFNS==^D20+^D15 ; Space for system & user order list
NDIRS==^D75
FDBLEN==.FBLEN
IOJFNS==CBLK+.CMIOJ ; IO JFNs for COMND
.CACHN==0 ; Chan for ^A
OPDEF CALL [PUSHJ P,]
OPDEF RET [POPJ P,]
DEFINE RETSKP<JRST RSKP>
OPDEF CALLRET [JRST]
;**;[103] Remove .FBHDR from DEFSTR FBLEN line RAS 9-SEP-80
DEFSTR FBLEN,,35,9 ; Actual length of the FDB
DEFINE CTB (DAT,FLGS,TXT)<
XWD [ASCIZ \TXT\],[FLGS+DAT]>
DEFINE ERROR (LBL,MSG)<
JRST [
IFNB <MSG>,<HRROI T1,[ASCIZ /MSG/]>
IFB <MSG>,<SETZ T1,>
CALL ERROUT
SKIPG NREDIR
JRST LBL
HRROI T1,[ASCIZ /?TAKE file aborted
/]
CALL ERROUT
JRST TAKERR]>
DEFINE FATAL(MSG)<
JRST [ PUSH P,T1
HRROI T1,[ASCIZ /?'MSG'
/]
PSOUT
POP P,T1
HALTF
RET]
>
DEFINE NOISE(MSG)<
MOVEI T2,[FLDDB. (.CMNOI,,<POINT 7,[ASCIZ /MSG/]>)]
COMND>
DEFINE DEFSPC (NAM,SIZ)<
NAM=%FREE
%FREE==%FREE+SIZ>
; Flags in F
COMMAF==1B0 ; For formatting output
DIRCH==1B1 ; Directory changed (GNJFN)
TAKEF==1B2 ; Take RESIST (AR%NAR) files
PNDFF==1B4 ; File already has migration pending
LSTTTF==1B5 ; Listing is to TTY
IFNDEF GN%STR,<GN%STR==1B13>
; Version info
VMAJOR==5 ;MAJOR VERSION #
VMINOR==0 ;MINOR VERSION #
;**;[104] Make Version Numbers decimal RAS 25-SEP-80
VEDIT==^D132 ;EDIT #
VWHO==0 ;GROUP WHO LAST EDITED (0=DEC DEVELOPMENT)
VERS==<VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT
REAPER: JRST START
JRST START
EXP VERS
DEFSPC (MSGSPC,2000) ; Message body
DEFSPC (TAPCNT,NTAPES) ; Space for this many tapes
DEFSPC (DONEFL,NFILMX) ; Map of files we've already done
; Command table
CTBL: NCTBL,,NCTBL
CTB .ARCHI,,<BEGIN>
CTB .FLUSH,,<DELETE-CONTENTS>
CTB .EXIT,,<EXIT>
CTB .LIST,,<LIST>
CTB .INVOL,,<MIGRATE>
CTB .ORDER,,<ORDER>
CTB .PERIO,,<PERIOD>
CTB .PURGE,,<PURGE>
CTB .SCAN,,<SCAN>
CTB .SKIP,,<SKIP>
CTB .TAKE,,<TAKE>
CTB .TAPE,,<TAPE>
CTB .TRIM,,<TRIM>
NCTBL==.-CTBL-1
CRLF: ASCIZ /
/
FENCE: IOWD NPDL,PDL
PDL: BLOCK NPDL
JFNSTP: 0 ; Pointer to ORDER list to use
SJFNPT: 0 ; System ORDER list
JFNPTR: 0
%JFNS: BLOCK NJFNS
DIRPTR: 0
DIRS: BLOCK NDIRS
LEVTAB: REPEAT 3,<.+3>
BLOCK 3
CHNTAB: 3,,CNTRLA ; ^A Routine
BLOCK ^D14
3,,ILIPSI ; For TAKE commands
BLOCK ^D36-^D16
CHNMSK: 1B<.CACHN>+1B<.ICILI>
GTOWBK: GJ%OLD+GJ%DEL+GJ%XTN ; File should exist
.NULIO,,.NULIO ; No I/O
0 ; No device
0 ; No dir
0 ; No name
0 ; No type
0 ; No protection
0 ; No account
0 ; No JFN
G1%IIN ; Find even invisible ones
STRTZR:! ; Start of area zipped at start up
LHOSTN: 0 ; Local site #
MSGPTR: 0 ; Pointer into message body
HAVORD: 0 ; Non 0 if we have system order list
HVUSOD: 0 ; Have user order list
WHEEL: 0 ; If wheel=-1
PERIOD: 0 ; Period after which file is considered
TRIM: 0 ; -1 => Trim over allocation directories
TAPE: 0 ; -1 => Check tapes in use
TPPTR: 0 ; Free space ptr for tape references
FLUSH: 0 ; -1 => Flush offline files older than PERIOD
PURGE: 0 ; -1 => purge expired FDB's from disk
INVOL: 0 ; -1 => Req migration of old files (PERIOD old)
SCNOLY: 0 ; -1 => Scan only, don't mark files
CMDTYP: 0
LOCJFN: 0 ; Local JFN routine
ARCJFN: 0 ; JFN for path of files to consider
CURDIR: 0 ; # of directory we are currently working on
LSTJFN: 0 ; Output file
NREDIR: 0 ; # times redirected (pushed)
TOTPGS: 0 ; # of pages collected
NFILES: 0 ; # of files marked
FLPGS: 0 ; # pages flushed
NFLFIL: 0 ; # of files flushed
NTMFIL: 0 ; # of temp files deleted
TMPGS: 0 ; Pages freed from temp files
NPURGE: 0 ; # of FDB's purged
GNJFLG: 0 ; Flag from JFN2ND saying it did the GNJFN
SNDFRK: 0 ; Fork handle for SNDMSG
FILPTR: 0 ; -# files in DONEFL
NLINB==40
LINBUF: BLOCK NLINB ; TEXTI line buffer
CBFSIZ==^D200/5 ; Size of command buffer
CBFR: BLOCK CBFSIZ
ACBSIZ==^D200/5 ; Size of atom bfr
ACBFR: BLOCK ACBSIZ
CBLK: BLOCK .CMGJB+1 ; Command state block
GJBLK: BLOCK .GJBFP+1 ; GTJFN arg blk
FDB: BLOCK FDBLEN ; Place for examining files
TAPBLK: BLOCK .ARPSZ+1 ; Place for ARCF to tape info
DEFDEV: BLOCK 11
DEFDIR: BLOCK 11
DEFNAM: BLOCK 11
DEFEXT: BLOCK 11
DIRWLD: BLOCK 11 ; Wildcard file spec
EOFADR: 0 ; Where to go on EOF PSI
TEMP: BLOCK 25 ; Block for STDIR's etc
DEVSTR: BLOCK 11 ; For GTOWBK default device
DIRSTR: BLOCK 11 ; For GTOWBK default directory
FILPTH: BLOCK ^D39 ; For BEGIN command file path
MAILFL: BLOCK 1 ; Flag for ENDUSR to hand to MLTOWN
MLBLK: BLOCK 3 ; Arg block for MLTOWN
ENDZRO:! ; End of area cleared at start up
START: RESET
SETZ F, ; Clear all flags
SETZM STRTZR ; Clear data area
MOVE T1,[STRTZR,,STRTZR+1]
BLT T1,ENDZRO-1
MOVE P,FENCE
MOVE T1,[SIXBIT/LHOSTN/]
SYSGT ; Get local site #
SKIPE T2 ; Anything there?
MOVEM T1,LHOSTN ; Yes, save it
MOVE JFNSTK,[-NJFNS,,%JFNS]
MOVEM JFNSTK,JFNPTR
CALL RLJFNS ; Release any lingering JFNS
MOVSI T1,-NDIRS
MOVEM T1,DIRPTR
MOVEI T1,.FHSLF
GPJFN
MOVEM T2,IOJFNS
MOVE T2,[LEVTAB,,CHNTAB]
SIR ; Set up interrupt tables
EIR
MOVE T2,CHNMSK ; Channels we'll handle
AIC
MOVE T1,[.TICCA,,.CACHN]
ATI ; Capture ^A
MOVEI T1,.FHSLF
RPCAP
TXNE T3,SC%WHL+SC%OPR
SETOM WHEEL ; User is a wheel
SKIPN WHEEL
SETOM SCNOLY ; Peons are listing only
MOVE T1,[ICBLK,,CBLK]
BLT T1,CBLK+.CMGJB ; Init command blk
SKIPN WHEEL
JRST PEON ; Go do peon code
MOVE T1,[-NTAPES,,TAPCNT]
MOVEM T1,TPPTR ; Init free space ptr
SETZM 0(T1) ; Make sure no 1st tape!
JRST TOPCMD ; Start talking to user
TOPCMD: SETZM CMDTYP ; Clear last one
HRROI T1,[ASCIZ /REAPER>/]
MOVEM T1,CBLK+.CMRTY
MOVEI T1,REPAR0
MOVEM T1,CBLK
MOVEI T1,CBLK
MOVEI T2,[FLDDB. (.CMINI)]
COMND ; Init line
; Here when reparse needed
REPAR1: MOVEI T1,CBLK
MOVEI T2,[FLDDB. (.CMKEY,,CTBL)]
COMND
TXNE T1,CM%NOP
ERROR TOPCMD,<>
HRRZ T2,0(T2) ; Get ptr to command word
MOVE T2,0(T2) ; Flags,,dispatch addr
MOVEM T2,CMDTYP ; Save
CALL 0(T2) ; Do it
MOVE JFNSTK,JFNPTR
CALL RLJFNS
JRST TOPCMD
REPAR0: MOVE P,FENCE
MOVE JFNSTK,JFNPTR
CALL RLJFNS ; Release those not covered
JRST REPAR1
; Initial command state block
ICBLK: REPAR0 ; Reparse dispatch
.PRIIN,,.PRIOU
POINT 7,[ASCIZ /REAPER>/] ; Prompt
POINT 7,CBFR ; Beg of user input
POINT 7,CBFR ; Beg of next field to be parsed
CBFSIZ*5 ; # chars there
0 ; # unparsed chars
POINT 7,ACBFR ; Point to atom buffer
ACBSIZ*5 ; Size (amount left) in atom bfr
GJBLK ; GTJFN arg blk
SETGTD: MOVE T2,[GJBLK,,GJBLK+1]
SETZM -1(T2)
BLT T2,GJBLK+.GJBFP ; Clear it to start
MOVE T2,[.PRIIN,,.PRIOU]
MOVEM T2,GJBLK+.GJSRC
MOVX T2,GJ%XTN
IORM T2,GJBLK+.GJGEN
MOVX T2,G1%IIN
MOVEM T2,GJBLK+.GJF2 ; Into extended blk
JUMPE T1,R ; Done if doesn't want stars
HRROI T2,[ASCIZ /*/]
MOVEM T2,GJBLK+.GJDIR ; For directory name
MOVEM T2,GJBLK+.GJNAM ; For file name
MOVEM T2,GJBLK+.GJEXT ; For extention
MOVX T2,GJ%IFG+.GJALL
IORM T2,GJBLK+.GJGEN
RET
; Here to do GTFDB & also set up TAPBLK with current file
$GTFDB: GTFDB
ERJMP [HRLI T2,.FBLN0 ; Probably a short FDB
GTFDB
JRST .+1]
LOAD T2,FBLEN,(T3) ; Get length of the FDB
CAIGE T2,.FBLXT ; Long enough for tape info?
JRST [ SETZM .FBTDT(T3) ; No, date is not valid then
SETZM TAPBLK+.ARTP1 ; No tape info
SETZM TAPBLK+.ARTP2 ; ...
RET]
HRRZS T1 ; JFN only
MOVX T2,.ARGST ; Get tape info
MOVEI T3,TAPBLK
ARCF
ERJMP .+1
RET
; Here to determine if file has ANY tape info associated with it +1=>no
; +2 => either 1 or 2 tapes there
HAVTAP: SKIPN TAPBLK+.ARTP1 ; Tape 1 ID there?
SKIPE TAPBLK+.ARTP2 ; No, how about tape 2 ID?
RETSKP ; One or the other is there
RET ; Neither are there
; BEGIN (Processing files) {filespec}
.ARCHI: NOISE <Processing files>
SETZ T1, ; Real JFNs
CALL GETFIL ; Get a file spec
JRST [ SKIPE WHEEL ; A WHEEL?
ERROR R,<?Bad filespec in BEGIN command>
MOVE T1,T2 ; Not a WHEEL
CLOSF
JFCL
RET] ; Ignore BEGIN if not WHEEL
CALL CONFRM
ERROR ARCHCX,<> ; Go release JFN
SKIPN WHEEL ; A WHEEL?
JRST [ MOVE T1,T2 ; No, ignore the BEGIN command
CLOSF
JFCL
RET]
ARCHI1: MOVEM T2,ARCJFN ; Path to check
SKIPN PERIOD ; was a period specified?
JRST [ SKIPE WHEEL ; If peon
SKIPE TRIM ; Or a TRIM run
JRST .+1 ; Don't mention no period
HRROI T1,[ASCIZ /%%No period specified, continuing...
/]
PSOUT
JRST .+1]
; Get a directory number so we can step with RCDIR
HRROI T1,DIRWLD ; Area for string with wildcards
MOVX T3,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF>
JFNS ; Get STR:<DIR>
MOVX T1,RC%AWL ; Allow wildcards
HRROI T2,DIRWLD ; Point to directory string
SETZ T3, ; No previous dir #
RCDIR ; Get a dir #
TXNE T1,RC%NOM ; No match???
FATAL <Failed to translate string to directory number>
MOVEM T3,CURDIR ; Save the result
HRROI T1,FILPTH ; Area for complete filespec
MOVE T2,ARCJFN
MOVX T3,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF>
JFNS
; Set up default strings for name and extension
HRROI T1,DEFNAM ; Area for name string
MOVX T3,<FLD(.JSAOF,JS%NAM)>
JFNS ; Get the name specified
HRROI T1,DEFEXT ; Area for extension string
MOVX T3,<FLD(.JSAOF,JS%TYP)>
JFNS ; Get the extension
MOVE T1,T2 ; JFN to T1
RLJFN ; No longer need this
JFCL
SETZM ARCJFN
CALL MLINIT ; Init stuff for sending mail
; Put in the listing file to describe what we were told to do
SKIPN T1,LSTJFN ; Have a listing file?
JRST [ MOVSI T1,(GJ%FOU+GJ%SHT)
HRROI T2,[ASCIZ /REAPER.LIST/]
GTJFN
ERROR R,<Unable to create list file>
MOVX T2,<FLD(7,OF%BSZ)+OF%WR>
OPENF
ERROR R,<Unable to open list file>
MOVEM T1,LSTJFN ; Save it
JRST .+1]
MOVE T1,LSTJFN
DVCHR ; Get characteristics of file
LOAD T2,DV%TYP,T2 ; Pick up device type
CAIN T2,.DVTTY ; Already went to TTY?
TXO F,LSTTTF ; Listing is to TTY
MOVE T1,LSTJFN
HRROI T2,[ASCIZ /
REAPER run started at /]
SETZB T3,T4
SOUT
SETO T2,
ODTIM
HRROI T2,CRLF
SOUT
HRROI T2,CRLF
SOUT
HRROI T2,[ASCIZ / Specified file path: /]
SOUT
HRROI T2,FILPTH
SOUT
SKIPN WHEEL
JRST [ HRROI T2,[ASCIZ /
The following would happen if the OPERATOR ran REAPER now:
/]
SOUT
JRST STAT9]
HRROI T2,CRLF
SETZB T3,T4
SOUT
SKIPN PERIOD ; Any period given to us?
JRST STAT0 ; No
HRROI T2,[ASCIZ / Period is: /]
SOUT
MOVE T2,PERIOD
MOVX T3,<FLD(^D10,NO%RDX)>
NOUT
JFCL
HRROI T2,[ASCIZ / days
/]
SETZB T3,T4
SOUT
;...
;...
STAT0: HRROI T2,[ASCIZ / Scan only
/]
SKIPE SCNOLY
SOUT
HRROI T2,[ASCIZ / Deleting disk contents of old offline files
/]
SKIPE FLUSH
SOUT
HRROI T2,[ASCIZ / Purging expired offline files
/]
SKIPE PURGE
SOUT
SKIPN TRIM ; Triming directories?
JRST STAT1 ; No, skip that
MOVEI COUNT,6 ; # to do before new line
HRROI T2,[ASCIZ / Trimming directories over permanent allocation
Order during TRIM for taking files is: /]
SOUT
SKIPN HAVORD ; Any?
JRST [ HRROI T2,[ASCIZ /None specified
/]
SOUT
JRST STAT1]
MOVE JFNSTK,[-NJFNS,,%JFNS]
CALL PRTORD ; Print it
STAT1: HRROI T2,[ASCIZ / Skipping directories: /]
SETZB T3,T4
SOUT
SKIPN DIRS ; Any spec'd?
JRST [ HRROI T2,[ASCIZ / None specified
/]
SOUT
JRST STAT3]
MOVEI COUNT,4 ; # before wrapping
TXZ F,COMMAF
MOVSI JFNSTK,-NDIRS
STAT4: SKIPN T2,DIRS(JFNSTK)
JRST STAT3 ; Done
PUSH P,T2
HRROI T2,[ASCIZ /, /]
TXOE F,COMMAF
SOUT
POP P,T2
DIRST
JRST [ HRROI T2,[ASCIZ /??????/]
SOUT
JRST .+1]
SOJLE COUNT,[ MOVEI COUNT,4
HRROI T2,[ASCIZ /
/]
SOUT
TXZ F,COMMAF
JRST .+1]
AOBJN JFNSTK,STAT4
STAT3: HRROI T2,CRLF
SOUT
STAT9:
;...
; Listing is started, now start processing
TXZ F,DIRCH ; New directory
DODIR: CALL CHKDIR ; Make sure of good directory
JRST ENDARC ; That's the last of them
SETZ DIRPGS, ; No pages collected yet
SETO T1,
CALL SETGTD ; Set up the block
MOVE T1,[.NULIO,,.NULIO]
MOVEM T1,GJBLK+.GJSRC
HRROI T1,TEMP ; Scratch area
MOVE T2,CURDIR ; Dir we are working on
DIRST ; Get the string
FATAL <Can't translate directory # to string>
MOVE T1,[POINT 7,TEMP]
MOVE T2,[POINT 7,DEFDEV] ; Make structure name
MOVEM T2,GJBLK+.GJDEV
DODIR1: ILDB T3,T1
CAIN T3,":"
SETZ T3,
IDPB T3,T2
JUMPN T3,DODIR1
DODIR2: ILDB T3,T1 ; Flush "<"
MOVE T2,[POINT 7,DEFDIR] ; Make directory name
MOVEM T2,GJBLK+.GJDIR
DODIR3: ILDB T3,T1
CAIN T3,">"
SETZ T3,
IDPB T3,T2
JUMPN T3,DODIR3
CALL GETORD ; Get any USER ORDER
HRROI T1,DEFNAM
MOVEM T1,GJBLK+.GJNAM
HRROI T1,DEFEXT
MOVEM T1,GJBLK+.GJEXT
DOFIL: SETZM FILPTR ; Reset count of entries in DONEFL
CALL DOKEEP ; Touch files WE want around
CALL DOPERI ; Migrate old files
CALL DOFLSH ; Delete contents of old archive files
CALL DOMISC ; Delete old temp files, etc.
CALL DOTRIM ; Trim directory back to quota
CALL DOTAPE ; Check tapes reference by this directory
CALL INCDIR ; Move on
JRST ENDARC ; No more
JRST DODIR ; Loop
INCDIR: MOVX T1,RC%STP+RC%AWL ; Gotta go to next directory
HRROI T2,DIRWLD ; Point to wildcard string
MOVE T3,CURDIR ; Current dir #
RCDIR ; Find next one
TXNE T1,RC%NMD ; No more dirs?
RET
MOVEM T3,CURDIR ; Remember new dir #
TXZ F,DIRCH ; New directory
MOVE JFNSTK,JFNPTR
CALL RLJFNS ; Release any user ORDER JFNs
RETSKP ; Done here
ARCHDF: SETO T1,
CALL SETGTD ; Set defaults to *
MOVEI T1,GJBLK
MOVE T2,[.NULIO,,.NULIO]
MOVEM T2,GJBLK+.GJSRC ; No input
HRROI T2,[ASCIZ /PS:<*>*.*.*/]
GTJFN
ERROR R,<? Bad filespec in BEGIN command>
JRST ARCHI1
ARCHCX: MOVE T1,T2 ; Here when file not confirmed
RLJFN
JFCL
RET
ENDARC: HRROI T1,TEMP
HRROI T2,CRLF
SETZB T3,T4
SOUT
MOVE T2,NFILES
MOVE T3,TOTPGS
HRROI T4,[ASCIZ / files marked for migration, /]
CALL LSTTOT
HRROI T1,TEMP
MOVE T2,NFLFIL
MOVE T3,FLPGS
HRROI T4,[ASCIZ / archive files deleted from disk, /]
CALL LSTTOT
HRROI T1,TEMP
MOVE T2,NTMFIL
MOVE T3,TMPGS
HRROI T4,[ASCIZ / temporary files deleted, /]
CALL LSTTOT
HRROI T1,TEMP
MOVE T2,NPURGE
SETZ T3, ; No pages from offline files
HRROI T4,[ASCIZ / expired files purged, /]
CALL LSTTOT
SKIPE TAPE ; Did we get tapes info?
CALL DMPTAP ; Yes, dump out the info now
MOVE T1,LSTJFN
CLOSF ; Close the listing file
JFCL
SETZM LSTJFN ; No longer valid
CALL MLDONE ; Clean up mail stuff
HALTF
JRST REAPER
; Period checker
DOPERI: SKIPN INVOL ; Switch for this turned on?
RET ; No
MOVX T1,GJ%IFG+GJ%XTN+.GJALL
MOVEM T1,GJBLK+.GJGEN ; Fix up GTJfn bits
MOVEI T1,GJBLK
HRROI T2,CRLF ; As if the user took default
GTJFN
RET ; Done, none here
MOVEM T1,LOCJFN ; Save the JFN
DOPER1: HRRZ T1,LOCJFN
MOVE T2,[FDBLEN,,.FBHDR]
MOVEI T3,FDB
CALL $GTFDB
MOVE T1,FDB+.FBCTL
TXNE T1,FB%ARC!FB%OFF!FB%DIR!FB%NOD!FB%TMP!FB%PRM
JRST DOPER9 ; Go to next file
MOVE T1,FDB+.FBBBT
TXNE T1,AR%RAR!AR%RIV!AR%NAR!AR%EXM ; If requested or resist, skip it
JRST DOPER9
CALL HAVTAP ; See if we have tape ID's already
CAIA ; We do not
JRST DOPER9 ; We do, don't migrate the file again
; Check to see if online expiration has occured
REPEAT 0,<
SKIPN T2,FDB+.FBNET ; Have on online expiration?
JRST DOPER3 ; No, file can't expire then
HLRZS T2 ; Want date portion of online exp
GTAD ; Get now
HLRZS T1
CAIGE T1,(T2) ; File expired?
JRST DOPER3 ; No (& does have exp. date)
JUMPN T2,DOPER5 ; Expired date if non-zero--take 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
GTAD
HLRZS T1
CAIGE T1,(T2) ; Expired?
JRST DOPER3 ; No, check for age
DOPER5: SETO T2, ; Flag file is expired
JRST DOPER2
> ; End REPEAT 0
; Now check for too old a file
DOPER3: SKIPG PERIOD ; Have a real period?
JRST DOPER9 ; No, skip this then
CALL GTAGE ; Get age of file
CAMGE T2,PERIOD ; Old enough?
JRST DOPER9 ; No, skip it
DOPER2: CALL CKDNFL ; Has this one been done before?
JRST DOPER9 ; Yes, skip it this time
PUSH P,T2 ; Save age
HRRZ T1,LOCJFN
MOVEI T2,.ARRIV ; Request file be migrated
MOVEI T3,.ARSET
SKIPN SCNOLY ; Only a scan?
ARCF ; No, real thing
ERJMP [HRROI T1,[ASCIZ /%ARCF failed in DOPERI
/]
PSOUT
CALL DOERST ; Include why in the printout
HRRZ T1,LOCJFN
HRROI T2,[ASCIZ / ARCF failed/]
CALL LSTFIL
POP P,T2 ; Age
JRST DOPER9]
HRRZ T1,FDB+.FBBYV
ADD DIRPGS,T1 ; Accum what we've taken
ADDM T1,TOTPGS ; Into running total
AOS NFILES ; Count files
HRROI T1,TEMP
POP P,T2 ; Restore age
repeat 0,<JUMPL T2,[HRROI T2,[ASCIZ /Online expiration reached/]
SETZB T3,T4
SOUT
JRST DOPER4]
>; end repeat 0
MOVX T3,<FLD(^D10,NO%RDX)>
NOUT
JFCL
HRROI T2,[ASCIZ / days old/]
SETZB T3,T4
SOUT
DOPER4: HRRZ T1,LOCJFN ; File taken
HRROI T2,TEMP
CALL LSTFIL ; Into listing
DOPER9: MOVE T1,LOCJFN
GNJFN
JRST [ SETZM LOCJFN
RET]
JRST DOPER1
; Flush contents of OLD online files with tape backup
DOFLSH: SKIPE PERIOD
SKIPN FLUSH
RET ; Either no period or Flush not wanted
MOVX T1,GJ%IFG+GJ%XTN+.GJALL
MOVEM T1,GJBLK+.GJGEN
MOVEI T1,GJBLK
HRROI T2,CRLF ; Take default
GTJFN
RET ; No files to do
MOVEM T1,LOCJFN ; Save the JFN
HRROI T1,[ASCIZ /Old file contents deleted from disk/]
MOVX T2,.MLOFL ; Use the offline msg file
CALL BEGUSR ; Start user message
DOFLS1: HRRZ T1,LOCJFN ; Current file
MOVE T2,[FDBLEN,,.FBHDR]
MOVEI T3,FDB
CALL $GTFDB
MOVE T1,FDB+.FBCTL
TXNE T1,FB%OFF ; Already off-line?
JRST DOFLS9 ; Yes, skip it
SKIPE TAPBLK+.ARTP1 ; First tape exist?
SKIPN TAPBLK+.ARTP2 ; AND 2nd? (HAVTAP is OR not AND)
JRST DOFLS9 ; Both tapes don't exist yet
CALL GTAGE ; Get its age
CAMGE T2,PERIOD ; Old enough?
JRST DOFLS9 ; No, skip the file
PUSH P,T2 ; Save the age
MOVX T1,DF%CNO+DF%NRJ ; Disk contents only
HRR T1,LOCJFN
SKIPN SCNOLY ; Only a scan?
DELF ; No, real thing
JRST [ SKIPE SCNOLY ; Real failure?
JRST .+1 ; No
HRROI T1,[ASCIZ /%DELF failed in DOFLSH - /]
PSOUT
CALL DOERST ; Include ERSTR's comments
HRRZ T1,LOCJFN
HRROI T2,[ASCIZ / DELF failed/]
CALL LSTFIL
POP P,T2
JRST DOFLS9]
HRROI T1,[ASCIZ / - Disk contents deleted/]
CALL TOUSR ; Include in the message
AOS NFLFIL
HRRZ T1,FDB+.FBBYV ; Get # of pages
ADD DIRPGS,T1
ADDM T1,FLPGS ; To total
HRROI T1,TEMP
HRROI T2,[ASCIZ / Disk contents deleted, /]
SETZB T3,T4
SOUT
POP P,T2 ; Age
MOVX T3,<FLD(^D10,NO%RDX)>
NOUT
JFCL
HRROI T2,[ASCIZ / days old/]
SETZ T3,
SOUT
HRRZ T1,LOCJFN
HRROI T2,TEMP
CALL LSTFIL
DOFLS9: MOVE T1,LOCJFN
GNJFN
JRST [ SETZM LOCJFN ; Done JFN is garbage
CALL ENDUSR ; End the message
RET]
JRST DOFLS1
; Here to touch various files that shouldn't get migrated...
DOKEEP: MOVX T1,GJ%OLD+GJ%XTN ; All files must exist
MOVEM T1,GJBLK+.GJGEN
MOVX T1,G1%IIN
MOVEM T1,GJBLK+.GJF2
HRROI T2,[ASCIZ /DIRECTORY.OWNER/]
CALL DOKEP1
HRROI T2,[ASCIZ /MAIL.TXT.1/]
CALL DOKEP1
HRROI T2,[ASCIZ /OFFLINE-FILE-MSGS.TXT/]
CALL DOKEP1
RET
DOKEP1: MOVE T1,[.NULIO,,.NULIO]
MOVEM T1,GJBLK+.GJSRC
MOVEI T1,GJBLK
GTJFN
RET ; File doesn't exist
PUSH P,T1 ; Save the JFN
;**;[132] Replace 8 lines with 6 lines at DOKEP1:+7L 2-JUN-82 RMT
MOVX T2,.AREXM ; [132] Set prohibit migration
MOVX T3,.ARSET ; [132]
ARCF ; [132]
ERJMP [ERROR R,<>] ; [132] Print any error messages
POP P,T1 ; [132] Recover the JFN
RLJFN ; [132] And get rid of it for good
JFCL
RET
; Trim directory back to size
DOTRIM: SKIPN TRIM
RET ; We weren't told to do this
MOVX T1,GJ%IFG+GJ%XTN+.GJALL
MOVEM T1,GJBLK+.GJGEN
MOVE T1,CURDIR ; Get current directory #
GTDAL
SUB T2,T3 ; Pages they are over
SUB T2,DIRPGS ; And those already stolen
JUMPLE T2,R ; Done if under allocation
TXON F,DIRCH ; Need to print directory name?
CALL LSTDIR ; Yes, do that
MOVE DIRPGS,T2 ; Those required from user
MOVE T1,LSTJFN
HRROI T2,[ASCIZ / Collecting /]
SETZB T3,T4
SOUT
MOVE T2,DIRPGS
MOVX T3,<FLD(^D10,NO%RDX)>
NOUT
JFCL
HRROI T2,[ASCIZ / pages
/]
SETZB T3,T4
SOUT
MOVE JFNSTK,JFNSTP ; Get pointer to ORDER list
DOTRI1: SKIPN T2,0(JFNSTK) ; Anything?
JRST DOTRI2 ; No, go to next phase
TXZ F,TAKEF ; Leave RESIST's (AR%NAR) if possible
CALL DOTRM ; Do the work
JRST DOTRIX ; Done
AOBJN JFNSTK,DOTRI1
DOTRI2: TXZ F,TAKEF ; Leave if we can
HRROI T2,[ASCIZ /*.*.*/]
CALL DOTRMS
JRST DOTRIX ; Done, enough collected
MOVE JFNSTK,JFNSTP ; Current ORDER list
DOTRI3: SKIPN T2,0(JFNSTK) ; Any there?
JRST DOTRI4 ; No, done
TXO F,TAKEF ; Take RESIST's if necessary
CALL DOTRM
JRST DOTRIX ; Done, enough pages collected
AOBJN JFNSTK,DOTRI3
DOTRI4: HRROI T2,[ASCIZ /*.*.*/]
TXO F,TAKEF ; Take what we have to
CALL DOTRMS
JRST DOTRIX ; Got all we needed
DOTRIX: JUMPLE DIRPGS,R ; Leave
TXON F,DIRCH ; Make sure we said what directory
CALL LSTDIR ; We didn't yet, do it now
MOVE T1,LSTJFN
HRROI T2,[ASCIZ / Still over allocation by /]
SETZB T3,T4
SOUT
MOVE T2,DIRPGS
MOVX T3,<FLD(^D10,NO%RDX)>
NOUT
JFCL
HRROI T2,[ASCIZ / pages
/]
SETZB T3,T4
SOUT
RET
; Do actual work; Expects T2 to have JFN of files to consider (ORDER)
DOTRM: HRROI T1,TEMP
MOVX T3,<FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+JS%PAF>
JFNS ; Default name string
HRROI T2,TEMP ; Point to default string
; Enter here with a string pointer in AC2 (also fallen into from DOTRM)
DOTRMS: MOVEI T1,GJBLK ; Enter here with string
GTJFN
RETSKP ; Done, none of correct flavor
MOVEM T1,LOCJFN ; Save the local JFN
DOTRM1: HRRZ T1,LOCJFN
MOVE T2,[FDBLEN,,.FBHDR]
MOVEI T3,FDB
TXZ F,PNDFF ; No archive pending on this file
CALL $GTFDB
CALL CKDNFL ; Check if file already done
JRST DOTRM9 ; Yes, don't do it again
MOVE T2,FDB+.FBCTL
MOVE T3,FDB+.FBBBT
TXNE T3,AR%RAR!AR%RIV ; Archive already pending?
JRST [ TXNE T3,AR%NDL ; Will we get any pages of it?
JRST DOTRM9 ; No, skip the file
TXO F,PNDFF ; Yes, flag archive already pending
JRST DOTRM8] ; And enter further down the line
TXNN T3,AR%EXM ; Not allowed to migrate it?
TXNE T2,FB%ARC!FB%OFF!FB%DIR!FB%TMP!FB%NOD!FB%PRM
JRST DOTRM9 ; Skip it
CALL HAVTAP ; Already have tape backup?
CAIA ; No, can take it
JRST DOTRM9 ; Yes, skip the file
TXNE F,TAKEF ; Take resists?
JRST DOTRM2 ; Yes
TXNE T3,AR%NAR ; No, Resist on?
JRST DOTRM9 ; Yes, pass it up
DOTRM2: HRRZ T1,LOCJFN
MOVX T2,.ARRIV ; Migrate it
MOVEI T3,.ARSET
SKIPN SCNOLY ; Only a scan?
ARCF ; No, real
ERJMP [HRROI T1,[ASCIZ /%ARCF failed in DOTRMS - /]
PSOUT
CALL DOERST ; Do ERSTR too
HRRZ T1,LOCJFN
HRROI T2,[ASCIZ / ARCF failed/]
CALL LSTFIL
JRST DOTRM9]
DOTRM8: HRRZ T2,FDB+.FBBYV ; Get # of pages we got back
SUB DIRPGS,T2
TXNN F,PNDFF ; Actually mark it?
ADDM T2,TOTPGS ; Yes, add to total pages
AOS NFILES ; And count the files
PUSH P,T2 ; Save # of pages
HRROI T1,TEMP
POP P,T2
MOVX T3,<FLD(^D10,NO%RDX)>
NOUT
JFCL
HRROI T2,[ASCIZ / pages claimed/]
TXNE F,PNDFF ; Was archive already pending?
HRROI T2,[ASCIZ / migration already pending/]
SETZB T3,T4
SOUT
HRRZ T1,LOCJFN
HRROI T2,TEMP
CALL LSTFIL ; Into listing
DOTRM9: JUMPLE DIRPGS,DOTRMD ; Done, end up things
MOVE T1,LOCJFN
GNJFN
RETSKP
JRST DOTRM1 ; Around for more
RET
DOTRMD: HRRZ T1,LOCJFN
RLJFN
JFCL
SETZM LOCJFN
RET ; Signal directory done
; Do miscellaneous operations -- delete old temp files,
; expunge FDBs which are past offline expiration.
DOMISC: MOVX T1,GJ%IFG+GJ%XTN+.GJALL
MOVEM T1,GJBLK+.GJGEN
MOVEI T1,GJBLK ; Get defaults
HRROI T2,CRLF ; Use them
GTJFN
RET ; Nothing to do
MOVEM T1,LOCJFN ; Save local JFN
HRROI T1,[ASCIZ /Offline expired files/]
MOVX T2,.MLNFL ; Don't send to offline msg file
CALL BEGUSR ; Start a message
DOMSC1: HRRZ T1,LOCJFN
MOVE T2,[FDBLEN,,.FBHDR]; Whole FDB
MOVEI T3,FDB
CALL $GTFDB
MOVE T1,FDB+.FBCTL ; Get ctl bits
TXNE T1,FB%TMP ; Temp file?
JRST DOTMP ; Delete it if too old
JRST DOFET ; Yes, check offline expiration
DOMSC9: MOVE T1,GNJFLG ; We have to do the GNJFN?
SETZM GNJFLG ; Clear for next time around
JUMPG T1,DOMSC1 ; No, was done for us & found a next file
MOVE T1,LOCJFN ; Either we should, or was done & failed
GNJFN ; Move to next file
CAIA
JRST DOMSC1 ; Go do next one
SETZM LOCJFN ; No longer valid
CALL ENDUSR ; Send off the message if necessary
RET
; Check offline file to see if it has reached offline expiration.
; If so, expunge it.
DOFET: SKIPN PURGE ; Purge expired FDBs?
JRST DOMSC9 ; No, done here
;**;[103] Replace one line at DOFET + 2L RAS 9-SEP-80
LOAD T1,FBLEN,FDB+.FBHDR ; Get the FDB length
CAIGE T1,.FBLXT ; Long enough?
JRST DOMSC9 ; No, skip this file
SKIPN FDB+.FBTP1 ; Have any tape info?
SKIPE FDB+.FBTP2
CAIA ; Has at least 1 tape's worth
JRST DOMSC9 ; Has none, skip this file
MOVE T1,FDB+.FBFET ; Get TAD/interval
TLNN T1,-1 ; Which is it?
JRST [ HRLZS T1 ; Make # days,,0
ADD T1,FDB+.FBTDT ; Date when will be expired
JRST .+1]
MOVE T2,T1 ; Expiration TAD in T2
GTAD ; Get now
CAMGE T1,T2 ; Past expiration?
JRST DOFET2 ; No, skip it
DOFET1: MOVE T1,FDB+.FBBBT
TXNN T1,AR%WRN ; User been warned about this?
JRST DOFET3 ; No, do so now
CALL JFN2ND ; Get a 2nd JFN on the file
PUSH P,LOCJFN ; Save indexable one
MOVEM T1,LOCJFN ; Replace with new one
PUSH P,T2 ; Spare JFN
HRRZ T1,LOCJFN ; Get JFN
MOVE T2,FDB+.FBCTL
TXNN T2,FB%OFF ; File currently offline?
JRST DOFETD ; Discard tape backup info since online
TXO T1,DF%EXP+DF%ARC
POP P,LOCJFN ; JFN in T1 should be no good after DELF
SKIPN SCNOLY ; Scan only?
DELF ; No, real thing
JRST [ RLJFN ; Ditch JFN
JFCL
SKIPE SCNOLY ; Get here from list only switch?
JRST .+1 ; Yes, wasn't really an error
HRROI T1,[ASCIZ /%DELF failed in DOFET - /]
PSOUT
CALL DOERST
HRRZ T1,LOCJFN
HRROI T2,[ASCIZ / DELF failed/]
CALL LSTFIL
HRRZ T1,LOCJFN
RLJFN
JFCL
POP P,LOCJFN
JRST DOMSC9]
AOS NPURGE ; Count # of files we do this to
HRRZ T1,LOCJFN
HRROI T2,[ASCIZ / Expunged, offline expiration reached/]
CALL LSTFIL
HRROI T1,[ASCIZ / - File deleted and expunged (expired)/]
CALL TOUSR
DOFET9: HRRZ T1,LOCJFN
RLJFN
JFCL
POP P,LOCJFN
JRST DOMSC9
DOFET2: MOVE T3,FDB+.FBBBT
TXNE T3,AR%WRN ; Been warned?
JRST DOMSC9 ; Yes, don't do it again
ADD T1,[PERWRN,,0] ; Make it look later than it is
CAMGE T1,T2 ; Now is it expired?
JRST DOMSC9 ; No, on the next file
DOFET3: HRRZ T1,LOCJFN
HRLI T1,.FBBBT ; Set the warning flag
MOVX T2,AR%WRN
MOVE T3,T2
SKIPN SCNOLY ; Don't if only a listing
CHFDB
HRROI T1,[ASCIZ / - Offline expiration approaching/]
CALL TOUSR ; Put this in the msg
JRST DOMSC9 ; And go on
DOFETD: MOVX T2,.ARDIS ; Discard tape info
MOVX T3,AR%CR1+AR%CR2 ; Clear both sets of tape info
SKIPN SCNOLY ; Don't if only a listing
ARCF
ERJMP [ HRROI T1,[ASCIZ /%ARCF failed in DOFETD - /]
PSOUT
CALL DOERST
JRST .+1]
HRRZ T1,LOCJFN
HRROI T2,[ASCIZ / Tape backup information discarded/]
CALL LSTFIL
HRROI T1,[ASCIZ / - Tape backup information discarded (expired)/]
CALL TOUSR
HRRZ T1,LOCJFN
RLJFN ; 2nd JFN no longer needed
JFCL
POP P,LOCJFN ; 3rd JFN was never needed here
JRST DOFET9 ; Clean up there
; Delete temporary files PERIOD days old.
DOTMP: SKIPN PERIOD ; Period specified?
JRST DOMSC9 ; No, nothing to do
CALL GTAGE
CAMGE T2,PERIOD ; File old enough?
JRST DOMSC9 ; No, skip it
CALL JFN2ND ; Get 2nd JFN on the file
PUSH P,LOCJFN
MOVEM T1,LOCJFN
PUSH P,T2 ; Save spare JFN
HRRZ T1,LOCJFN
TXO T1,DF%EXP
POP P,LOCJFN ; T1 JFN bogus after DELF
SKIPN SCNOLY ; Scanning?
DELF ; No, do it for real
JRST [ RLJFN ; DELF lost for some reason
JFCL
SKIPE SCNOLY ; Get here from listing only run?
JRST .+1 ; Yes, continue normally
HRROI T1,[ASCIZ /%DELF failed in DOTMP - /]
PSOUT
CALL DOERST
HRRZ T1,LOCJFN
HRROI T2,[ASCIZ / DELF failed/]
CALL LSTFIL
HRRZ T1,LOCJFN
RLJFN
JFCL
POP P,LOCJFN
JRST DOMSC9]
HRRZ T1,FDB+.FBBYV ; Get pages claimed
ADD DIRPGS,T1 ; Accumulate dir total
ADDM T1,TOTPGS ; Account total pages in this directory
ADDM T1,TMPGS ; Accumulate temp file total
AOS NTMFIL ; Count temp files deleted
HRROI T1,TEMP
MOVX T3,<FLD(^D10,NO%RDX)>
NOUT ; Output age of file
JFCL
HRROI T2,[ASCIZ / days old, deleted and expunged/]
SETZB T3,T4
SOUT
HRRZ T1,LOCJFN
HRROI T2,TEMP
CALL LSTFIL
JRST DOFET9
DOTAPE: MOVX T1,GJ%IFG+GJ%XTN+.GJALL
MOVEM T1,GJBLK+.GJGEN
MOVEI T1,GJBLK
HRROI T2,CRLF
GTJFN
RET ; None to do
MOVEM T1,LOCJFN
DOTAP1: HRRZ T1,LOCJFN
MOVX T2,.ARGST
MOVEI T3,TAPBLK
ARCF ; Get the tape info
ERJMP DOTAP2 ; Isn't any for that file
SKIPE T1,TAPBLK+.ARTP1
CALL DOTAP ; If any, do it
SKIPE T1,TAPBLK+.ARTP2
CALL DOTAP
DOTAP2: MOVE T1,LOCJFN
GNJFN
RET ; All done
JRST DOTAP1
DOTAP: MOVE T2,[-NTAPES,,TAPCNT]
DOTP1: SKIPN 0(T2) ; Have a tape in this slot?
JRST DOTP2 ; No, insert current guy
CAMN T1,0(T2) ; This our tape?
JRST [ AOS 1(T2) ; Increment the count
RET]
ADD T2,[2,,2] ; Step to next slot
JUMPL T2,DOTP1 ; Loop if there is a next one
RET ; Not found & space is full
DOTP2: SKIPN T2,TPPTR ; Get free space ptr
RET ; There is no more free
MOVEM T1,0(T2) ; Remember tape ID
MOVEI T3,1
MOVEM T3,1(T2) ; Init count to 1
ADD T2,[2,,2] ; Move on to next one
MOVEM T2,TPPTR ; Update free ptr
JUMPL T2,R ; Done if free space still available
DOTPFL: SETZM TPPTR
HRROI T1,[ASCIZ /%Tape reference count buffer is full
/]
PSOUT
RET
; Check CURDIR to see if SKIPping this directory; if so, advance
; to one we aren't SKIPping
CHKDIR: SKIPN DIRS ; Skipping anything?
RETSKP ; No, stop here then
MOVE T3,CURDIR ; Get current dir #
MOVSI T1,-NDIRS ; Those to check
CHKDI1: CAME T3,DIRS(T1) ; Skip this guy?
AOBJN T1,CHKDI1 ; Loop
JUMPGE T1,RSKP ; Done, no match
CHKDI2: CALL INCDIR ; To next directory
RET ; No next
JRST CHKDIR ; Check this one too
GTAGE: PUSH P,[377777,,0] ; File was VERY old
MOVSI T4,-NDATES
GTAD ; Get now
GTAGE1: MOVE T3,DATES(T4) ; Those we need to check
MOVE T2,FDB(T3) ; Get it
SUB T2,T1 ; Find difference
MOVNS T2
CAMGE T2,0(P) ; Smaller than what we have?
MOVEM T2,0(P) ; Yes, save it
GTAGE2: AOBJN T4,GTAGE1 ; Find smallest (most recent date)
HLRZ T2,0(P) ; Get what we found
ADJSP P,-1 ; Remove from stack
CAILE T2,^D365*10 ; tops20 hasn't been around this long
SETZ T2, ; is impossible age, call it 0
RET ; And return
DATES: .FBCRV
.FBWRT
.FBREF
.FBTDT ; Last archive d&t
NDATES==.-DATES
; Here to see if a file has already been done once, & record if not
; Ret +1 if already done, +2 if not
CKDNFL: MOVE T1,FDB+.FBADR ; Assume caller as obtained the FDB
SKIPN T4,FILPTR ; Get current count
JRST CKFLD1 ; None, make 1st entry
HRLZS T4 ; Make an AOBJN ptr
CKFLD2: CAMN T1,DONEFL(T4) ; This match?
RET ; Yes, note we've seen the file before
AOBJN T4,CKFLD2 ; No match yet
CKFLD1: MOVEM T1,DONEFL(T4) ; Record new guy
SOS T1,FILPTR ; Update the count
MOVMS T1 ; Make positive count
CAIGE T1,NFILMX ; Over running the buffer?
RETSKP ; No
AOS FILPTR ; Yes, keep using last cell
HRROI T1,[ASCIZ \%%File buffer full in CKDNFL - increase NFILMX
\]
PSOUT
RETSKP
.EXIT: NOISE <To monitor>
SKIPLE NREDIR
ERROR .+1,<EXIT command encountered in TAKE file>
CALL CONFRM
ERROR R,<>
HALTF
RET
EXIT1: HALTF
JRST EXIT1
.FLUSH: NOISE <Of old offline files>
CALL CONFRM
ERROR R,<>
SETOM FLUSH
RET
.INVOL: NOISE <Old files to offline storage>
CALL CONFRM
ERROR R,<>
SETOM INVOL
RET
.LIST: NOISE <Output to file>
LIST1: MOVEI T1,CBLK
MOVEI T2,[FLDDB. (.CMOFI,CM%SDH,,,<REAPER.LIST>)]
SKIPN WHEEL
MOVEI T2,[FLDDB. (.CMOFI,CM%SDH,,<Output to file>,<TTY:>)]
COMND
TXNE T1,CM%NOP
ERROR R,<? Bad filespec in LIST command>
PUSH P,T2 ;SAVE JFN
CALL CONFRM ;CONFIRM THE LINE
ERROR PERIOX,<> ;BAD
POP P,T1 ;RESTORE JFN
MOVX T2,<FLD(7,OF%BSZ)+OF%WR>
OPENF
ERROR R,<? Cannot open listing file>
EXCH T1,LSTJFN
JUMPE T1,R
CLOSF
JFCL
RET
COMCON: FLDDB. (.CMCMA,CM%SDH,,<File list>,,CFMBLK)
.ORDER: NOISE <For trimming>
MOVE JFNSTK,JFNPTR ; Free space
ORDER1: SETO T1, ; Parse only pls
CALL GETFIL
ERROR R,<? Bad filespec in ORDER list>
ORDER3: MOVEM T2,0(JFNSTK) ; Save JFN
AOBJP JFNSTK,[ ERROR ORDER2,<% ORDER space is full>]
MOVEI T1,CBLK
MOVEI T2,COMCON
COMND ; Get a file or confirm it
HRRZS T3 ; Get what we were given
CAIN T3,CFMBLK ; End?
JRST ORDER2 ; Yes, take exit
CAIE T3,COMCON ; Comma?
ERROR R,<? Bad syntax in ORDER command> ; Garbage
SETO T1, ; Parse only
CALL GETFIL
ERROR R,<? Bad filespec in ORDER list>
JRST ORDER3 ; Loop
ORDER2: MOVEM JFNSTK,JFNPTR ; Cover stack
SETOM HAVORD ; Say we have a system order list
RET
.PERIO: NOISE <For migration>
MOVEI T1,CBLK
MOVEI T2,[FLDDB. (.CMNUM,CM%SDH,<^D10>,<Number of days>)]
COMND
TXNE T1,CM%NOP
ERROR R,<? Bad PERIOD>
PUSH P,T2 ; Save # of days
NOISE <Days>
CALL CONFRM
ERROR PERIOX,<>
POP P,PERIOD
RET
PERIOX: ADJSP P,-1
RET
.PURGE: NOISE <Expired FDBs from disk>
CALL CONFRM
ERROR R,<>
SETOM PURGE
RET
.SCAN: NOISE <Only>
CALL CONFRM
ERROR R,<>
SETOM SCNOLY
RET
.SKIP: NOISE <Directories>
MOVE JFNSTK,DIRPTR
SKIP1: MOVEI T1,CBLK
MOVEI T2,[FLDDB. (.CMDIR,CM%SDH,CM%DWC,<NAME OF DIRECTORY TO SKIP>)]
COMND
TXNE T1,CM%NOP
ERROR R,<? Bad directory name in SKIP list>
MOVE T3,T2
SKIP3: MOVEM T3,DIRS(JFNSTK) ; Save #
AOBJP JFNSTK,[ ERROR SKIP2,<% SKIP space full>]
MOVX T1,RC%STP+RC%AWL
MOVE T2,CBLK+.CMABP
RCDIR
;**;[130] ADD 1 LINE AT SKIP3:+4L RMT 18-MAY-82
ERJMP [ERROR R,<>] ;[130] Type RCDIR% error
TXNN T1,RC%NOM+RC%AMB+RC%NMD
JRST SKIP3
MOVEI T1,CBLK
MOVEI T2,COMCON
COMND
HRRZS T3 ; What actually took
CAIN T3,CFMBLK ; Confrm?
JRST SKIP2 ; Yes, end it
CAIE T3,COMCON ; Comma?
ERROR R,<? Bad syntax in SKIP command>
JRST SKIP1
SKIP2: MOVEM JFNSTK,DIRPTR
RET
.TAKE: NOISE <Commands from file>
SETZ T1, ; No *'s
CALL SETGTD
MOVX T1,GJ%OLD
IORM T1,GJBLK+.GJGEN
MOVEI T1,CBLK
MOVEI T2,[FLDDB. (.CMFIL,,,,<SYSTEM:REAPER.CMD>)]
COMND
TXNE T1,CM%NOP
ERROR R,<? TAKE file not found>
CALL CONFRM
ERROR R,<>
MOVE T1,T2 ; Attempt to open it
; PEON code enters here
TAKE1: MOVX T2,<FLD(7,OF%BSZ)+OF%RD>
OPENF
ERROR R,<? Cannot open TAKE file>
PUSH P,IOJFNS ; Save previous
PUSH P,FENCE ; Previous stack ptr
MOVEM P,FENCE ; Current fence
HRL T2,T1
HRRI T2,.NULIO ; Suppress output
MOVEM T2,IOJFNS ; Set it
AOS NREDIR ; We are redirected
MOVEI T1,EOF
MOVEM T1,EOFADR
JRST TOPCMD ; Re-enter it
TAKERR: MOVE P,FENCE ; Restore state of stack
; Fall thru to EOF
EOF: MOVE T1,IOJFNS ; Save current
POP P,FENCE ; Recover old guy
POP P,IOJFNS
SOS NREDIR ; Pop one level of redirection
HLRZS T1
CLOSF
JFCL
RET
.TAPE: NOISE <Check of tapes in use>
CALL CONFRM
ERROR R,<>
SETOM TAPE
RET
.TRIM: NOISE <Directories over allocation>
CALL CONFRM
ERROR R,<>
SETOM TRIM
RET
; Listing routines
LSTFIL: TXON F,DIRCH ; New directory?
CALL LSTDIR ; Yes, spit it out
PUSH P,T1 ; Save JFN
PUSH P,T2 ; Save note
MOVE T1,LSTJFN ; Where it goes
MOVE T2,-1(P) ; JFN
MOVX T3,<FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF+JS%TMP>
JFNS
HRROI T2,[ASCIZ / /]
SETZB T3,T4
SOUT
POP P,T2 ; Note
CAIE T2,0 ; Any?
SOUT ; Yes, include it
HRROI T2,CRLF
SOUT
POP P,T1 ; JFN
RET
LSTDIR: PUSH P,T1
PUSH P,T2
HRRZ T1,LSTJFN
HRROI T2,CRLF
SETZB T3,T4
SOUT
HRROI T2,[ASCIZ / /]
SOUT
MOVE T2,CURDIR ; Current dir #
DIRST
JFCL
HRROI T2,CRLF
SETZB T3,T4
SOUT
PUSH P,JFNSTK ; Save this
MOVE JFNSTK,JFNSTP ; Current ordering list
SKIPE HVUSOD ; Have a user order?
JRST [ HRROI T2,[ASCIZ / User ordering: /] ; Yes
SETZB T3,T4
SOUT
CALL PRTORD ; Print it
JRST .+1]
POP P,JFNSTK
POP P,T2
POP P,T1
RET
LSTTOT: PUSH P,T3
PUSH P,T4
MOVX T3,<FLD(^D10,NO%RDX)>
NOUT ; No. of files
JFCL
MOVE T2,0(P) ; String ptr
SETZB T3,T4
SOUT
MOVE T2,-1(P) ; No. of pages
MOVX T3,<FLD(^D10,NO%RDX)>
NOUT
JFCL
HRROI T2,[ASCIZ / pages
/]
SETZB T3,T4
SOUT
HRROI T1,TEMP
TXNN F,LSTTTF ; Listing to TTY?
PSOUT ; No, do it now
MOVE T1,LSTJFN
HRROI T2,TEMP
SOUT
POP P,T4
POP P,T3
RET
CFMBLK: FLDDB. (.CMCFM)
CONFRM: PUSH P,T1
PUSH P,T2
PUSH P,T3
MOVEI T1,CBLK
MOVEI T2,CFMBLK
COMND ; Confirm please
TXNN T1,CM%NOP
AOS -3(P) ; Say confirmed
POP P,T3
POP P,T2
POP P,T1
RET
GETFIL: PUSH P,T1 ; Save parse only param
SETO T1, ; Say we want *'s
CALL SETGTD ; Set the defaults for GTJFN
MOVX T1,GJ%OLD+GJ%IFG+GJ%DEL
IORM T1,GJBLK+.GJGEN
POP P,T1
CAMN T1,[-1] ; Parse only?
JRST [ MOVX T1,GJ%IFG+GJ%OLD
ANDCAM T1,GJBLK+.GJGEN
MOVX T1,GJ%OFG
IORM T1,GJBLK+.GJGEN
JRST .+1]
MOVEI T1,CBLK
MOVEI T2,[FLDDB. (.CMFIL)]
MOVE T3,GJBLK+.GJCPP
COMND
TXNE T1,CM%NOP
RET
RSKP: AOS 0(P)
R: RET
RLJFNS: SKIPE T1,0(JFNSTK) ; Anything?
RLJFN ; Yes, release it
JFCL
SETZM 0(JFNSTK)
AOBJN JFNSTK,RLJFNS
RET
CNTRLA: PUSH P,T1
SKIPN CURDIR ; Processing a BEGIN command?
JRST [ HRROI T1,[ASCIZ / Not processing a BEGIN command
/]
;**;[104] Replace one line at CNTRLA+3L with 2 Lines RAS 25-SEP-80
CALL CRIF ;[104] Check for beginning of line
PSOUT ;[104] And output string
JRST CNTRA1]
PUSH P,T2
HRROI T1,[ASCIZ / Working on /]
;**;[104] Replace 2 Lines at CNTRLA+7L with 3 Lines RAS 25-SEP-80
CALL CRIF ;[104] Check for beginning of line
PSOUT ;[104] And output string
MOVX T1,.PRIOU ;[104] Output goes to Primary Output
MOVE T2,CURDIR
DIRST
JRST [HRROI T1,[ASCIZ /changing directories...
/]
;**;[104] Replace 1 Line at CNTRA2-4L with 2 Lines RAS 25-SEP-80
CALL CRIF ;[104] Check for beginning of line
PSOUT ;[104] And output string
JRST CNTRA2]
HRROI T1,CRLF
;**;[104] Replace 1 Line at CNTRA2-1L with 2 Lines RAS 25-SEP-80
CALL CRIF ;[104] Check for beginning of line
PSOUT ;[104] And output string
CNTRA2: POP P,T2
CNTRA1: POP P,T1
DEBRK
ERROUT: PUSH P,T1
PUSH P,T2
PUSH P,T3
PUSH P,T4 ; Be invisible to caller
CALL CRIF
;**;[104] Replace 1 line at ERROUT+5L with 1 Line RAS 25-SEP-80
MOVX T1,.PRIOU ; Output goes to primary output
SETZB T3,T4
MOVE T2,-3(P) ; Get supplied error message
SKIPN T2 ; Was a string handed to us?
JRST [ HRROI T2,[ASCIZ \?\]
SOUT
JRST ERROU1]
SOUT ; Print it
HRROI T2,[ASCIZ \ - \]
SOUT
ERROU1: MOVE T2,[.FHSLF,,-1] ; Most recent error message
SETZ T3,
ERSTR
JFCL
JFCL
HRROI T2,CRLF
SOUT
PRET4: POP P,T4
POP P,T3
POP P,T2
POP P,T1
RET
CRIF: PUSH P,T1
PUSH P,T2
PUSH P,T3
PUSH P,T4
;**;[104] Replace 1 Line at CRIF+4L with 1 Line RAS 25-SEP-80
MOVX T1,.PRIOU ; Output goes to primary output
RFPOS
HRRZS T2
CAIGE T2,1
JRST PRET4
HRROI T2,CRLF
SETZB T3,T4
SOUT
JRST PRET4
ILIPSI: SKIPN EOFADR
FATAL <? Illegal instruction interrupt>
MOVE P,FENCE
CIS
PUSH P,EOFADR
SETZM EOFADR ; Clear
RET ; Return where we're wanted
GETORD: SKIPN TRIM ; Will the order be useful?
JRST GETOR4 ; Flag no user order & return
SETOM HVUSOD ; Assume the user will have one
MOVE JFNSTK,JFNPTR ; Where free space starts
PUSH P,GJBLK+.GJGEN ; Save this, it's set up for someone
MOVX T1,GJ%OLD
MOVEM T1,GJBLK+.GJGEN ; Set what we need
MOVEI T1,GJBLK
HRROI T2,[ASCIZ /MIGRATION.ORDER/]
GTJFN
JRST GETOR3 ; No order list for us
HRRZS T1 ; Probably got flags back
PUSH P,T1 ; Save the JFN
MOVX T2,<FLD(7,OF%BSZ)+OF%RD>
OPENF
JRST [ POP P,T1 ; JFN
RLJFN
JFCL
JRST GETOR3]
MOVEM JFNSTK,JFNSTP ; Set for user ORDER list
MOVEI T1,GTOREO
MOVEM T1,EOFADR ; Where EOF interrupt should go
PUSH P,(P) ; Save JFN again
MOVE T1,FENCE
MOVEM T1,-1(P) ; Save dis guy
MOVEM P,FENCE
GETOR1: MOVX T1,GJ%OFG+GJ%SHT+GJ%FNS+.GJALL
HRL T2,0(P) ; Read from file
HRRI T2,.NULIO ; No output
GTJFN
JRST GETOR2 ; Abort on error of any kind
MOVEM T1,0(JFNSTK) ; Save it
AOBJN JFNSTK,GETOR1 ; Loop until...
ERROR GTOREO,<GETORD: User's ORDER list caused JFN storage to fill up>
GETOR2:
GTOREO: POP P,T1
CLOSF
JFCL
POP P,FENCE ; Restore this to original contents
GETOR3: POP P,GJBLK+.GJGEN ; Restore GTJFN block
CAME JFNSTK,JFNPTR ; Get anything?
RET
MOVE T1,[-NJFNS,,%JFNS]
MOVEM T1,JFNSTP
GETOR4: SETZM HVUSOD ; User didn't have an order list
RET
PRTORD: TXZ F,COMMAF
STAT2: SKIPN T2,0(JFNSTK)
JRST STAT21 ; Done
PUSH P,T2
HRROI T2,[ASCIZ /, /]
SETZ T3,
TXOE F,COMMAF
SOUT ; Make it pretty
POP P,T2
MOVX T3,<FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF>
JFNS
SOJLE COUNT,[ MOVEI COUNT,6 ; Reset count
HRROI T2,[ASCIZ /
/]
SETZB T3,T4
SOUT
TXZ F,COMMAF
JRST .+1]
AOBJN JFNSTK,STAT2 ; Loop over possible ones
STAT21: HRROI T2,CRLF
SETZB T3,T4
SOUT
RET
BEGUSR: SKIPE SCNOLY
RET ; Scan only, don't do message
MOVEM T2,MAILFL ; Save flag handed us
MOVEM T1,MLBLK+1 ; Remember the subject
MOVE T1,CURDIR
MOVEM T1,MLBLK+0 ; Save directory #
MOVE T1,[POINT 7,MSGSPC]
MOVEM T1,MSGPTR
MOVEM T1,MLBLK+2 ; Text field
RET ; All set up
ENDUSR: SKIPE SCNOLY
RET ; Don't if scan only
MOVE T1,MSGPTR
CAMN T1,[POINT 7,MSGSPC] ; Have anything for the user?
RET ; No, don't bother sending then
HRROI T2,CRLF
SETZB T3,T4
SOUT ; Finish off text of message
MOVEI T1,MLBLK
MOVE T2,MAILFL ; Pick up flag type user wanted
CALL MLTOWN ; Mail to owner of the files
RET
TOUSR: SKIPE SCNOLY
RET ; Don't if scan only
PUSH P,T1 ; Save comment line
MOVE T1,MSGPTR
HRRZ T2,LOCJFN
MOVX T3,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF>
JFNS
POP P,T2 ; Comment line
SETZB T3,T4
TLNE T2,-1 ; Look like a string ptr?
SOUT ; Yes, include it
HRROI T2,CRLF
SOUT
MOVEM T1,MSGPTR
RET
JFN2ND: HRROI T1,TEMP
HRRZ T2,LOCJFN
MOVX T3,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF>
JFNS
MOVX T1,GJ%IFG+GJ%XTN+GJ%DEL
MOVEM T1,GJBLK+.GJGEN
MOVEI T1,GJBLK
HRROI T2,TEMP
GTJFN
FATAL <GTJFN Failed in JFN2ND>
PUSH P,T1 ; Save 2nd JFN for a bit
MOVEI T1,GJBLK
HRROI T2,TEMP ; Get a 2nd JFN (3rd?)
GTJFN
FATAL <2nd GTJFN in JFN2ND failed>
PUSH P,T1
MOVE T1,LOCJFN
GNJFN ; Step to next file
SKIPA T2,[-1] ; Failed
MOVEI T2,1 ; JFN2ND won
MOVEM T2,GNJFLG ; Remember for whoever
POP P,T2 ; 3rd JFN
POP P,T1 ; 2nd JFN
RET
; Here to sort & print tape reference counts
DMPTAP: MOVE T1,[-NTAPES,,TAPCNT]
TAPDM1: MOVE T2,[-NTAPES,,TAPCNT]
TAPDM3: SKIPN 0(T2) ; Empty?
JRST TAPDM4 ; Yes, step outer ptr
SKIPN T3,0(T1) ; Outer done?
JRST TAPDM5 ; Yes
CAML T3,0(T2) ; Need to swap places?
JRST TAPDM2 ; No, step to next cell
EXCH T3,0(T2)
EXCH T3,0(T1)
MOVE T3,1(T1)
EXCH T3,1(T2)
EXCH T3,1(T1)
TAPDM2: AOBJN T2,.+1
AOBJN T2,TAPDM3
TAPDM4: AOBJN T1,.+1
AOBJN T1,TAPDM1
TAPDM5: MOVE T1,LSTJFN
MOVEI T2,"L"-100
BOUT ; Next page please
HRROI T2,[ASCIZ /
Tape ID Count Tape ID Count Tape ID Count
/]
SETZB T3,T4
SOUT
MOVE COUNT,[-NTAPES,,TAPCNT]
TAPDM6: SKIPN 0(COUNT)
JRST TAPDM7 ; Done?
CALL TAPPRT
ADD COUNT,[2,,2]
JUMPGE COUNT,TAPDM7
SKIPN 0(COUNT)
JRST TAPDM7
MOVE T1,LSTJFN
MOVEI T2,TAB
BOUT
BOUT
CALL TAPPRT
ADD COUNT,[2,,2]
JUMPGE COUNT,TAPDM7
SKIPN 0(COUNT)
JRST TAPDM7
MOVE T1,LSTJFN
MOVEI T2,TAB
BOUT
BOUT
CALL TAPPRT
ADD COUNT,[2,,2]
JUMPGE COUNT,TAPDM7
MOVE T1,LSTJFN
HRROI T2,CRLF
SETZB T3,T4
SOUT
JRST TAPDM6
TAPDM7: MOVE T1,LSTJFN
HRROI T2,CRLF
SETZB T3,T4
SOUT
RET
TAPPRT: MOVE T2,0(COUNT) ; Get tape ID
TLNE T2,777777 ; # or sixbit
JRST TAPSIX ; Sixbit
MOVE T1,LSTJFN
MOVX T3,<FLD(7,NO%COL)+FLD(^D10,NO%RDX)+NO%MAG+NO%LFL>
NOUT
JFCL
TAPPR1: HRROI T2,[ASCIZ / /]
SETZB T3,T4
SOUT
MOVE T2,1(COUNT) ; Get reference count
MOVX T3,<FLD(5,NO%COL)+FLD(^D10,NO%RDX)+NO%MAG+NO%LFL>
NOUT
JFCL
RET
TAPSIX: MOVEI T2," "
BOUT
MOVE T3,0(COUNT)
SETZ T2,
MOVE T1,[POINT 7,TEMP]
SETZ T4,0
TAPSI1: ROTC T2,6 ; Move a char into T2
JUMPE T2,TAPSI2
ADDI T2,40
IDPB T2,T1
SETZ T2,
AOJA T4,TAPSI1 ; Count # of chars
TAPSI2: IDPB T2,T1 ; End the string
MOVEI T3,6
MOVE T1,LSTJFN
MOVEI T2," "
SUB T3,T4 ; # of spaces needed
JUMPLE T3,TAPSI3
BOUT
SOJG T3,.-1
TAPSI3: HRROI T2,TEMP
SETZB T3,T4
SOUT
JRST TAPPR1
; Here to do check for users who would like see what stands to be taken
; given current policies
PEON: MOVX T1,GJ%OLD+GJ%SHT
HRROI T2,[ASCIZ /SYSTEM:REAPER.CMD/]
GTJFN
JRST [ HRROI T1,[ASCIZ /?Policy file not available
/]
PSOUT
HALTF
JRST REAPER]
CALL TAKE1 ; Fake a take on that file
PEON1: HRROI T1,[ASCIZ / Output to: /]
;**;[131] Replace 2 lines with 7 lines at PEON1:+1L RMT 18-MAY-82
MOVEM T1,CBLK+.CMRTY ; [131] Save the new prompt
MOVEI T1,REPAR2 ; [131]
MOVEM T1,CBLK ; [131] And new reparse address
MOVEI T1,CBLK ; [131]
MOVEI T2, [FLDDB. (.CMINI)] ; [131]
COMND ; [131] Print the new prompt
REPAR2: CALL LIST1 ; [131] Get the file for output
SKIPN LSTJFN ; Get one?
JRST PEON1 ; No, try again
PEON2: HRROI T1,[ASCIZ / Check files: /]
;**;[131] Replace 2 lines with 7 lines at PEON2:+1L RMT 18-MAY-82
MOVEM T1,CBLK+.CMRTY ; [131] Save the new prompt
MOVEI T1,REPAR3 ; [131]
MOVEM T1,CBLK ; [131] And new reparse address
MOVEI T1,CBLK ; [131]
MOVEI T2, [FLDDB. (.CMINI)] ;
COMND ; [131] Print new prompt
REPAR3: MOVEI T1,[<GJ%OLD+GJ%DEL+GJ%IFG+GJ%XTN+GJ%CFM>!.GJALL
.PRIIN,,.PRIOU ; From where ever
0 ; Default the device
0 ; Default the dir too
-1,,[ASCIZ /*/] ; All files
-1,,[ASCIZ /*/] ; All types
0 ; Protection
0 ; Account
0 ; JFN
;**;[131] Replace 5 lines with 15 lines at DOERST-8L RMT 18-MAY-82
G1%IIN ; Find invisible
0 ; [131] User's typescript
0 ; [131] Number of bytes in user's typescript
0 ; [131] Pointer to CTL/R buffer
0 ; [131] Pointer to dest. buffer
0] ; [131] Pointer to attribute block
MOVEM T1,CBLK+.CMGJB ; [131] Set up GTJFN block
MOVEI T1,CBLK ; [131]
MOVEI T2,[FLDDB. (.CMFIL)] ; [131]
COMND ; [131] Parse the filespec
TXNE T1,CM%NOP ; [131] Bad one?
ERROR PEON2,<> ; [131] Type the error and try again
PUSH P,T2 ; [131] Save the JFN
CALL CONFRM ; [131] Confirm
POP P,T2 ; [131] Get back the JFN
CALL ARCHI1 ; Do it
HALTF
JRST .-1 ; No continue
DOERST: PUSH P,T1
PUSH P,T2
PUSH P,T3 ; Save things
MOVX T1,.PRIOU ; To TTY
MOVE T2,[.FHSLF,,-1] ; Most recent one
SETZ T3,
ERSTR
JFCL
JRST [ HRROI T1,[ASCIZ /ERSTR failed/]
PSOUT
JRST .+1]
HRROI T1,CRLF
PSOUT
POP P,T3
POP P,T2
POP P,T1
RET
END <3,,REAPER>