Trailing-Edge
-
PDP-10 Archives
-
AP-D483B-SB_1978
-
logout.mac
There are 3 other files named logout.mac in the archive. Click here to see a list.
TITLE LOGOUT New LOGOUT for GALAXY-10 Systems
SUBTTL Larry Samberg/LSS 28 Mar 77
;Copyright (C) 1974,1975,1976,1977,
; Digital Equipment Corp., Maynard, MA.
;ASSEMBLY AND LOADING INSTRUCTIONS
; .COMPILE LOGOUT
; .LOAD LOGOUT
; .SSAVE LOGOUT
SEARCH MACTEN,UUOSYM,SCNMAC
%%MACT==%%MACT
%%UUOS==%%UUOS
%%SCNM==%%SCNM
.REQUE REL:WILD ;LEVEL-D DISK ROUTINES
.REQUE REL:SCAN ;GET .TOUTS FROM SCAN
.REQUE REL:HELPER ;DECSYSTEM-10 HELP TEXT TYPER
;VERSION INFORMATION
LGTVER==102 ;MAJOR VERSION
LGTMIN==0 ;MINOR VERSION
LGTEDT==2027 ;EDIT LEVEL
LGTWHO==0 ;WHO LAST PATCHED
%LGT==<BYTE (3)LGTWHO(9)LGTVER(6)LGTMIN(18)LGTEDT>
LOC 137
.JBVER:: EXP %LGT
TWOSEG ;HISEG PROGRAM
RELOC 400000 ;START IN HISEG
SALL ;SUPPRESS MACRO EXPANSIONS
;***DEBUGGING TIP***
;
;WHEN DEBUGGING LOGOUT, SET LOCATION "PSICCI" TO A "JFCL" SO YOU
; CAN CONTROL-C OUT WHENEVER YOU WANT.
SUBTTL Revision History
;2000 VERSION RELEASED WITH FIRST GALAXY-10 FIELD-TEST RELEASE, JUNE, 1975
;2001 DE-IMPLEMENT /Q SWITCH. MAKE /F DO A /Q IF STR IS OVER QUOTA
;2002 FIX INCORRECT AC REFERENCE IN PISYS UUO FROM T1 TO T4
;2003 FIX AN EDITTING ERROR IN EDIT 2001
;2004 MAKE THE BATCH DELETION ALGORITM UNDERSTAND NQC FILES AND ALSO
; RECOVER MORE GRACEFULLY FROM SOME ERROR CONDITIONS
;2005 IF ACCOUNTING SYSTEM FAILURE IN A BATCH JOB, NOTIFY THE OPR AND
; LOG THE JOB OFF ANYWAY
;2006 MAKE THIS VERSION 101, NOVEMMBER, 1975
;2007 CLEAR L.USE BEFORE DOING QUOTA CHECKING ON EACH STRUCTURE
;2010 ENABLE FOR CONTROL-C INTERRUPTS, AND LET THE USER GET OUT
; WHILE WE ARE COMMAND SCANNING
;2011 IMPLEMENT /T TO DELETE JOB'S UNPROTECTED TEMP FILES
;2012 ADD A ROUTINE CALLED "TYPSTR" TO TYPE OUT THE CURRENT FILE-STRUCTURE
;2013 REMOVE /T SWITCH AND MAKE TMP FILE DELETION AUTOMATIC
;2014 MOVE "OTHER JOBS SAME PPN" MESSAGE TO THE BEGINNING RATHER
; THAN PART OF THE SUMMARY MESSAGE
;2015 DO A CLRBFI UPON FINISHING COMMAND-SCAN
;2016 ADD .BLI TO IMPORT TABLE IN LGTBA
;2017 DO A CLRBFI (EDIT 2015) IFF BATCH JOB
;2020 IF WE TRY TO DELETE A FILE BECAUSE A STRUCTURE IS OVER QUOTA
; ON /B, AND THE DELETE FAILS, MAKE HIS QUOTA LOOK BIGGER BY
; THE SIZE OF THE FILE UNLESS THE ERROR WAS PROTECTION FAILURE
; (SEE MOTIVATION SECTION FOR FURTHER INFO).
;2021 IF DAEMON IS NOT RUNNING, A USER CAN LOG OUT IF HE
; SAYS K/B BECAUSE LOCATION L.BJOB WAS BEING TIMESHARED.
;2022 RATHER THAN DELETING TEMP FILES ON A STRUCTURE BY STRUCTURE
; BASIS, DELETE THEM ALL AT ONCE.
;2023 MAKE THIS VERSION 102 (NOTE: VERSION 101 WAS NEVER RELEASED).
;2024 FIX SOME MINOR PROBLEMS AND DO SOME CODE CLEANUP.
;2025 TRY HARD TO DELETE EMPTY SFDS IN /B ALGORITHM.
;;FIRST FIELD-TEST RELEASE OF GALAXY VERSION 2, JANUARY 1977
;;SECOND FIELD-TEST RELEASE OF GALAXY VERSION 2, MARCH 1977
;2026 TMP FILES WEREN'T ALWAYS DELETED DUE TO FUZZY CODING IN THE
; DELTMP ROUTINE (QAR #30).
;2027 IF LOGOUT DELETED TMP FILES, SOME STRUCTURES WERE NOT
; QUOTA CHECKED AND USERS HAD TO RECOMP NEXT TIME THEY LOGGED IN.
SUBTTL Motivation for major functional changes
;2011 THE FACILITY TO DELETE A JOB'S TEMP FILES WAS ADDED DUE TO
; A LARGE NUMBER OF USER REQUESTS FOR SUCH A FACILITY.
;2013 THE DECISION TO MAKE EDIT 2011 SWITCHABLE WAS TO AVOID THE
; EXTRA DISK OVERHEAD UNLESS THE USER EXPLICITLY REQUESTS IT.
; IT WAS THEN REALIZED THAT THE OVERHEAD IS MINIMAL SINCE:
; 1) THE JOB IS LOGGED IN
; 2) THE UFD HAS ALREADY BEEN LOOKED-UP OR IS ABOUT
; TO BE
; SO THE OVERHEAD CONSISTS SOLELY OF READING THE UFD AS DATA
; WHICH IS MINIMAL.
;2020 IF THE DELETE OF A FILE FAILS, THE PROBABLE REASON IS THAT
; IT IS THE BATCH LOG FILE WHICH IS STILL OPEN BY BATCON.
; THIS FILE CANNOT BE TREATED AS NON-EXISTANT SINCE LOGOUT
; WILL THEN SET RIBUSD WRONG, SO BY INTERNALLY CONSIDERING
; HIS QUOTA TO BE THAT MUCH BIGGER, WE WILL AVOID DELETING
; OTHER FILES SIMPLY BECAUSE THE LOG FILE IS LARGE. IT WILL
; STILL BE COUNTED AGAINST HIS QUOTA ON FUTURE LOGINS SO
; IF THE BATCH SYSTEM DOESN'T DELETE THE LOG AFTER ITS
; PRINTED, IT WILL BE GOTTEN THE NEXT TIME HE LOGS OFF.
SUBTTL Accumulator Assignments
T1=1 ;T1 THRU T4 ARE TEMPS AND ARE
T2=2 ; ALSO USED BY WILD
T3=3
T4=4
P1=5 ;P1 - P4 ARE "MY" ACS AND ARE
P2=6 ; PRESERVED BY ALL EXTERNAL SUBROUTINES
P3=7
P4=10
P=17 ;PUSHDOWN POINTER
;I/O Channel Definitions
FS==1 ;CURRENT FILE STRUCTURE
SCR==2 ;SCRATCH I/O CHANNEL FOR .LGTXX
;LOGOUT Types (FOUND IN LOCATION L.TYPE)
LTYPEF==1 ;KJOB/F
LTYPEB==2 ;KJOB/B
SUBTTL Conditional Assembly Parameters
ND PDLSIZ,100 ;SIZE OF PUSHDOWN LIST
ND TM2TRY,^D300 ;NUMBER OF TIMES TO TRY UFD INTERLOCK
ND SLTIME,^D500 ;NUMBER OF MS TO SLEEP BET TRIES
ND TMB4MS,^D60 ;NUMBER OF SLEEPS BEFORE TYPING MESSAGE
SUBTTL Entry and Initialization
LGOUT: TDZA T1,T1 ;CLEAR T1 FOR NORMAL ENTRY
MOVEI T1,1 ;SET T1 FOR CCL ENTRY
RESET ;RESET THE WORLD
MOVE P,[IOWD PDLSIZ,L.PDL]
MOVE T2,[LOWBEG,,LOWBEG+1]
CLEARM LOWBEG ;CLEAR FIRST WORD OF STORAGE AREA
BLT T2,LOWEND ;CLEAR THE REST OF THE STORAGE AREA
MOVEM T1,L.CCL ;SAVE CCL GLAG
MOVEI T1,TTYOUT ;GET ADDRESS OF TYPER
PUSHJ P,.TYOCH## ;AND TELL SCAN ABOUT IT
PUSHJ P,GTTABS ;FILL IN ALL THE GETTABS
PJOB T1, ;GET MY JOB NUMBER
MOVEM T1,L.JOB ;AND SAVE IT
MOVE T1,L.JLIM ;GET .GTLIM WORD
TXNE T1,JB.LBT ;IS IT A BATCH JOB?
SETOM L.BJOB ;YES, SET THE FLAG
SETOM L.OKCC ;LET ^C THRU RIGHT NOW
MOVEI T1,L.PSIB ;GET ADDRESS OF INTERRUPT VECTOR
PIINI. T1, ;INITIALIZE THE PI SYSTEM
JRST LGOU.1 ;IF THERE IS ONE TO INITIALIZE
MOVEI T1,PSIDET ;ADDRESS OF INTERRUPT ROUTINE
MOVEM T1,DETINB+.PSVNP ;AND STORE IT IN INTERRPT VECTOR
HRREI T1,.PCDAT ;CONDITION=ATTACH/DETACH
HRLZI T2,DETINB-L.PSIB;GET VECTOR OFFSET,,0
CLEAR T3, ;AND CLEAR RESERVED WORD
MOVE T4,[PS.FON+PS.FAC+T1]
PISYS. T4, ;TURN ON PIS, ADD NEW CONDITION
JFCL ;WE TRIED!!
MOVEI T1,PSICCI ;GET ADDRESS OF THE ROUTINE
MOVEM T1,CCIINB+.PSVNP;AND STORE IN VECTOR
HRREI T1,.PCSTP ;^C CONDITION CODE
HRLZI T2,CCIINB-L.PSIB;AND THE OFFSET
CLEAR T3, ;CLEAR EXTRA WORD
MOVE T4,[PS.FON+PS.FAC+T1]
PISYS. T4, ;AND ADD THE CONDITION
JFCL ;OH WELL.
LGOU.1: GETLIN T1, ;GET TTY NAME
TLNN T1,-1 ;DETACHED?
SETOM L.DET ;YES, SET THE FLAG
MOVEM T1,L.TTY ;SAVE TTY NAME
MOVE T1,L.CCL ;GET CCL FLAG
JUMPN T1,CCLENT ;AND DO CCL ENTRY IF NECESSARY
;ELSE, FALL THRU AND SCAN COMMAND LINE
SUBTTL Scan KJOB Command Line
LSCAN: SKIPE L.DET ;ARE WE DETACHED?
JRST CCLENT ;YES, USE CCL ENTRY
RESCAN 1 ;RESCAN THE COMMAND LINE
SKPINL ;ANYTHING THERE?
JRST SCDONE ;NO, ASSUME .KJOB/F
LSCA.2: INCHSL T1 ;GET A CHARACTER
JRST SCDONE ;NOTHING THERE!!
CAIE T1,.CHLFD ;LINE-FEED?
CAIN T1,.CHESC ;OR ESCAPE?
JRST SCDONE ;YES, EOL!!
CAIE T1,.CHFFD ;IS IT A FORMFEED
CAIN T1,.CHVTB ;OR A VERTICAL TAB?
JRST SCDONE ;YES, DONE
CAIE T1,.CHCNC ;CONTROL C
CAIN T1,.CHCNZ ;CONTROL Z
JRST SCDONE ;YES, DONE
CAIE T1," " ;A BLANK
CAIN T1,.CHCRT ;OR A CARRAIGE-RETURN
JRST LSCA.2 ;YES, IGNORE IT
CAIE T1,"/" ;LOOK FOR A SLASH
JRST LSCA.2 ;AND KEEP LOOPING
LSCA.3: INCHSL T1 ;GET CHARACTER AFTER "/"
JRST LSCA.5 ;NONE, BAD SYNTAX!!
CAIL T1,"A"+40 ;GREATER THAN LC A?
CAILE T1,"Z"+40 ;YES, LESS THAN LC Z?
SKIPA ;NO, NOT LOWER-CASE
SUBI T1,40 ;YES, IT'S LOWER CASE, CONVERT IT
CLEAR T2, ;START AT ZERO
CAIN T1,"B" ;/B?
MOVEI T2,LTYPEB ;YES!!
CAIN T1,"F" ;NO, /F?
MOVEI T2,LTYPEF ;YES, /F
JUMPE T2,LSCA.4 ;JUMP IF NOT /F OR /B
SKIPE L.TYPE ;DID HE SPECIFY A LOGOUT TYPE ALREADY?
JRST LSCA.6 ;YES, CONFLICTING SWITCHES
MOVEM T2,L.TYPE ;NO, SAVE THIS ONE
JRST LSCA.2 ;AND GET SOME MORE
LSCA.4: CAIN T1,"N" ;/N (NO-TYPEOUT)
JRST [SETOM L.NWRD ;YES, SET THE WORD
JRST LSCA.2] ;AND LOOP AROUND
CAIE T1,"H" ;OR FINALLY /H?
JRST LSCA.7 ;NO, UNRECOGNIZED SWITCH
MOVX T1,'LOGOUT' ;CALL THE HELPER
PUSHJ P,.HELPR## ; !HELP!
JRST DOEXIT ;AND EXIT
CCLENT: MOVEI T1,LTYPEB ;ASSUME /B FOR CCL ENTRY
MOVEM T1,L.TYPE ;STORE IT
;HERE WHEN DONE DOING THE SCAN
SCDONE: MOVEI T1,LTYPEF ;LOAD /F CODE
SKIPN L.TYPE ;DID HE SPECIFY A SWITCH
MOVEM T1,L.TYPE ;NO, SAVE /F AS DEFAULT
SKIPE L.BJOB ;IF HE IS A BATCH JOB,
CLRBFI ; THEN CLEAR TYPE-AHEAD
CLEARM L.OKCC ;NO MORE ^C ALLOWED
SKIPN L.NWRD ;DON'T TYPE MESSAGE ON /N
OTHUSR T1, ;OTHER USERS SAME PPN?
JRST CHKQTA ;NO, CONTINUE ON
MOVX T1,'LGTAJL' ;GET THE MESSAGE NAME
MOVEI T2,[ASCIZ /Another job is still logged-in under /]
HRLI T2,"[" ;KEY CHARACTER
PUSHJ P,.ERMSG## ;TYPE THE MESSAGE
MOVE T1,F.PPN ;GET THE PPN WORD
PUSHJ P,.TPPNW## ;AND TYPE IT
PUSHJ P,.TRBRK## ;TYPE RIGHT BRACKET
PUSHJ P,.TCRLF## ;AND A CRLF
JRST CHKQTA ;AND GO CHECK QUOTAS
;COMMAND ERRORS
LSCA.5: MOVX T1,'LGTISK' ;GET ERROR CODE
MOVEI T2,[ASCIZ /Illegal Syntax in KJOB Command/]
JRST DIE ;AND DIE
LSCA.6: MOVX T1,'LGTCSK' ;GET THE CODE
MOVEI T2,[ASCIZ /Conflicting Switches in KJOB Command/]
JRST DIE ;AND GIVE UP
DIE: HRLI T2,"?" ;AND A QUESTION MARK
PUSHJ P,.ERMSG## ;TYPE A MESSAGE
PUSHJ P,.TCRLF## ;TYPE A CRLF
CLRBFI ;AND CLEAR TYPE AHEAD
JRST DOEXIT ;AND EXIT
;HERE ON AN ILLEGAL SWITCH. GIVE A WARNING AND CONTINUE SCANNING.
;GET HERE WITH T1 CONTAINING THE SWITCH TYPED.
;
LSCA.7: PUSH P,T1 ;SAVE SWITCH
MOVX T1,'LGTURS' ;UNRECOGNIZED SWITCH
MOVEI T2,[ASCIZ ?Unrecognized switch ?]
HRLI T2,"%" ;MAKE IT A WARNING
PUSHJ P,.ERMSG## ;TYPE IT
MOVEI T1,"/" ;LOAD A SLASH
PUSHJ P,.TCHAR## ;AND TYPE IT
POP P,T1 ;GET SWITCH BACK
PUSHJ P,.TFCHR## ;TYPE IT
MOVEI T1,[ASCIZ / - ignored/]
PUSHJ P,.TSTRG## ;TELL HIM WHAT WE'RE DOING
PUSHJ P,.TCRLF## ;TYPE A CRILIF
JRST LSCA.2 ;AND CONTINUE SCANNING
SUBTTL Main Quota Checking Loop
CHKQTA: CLEARM L.OVQT ;CLEAR THE OVER-QUOTA FLAG
PUSHJ P,DELTMP ;DELETE JOB'S TMP FILES
SETZM L.STR ;TO GET FIRST STR FROM NXTSTR
CHKQ.1: PUSHJ P,NXTSTR ;GET THE NEXT STRUCTURE IN THE S/L
SKIPN L.STR ;IS THERE A STR?
JRST CHKQ.6 ;NO, DONE
PUSHJ P,SETLOK ;SET UFD INTERLOCK
MOVX T1,.IODMP+UU.PHS ;GET OPEN BITS
MOVE T2,L.STR ;GET STRUCTURE NAME
CLEAR T3, ;NO BUFFERS
OPEN FS,T1 ;OPEN THE STRUCTURE
JRST T$OUF ;LOSE!!
MOVE T1,L.DCBK+.DCSMT ;GET MOUNT COUNT
SOJLE T1,CHKQ.3 ;I'M THE ONLY USER
OTHUSR T1, ;OTHER JOBS SAME PPN?
JRST CHKQ.3 ;NO, MUST CHECK QUOTA
;THERE IS ANOTHER JOB LOGGED IN UNDER MY PPN. LOOP THRU TO SEE
; IF HE (THEM) HAS THIS STR IN HIS S/L. IF SO, WE'LL GET
; IT WHEN HE LOGS OFF.
MOVE T2,F.PPN ;LOAD MY PPN
MOVE T3,L.STR ;AND THE STRUCTURE NAME
MOVEI T1,1 ;START WITH JOB 1
SKIPN P1,L.HJIU ;LOAD HIEST JOB NO. IN USE
MOVE P1,L.MXJB ;COULDN'T GET IT, USE JOBN
CHKQ.2: CAMN T1,L.JOB ;IS THIS MY JOB?
JRST CHKQ2A ;YES, SKIP IT
MOVE T4,[3,,T1] ;ARG POINTER FOR GOBSTR
GOBSTR T4, ;SEE IF ITS THERE
JRST CHKQ2A ;IT'S NOT, KEEP CHECKING
SETOM L.OJCS ;IT IS, SET A FLAG FOR "SUMARY"
JRST CHKQ.5 ;AND SKIP THE CHECK
CHKQ2A: CAME T1,P1 ;DONE?
AOJA T1,CHKQ.2 ;NO, LOOP
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
CHKQ.3: PUSHJ P,DOCHK ;CHECK THE QUOTA
SKIPN L.DSTS ;IS STR OVER QUOTA?
JRST CHKQ.4 ;NO, GET NEXT
SETOM L.OVQT ;SET "OVER QUOTA SOMEWHERE" FLAG
PUSHJ P,T$LQE ;TYPE OVER-QUOTA MESSAGE
MOVE P1,L.TYPE ;GET LOGOUT TYPE
CAIE P1,LTYPEB ;BATCH LOGOUT?
JRST CHKQ.5 ;NO, DON'T FINISH OFF THE UFD
MOVE T1,L.STR ;YES, GET STR NAME
MOVE T2,F.PPN ;AND THE PPN
MOVE T3,L.QOUT ;AND THE QUOTA
MOVEI T4,SCR ;AND THE CHANNEL
PUSHJ P,.LGTBA## ;PUT HIM UNDER QUOTA
MOVEM T1,L.UUO+.RBUSD ;WE DID A RECOMP IN LGTBA
MOVEM T1,L.USE ;AND SAVE TO TOTAL
CHKQ.4: PUSHJ P,UFDDSP ;FINISH OFF THE UFD
CHKQ.5: RELEAS FS, ;RELEASE THE CHANNEL
PUSHJ P,CLRLOK ;CLEAR THE UFD INTERLOCK
MOVE T1,L.USE ;GET NUMBER OF BLOCKS
ADDM T1,L.TBLK ;AND ADD TO TOTAL
JRST CHKQ.1 ;LOOP
CHKQ.6: MOVE P1,L.TYPE ;GET LOGOUT TYPE
CAIE P1,LTYPEB ;ARE WE /BATCH?
SKIPL L.OVQT ;NO, ARE WE OVER QUOTA ANYWHERE?
JRST DOACCT ;EITHER BATCH OR UNDER QUOTA
JRST DOEXIT ;WE'RE OVER ON /F
SUBTTL NXTSTR -- Get Next Structure in S/L
;CALL NXTSTR WILL THE CURRENT STRUCTURE NAME IN L.STR TO RETURN
; THE NEXT STRUCTURE IN THE SEARCH LIST IN L.STR.
;
;WHEN THE END OF THE SEARCH LIST IS REACHED (OR IF JOBSTR FAILS),
; L.STR IS RETURNED CONTAINING 0.
NXTSTR: SKIPN T2,L.STR ;GET LAST STRUCTURE
SETO T2, ;NULL, BEGINNING OF LIST
NXTS.1: MOVE T1,[3,,T2] ;ARG TO JOBSTR
JOBSTR T1, ;GET THE NEXT STRUCTURE
JRST NXTS.3 ;LOSE!!
MOVEM T2,L.STR ;SAVE THE STR NAME
MOVEM T2,L.DCBK ;AND SAVE FOR DSKCHR
JUMPE T2,NXTS.1 ;IGNORE THE FENCE
AOJE T2,NXTS.4 ;END OF LIST IF -1
MOVE T3,T4 ;GET STR FLAGS INTO T3
TXZN T3,DF.SWL ;WAS SOFTWARE WRITE LOCK SET?
JRST NXTS.2 ;NO, CONTINUE
MOVEI T1,.FSMNW ;LOAD FUNCTION CODE INTO T1
MOVE T2,L.STR ;GET STRUCTURE IN T2
MOVE T4,[3,,T1] ;LOAD ARGLIST POINTER
STRUUO T4, ;CLEAR SOFTWARE WRITE-LOCK
PUSHJ P,[MOVX T1,'LGTCCW'
MOVEI T2,[ASCIZ /Can't clear software write-lock on structure /]
HRLI T2,"%"
PUSHJ P,.ERMSG##
PUSHJ P,TYPSTR
PJRST .TCRLF##]
NXTS.2: MOVE T1,[L.DCBK+1,,L.DCBK+2]
CLEARM L.DCBK+1 ;CLEAR FIRST WORD OF DSKCHR BLOCK
BLT T1,L.DCBK+.DCSMT ;CLEAR THE REST
MOVE T1,[.DCSMT+1,,L.DCBK]
DSKCHR T1,UU.PHY ;GET DISK CHARACTERISTICS
JFCL ;LOSE, RETURN ZEROED WORDS
POPJ P, ;RETURN
NXTS.3: MOVX T1,'LGTJUF' ;GET THE ERROR CODE
MOVEI T2,[ASCIZ /JOBSTR UUO Failed - No Quota Enforcement
/]
HRLI T2,"%" ;AND THE CHARACTER
PUSHJ P,.ERMSG## ;TYPE THE MESSAGE
NXTS.4: CLEARM L.STR ;ZERO THE STRUCTURE WORD
POPJ P, ;AND RETURN
SUBTTL DOCHK -- Routine to Quota-Check a Structure
;DOCHK IS CALLED FROM CHKQTA TO GET ALL THE VITAL STATISTICS
; ABOUT THE UFD AND DETERMINE WHETHER ITS OVER QUOTA.
DOCHK: PUSHJ P,.SAVE1## ;SAVE P1
MOVE T1,[L.UUO,,L.UUO+1]
CLEARM L.UUO ;CLEAR FIRST WORD OF LOOKUP BLOCK
BLT T1,L.UUO+.RBTIM ;CLEAR THE REST
MOVEI T1,.RBTIM ;GET LENGTH OF BLOCK
MOVEM T1,L.UUO ;STORE RIBCNT
MOVE T1,F.PPN ;GET MY PPN
MOVEM T1,L.UUO+.RBNAM ;STORE AS FILENAME
MOVSI T1,'UFD' ;.UFD
MOVEM T1,L.UUO+.RBEXT
MOVE T1,L.MFPP ;GET THE MFD PPN
MOVEM T1,L.UUO+.RBPPN ;AND STORE IT
CLEARM L.DSTS ;NOT OVER QUOTA, YET
CLEARM L.USE ;AND NO BLOCKS USED, YET
LOOKUP FS,L.UUO ;LOOKUP THE UFD
JRST T$ULF ;LOOKUP FAILED
MOVX T1,DC.NPA ;GET "NO PREVIOUS ACCESS" BIT
CAME T1,L.DCBK+.DCUFT ;WAS IT SET?
JRST DOCH.1 ;NO, GO NORMAL ROUTE
MOVE T1,L.UUO+.RBUSD ;GET RIBUSD
JRST DOCH.2 ;AND MEET AT THE PASS
DOCH.1: MOVE T1,L.UUO+.RBQTF ;GET FCFS QUOTA
SUB T1,L.DCBK+.DCUFT ;SUBTRACT UFBTAL
DOCH.2: MOVEM T1,L.USE ;AND SAVE BLOCKS USED
SETOM L.UUO+.RBUSD ;LET MONITOR FILL IN RIBUSD
; TO AVOID ANY RACES
CLEAR P1, ;SET "FIRST TIME THRU"
DOCH.3: MOVE T1,L.UUO+.RBQTO ;GET LOGGED-OUT QUOTA
MOVEM T1,L.QOUT ;AND SAVE IT
SUB T1,L.USE ;SUBTRACT USED
JUMPGE T1,DOCH.4 ;JUMP IF ASSUMPTION WAS CORRECT
MOVNM T1,L.DSTS ;ELSE, SAVE OVERAGE
MOVE T2,L.TYPE ;GET THE LOGOUT TYPE
SKIPN P1 ;FIRST TIME THRU?
CAIN T2,LTYPEB ;IS THIS NOT /B?
POPJ P, ;NO, OR WE'VE BEEN HERE BEFORE
PUSHJ P,RECOMP ;RECOMP THE STRUCTURE
MOVEM T1,L.USE ;SAVE BLOCKS USED
MOVEM T1,L.UUO+.RBUSD ;AND IN UFD ALSO
CLEARM L.DSTS ;CLEAR THE OVERAGE FOR ANOTHER TRY
AOJA P1,DOCH.3 ;SET "BEEN HERE" FLAG AND LOOP
DOCH.4: POPJ P, ;AND RETURN
SUBTTL Accounting
DOACCT: MOVE T1,L.TYPE ;GET LOGOUT TYPE
CAIN T1,LTYPEB ;IS IT /B
PUSHJ P,GTTABS ;YES, CHARGE HIM FOR ALL THAT WORK
MOVE T1,L.JOB ;GET MY JOB NUMBER
DPB T1,[POINT 9,F.HDR,17]
SETOB T1,T2 ;ASSUME CTY IN T1, ARG FOR GETLCH IN T2
SKIPGE L.DET ;ARE WE DETACHED?
JRST DOAC.1 ;YES, MAKE IT -2
GETLCH T2 ;GET LINE CHARACTERISTICS
TXNE T2,GL.ITY ;IS THIS OVER A PTY
SETOM L.PTY ;YES, SET FLAG
TXNE T2,GL.CTY ;IS THIS THE CTY?
JRST DOAC.2 ;YES, WE ARE ALL DONE
SKIPA T1,T2 ;GET LINE NUMBER IN T1
DOAC.1: TRZ T1,1 ;MAKE -1 INTO -2
DOAC.2: DPB T1,[POINT 12,F.HDR,29]
MOVE T1,F.RTM ;GET RUNTIME IN TICKS
IMULI T1,^D1000 ;CONVERT TO MILLI-TICKS
IDIV T1,L.TIC ;CONVERT TO MILLI-SECONDS
MOVEM T1,F.RTM ;AND STORE RUNTIME
MOVE T1,F.CTI ;GET CTI IN KCTS
IMULI T1,^D100 ;GET CTI IN <KCT>*100
IDIV T1,L.TIC ;DIVIDE BY JIFSEC
MOVEM T1,F.CTI ;YIELDING KILO-CORE-CENTI-SECS
MOVSI T1,777700 ;MASK FOR INCREMENTAL READS AND WRITES
ANDCAM T1,F.DRD ;TURN OFF INCREMENTAL READS
ANDCAM T1,F.DWT ;TURN OFF INCREMENTAL WRITES
MOVEI T1,.FACT ;GET DAEMON FUNCTION
MOVEM T1,F.FUN ;SAVE IN THE FACT BLOCK
MOVE T1,[141000,,7] ;GET FUNCTION WORD
IORM T1,F.HDR ;AND OR IT IN
MOVE T1,[F.LEN,,F.FUN]
DAEMON T1, ;CALL THE DAEMON
JRST T$ASF ;STRANGE??
JRST SUMARY ;ONWARD AND UPWARD
SUBTTL Type Summary Messages
SUMARY: SKIPE L.NWRD ;DID HE SAY /N?
JRST SUMA.2 ;YES, HE DOESN'T WANT MESSAGE
MOVEI T1,[ASCIZ /Job /]
PUSHJ P,.TSTRG##
MOVE T1,L.JOB ;GET JOB NUMBER
PUSHJ P,.TDECW## ;TYPE IT "JOB NN"
MOVEI T1,[ASCIZ / User /]
PUSHJ P,.TSTRG##
SKIPE T1,L.MYN1 ;GET FIRST HALF OF MY NAME
PUSHJ P,.TSIXN## ;TYPE IT
SKIPN T1,L.MYN1 ;GET FIRST HALF OF MY NAME BACK
MOVEI T1,77 ;MAKE THE FOLLOWING TEST FAIL
TRNN T1,77 ;WAS THE LAST CHARACTER A SPACE?
PUSHJ P,.TSPAC## ;YES, TYPE A SPACE
SKIPE T1,L.MYN2 ;GET SECOND HALF
PUSHJ P,.TSIXN## ;TYPE IT
PUSHJ P,.TSPAC## ;TYPE A SPACE
MOVE T1,F.PPN ;GET MY PPN
PUSHJ P,.TPPNW## ;AND TYPE IT
PUSHJ P,.TCRLF## ;TYPE A CRLF
MOVEI T1,[ASCIZ /Logged-off /]
PUSHJ P,.TSTRG## ;TYPE THE STRING
MOVE T1,L.TTY ;GET THE TTY NAME
PUSHJ P,.TSIXN## ;AND TYPE IT
MOVEI T1,[ASCIZ / at /]
PUSHJ P,.TSTRG## ;TYPE IT
PUSHJ P,.TTIMN## ;TYPE THE TIME
MOVEI T1,[ASCIZ / on /]
PUSHJ P,.TSTRG##
PUSHJ P,.TDATN## ;TYPE THE DATE
PUSHJ P,.TCRLF## ;AND A CRLF
;"SUMARY" IS CONTINUED ON THE NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
SUMA.1: MOVEI T1,[ASCIZ /Runtime:/]
PUSHJ P,.TSTRG## ;AND A LABEL
MOVE T1,F.RTM ;GET RUNTIME IN MILLI-SECONDS
PUSHJ P,.TTIME## ;TYPE IT
MOVEI T1,[ASCIZ /, KCS:/]
PUSHJ P,.TSTRG##
MOVE T1,F.CTI ;GET CORE-TIME INTEGRAL IN KCS*100
IDIVI T1,^D100 ;CONVERT TO KCS
PUSHJ P,.TDECW## ;TYPE IT
MOVEI T1,[ASCIZ /, Connect time:/]
PUSHJ P,.TSTRG## ;TYPE IT
MOVE T1,L.NOW ;GET TIME OF DAY NOW
SUB T1,L.JLT ;SUBTRACT JOB LOGIN TIME
MULI T1,^D86400 ;CONVERT TO SECONDS
ASHC T1,^D17 ;SHIFT IT IN
IMULI T1,^D1000 ;CONVERT TO MILLISECS
PUSHJ P,.TTIME## ;AND TYPE IT
PUSHJ P,.TCRLF## ;AND A CRLF
MOVEI T1,[ASCIZ /Disk Reads:/]
PUSHJ P,.TSTRG## ;TYPE A LINE
MOVE T1,F.DRD ;GET NUMBER OF READS
PUSHJ P,.TDECW## ;AND TYPE IT
MOVEI T1,[ASCIZ /, Writes:/]
PUSHJ P,.TSTRG##
MOVE T1,F.DWT ;GET NUMBER OF WRITES
PUSHJ P,.TDECW## ;TYPE IT
SKIPE L.OJCS ;OTHER JOB CONTAIN CONFLICTING STR?
JRST SUMA.2 ;YES, WE DIDN'T COUNT EVERYTHING THEN
MOVEI T1,[ASCIZ /, Blocks saved:/]
PUSHJ P,.TSTRG##
MOVE T1,L.TBLK ;GET TOTAL NUMBER OF BLOCKS
PUSHJ P,.TDECW## ;AND TYPE IT
SUMA.2: PUSHJ P,.TCRLF## ;AND A CRLF
MOVEI T1,ENDMSG ;ADDRESS OF FINAL MESSAGE
SKIPE L.NWRD ;DID HE SAY /N?
MOVEI T1,ENDMS1 ;YES, JUST TYPE "."
SKIPL L.PTY ;BUT NOT IF THIS IS A PTY
PUSHJ P,.TSTRG ;TYPE IT
JRST BYEBYE ;AND SAY GOODBYE
ENDMSG: BYTE (7) .CHLFD,.CHLFD,.CHLFD,.CHLFD,.CHLFD
BYTE (7) .CHLFD,.CHLFD,.CHLFD,.CHLFD,.CHLFD
ENDMS1: BYTE (7) ".",0,0
SUBTTL Finishing-Up
BYEBYE: CLEARB T3,T4 ;BLOCK FOR TMPCOR UUO
MOVE T1,[.TCRDD,,T3] ;DELETE DIRECTORY
TMPCOR T1, ;DO IT
JFCL ;DOESN'T MATTER
MOVEI T1,.FSDSL ;FUNCTION TO DEFINE S/L
SETOB T2,T3 ;MY JOB, MY PPN
MOVX T4,DF.SRM ;DELETE ALL STRS
MOVE P1,[4,,T1] ;ARGLIST
STRUUO P1, ;DO IT!!
JFCL ;OH WELL, AT LEAST WE TRIED
LOGOUT ;****END OF JOB****
SUBTTL SETLOK -- Set UFD Interlock
;SETLOK IS CALLED TO SET THE UFD INTERLOCK FOR THE STR WHOSE NAME IS
; IN L.STR. SETLOK WILL MAKE "TM2TRY" TRIES AND SLEEP FOR "SLTIME"
; MILLISECS BETWEEN EACH TIME, AND THEN FORCE THE INTERLOCK.
; AFTER "TMB4MS" TRIES, A MESSAGE EXPLAINING THE WAIT IS TYPED.
SETLOK: PUSHJ P,.SAVE1## ;SAVE P1
MOVEI T1,.FSULK ;FUNCTION IN T1
MOVE T2,L.STR ;STRUCTURE IN T2
MOVE T3,F.PPN ;AND PPN IN T3
MOVEI P1,TM2TRY ;AND NUMBER OF TIMES TO TRY
SETL.1: MOVE T4,[3,,T1] ;ARGLIST FOR STRUUO
STRUUO T4, ;AND DO IT
SKIPA ;COULDN'T GET IT
POPJ P, ;GOT IT!!
CAIE P1,<TM2TRY-TMB4MS> ;TIME FOR A MESSAGE?
JRST SETL.2 ;NO, JUST SLEEP
PUSHJ P,.PSH4T## ;SAVE T1-T4
MOVEI T1,[ASCIZ /[LGTWFI Waiting for /]
PUSHJ P,.TSTRG## ;TYPE THE FIRST PART
PUSHJ P,TYPSTR ;TYPE THE STRUCTURE NAME
MOVEI T1,[ASCIZ / UFD Interlock]
/]
PUSHJ P,.TSTRG## ;AND FINISH OFF
PUSHJ P,.POP4T## ;RESTORE T1-T4
SETL.2: MOVEI T4,SLTIME ;LOAD THE SLEEP TIME
HIBER T4, ;ZZZZZ
JFCL
SOJG P1,SETL.1 ;LOOP FOR ANOTHER TRY
POPJ P, ;WE'VE WAITED LONG ENOUGH,
; FORCE IT
SUBTTL CLRLOK -- Clear UFD Interlock
CLRLOK: MOVEI T1,.FSUCL ;LOAD FUNCTION,
MOVE T2,L.STR ;STRUCTURE NAME
MOVE T3,F.PPN ;AND PPN
MOVE T4,[3,,T1] ;ARGLIST FOR STRUUO
STRUUO T4, ;DO IT
POPJ P, ;PUNT!
POPJ P, ;WIN!!
SUBTTL RECOMP -- Recompute Blocks Used
;CALLED WITH STRUCTURE NAME IN L.STR. RETURN WITH BLOCKS USED
; IN T1.
RECOMP: MOVEI T1,[ASCIZ /[LGTRDU Recomputing Disk Usage on /]
PUSHJ P,.TSTRG## ;TYPE THE STRING
PUSHJ P,TYPSTR ;TYPE THE STRUCTURE NAME
MOVEI T1,"]" ;A CLOSE BRACKET
PUSHJ P,.TCHAR## ;TYPE IT
PUSHJ P,.TCRLF## ;AND A CRLF
MOVE T1,L.STR ;GET STRUCTURE NAME
MOVE T2,F.PPN ;GET PPN
MOVEI T3,SCR ;SCRATCH CHANNEL
PJRST .LGTRC## ;RECOMP AND RETURN
SUBTTL DELTMP -- Routine to delete job's TMP files
DELTMP: PUSHJ P,.SAVE3## ;SAVE P1-P3
MOVSI T1,'DSK' ;GET "DISK"
MOVE T2,F.PPN ;GET PPN
HRLOI T3,'TMP' ;AND EXT,,MASK
PUSHJ P,.LGTSE## ;SETUP TO READ DSK:*.TMP
CLEARM L.NTMP ;AND ZERO THE COUNT
MOVE P1,L.JOB ;GET JOB NUMBER
IDIVI P1,^D100 ;START SPLITTING DIGITS
IDIVI P2,^D10 ;AND THE LAST 2
LSH P1,^D12 ;SHIFT OVER 2 PLACE
LSH P2,^D6 ;SHIFT OVER 1 PLACE
IORI P1,'000'(P2) ;AND PUT THEM BACK TOGETHER IN 6BIT
IOR P1,P3 ;AND THE LAST DIGIT
SETZM L.STR ;START WITH NO STRUCTURE
DELT.1: CLEARB T1,T2 ;USE DEFAULT BLOCKS
PUSHJ P,.LGTLA## ;GET A FILE
JRST DELT.3 ;DONE, FINISH UP
HLRZ T3,.RBNAM(T2) ;GET FIRST 3 CHARS OF FILENAME
CAME T3,P1 ;IS IT FOR THIS JOB?
JRST DELT.1 ;NO, LOOP AROUND
MOVE T3,1(T1) ;GET DEVICE FROM OPEN BLOCK
CAMN T3,L.STR ;SAME AS LAST STRUCTURE?
JRST DELT.2 ;YES, CONTINUE ON
MOVEM T3,L.STR ;NO, SAVE STRUCTURE NAME
MOVEI T3,.IODMP ;LOAD AN I/O MODE
MOVEM T3,0(T1) ;STORE IT IN THE OPEN BLOCK
OPEN SCR,0(T1) ;OPEN THE DEVICE
JRST T$OUF ;AND GIVE THE ERROR
DELT.2: LOOKUP SCR,(T2) ;YES, LOOKUP IT UP
JRST DELT.1 ;LOSE
LDB T1,[POINT 9,.RBPRV(T2),8] ;GET PROTECTION
CAIL T1,200 ;IS IT UNPRESERVED?
JRST DELT.1 ;NO, IGNORE IT
CLEARB T1,T2 ;SETUP TO DELETE IT
CLEARB T3,T4 ; " " " "
RENAME SCR,T1 ;AND DELETE IT
JRST DELT.1 ;LOSE
AOS L.NTMP ;WIN, COUNT IT UP
JRST DELT.1 ;AND LOOP AROUND
DELT.3: RELEAS SCR, ;RELEASE THE CHANNEL
SKIPN L.NTMP ;ANYTHING DELETED?
POPJ P, ;NO, JUST RETURN
MOVEI T1,[ASCIZ /[LGTDTF Deleted /]
PUSHJ P,.TSTRG## ;TYPE FIRST PART
MOVE T1,L.NTMP ;GET NUMBER OF FILES
PUSHJ P,.TDECW## ;TYPE IT
MOVEI T1,[ASCIZ / TMP files]
/]
PJRST .TSTRG## ;TYPE SECOND PART AND RETURN
SUBTTL UFDDSP -- Dispose of UFD
;UFDDSP IS CALLED AFTER QUOTA ENFORCEMENT IS DONE ON A STRUCTURE. IF
; THE STRUCTURE STILL HAS FILES ON IT, THE UFD IS JUST RENAMED
; TO TURN THE LOGGED-IN BIT OFF. IF THERE ARE NO FILES ON THE
; STRUCTURE, THE UFD IS DELETED.
UFDDSP: MOVE T1,L.UUO+.RBSTS ;GET RIBSTS FOR THE UFD
TXNE T1,RP.NDL ;"NO DELETE"?
POPJ P, ;YES, ALSO NO RENAME
TXZ T1,RP.LOG ;TURN OFF LOGGED-IN BIT
MOVEM T1,L.UUO+.RBSTS ;AND SAVE RIBSTS
HLRZ T1,F.PPN ;GET MY PROJECT NUMBER
HRRZ T2,F.PPN ;GET MY PROGRAMMER NUMBER
CAILE T2,10 ;AM I [A,B] S.T. B<=10
CAIGE T1,10 ;OR [A,B] S.T. A<10
JRST UFDD.1 ;YES, JUST RENAME UFD.
SKIPN L.UUO+.RBSIZ ;ANYTHING WRITTEN IN UFD?
JRST UFDD.2 ;NO, DELETE IT
SKIPE L.USE ;ANYTHING IN THE UFD
JRST UFDD.1 ;DEFINITELY.
MOVE T1,L.STR ;GET THE STR NAME
MOVE T2,F.PPN ;AND THE PPN
PUSHJ P,.LGTSA## ;SETUP TO LOOKUP EVERYTHING UP
CLEARB T1,T2 ;USE DEFAULTS FOR EVERY THING
PUSHJ P,.LGTLA## ;LOOKUP FIRST FILE
JRST UFDD.2 ;NOTHING THERE, DELETE UFD
;HERE TO RENAME THE UFD
UFDD.1: RENAME FS,L.UUO ;RENAME THE UFD
PUSHJ P,T$URF ;FAILED?
POPJ P, ;AND RETURN
;HERE TO DELETE THE UFD
UFDD.2: PUSHJ P,.SAVE4## ;SAVE P1-P4
CLEARB P1,P2 ;MAKE A ZEROED RENAME BLOCK
CLEARB P3,P4 ; " "
RENAME FS,P1 ;DELETE THE UFD
JRST UFDD.1 ;CAN'T DELETE, JUST TRY RENAME
POPJ P, ;AND RETURN
SUBTTL GTTABS -- Routine to do all GETTABs
;GTTABS IS DRIVEN BY THREE TABLES GENERATED BY THE "TABS" MACRO.
; THE FIRST TABLE CONTAINS THE ARGUMENT TO GETTAB, THE SECOND,
; CONTAINS DEFAULTS TO USE ON FAILURE, AND THE THIRD CONTAINS
; AN INSTRUCTION WHICH IS EXECUTED TO STORE THE RESULTS.
;HISTORICAL NOTE: THE GETTAB UUO (CALLI 41) IS NEW WITH THE 3.19
; MONITOR RELEASE. THE UUO WAS IMPLEMENTED TO ALLOW UNPRIVILEGED
; PROGRAMS TO EXAMINE VARIOUS MONITOR TABLES. THE CALL IS:
; MOVE AC,[INDEX,,TABLE#]
; GETTAB AC,
; ERROR RETURN
GTTABS: MOVSI T2,-.NMTAB ;MAKE AOBJN POINTER
GTTAB1: MOVE T1,GTAB1(T2) ;GET AN ARGUMENT
GETTAB T1, ;DO THE GETTAB
MOVE T1,GTAB2(T2) ;FAIL!! USE DEFAULT
XCT GTAB3(T2) ;STORE THE RESULT
AOBJN T2,GTTAB1 ;AND LOOP
POPJ P, ;RETURN WHEN DONE
;THE ARGUMENTS TO THE TABS MACRO ARE:
; 1) ARGUMENT TO GETTAB
; 2) DEFAULT VALUE
; 3) INSTRUCTION TO STORE RESULT
; (NOTE: MACRO EXPANSION GENERATES THE CORRECT AC FIELD
; THEREFORE IT SHOULD BE BLANK IN THE ARGUMENT)
DEFINE TABS,<
T <%LDMFD>,<1,,1>,<MOVEM L.MFPP>
T <-1,,.GTPPN>,<0>,<MOVEM F.PPN>
T <-1,,.GTNM1>,<0>,<MOVEM L.MYN1>
T <-1,,.GTNM2>,<0>,<MOVEM L.MYN2>
T <-1,,.GTPRV>,<0>,<MOVEM L.PRIV>
T <-1,,.GTKCT>,<0>,<MOVEM F.CTI>
T <-1,,.GTRCT>,<0>,<MOVEM F.DRD>
T <-1,,.GTWCT>,<0>,<MOVEM F.DWT>
T <-1,,.GTTIM>,<0>,<MOVEM F.RTM>
T <-1,,.GTCNO>,<0>,<MOVEM L.CNO>
T <-1,,.GTJLT>,<0>,<MOVEM L.JLT>
T <-1,,.GTLIM>,<0>,<MOVEM L.JLIM>
T <%CNSTS>,<0>,<MOVEM L.STS>
T <%CNDTM>,<0>,<MOVEM L.NOW>
T <%CNTIC>,<^D60>,<MOVEM L.TIC>
T <%CNSJN>,<^D64>,<HRRZM L.MXJB>
T <%NSHJB>,<0>,<MOVEM L.HJIU>
T <%LDFFA>,<1,,2>,<MOVEM L.FFA>
> ;END OF TABS MACRO
DEFINE T(A,B,C),<
EXP <A>
>
GTAB1: TABS
.NMTAB==.-GTAB1
DEFINE T(A,B,C),<
EXP <B>
>
GTAB2: TABS
DEFINE T(A,B,C),<
EXP <C> + <T1>B12
>
GTAB3: TABS
SUBTTL TTYOUT -- Type a character on the user's teletype
;CALLED BY .TCHAR ROUTINE IN .TOUTS MODULE OF SCAN WITH CHARACTER FOR
; TYPING IN T1.
TTYOUT: SKIPL L.DET ;ARE WE DETACHED?
OUTCHR T1 ;ELSE TYPE THE CHARACTER
POPJ P, ;AND RETURN
SUBTTL PSIDET -- Interrupt Routine for DETACH
PSIDET: SETOM L.DET ;SET DETACHED FLAG
DEBRK. ;AND RESTORE INTERRUPT LEVEL
JFCL ;??
POPJ P, ;HOPEFULLY CALLED BY PUSHJ
SUBTTL PSICCI -- Interrupt Routine for Control-C
PSICCI: SKIPE L.OKCC ;ARE WE ALLOWING ^C NOW?
JRST DOEXIT ;YES, GO AHEAD
DEBRK. ;NO, DISMISS THE INTERRUPT
JFCL
POPJ P, ;IF CALLED WITH A PUSHJ
SUBTTL DOEXIT -- Routine to LOGIN and EXIT
DOEXIT: MOVE P1,F.PPN ;LOAD THE PPN
MOVE P2,L.PRIV ;GET JBTPRV WORD
MOVE P3,L.MYN1 ;GET FIRST HALF OF MY NAME
MOVE P4,L.MYN2 ;GET SECOND HALF OF MY NAME
MOVE P4+1,L.CNO ;GET CHARGE NUMBER
MOVE T1,[-5,,P1] ;ARGUMENT LIST
CLRBFI ;CLEAR ANY TYPE-AHEAD
LOGIN T1, ;GET BACK IN
JFCL ;ERROR IF WE ARE LOGGED-IN
RESET ;RESET THE WORLD
MONRT. ;AND EXIT
JRST .-1 ;WITH NO CONTINUE ALLOWED
SUBTTL T$OUF -- Type OPEN Failure message
;CALLED WITH L.STR CONTAINING THE STRUCTURE NAME.
T$OUF: MOVEI T1,[ASCIZ /?LGTOUF OPEN UUO Failed for structure /]
PUSHJ P,.TSTRG## ;TYPE IT
PUSHJ P,TYPSTR ;TYPE A STRUCTURE NAME
PUSHJ P,.TCRLF## ;AND A CRLF
JRST DOEXIT ;AND EXIT
SUBTTL T$LQE -- Type Quota-Exceeded message
;CALL WITH STRUCTURE NAME IN L.STR
T$LQE: PUSHJ P,.PSH4T## ;SAVE T1-T4
MOVEI T1,"?" ;ASSUME A "?"
MOVE T2,L.TYPE ;GET LOGOUT TYPE
CAIN T2,LTYPEB ;/BATCH?
MOVEI T1,"%" ;YES, LOAD A "%"
PUSHJ P,.TCHAR## ;TYPE THE INITIAL CHARACTER
MOVEI T1,[ASCIZ /LGTLQE /]
PUSHJ P,.TSTRG## ;START TYPING ERROR MESSAGE
PUSHJ P,TYPSTR ;TYPE THE STRUCTURE NAME
MOVEI T1,[ASCIZ / Logged-out quota /]
PUSHJ P,.TSTRG##
MOVE T1,L.QOUT ;GET THE QUOTA
PUSHJ P,.TDECW## ;AND TYPE IT
MOVEI T1,[ASCIZ / exceeded by /]
PUSHJ P,.TSTRG## ;TYPE IT
MOVE T1,L.DSTS ;GET OVERAGE
PUSHJ P,.TDECW## ;TYPE IT
MOVEI T1,[ASCIZ / blocks
/]
PUSHJ P,.TSTRG## ;FINISH IT OFF
PUSHJ P,.POP4T## ;RESTORE T1 THRU T4
POPJ P, ;AND RETURN
SUBTTL T$ULF -- Type UFD LOOKUP Failure
;CALLED WITH L.STR CONTAINING STRUCTURE NAME AND L.UUO CONTAINING
; THE LOOKUP BLOCK.
T$ULF: PUSHJ P,.PSH4T## ;SAVE T1 THRU T4
HRRZ T1,L.UUO+.RBEXT ;GET ERROR CODE
JUMPE T1,T$ULF1 ;NO UFD-->NO FILES-->UNDER QUOTA
MOVEI T1,[ASCIZ /%LGTULF /]
PUSHJ P,.TSTRG## ;TYPE IT
PUSHJ P,TYPSTR ;TYPE THE STRUCTURE NAME
MOVEI T1,[ASCIZ / UFD LOOKUP Failure /]
PUSHJ P,.TSTRG## ;TYPE IT
HRRZ T1,L.UUO+.RBEXT ;GET THE CODE
PUSHJ P,.TOCTW## ;TYPE IT
PUSHJ P,.TCRLF## ;TYPE A CRLF
T$ULF1: PUSHJ P,.POP4T## ;RESTORE T1 - T4
POPJ P, ;AND RETURN
SUBTTL T$URF -- Type UFD RENAME Failure
;CALLED WITH L.STR CONTAINING STRUCTURE NAME, AND L.UUO CONTAINING
; THE RENAME BLOCK.
T$URF: PUSHJ P,.PSH4T## ;SAVE T1-T4
HRRZ T1,L.UUO+.RBEXT ;GET ERROR CODE
SKIPN T1 ;IF ZERO
JRST T$URF1 ;JUST FORGET IT
MOVEI T1,[ASCIZ /%LGTURF /]
PUSHJ P,.TSTRG## ;TYPE THE MESSAGE HEADER
PUSHJ P,TYPSTR ;TYPE THE STRUCTURE NAME
MOVEI T1,[ASCIZ / UFD RENAME Failure /]
PUSHJ P,.TSTRG##
HRRZ T1,L.UUO+.RBEXT ;GET ERROR CODE
PUSHJ P,.TOCTW## ;TYPE IT
PUSHJ P,.TCRLF## ;TYPE A CRLF
T$URF1: PUSHJ P,.POP4T## ;RESTORE ACS
POPJ P, ;AND RETURN
SUBTTL T$ASF -- Tell about accounting failure
T$ASF: MOVE P1,T1 ;SAVE THE ERROR CODE
SKIPN L.BJOB ;IS THIS A BATCH JOB?
JRST T$ASF0 ;NO, CONTINUE
MOVEI T1,"""" ;LOAD A DOUBLE QUOTE
PUSHJ P,.TCHAR## ;TYPE IT
PUSHJ P,.TCRLF## ;AND A CRLF TO PUT JOB INTO DIALOG MODE
T$ASF0: MOVEI T1,[ASCIZ /?LGTASF Accounting System Failure
/]
PUSHJ P,.TSTRG## ;TELL HIM IN BROAD TERMS
MOVEI T1,[ASCIZ / DAEMON UUO Failed /]
PUSHJ P,.TSTRG## ;NOW BE MORE SPECIFIC
CAMN P1,[F.LEN,,F.FUN] ;DID AC CHANGE??
JRST T$ASF1 ;DO, DAEMONS NOT RUNNING
MOVEI T1,[ASCIZ /- error code /]
PUSHJ P,.TSTRG
MOVE T1,P1 ;GET THE ERROR CODE BACK
PUSHJ P,.TOCTW## ;AND TYPE IT
JRST T$ASF2 ;AND FINISH UP
T$ASF1: MOVEI T1,[ASCIZ /- DAEMON not running/]
PUSHJ P,.TSTRG##
T$ASF2: PUSHJ P,.TCRLF## ;TYPE A CRLF
SKIPE L.BJOB ;IS THIS A BATCH JOB?
JRST T$ASF5 ;YES, JUST CONTINUE
MOVE T1,F.PPN ;GET MY PPN
CAMN T1,L.FFA ;AM I OPR?
JRST T$ASF3 ;YES, CONTINUE ANYWAY
MOVE T1,L.STS ;GET THE STATES WORD
TXNE T1,ST%NRT ;SCHED 10?
JRST T$ASF4 ;YES, LET JMF THRU
MOVEI T1,[ASCIZ / Call the Operator/]
PUSHJ P,.TSTRG## ;TELL HIM WHAT HE CAN DO
PUSHJ P,.TCRLF## ;AND TYPE A CRLF
JRST DOEXIT ;AND EXIT
T$ASF3: MOVEI T1,[ASCIZ / Continuing since you are [OPR]/]
PUSHJ P,.TSTRG## ;TELL HIM THE GOOD NEWS
PUSHJ P,.TCRLF## ;AND A CRLF
JRST SUMARY ;AND GO OFF FOR SUMARY MESSAGES
T$ASF4: MOVEI T1,[ASCIZ / Continuing for system debugging/]
PUSHJ P,.TSTRG## ;TYPE IT
PUSHJ P,.TCRLF## ;AND A CRLF
JRST SUMARY ;AND GIVE SUMARY
T$ASF5: MOVEI T1,[ASCIZ / Continuing LOGOUT of Batch Job/]
PUSHJ P,.TSTRG## ;TYPE IT
PUSHJ P,.TCRLF## ;A CRLF
JRST SUMARY ;AND GIVE SUMARY MESSAGE
SUBTTL TYPSTR -- Routine to type current structure name
;TYPSTR IS CALLED TO TYPE THE CURRENT FILE-STRUCTURE NAME ON THE TTY.
; THE STRUCTURE CONTAINED IN LOCATION L.STR IS USED, AND THE
; ROUTINE TYPES OUT "STR:"
TYPSTR: MOVE T1,L.STR ;GET THE STRUCTURE NAME
PUSHJ P,.TSIXN## ;TYPE IT
PJRST .TCOLN## ;TYPE A COLON AND RETURN
SUBTTL Storage Area
XLIST ;SO LITERALS DON'T COME OUT
LIT ;FORCE OUT LITERAL POOL
LIST ;RESTORE LISTING
RELOC ;DOWN TO LOW-SEGMENT
LOWBEG: ;BEGINNING
L.PDL: BLOCK PDLSIZ ;PUSHDOWN LIST
L.CCL: BLOCK 1 ;CCL ENTRY FLAG
L.TYPE: BLOCK 1 ;LOGOUT TYPE, /F,/B
L.NWRD: BLOCK 1 ;FLAG = -1 IF /N
L.PSIB: BLOCK ^D8 ;INTERRUPT VECTOR FOR PSI
DETINB==L.PSIB ;INTERRUPT CELL OFFSET FOR DETACH
CCIINB==L.PSIB+ ;INTERRUPT CELL OFFSET FOR ^C
L.OVQT: BLOCK 1 ;OVER-QUOTA FLAG
L.UUO: BLOCK .RBTIM+1 ;LOOKUP BLOCK FOR UFDS
L.DCBK: BLOCK .DCSMT+1 ;DSKCHR BLOCK
L.TBLK: BLOCK 1 ;ACCUMULATED TOTAL # BLOCKS
L.OJCS: BLOCK 1 ;OTHER JOB CONTAINS A STRUCTURE
L.OKCC: BLOCK 1 ;-1 IF ALLOWED OUT ON ^C
;STRUCTURE INFORMATION
L.STR: BLOCK 1 ;STRUCTURE NAME
L.QOUT: BLOCK 1 ;LOGGED-OUT QUOTA FOR STR
L.USE: BLOCK 1 ;BLOCKS USED ON STR
L.DSTS: BLOCK 1 ;STATUS
L.NTMP: BLOCK 1 ;NUMBER OF TEMP FILES DELETED
;JOB INFORMATION
L.JOB: BLOCK 1 ;JOB NUMBER
L.TTY: BLOCK 1 ;TTY NAME
L.DET: BLOCK 1 ;DETACHED FLAG
L.PTY: BLOCK 1 ;FLAG =1 IF THIS IS A PTY
L.MYN1: BLOCK 1 ;FIRST HALF OF MY NAME
L.MYN2: BLOCK 1 ;SECOND HALF OF MY NAME
L.CNO: BLOCK 1 ;MY CHARGE NUMBER
L.JLT: BLOCK 1 ;JOB LOGIN TIME IN UDT FORMAT
L.PRIV: BLOCK 1 ;MY PRIVILEGES
L.JLIM: BLOCK 1 ;JOB'S .GTLIM WORD
L.BJOB: BLOCK 1 ;-1 IF A BATCH JOB
;GETTAB INFORMATION
L.MFPP: BLOCK 1 ;MFD PPN
L.STS: BLOCK 1 ;SYSTEM STATES WORD
L.TIC: BLOCK 1 ;TICKS/SECOND
L.MXJB: BLOCK 1 ;MAXIMUM JOB NUMBER
L.HJIU: BLOCK 1 ;HIEST JOB NUMBER IN USE
L.FFA: BLOCK 1 ;FULL-FILE-ACCESS PPN [OPR]
L.NOW: BLOCK 1 ;NOW IN UDT FORMAT
;FACT BLOCK
F.FUN: EXP .FACT ;DAEMON FUNCTION
F.HDR: 141000,,000007 ;ENTRY TYPE 141, 7 WORDS LONG
F.PPN: BLOCK 1 ;PPN WORD
F.DAT: BLOCK 1 ;DATE-TIME (FILLED IN BY DAEMON)
F.RTM: BLOCK 1 ;RUNTIME (IN SECS*100)
F.CTI: BLOCK 1 ;CORE-TIME INTEGRAL IN <KCS>*100
F.DRD: BLOCK 1 ;TOTAL DISK READS
F.DWT: BLOCK 1 ;TOTAL DISK WRITES
F.LEN==.-F.FUN ;LENGTH OF DAEMON BLOCK
LOWEND==.-1
PRGEND LGOUT
TITLE .LGTRC -- Recompute Disk Usage on a File-structure
SUBTTL Larry Samberg 4 Dec 74
;***Copyright (C) 1974,75, Digital Equipment Corp., Maynard MA.***
SEARCH MACTEN ;SEARCH MACRO DEFINITIONS
%%MACT==%%MACT
SEARCH UUOSYM ;SEARCH UUO SYMBOLS
SEARCH SCNMAC ;SEARCH SCAN-WILD SYMBOLS
TWOSEG ;HISEG PROGRAM
RELOC 400000 ;START IN HISEG
SALL ;SUPPRESS MACRO EXPANSIONS
;This module provides a single routine .LGTRC which will
; recompute disk usage for a specified UFD on a
; specified file-structure.
SUBTTL Accumulator Assignments
T1=1 ;T1 - T4 ARE TEMPS WHICH ARE
T2=2 ; NOT PRESERVED
T3=3
T4=4
P1=5 ;P1 - P4 MUST BE SAVED BEFORE USING
P2=6
P3=7
P4=10
P=17 ;PUSHDOWN POINTER
SUBTTL .LGTRC -- Routine to Recompute Disk Usage
;.LGTRC IS CALLED WITH A FILE-STRUCTURE NAME IN T1, A PPN IN T2
; AND THE NUMBER OF A FREE I/O CHANNEL IN T3. (CHAN 17 IS
; USED IF THE ARGUMENT IS NOT BETWEEN 1 AND 16 INCLUSIVE).
; IT RETURNS THE TOTAL NUMBER OF BLOCKS ALLOCATED ON THE
; STRUCTURE IN T1.
ENTRY .LGTRC
.LGTRC: SKIPLE T3 ;CHANNEL LE 0?
CAILE T3,17 ;OR GT 17?
MOVEI T3,17 ;YES, USE 17 AS DEFAULT
ROT T3,-^D13 ;POSITION IT IN AC FIELD
MOVEM T3,L.CHN ;AND SAVE IT
MOVX T4,<LOOKUP (T2)>;BUILD SOME UUOS
IOR T4,T3 ;OR IN THE CHANNEL FIELD
MOVEM T4,L.LKUP ;AND SAVE IT
MOVX T4,<CLOSE CL.ACS>;AND THE CLOSE UUO
IOR T4,T3 ;OR IN THE CHANNEL
MOVEM T4,L.CLS ;SAVE IT
PUSH P,T1 ;SAVE STRUCTURE NAME
PUSHJ P,.LGTSA## ;SETUP TO LOOKUP *.*
POP P,T2 ;GET STRUCTURE NAME BACK
MOVX T1,.IODMP+UU.PHS;OPEN BITS
CLEAR T3, ;NO BUFFERS
MOVE T4,[OPEN T1] ;OPEN UUO
IOR T4,L.CHN ;OR IN THE CHANNEL
XCT T4 ;AND DO IT
HALT . ;***FOR NOW
CLEARM L.TOT ;CLEAR COUNT
LGTRC1: CLEARB T1,T2 ;USE DEFAULT OPEN AND LKUP BLOCKS
PUSHJ P,.LGTLA## ;GET A FILE
JRST LGTRC2 ;DONE
XCT L.LKUP ;LOOKUP THE FILE
HALT . ;***FOR NOW
MOVE T1,.RBALC(T2) ;GET BLOCKS ALLOCATED
ADDM T1,L.TOT ;ADD TO THE TOTAL
XCT L.CLS ;CLOSE THE CHANNEL
JRST LGTRC1 ;AND LOOP
LGTRC2: MOVX T1,<RELEAS> ;GET THE UUO
IOR T1,L.CHN ;OR IN THE CHANNEL
XCT T1 ;AND DO THE UUO
MOVE T1,L.TOT ;GET THE TOTAL
POPJ P, ;AND RETURN
SUBTTL Storage Area
XLIST ;SO LITERALS DON'T COME OUT
LIT ;FORCE OUT LITERAL POOL
LIST ;RESTORE LISTING
RELOC ;DOWN TO LOW-SEGMENT
L.TOT: BLOCK 1 ;ACCUMULATED TOTAL
L.CHN: BLOCK 1 ;<CHANNEL>B12
L.LKUP: BLOCK 1 ;LOOKUP UUO
L.CLS: BLOCK 1 ;CLOSE UUO
PRGEND
TITLE .LGTBA -- Batch File Deletion Algorithm
SUBTTL Larry Samberg 3 Jul 75
;***Copyright (C) 1974,75, Digital Equipment Corp., Maynard MA.***
SEARCH MACTEN ;SEARCH MACRO DEFINITIONS
%%MACT==%%MACT
SEARCH UUOSYM ;SEARCH UUO SYMBOL DEFINITIONS
SEARCH SCNMAC ;SEARCH SCAN-WILD DEFINITIONS
TWOSEG ;HISEG PROGRAM
RELOC 400000 ;START IN HISEG
SALL ;SUPPRESS MACRO EXPANSIONS
;This module provides a deletion algorithm for
; forcing a user under his logout quota. The single entry
; point .LGTBA is called with the structure name, the
; PPN, and the logout quota for the structure. Upon
; return, the user will be under quota on that structure.
SUBTTL Accumulator Assignments
T1=1 ;T1 THRU T4 ARE TEMPS AND ARE ALSO
; USED BY WILD
T2=2
T3=3
T4=4
P1=5 ;P1 - P4 CAN BE USED, BUT MUST BE
; SAVED FIRST.
P2=6
P3=7
P4=10
P=17 ;PUSHDOWN POINTER
SUBTTL Tables
DEFINE FIRMAC,<
X TMP,777777
X TEM,777777
X SFD,777777
X BAK,777777
X Q??,770000
X MAP,777777
X CRF,777777
X LS?,777700
X LIS,777777
X LPT,777777
X PTP,777777
X PLT,777777
X CDP,777777
X Z??,770000
X FOO,777777
X LOG,777777
> ;END DEFINE FIRMAC
;NOW GENERATE THE "FIRST" TABLE
DEFINE X(A,B),<
XLIST
<SIXBIT /A/>+B
LIST
> ;END DEFINE X
FIRST: FIRMAC
FIRLEN==.-FIRST
DEFINE IMPMAC,<
X RNO
X RND
X CMD
X KBD
X CED
X MCR
X SNO
X FAI
X FOR
X F4
X MAC
X ALG
X AID
X BLI
X B10
X B11
X COB
X CBL
X BAS
X PAL
X P11
X SRC
X IDA
X IDX
X DAT
> ;END DEFINE IMPMAC
;NOW GENERATE THE "IMPORT" TABLE
DEFINE X(A),<
XLIST
SIXBIT /A/
LIST
> ;END DEFINE X
IMPORT: IMPMAC
IMPLEN==.-IMPORT
SUBTTL .LGTBA -- Entry to Deletion Algorithm
ENTRY .LGTBA
;.LGTBA IS CALLED WITH:
; T1 CONTAINING THE STRUCTURE NAME
; T2 CONTAINING THE PPN
; T3 CONTAINING THE LOGGED-OUT QUOTA
; T4 CONTAINING THE I/O CHANNEL TO USE
;
;.LGTBA RETURNS WITH:
; T1 CONTAINING THE NUMBER OF BLOCKS ALLOCATED ON THE STRUCTURE
; (AND THE STRUCTURE IS UNDER QUOTA)
.LGTBA: PUSHJ P,.SAVE4## ;SAVE THE P REGS
MOVEM T1,L.STR ;SAVE STRUCTURE NAME
MOVEM T2,L.PPN ;SAVE PPN
MOVEM T3,L.OUT ;SAVE QUOTA
LSH T4,^D23 ;PUT CHANNEL INTO AC FIELD
MOVE T1,T4 ;GET THE CHANNEL
IOR T1,[OPEN] ;MAKE AN OPEN UUO
MOVEM T1,U.OPEN ;AND SAVE IT
MOVE T1,T4 ;GET THE CHANNEL
IOR T1,[LOOKUP] ;MAKE A LOOKUP
MOVEM T1,U.LOOK ;AND SAVE IT
MOVE T1,T4 ;GET THE CHANNEL
IOR T1,[RENAME] ;MAKE A RENAME
MOVEM T1,U.RENA ;AND SAVE IT
MOVE T1,T4 ;GET THE CHANNEL
IOR T1,[CLOSE] ;MAKE A CLOSE
MOVEM T1,U.CLOSE ;AND SAVE IT
MOVE T1,T4 ;GET THE CHANNEL
IOR T1,[RELEAS] ;MAKE A RELEASE
MOVEM T1,U.RELE ;AND SAVE IT
MOVX T1,.IODMP+UU.PHS;GET IO MODE
MOVE T2,L.STR ;STRUCTURE NAME
MOVEM T1,L.OBLK ;AND SAVE IO STATUS
MOVEM T2,L.OBLK+1 ;STR NAME
CLEARM L.OBLK+2 ;NO BUFFERS
MOVE T4,U.OPEN ;GET THE OPEN UUO
IORI T4,L.OBLK ;PUT IN THE RIGHT ADDRESS
XCT T4 ;OPEN THE CHANNEL
JRST [MOVE T1,L.OUT ;THAT'S ALL WE REALLY KNOW
POPJ P,] ;AND RETURN
PUSHJ P,STEP1 ;GO TO STEP 1
MOVE T1,L.TOT ;RETURN HERE WHEN UNDER QUOTA,
; GET TOTAL BLOCKS ALLOCATED
ADD T1,L.NQC ;ADD NUMBER OF NQC FILES
XCT U.RELE ;RELEASE THE CHANNEL
POPJ P, ;AND RETURN
SUBTTL Step 1 -- Recomp and Get Large Files
;STEP 1 OF THE FILE-DELETION ALGORITHM DOES A RECOMP OF THE SPECIFIED
; UFD, AND DELETES ALL FILES WHICH ARE STRICTLY LARGER THAN THE
; LOGGED-OUT QUOTA.
STEP1:
CLEARM L.TOT ;CLEAR ACCUMULATED TOTAL
CLEARM L.NQC ;CLEAR # NQC FILES
CLEARM L.NDEL ;AND CLEAR # OF FILES DELETED
MOVE T1,L.STR ;GET STRUCTURE NAME
MOVE T2,L.PPN ;AND PPN
PUSHJ P,.LGTSA## ;SETUP TO GET *.*
STEP1A:
CLEARB T1,T2 ;USE DEFAULT OPEN-LOOKUP BLOCKS
PUSHJ P,.LGTLA## ;GET A FILE TO WORK ON
JRST STEP1C ;NO MORE FILES
XCT U.CLOSE ;CLOSE OUT THE CHANNEL
MOVE T1,U.LOOK ;GET THE LOOKUP
HRR T1,T2 ;PUT IN THE ADDRESS
XCT T1 ;AND DO IT
JRST STEP1A ;LOSE, IGNORE IT
MOVX T4,RP.NQC ;GET NQC BIT
TDNE T4,.RBSTS(T2) ;IS IT SET?
JRST STEP1D ;YES, COUNT THE FILE
MOVE T3,.RBALC(T2) ;GET BLOCKS ALLOCATED
CAMLE T3,L.OUT ;LARGER THAN QUOTA?
JRST STEP1B ;YES, DELETE IT
ADDM T3,L.TOT ;NO, ACCUMLATE THE TOTAL
JRST STEP1A ;AND LOOP
STEP1B:
MOVE T1,T2 ;GET ADDRESS OF LKP BLOCK
PUSHJ P,DELFIL ;DELETE THE FILE
JRST STEP1A ;AND LOOP
STEP1C:
MOVE T1,L.TOT ;GET TOTAL BLOCKS
CAMG T1,L.OUT ;GREATER THAN QUOTA?
POPJ P, ;NO, EXIT THE ALGORITHM
JRST STEP2 ;YES, GO ON TO STEP 2
STEP1D:
MOVE T3,.RBALC(T2) ;GET BLOCKS ALLOCATED
ADDM T3,L.NQC ;ADD TO TOTAL
JRST STEP1A ;AND LOOP AROUND
SUBTTL Step 2 -- Delete FIRST Files
;STEP 2 OF THE FILE-DELETION ALGORITHM LOOPS THRU THE 'FIRST' TABLE
; OF EXTENSIONS IN ORDER, AND FOR EACH EXTENSION, 'EXT', WE
; BEGIN DELETING ALL UNPROTECTED (<200) *.EXT UNTIL WE ARE
; UNDER QUOTA. IF WE DELETE *.EXT AND ARE STILL OVER QUOTA
; WE GO ON TO THE NEXT EXTENSION. IF WE REACH THE END OF THE
; TABLE, ON TO STEP 3.
STEP2:
MOVEI P1,FIRST ;START ADR OF TABLE
HRLI P1,-FIRLEN ;AND NEGATIVE LENGTH
STEP2A:
MOVE T3,(P1) ;GET EXT,,MASK
MOVE T1,L.STR ;GET STRUCTURE
MOVE T2,L.PPN ;AND PPN
PUSHJ P,.LGTSE## ;SETUP TO GET *.EXT
STEP2B:
CLEARB T1,T2 ;USE DEFAULT OPEN AND LKP BLKS
PUSHJ P,.LGTLA## ;GET A FIND
JRST STEP2C ;THAT'S ALL FOLKS
MOVEI T1,177 ;MAX PROTECTION
PUSHJ P,LOKFIL ;LOOKUP AND DELETE
MOVE T1,L.TOT ;GET TOTAL BLOCKS USED
CAMG T1,L.OUT ;STILL OVER QUOTA?
POPJ P, ;NO, RETURN
JRST STEP2B ;YES, LOOP
STEP2C:
AOBJN P1,STEP2A ;FINISHED THAT EXT,
; ON TO THE NEXT
JRST STEP3 ;NO NEXT EXT, ON TO STEP 3
SUBTTL STEP3 -- Get all other unIMPORTant Files
;STEP 3 DELETES ALL REMAINING UNPROTECTED FILES WHOSE EXTENSIONS DON'T
; APPEAR IN THE "IMPORT" TABLE.
STEP3:
MOVE T1,L.STR ;GET THE STRUCTURE NAME
MOVE T2,L.PPN ;AND THE PPN
PUSHJ P,.LGTSA## ;SETUP TO READ ABSOLUTELY EVERYTHING
STEP3A:
CLEARB T1,T2 ;USE DEFAULT BLOCKS
PUSHJ P,.LGTLA## ;GET A FILE TO LOOKUP
JRST STEP4 ;NO MORE, ON TO STEP 4
MOVE P1,[-IMPLEN,,IMPORT] ;POINT TO IMPORT TABLE
HLLZ T3,.RBEXT(T2) ;GET THE EXTENSION OF THE FILE
STEP3B:
CAMN T3,(P1) ;MATCH???
JRST STEP3A ;YES, IT'S IMPORTANT, SKIP IT
AOBJN P1,STEP3B ;NO, KEEP LOOPING
STEP3C:
MOVEI T1,177 ;MAX PROTECTION
PUSHJ P,LOKFIL ;AND LOOKUP AND DELETE
MOVE T1,L.TOT ;GET THE TOTAL
CAMG T1,L.OUT ;STILL OVER QUOTA?
POPJ P, ;NO, DONE!!
JRST STEP3A ;YES, KEEP GOING
SUBTTL STEP4 -- Get rest of FIRST files
;STEP FOUR OF THE FILE-DELETION ALGORITHM DELETES ALL REMAINING
; FILES WHOSE EXTENSION IS IN THE "FIRST" TABLE. THE TABLE
; IS, AS IN STEP 2, SCANNED IN ORDER AND THE ALGORITHM STOPS
; AS SOON AS WE ARE UNDER QUOTA.
STEP4:
MOVEI P1,FIRST ;START ADR OF TABLE
HRLI P1,-FIRLEN ;AND NEGATIVE LENGTH
STEP4A:
MOVE T3,(P1) ;GET EXT,,MASK
MOVE T1,L.STR ;GET STRUCTURE
MOVE T2,L.PPN ;AND PPN
PUSHJ P,.LGTSE## ;SETUP TO GET *.EXT
STEP4B:
CLEARB T1,T2 ;USE DEFAULT OPEN AND LKP BLKS
PUSHJ P,.LGTLA## ;GET A FIND
JRST STEP4C ;THAT'S ALL FOLKS
MOVEI T1,1000 ;SUPER MAX
PUSHJ P,LOKFIL ;LOOKUP AND DELETE
MOVE T1,L.TOT ;GET TOTAL BLOCKS USED
CAMG T1,L.OUT ;STILL OVER QUOTA?
POPJ P, ;NO, RETURN
JRST STEP4B ;YES, LOOP
STEP4C:
AOBJN P1,STEP4A ;FINISHED THAT EXT,
; ON TO THE NEXT
JRST STEP5 ;NO NEXT EXT, ON TO STEP 5
SUBTTL STEP 5 -- Get unprotected IMPORTANT Files
;STEP FIVE DELETES ALL FILES WHOSE EXTENSIONS APPEAR IN
; THE "IMPORT" TABLE WHICH ARE UNPROTECTED.
STEP5:
MOVEI P1,IMPORT ;START ADR OF TABLE
HRLI P1,-IMPLEN ;AND NEGATIVE LENGTH
STEP5A:
HLLO T3,(P1) ;GET EXT,,MASK
MOVE T1,L.STR ;GET STRUCTURE
MOVE T2,L.PPN ;AND PPN
PUSHJ P,.LGTSE## ;SETUP TO GET *.EXT
STEP5B:
CLEARB T1,T2 ;USE DEFAULT OPEN AND LKP BLKS
PUSHJ P,.LGTLA## ;GET A FIND
JRST STEP5C ;THAT'S ALL FOLKS
MOVEI T1,177 ;MAX PROTECTION
PUSHJ P,LOKFIL ;LOOKUP AND DELETE
MOVE T1,L.TOT ;GET TOTAL BLOCKS USED
CAMG T1,L.OUT ;STILL OVER QUOTA?
POPJ P, ;NO, RETURN
JRST STEP5B ;YES, LOOP
STEP5C:
AOBJN P1,STEP5A ;FINISHED THAT EXT,
; ON TO THE NEXT
JRST STEP6 ;NO NEXT EXT, ON TO STEP 6
SUBTTL STEP6 -- Get rest of unIMPORTant files
;STEP 6 IS SIMILAR TO STEP 3 IN THAT IT GETS FILES WHOSE EXTENSIONS
; DON'T APPEAR IN THE "IMPORT" TABLE, EXCEPT THAT NOW IT
; IGNORES THE PROTECTION AND JUST DELETES THE FILE.
STEP6:
MOVE T1,L.STR ;GET THE STRUCTURE NAME
MOVE T2,L.PPN ;AND THE PPN
PUSHJ P,.LGTSA## ;SETUP TO READ ABSOLUTELY EVERYTHING
STEP6A:
CLEARB T1,T2 ;USE DEFAULT BLOCKS
PUSHJ P,.LGTLA## ;GET A FILE TO LOOKUP
JRST STEP7 ;NO MORE, ON TO STEP 4
MOVE P1,[-IMPLEN,,IMPORT] ;POINT TO IMPORT TABLE
HLLZ T3,.RBEXT(T2) ;GET THE EXTENSION OF THE FILE
STEP6B:
CAMN T3,(P1) ;MATCH???
JRST STEP6A ;YES, IT'S IMPORTANT, SKIP IT
AOBJN P1,STEP6B ;NO, KEEP LOOPING
STEP6C:
MOVEI T1,1000 ;SUPER MAX PROTECTION
PUSHJ P,LOKFIL ;LOOKUP IT AND DELETE
MOVE T1,L.TOT ;GET THE TOTAL
CAMG T1,L.OUT ;STILL OVER QUOTA?
POPJ P, ;NO, DONE!!
JRST STEP6A ;YES, KEEP GOING
SUBTTL STEP 7 -- Give Up
;STEP 7 SIMPLY DELETES EVERYTHING
STEP7:
MOVE T1,L.STR ;GET STRUCTURE NAME
MOVE T2,L.PPN ;GET THE PPN
PUSHJ P,.LGTSA## ;SETUP TO GET EVERYTHING
STEP7A:
CLEARB T1,T2 ;USE DEFAULT BLOCKS
PUSHJ P,.LGTLA ;GET A FILE
POPJ P, ;WE'RE DONE...
MOVEI T1,1000 ;GET THEM ALL!!!
PUSHJ P,LOKFIL ;LOOKUP AND DELETE
MOVE T1,L.TOT ;GET TOTAL
CAMG T1,L.OUT ;DONE YET?
POPJ P, ;YES, RETURN
JRST STEP7A ;NO, LOOP
SUBTTL LOKFIL -- Routine to LOOKUP a file
;LOKFIL IS CALLED WITH T1 CONTAINING A PROTECTION, AND T2 CONTAINING
; THE ADDRESS OF A LOOKUP BLOCK. THE FILE IS LOOK-ED UP, AND
; IF THE PROTECTION IS .LE. THAN THE PROTECTION SPECIFIED
; BY THE USER IN T1, THE FILE IS DELETED, AND ALL COUNTS
; ARE UPDATED.
;
;IF THE FILE IS ANY SFD, TRY TO DELETE IT IN ANY CASE
LOKFIL: XCT U.CLOSE ;CLOSE OUT THE CHANNEL
MOVE T3,U.LOOK ;GET THE LOOKUP UUO
HRR T3,T2 ;OR IN THE ADDRESS
XCT T3 ;AND DO THE LOOKUP
POPJ P, ;FAILED, FORGET IT
MOVX T4,RP.NQC ;GET NQC BIT
TDNE T4,.RBSTS(T2) ;IS IT AN NQC FILE?
POPJ P, ;YES, IGNORE IT
HLRZ T3,.RBEXT(T2) ;GET THE FILE EXTENSION
MOVEI T4,0 ;LOAD A SMALL PROTECTION
CAIE T3,'SFD' ;SKIP IF ITS AN SFD
LDB T4,[POINT 9,.RBPRV(T2),8] ;GET THE PROTECTION
CAMLE T4,T1 ;IS IT LESS?
POPJ P, ;YES, JUST RETURN
MOVN T3,.RBALC(T2) ;NO, GET RIBALC
ADDM T3,L.TOT ;AND DECREMENT TOTAL
MOVE T1,T2 ;GET ADR OF LOOKUP BLOCK
PUSHJ P,DELFIL ;DELETE THE FILE
POPJ P, ;AND RETURN
SUBTTL DELFIL -- Routine to DELETE a file
;DELFIL IS CALLED WITH T1 CONTAINING THE ADDRESS OF THE LOOKUP BLOCK.
; A MESSAGE IS TYPED AND THE FILE (WHICH IS ASSUMED TO BE
; LOOK'ED UP) IS DELETED.
DELFIL: PUSHJ P,.SAVE1## ;SAVE P1
MOVEM T1,L.DBLK ;SAVE THE ARGUMENT
SKIPE L.NDEL ;DID WE DELETE ANY ALREADY?
JRST DELF.1 ;YES, SKIP THE EXTRA MESSAGE
MOVEI T1,[ASCIZ /Files deleted:
/]
PUSHJ P,.TSTRG## ;NO, TYPE THE MESSAGE
DELF.1: CLEARB T1,T2 ;CLEAR A RENAME BLOCK
CLEARB T3,T4 ; " "
MOVE P1,U.RENA ;GET A RENAME UUO
IORI P1,T1 ;PUT IN ADDRESS FIELD
XCT P1 ;AND DO IT
JRST DELF.2 ;FAILED?
AOS L.NDEL ;ANOTHER ONE DELETED
MOVEI T1,[ASCIZ / /] ;LOAD SOME SPACES
PUSHJ P,.TSTRG## ;AND TYPE THEM
MOVEI T1,L.OBLK ;GET ADR OF OPEN BLOCK
MOVE T2,L.DBLK ;GET ADR OF LKP BLOCK
PUSHJ P,.TOLEB## ;TYPE A FILESPEC
MOVEI T1,[ASCIZ / /] ;LOAD SEVEN SPACES
PUSHJ P,.TSTRG## ;TO LINE UP TAB STOPS
PUSHJ P,.TTABC## ;A TAB
MOVE P1,L.DBLK ;GET ADDRESS OF LOOKUP BLOCK
MOVE T1,.RBALC(P1) ;GET BLOCKS ALLOCATED
PUSHJ P,.TDECW## ;TYPE IT
MOVEI T1,[ASCIZ / blocks freed/]
PUSHJ P,.TSTRG## ;AND TYPE IT
PJRST .TCRLF## ;AND A CRLF AND RETURN
DELF.2: MOVE T1,L.DBLK ;GET ADDRESS OF LOOKUP BLOCK
MOVE T1,.RBALC(T1) ;GET BLOCKS ALLOCATED
ADDM T1,L.TOT ;ADD BACK IN
HRRZS T2 ;GET ONLY THE ERROR CODE IN T2
CAIE T2,ERPRT% ;IS IT PROTECTION FAILURE?
ADDM T1,L.OUT ;NO, MAKE HIS QUOTA BIGGER (SORT OF)
POPJ P, ;AND RETURN
SUBTTL Storage Area
XLIST ;SO LITERALS DON'T COME OUT
LIT ;FORCE OUT LITERALS
LIST ;RESTORE THE LISTING
RELOC ;DOWN TO LOWSEG
L.STR: BLOCK 1 ;THE STRUCTURE
L.PPN: BLOCK 1 ;THE PPN
L.OUT: BLOCK 1 ;THE QUOTA
L.TOT: BLOCK 1 ;ACCUMULATED TOTAL BLOCKS ALLOCATED
L.NQC: BLOCK 1 ;ACCUMULATED TOT BLKS ALLOC TO NQC FILES
L.NDEL: BLOCK 1 ;NUMBER OF FILES DELETED
L.DBLK: BLOCK 4 ;RENAME BLOCK
L.OBLK: BLOCK 3 ;OPEN BLOCK
;UUOS TO EXECUTE
U.OPEN: BLOCK 1 ;OPEN UUO
U.CLOS: BLOCK 1 ;CLOSE UUO
U.RELE: BLOCK 1 ;RELEASE UUO
U.LOOK: BLOCK 1 ;LOOKUP UUO
U.RENA: BLOCK 1 ;RENAME UUO
PRGEND
TITLE .LGTSA -- LOOKUP All Files in UFD Order
SUBTTL Larry Samberg 15 Jan 75
;***Copyright (C) 1974, Digital Equipment Corp., Maynard, MA.***
SEARCH MACTEN ;SEARCH MACRO DEFINITIONS
%%MACT==%%MACT
SEARCH UUOSYM ;SEARCH UUO SYMBOL DEFINITIONS
SEARCH SCNMAC ;SEARCH SCAN-WILD DEFINITIONS
TWOSEG ;HISEG PROGRAM
RELOC 400000 ;START IN HISEG
SALL ;SUPPRESS MACRO EXPANSIONS
;This module, .LGTSA, provides a pair of routines, .LGTSA
; and .LGTLA which are used to LOOKUP all files in
; a particular UFD on a particular file-structure
; in UFD order.
;.LGTSA is called first with the PPN and file-structure name
; to setup the world. Then, .LGTLA is called to return
; the name of each file in the specified UFD.
;In addition, a routine .LGTSE is provided to read *.EXT
; for some extension provided as an argument.
SUBTTL Accumulator Assignments
T1=1 ;T1 THRU T4 ARE TEMPS AND ARE
T2=2 ; ALSO USED BY WILD
T3=3
T4=4
P1=5 ;P1 - P4 CAN BE USED, BUT MUST BE
P2=6 ; SAVE FIRST
P3=7
P4=10
P=17 ;PUSHDOWN POINTER
SUBTTL .LGTSA -- Setup to LOOKUP STR:*.*[,,*,*,*,*,*]
;.LGTSA IS CALLED TO SETUP A WILD BLOCK TO LOOKUP EVERY FILE ON A
; STRUCTURE. CALL WITH THE STRUCTURE NAME IN T1, AND PPN IN T2.
; USES T1,T2,T3,T4.
;THIS ROUTINE WAS ORIGINALLY WRITTEN BY DON LEWINE FOR LOGIN VERSION
; 55. MY THANKS TO HIM FOR SUPPLYING IT FULLY DEBUGGED./LSS
ENTRY .LGTSA
.LGTSA: MOVE T3,[WILDBK,,WILDBK+1] ;BLT POINTER TO WILD BLOCK
CLEARM WILDBK ;CLEAR THE FIRST WORD
BLT T3,WILDBK+.FXLEN-1 ;AND CLEAR THE REST
MOVEM T1,WILDBK+.FXDEV ;SAVE THE STRUCTURE
MOVEM T2,WILDBK+.FXDIR ;SAVE THE PPN
SETOM WILDBK+.FXDIM ;AND SET DIRECTORY MASK
MOVX T1,FX.DIR!FX.PHY!FX.NOM!FX.PRT
MOVEM T1,WILDBK+.FXMOD ;STORE ALL THE STATUS BITS
TXO T1,FX.STR ;SET ANOTHER BIT
MOVEM T1,WILDBK+.FXMOM ;AND THE MASK FOR THE MOD WORD
MOVSI T1,'* ' ;CLASSICAL WILDCARD
MOVEM T1,WILDBK+.FXNAM ;STORE AS FILENAME
MOVEM T1,WILDBK+.FXEXT ; EXTENSION
MOVEM T1,WILDBK+.FXDIR+2 ; 1ST SFD
MOVEM T1,WILDBK+.FXDIR+4 ; 2ND SFD
MOVEM T1,WILDBK+.FXDIR+6 ; 3RD SFD
MOVEM T1,WILDBK+.FXDIR+10 ; 4TH SFD
MOVEM T1,WILDBK+.FXDIR+12 ; 5TH SFD
SETOM WILDBK+.FXBFR ;NO /BEFORE
SETOM WILDBK+.FXSNC ;NO /SINCE
SETZM WILDPT ;WILD'S POINTER
POPJ P, ;RETURN
SUBTTL .LGTSE -- Setup to read *.EXT[*,*,*,*,*]
;.LGTSE IS CALLED SIMILARLY TO THE WAY .LGTSA IS CALLED, WITH T1
; CONTAINING THE STRUCTURE NAME AND T2 CONTAINING THE PPN.
; IN ADDITION T3 CONTAINS 'EXT,,MASK'.
ENTRY .LGTSE
.LGTSE: PUSH P,T3 ;SAVE EXT,,MASK
PUSHJ P,.LGTSA ;SETUP TO READ *.*
POP P,WILDBK+.FXEXT ;STORE EXT,,MASK
POPJ P, ;AND RETURN
SUBTTL .LGTLA -- Routine to call .LKWLD
;.LGTLA IS CALLED WITH T1 CONTAINING THE ADDRESS OF AN OPEN BLOCK,
; AND T2 CONTAIN XWD SIZE,,ADR WHERE ADR IS THE ADDRESS OF A
; LOOKUP BLOCK, AND SIZE IS THE LENGTH OF THE BLOCK - 1
; (I.E. THE NUMBER OF RIB WORDS DESIRED). IF ANY OF THESE
; FIELDS ARE ZERO UPON CALLING .LGTLA, IT IS FILLED IN WITH
; DEFAULT PARAMETERS. .LGTLA ALL CALLS .LKWLD TO SETUP
; THE LOOKUP AND OPEN BLOCK FOR THE NEXT FILE (.LGTSA SHOULD
; BE CALLED TO SET EVERYTHING UP BEFORE THE FIRST CALL).
; RETURNS T1 AND T2 UNCHANGED (WITH MISSING FIELDS FILLED).
; SKIP RETURN WITH NEXT FILE, NON-SKIP IF NO MORE FILES.
INTERN .LGTLA
.LGTLA: SKIPN T1 ;DID HE SPEC AN OPEN BLOCK
MOVEI T1,OPENBK ;NO, DEFAULT ONE
TRNN T2,-1 ;DID HE SPECIFY A LOOKUP BLOCK?
HRRI T2,LKUPBK ;NO, USE DEFAULT
TLNN T2,-1 ;AND SIZE?
HRLI T2,.RBTIM ;DEFAULT
PUSHJ P,.PSH4T## ;SAVE T1 - T4
HRRM T2,WLDARG+1 ;SAVE LOOKUP BLOCK ADR
HRLM T1,WLDARG+1 ;SAVE OPEN BLOCK ADR
AOBJN T2,.+1 ;INCREMENT SIZE HALF
HLRZM T2,WLDARG+2 ;SAVE RIBCNT+2
HRRI T2,.FXLEN ;AND LOAD LEN OF WILD BLOCK
MOVSM T2,WLDARG+2 ;AND SAVE THEM SWAPPED
MOVEI T1,WILDPT ;GET ADR OF POINTER WORD
MOVEM T1,WLDARG+3 ;STORE IT
MOVSI T1,[WILDBK] ;ADR(ADR(WILDBJ))
MOVEM T1,WLDARG ;SAVE IT
MOVE T1,[4,,WLDARG] ;ARG POINTER
PUSHJ P,.LKWLD## ;CALL WILD
JRST LOKA.1 ;NO MORE!!
PUSHJ P,.POP4T## ;RESTORE T1-T4
PJRST .POPJ1## ;AND SKIP MORE
LOKA.1: PUSHJ P,.POP4T## ;RESTORE T1-T4
POPJ P, ;AND RETURN
SUBTTL Storage Area
XLIST ;SO LITERALS DON'T COME OUT
LIT ;FORCE OUT LITERAL POOL
LIST ;RESTORE LISTING
RELOC ;DOWN TO LOW-SEGMENT
WILDBK: BLOCK .FXDIR+14 ;WILD BLOCK
WILDPT: BLOCK 1 ;WILD POINTER
OPENBK: BLOCK 3 ;DEFAULT OPEN BLOCK
LKUPBK: BLOCK .RBTIM+1 ;DEFAULT LOOKUP BLOCK
WLDARG: BLOCK 4 ;ARGBLOCK FOR WILD
END