Google
 

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