Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
utilities/purscr.mid
There are no other files named purscr.mid in the archive.
TITLE PURSCR
SUBTTL MRC 3/14/80
; Clean up scratch directories, then rebuild directories with appropriate
; allocations.
.DECSAV ; select .EXE binary format
A=1 ? B=2 ? C=3 ? D=4 ; JSYS AC's
L=5 ; loop control
P=17 ; stack pointer
DEFINE TMSG STRING
HRROI A,[ASCIZ\STRING\]
PSOUT%
TERMIN
DEFINE INS ?VALUE,MASK
<.DPB VALUE,<.BP MASK>> TERMIN
CALL=PUSHJ P, ; subroutine linkage
RET=POPJ P,
CALLRET==JRST
PDLLEN==10. ; stack length
STRBUF: BLOCK 10. ; temporary string buffer area
PDL: BLOCK PDLLEN ; stack
JFN: BLOCK 1 ; save of current JFN
DAYTIM: BLOCK 1 ; date/time when program started
CRDBLK: .CDDFE ; size of block following
BLOCK .CDDFE+1 ; directory block
SCRDIR: 440700,,[ASCIZ/PS:<1SCRATCH>/]; list of scratch directories
440700,,[ASCIZ/PS:<2SCRATCH>/]
440700,,[ASCIZ/PS:<3SCRATCH>/]
440700,,[ASCIZ/PS:<4SCRATCH>/]
NSCDIR==.-SCRDIR
SUBTTL Main Program
EVEC: JRST PURSCR ; start address
JRST PURSCR ; reentry address
.FVERS ; version
EVECL==.-EVEC
PURSCR: RESET% ; initialize all I/O
MOVE P,[PDL(-PDLLEN)] ; set up stack
MOVEI A,.PTYPAR ; get number of first PTY
GETAB
ERCAL FATAL
HRROI B,.TTDES-1(A) ; -1,,CTY designator
MOVEI A,.FHSLF
SPJFN% ; set primary output to be CTY
ERCAL FATAL
SETOB B,C ; enable all capabilities
EPCAP%
ERCAL FATAL
GTAD% ; get time now
MOVEM A,DAYTIM
; falls through
; drops in
; Here we loop through each directory and flush all files written more than
; three hours ago.
MOVSI L,-NSCDIR
FLSLUP: MOVE A,[440700,,STRBUF] ; set directory in file name
SKIPA B,SCRDIR(L)
IDPB A
ILDB B
JUMPN .-2
MOVE B,[440700,,[ASCIZ/*.*.*/]]
ILDB B ; set file name, terminate with null
IDPB A
JUMPN .-2
MOVSI A,(GJ%OLD\GJ%IFG\GJ%FLG\GJ%SHT)
HRROI B,STRBUF
GTJFN%
ERCAL [CAIE A,GJFX32 ; no files match the specification?
JRST FATAL ; something else - lose
ADJSP P,-1 ; nothing to do here, try next directory
JRST FLSNXD]
MOVEM A,JFN ; save JFN for later
CAIA
FLSFIL: GNJFN% ; get next file in directory
ERJMP FLSNXD ; all done
HRRZ A,JFN
MOVE B,[1,,.FBCRV] ; read creation date/time
MOVEI C,D ; into D
GTFDB%
ERCAL FATAL
MOVE B,DAYTIM ; get difference between file time and "now"
SUB B,D
CAIGE B,<1,,0>/8. ; more than 3 hours old? (1/8 of a day)
JRST FLSNXF ; no, try next file
HRLI A,(DF%NRJ) ; don't release JFN
DELF%
ERCAL WARN ; file busy or something
FLSNXF: MOVE A,JFN ; get JFN back
JRST FLSFIL
FLSNXD: MOVSI A,(RC%EMO) ; get directory number
MOVE B,SCRDIR(L)
RCDIR%
ERCAL FATAL
MOVSI A,(DD%DNF) ; now expunge this directory
MOVE B,C
DELDF%
ERCAL FATAL
AOBJN L,FLSLUP ; loop to clean out next directory
; falls through
; drops in
; Here we go and adjust the allocations for each scratch directory to
; be 20% of the available free disk
HRROI A,[ASCIZ/PS:/] ; get device designator for PS:
STDEV%
ERCAL FATAL
MOVE A,B ; now get the free space in B
GDSKC%
ERCAL FATAL
IDIVI B,5 ; 20% of free space
MOVEM B,CRDBLK+.CDLIQ
MOVEM B,CRDBLK+.CDLOQ
MOVSI L,-NSCDIR
ADJLUP: MOVE A,SCRDIR(L) ; adjust the allocation
MOVE B,[CD%LIQ\CD%LOQ\CRDBLK]; just allocations
SETZ C, ; we should be a wheel - no password
CRDIR%
ERCAL WARN ; perhaps directory over allocation now
AOBJN L,ADJLUP
HALTF%
JRST .-1
SUBTTL Error stuff
; Fatal JSYS errors come here
FATAL: MOVEI A,"? ; indicate fatal error
PBOUT
JSR ERMSG ; output JSYS information
MOVEI A,.PRIIN ; flush input buffer
CFIBF%
HALTF%
RET ; try to continue, maybe
; Warnings
WARN: MOVEI A,"% ; indicate warning
PBOUT
JSR ERMSG
RET
; Common JSYS error typeout routine
ERMSG: 0
TMSG [PURSCR: ]
MOVEI A,.PRIOU ; output message for last error
HRLOI B,.FHSLF
SETZ C,
ERSTR%
NOP
NOP
TMSG [, JSYS at PC=]
MOVEI A,.PRIOU ; output the PC
MOVE B,(P) ; get PC from top of stack
SUBI B,2 ; point PC at actual location of the JSYS
MOVE C,[NO%MAG\8.]
NOUT%
JRST 4,.-1 ; this can't happen
TMSG [
]
JRST @ERMSG ; return
END EVECL,,EVEC