Trailing-Edge
-
PDP-10 Archives
-
tops10_703a_sys_ap115_bb-ju01b-bb
-
logout.x14
There are 3 other files named logout.x14 in the archive. Click here to see a list.
TITLE LOGOUT New LOGOUT for GALAXY-10 Systems
SUBTTL Larry Samberg/LSS/KPY/WCL/DPM/JAD 2-Dec-85
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION
;1975,1976,1977,1978,1979,1980,1981,1982,1984,1985,1986.
;ALL RIGHTS RESERVED.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH JOBDAT,MACTEN,UUOSYM,SCNMAC,UFDPRM
%%JOBD==%%JOBD
%%MACT==%%MACT
%%UUOS==%%UUOS
%%SCNM==%%SCNM
%%UFDS==%%UFDS
.REQUE REL:WILD ;LEVEL-D DISK ROUTINES
.REQUE REL:SCAN ;GET .TOUTS FROM SCAN
.REQUE REL:HELPER ;DECSYSTEM-10 HELP TEXT TYPER
.REQUE REL:UFDSET ;UFD MANIPULATION ROUTINES
;VERSION INFORMATION
LGTVER==103 ;MAJOR VERSION
LGTMIN==0 ;MINOR VERSION
LGTEDT==2113 ;EDIT LEVEL
LGTWHO==0 ;WHO LAST PATCHED
%LGT==<VRSN. (LGT)>
LOC .JBVER
EXP %LGT
TWOSEG ;HISEG PROGRAM
RELOC 400000 ;START IN HISEG
COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1975,1986. ALL RIGHTS RESERVED.
\;END COPYRIGHT MACRO
SALL ;SUPPRESS MACRO EXPANSIONS
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.
;2030 IF LOOKUP AT LGTRC1+3 FAILS, DON'T HALT. SET T1 TO ZERO.
;2031 IN DEFINITION OF FIRMAC (IN .LGTBA) "X LS?,777700" DELETES LISP
; SOURCE FILES (*.LSP FILES.) CHANGE TO DELETE ALL *.LSD, *.LSQ AND
; *.LST FILES.
;2032 MAKE CCIINB POINT TO L.PSIB+4, NOT L.PSIB SINCE DETINB POINTS THERE.
;2033 WHEN AN ATTACH OR A DETACH IS TRAPPED AT PSIDET, DO A CLRBFO TO
; CLEAR THE OUTPUT BUFFER TO AVOID GETTING STUCK IN TO STATE.
;2034 MAKE IT IGNORE ANY CHARACTERS TO THE RIGHT OF A SEMICOLON
; (COMMENTS)
;2035 COMPLETE EDIT 2034 BY ALLOWING COMMENTS TO BEGIN WITH "!"
;2036 SPR # 10-25857 WCL 13-Jul-78
; Change EXP initialization of F.FUN and F.HDR to BLOCK's
;2037 SPR 10-26842 KPY 18-OCT-78
; DO A CLRBFI (2017) FOR PTYs ALSO
;2040 SPR 10-26925 KPY 6-NOV-78
; IF LOGOUT IS RUN WITHOUT PRIVILEGES, ISSUE AN ERROR MESSAGE
; AND EXIT (DOES NOT APPLY TO BATCH AND DETACHED JOBS)
;2041 SPR 10-26900 KPY 7-NOV-78
; USE L.NOW WHEN REPORTING SUMMARY TO BE CONSISTANT WITH DATE/TIME
; REPORTED IN FACT FILE
;
;2042 Check for a job having eternal ENQ. locks set and exit (if a
; timesharing user) or detach job (if a Batch user).
;
;2043 Add a call to CLRLOK at T$OUF so the UFD interlock is cleared
; before exit if OPEN UUO fails due to funny space full condition.
;
;2044 Report other users logged in like LOGIN does.
;
;2045 Edit 2042 attempted to detach a Batch job if there were any
; outstanding eternal ENQ. locks. It was a bad idea. Hang the
; Batch stream instead.
;
;2046 Add a flag (F.FLAG) to determine if FACT file entries should be
; made. This is in preparation for converting to USAGE accounting.
; *** Note ***
; FACT file code will be removed once USAGE accounting is fully
; implemented.
;
;2047 Attempt to fix the problem of not deleting all files that should be
; deleted when KJOB/BATCH is typed.
;
;2050 (SPR 10-29858 / RKB / 26-Aug-80) Add the DBS filename extension
; to the IMPORT table.
;
;2051 Add some more extensions: R16, R36, and PAS.
;
;2052 Remove edit 2047 since it didn't work right. To correctly fix the
; the problem, WILD need some work.
;
;2053 Clear any time limit so that batch jobs won't die in the middle of
; logging out.
;
;2054 Make debugging easier. Don't check for JACCT privs. Don't delete TMPCORr
; files. Don't empty search list. Allow control-C to do their thing.
;
;2055 Incorporate missing HOSS edit #2042 that defines WLDARG scan block
; length correctly.
;
;2056 Incorporate missing HOSS edit #2051 that added the INI extension to the
; list of 'important' files.
;
;2057 In the batch deletion algorithm, delete zero block files first.
;
;2060 Clear the time limit after command scanning is done so a batch user
; can't type KJOB/HELP to give himself infinite time and continue his
; job. Remove the 10 line-feeds following the summary text so that
; any tape statistics that get reported when jobs logout will appear
; close to the summary text.
;
;2061 Don't type "Files deleted:" before the RENAME UUO is attempted. If
; it fails, print a warning.
;
;2062 If we can't log the guy out and there's no operator on duty, don't
; tell him to call the operator.
;
;2063 If RESCAN fails and the job is a batch job, we might have been invoked
; by a forced KJOB command, so default to /BATCH.
;
;2064 A few more extensions for the FIRMAC and IMPMAC macros.
;
;2065 Make statistics typed by LOGOUT match those produced by the ACTDAE.
;
;2066 Always type flag LGTLQE errors with a question mark. BATCON
; doesn't depend on getting the %. BATCON %105(5000) needs this
; for KSYS processing.
;
;2067 Change DELTMP to use a FILOP. delete so FILDAE protected files get
; handled in the proper fashion.
;
; Start version 103 for 7.03
;
;2100 Turn off FACT file support by removing code.
;
;2101 Add SCAN switch scanning to get SWITCH.INI support.
;
;2102 Add the /HANGUP switch to hang up dataset lines. Useful for
; MICOM lines and other dataset look-a-likes.
;
;2103 Change the name of /HANGUP to /DISCONNECT, since this function
; works for all types of lines (DATASET, NRT, LAT, etc.).
;
;2104 Make NRT, CTERM, and LAT lines automatically disconnect by default.
; Set path to [,] just after deleting TMP files to insure SFDs
; may be deleted.
;
;2105 Do copyrights.
;
;2106 Add missing angle brackets in DISC macro definition to cause more
; than one entry in DISTAB to be built.
;
;2107 Massive clean-up, revise to use UFDSET.
;
;2110 Move call to GTTABS above call to .ISCAN to prevent jobs from
; getting logged-in under [0,0] if user types bad guide word or
; makes a similar .SCAN syntax error.
;
;2111 Inform LOGOUT it can be run without the user having been logged
; in previously (see MCO 12640). Key off the job's logged-in time
; being zero to decide whether to perform full LOGOUT functions.
; Use new TRMOP. function .TODNT to disconnect terminal (.TODSF
; has reverted to 7.02 functionality). Still do .TODSF, but add
; .TODNT after .TODSF.
;
;2112 Add "BYE" command to always force a DISCONNECT.
;
;2113 Zero TMPCOR before romping through the delete code.
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.
;2107 CHANGE LOGOUT TO USE UFDSET SO ALL UFD MANIPULATORS ARE
; CONSISTENT (LOGIN, LOGOUT, PULSAR).
;2111 KJOB/DISCONNECT IS A GREAT IDEA BUT ONLY WORKS IF THE JOB
; WAS LOGGED IN WHEN THE COMMAND WAS TYPED. CHANGE THE MONITOR
; SO IT ALWAYS INVOKES LOGOUT ON A "KJOB" COMMAND SO LOGOUT CAN
; LET USERS TYPE "KJOB/D" WHEN NOT LOGGED IN.
SUBTTL Debugging patch for the monitor
;THIS PATCH WILL ALLOW YOU TO DEBUG LOGOUT UNDER NORMAL TIMESHARING.
;THE PATCH IS EXECUTED VIA FILDDT AND CAUSES YOUR TERMINAL TO RUN
;LOGOUT FROM HAKSTR/HAKPPN WHILE ALL OTHER TERMINALS USE SYSPPN.
;NOTE THAT THE "$" ARE DOLLAR SIGNS. BEFORE EDITTING THIS PATCH OUT
;AND APPLYING WITH FILDDT, CHANGE THE DOLLAR SIGNS TO ESCAPES.
;THIS PATCH HAS BEEN TESTED UNDER THE 7.03 MONITOR. IT WILL NOT WORK
;WITH PREVIOUS MONITORS.
REPEAT 0,<
PATCH/HAKPPN:10,,56
HAKSTR:$"/DSKB/
LOGLDB:-1
LOGHAK:PUSHJ P,. 2
JRST MSTART
CAME U,LOGLDB
POPJ P,
PUSHJ P,SAVE1
MOVE P1,SGANAM+.JDAT
CAME P1,LGONAM
POPJ P,
MOVE P1,HAKSTR
MOVEM P1,SGADEV+.JDAT
MOVE P1,HAKPPN
MOVEM P1,SGAPPN+.JDAT
POPJ P,
COMCON$:
SGSET9-FTMP/JRST LOGHAK
GJOB2 5/JFCL
.CPJOB[$Q<JOBNOX:
TTYTAB JOBNOX[
$Q DDBLDB[$Q<LDB:
LOGLDB/LDB
>>>; END REPEAT 0
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
N==P3 ;WORD SCANNING RESULT
P4=10
C==P4 ;CHARACTER SCANNING RESULT
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 UFDSEC,^D5*^D60 ;SECONDS TO WAIT FOR UFD INTERLOCK
ND MAXFS,^D36 ;MAXIMUM NUMBER OF FILE STRUCTURES
ND TEMPSW,0
; MACRO TO DEFINE APC CODES FOR LINES WHICH WILL GET AUTOMATICALLY
; DISCONNECTED.
IFNDEF DISC,<
DEFINE DISC,<
X (<NRT,CTM,LAT>) ;;NRT, CTERM, LAT
> ;END DEFINE DISC
> ;END IFNDEF DISC
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]
SETZM LOWBEG ;CLEAR FIRST WORD OF STORAGE AREA
BLT T2,LOWEND ;CLEAR THE REST OF THE STORAGE AREA
MOVEM T1,L.CCL ;SAVE CCL GLAG
PUSHJ P,GTTABS ;FILL IN ALL THE GETTABS
MOVE T1,ISCPTR ;POINT TO ARGUMENT BLOCK
PUSHJ P,.ISCAN## ;FIRE UP SCAN
CAIL T1,0 ;IF A KNOWN COMMAND (.GT. 0)
ADDI T1,1 ; THEN OFFSET INDEX TO MATCH LGTN NAMES
MOVEM T1,L.CMD ;REMEMBER INVOKING COMMAND (IF ANY)
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
SETZ 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
SETZ 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
SKIPE .JBDDT ;DEBUGGING ?
JRST LSCAN ;YES--SKIP PRIV CHECKS
PJOB T1, ;GET JOB NUMBER
MOVNS T1 ;NEGATE SAME
JOBSTS T1, ;GET JOB STATUS
JRST LSCAN ;ERROR--ASSUME OK
TXNE T1,JB.UJC ;GET JOB'S PRIVS
JRST LSCAN ;HAS PRIVS--OK
SKIPN L.DET ;IF WE ARE DETACHED
SKIPE L.BJOB ;OR A BATCH JOB
JRST LSCAN ;THEN OK
MOVX T1,'LGTLNP' ;GET ERROR TYPE
MOVE T2,["?",,[ASCIZ /LOGOUT not running with privileges/]]
PUSHJ P,.ERMSG## ;TYPE MESSAGE
PUSHJ P,.TCRLF## ;TYPE A CRLF
CLRBFI ;AND CLEAR TYPE AHEAD
JRST DOEXIT ;AND EXIT
SUBTTL Scan KJOB Command Line
LSCAN: SETOM L.TYPE ;INITIALIZE
SETOM L.DISC ; SWITCH
SETOM L.NWRD ; STORAGE
SETOM L.TEMP ; ....
SKIPN T1,L.CCL ;GET CCL FLAG
SKPINL ;ANYTHING THERE?
JUMPE T1,FRCKJB ;MIGHT BE A FORCED KJOB COMMAND IF L.CCL = 0
MOVE T1,PSCPTR ;POINT TO .PSCAN BLOCK
LSCAN1: PUSHJ P,.PSCAN## ;GO SET UP FOR PARTIAL SCAN
JRST DOEXIT ;SCAN RECURSION
PUSHJ P,.TIAUC## ;GET A CHARACTER
LSCAN2: CAIN C," " ;A SPACE?
PUSHJ P,.TIAUC## ;YES--GET A REAL CHARACTER
CAIN C,"@" ;INDIRECT COMMAND FILESPEC ON THE WAY?
JRST LSCAN3 ;YES
CAIE C,"/" ;SWITCH COMING?
JRST SCDONE ;DONE WITH COMMAND SCAN
PUSHJ P,.KEYWD## ;YES--ASK SCAN TO PROCESS
JRST LSCAN4 ;ERROR IF NO SWITCH
JUMPG C,LSCAN2 ;LOOP UNLESS AT EOL
JRST SCDONE ;DONE WITH COMMAND SCAN
LSCAN3: PUSHJ P,.GTIND## ;GET FILESPEC
JUMPLE C,LSCAN1 ;LOOP IF EOL
JRST SCDONE ;ELSE FINISH UP
LSCAN4: MOVE T1,['LGTNSS'] ;GET PREFIX
MOVE T2,["?",,[ASCIZ /No switch specified/]]
PUSHJ P,.ERMSG## ;ISSUE MESSAGE
PUSHJ P,.TCRLF## ;AN EXTRA NEW LINE
SKIPN L.BJOB ;BATCH JOB?
JRST DOEXIT ;GIVE UP
FRCKJB: SKIPN L.BJOB ;A BATCH JOB?
SKIPA T1,[LTYPEF] ;NO - MAKE IT /FAST
MOVEI T1,LTYPEB ;ASSUME /BATCH
MOVEM T1,L.TYPE ;STORE IT
MOVE C,[.CHEOL] ;SAY WE'RE AT END OF LINE
JRST SCDONE ;ONWARD
;HERE WHEN DONE DOING THE SCAN
SCDONE: SKIPLE C ;ALL PARSE OK?
PJRST E.ILSC## ;JUNK ON LINE
MOVE T1,OSCPTR ;POINT TO SCAN ARGUMENT BLOCK
PUSHJ P,.OSCAN## ;APPLY SWITCH.INI DEFAULTS
MOVEI T1,LTYPEF ;ASSUME A TIMESHARING USER
SKIPE L.BJOB ;BATCH JOB?
SKIPA T1,[LTYPEB] ;YES
SKIPGE L.TYPE ;NEED TO DEFAULT SWITCH?
MOVEM T1,L.TYPE ;YES
HRLZI T1,.STTLM ;T1:= FUNCTION CODE,,ZERO TIME LIMIT
SETUUO T1, ;CLEAR IT
SKIPA ;CAN'T
JRST SCDO.1 ;CONTINUE
MOVX T1,'LGTCCT' ;GET PREFIX
MOVE T2,["%",,[ASCIZ |Can't clear time limit|]]
PUSHJ P,.ERMSG## ;TYPE IT
PUSHJ P,.TCRLF## ;TYPE A CRLF
SCDO.1: 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
SETO T1, ;SET FOR OUR LINE
GETLCH T1 ;GET ITS CHARACTERISTICS
TXNE T1,GL.ITY ;IF HE IS ON A PTY
CLRBFI ; THEN CLEAR TYPE-AHEAD
SETZM L.OKCC ;NO MORE ^C ALLOWED
SKIPE L.EQJ ;JOB HAVE ANY ETERNAL ENQ. LOCKS ?
JRST T$ENQ ;YES - CAN'T LOG JOB OUT
SKIPN L.JLT ;WAS JOB EVER LOGGED IN?
JRST SUMARX ;NO, SKIP QUOTA CHECKING
SKIPE L.NWRD ;DON'T TYPE MESSAGE ON /N
OTHUSR T1, ;OTHER USERS SAME PPN?
JRST CHKQTA ;NO, CONTINUE ON
PUSHJ P,T$USR ;YES - GO REPORT OTHER USERS
JRST CHKQTA ;AND GO CHECK QUOTAS
SUBTTL Main Quota Checking Loop
CHKQTA: SETZM L.OVQT ;CLEAR THE OVER-QUOTA FLAG
MOVE T1,[.TCRDD,,T2] ;SET UP UUO AC
SETZB T2,T3 ;NO BUFFER
SKIPN .JBDDT ;DEBUGGING?
TMPCOR T1, ;ZERO TMPCOR
JFCL ;IGNORE ERRORS
MOVE T1,[3,,T2] ;SET UP UUO AC
MOVEI T2,.PTFSD ;SET DEFAULT PATH
SETZB T3,T4 ;NO FLAGS, SET TO UFD
PATH. T1, ;.PATH [,]
JFCL ;IGNORE ERRORS
SKIPE L.TEMP ;WANT TO DELETE *.TMP
PUSHJ P,DELTMP ;DELETE JOB'S TMP FILES
PUSHJ P,INISTR ;INITIALIZE STRUCTURE LIST
SETOM L.RDU ;SET SO WE GET A RECOMPUTING MSG
SETOM L.CSTR ;START AT THE BEGINNING
CHKQ.1: PUSHJ P,NXTSTR ;GET THE NEXT STRUCTURE IN THE S/L
JRST CHKQ.5 ;DONE
PUSHJ P,SETLOK ;SET UFD INTERLOCK
MOVX T1,.IODMP+UU.PHS ;GET OPEN BITS
MOVE T2,L.STR ;GET STRUCTURE NAME
SETZ 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,L.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.4 ;AND SKIP THE CHECK
CHKQ2A: CAME T1,P1 ;DONE?
AOJA T1,CHKQ.2 ;NO, LOOP
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.4 ;NO, DON'T FINISH OFF THE UFD
MOVE T1,L.STR ;YES, GET STR NAME
MOVE T2,L.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: RELEAS FS, ;RELEASE THE CHANNEL
PUSHJ P,UFDDMO ;REMOVE STRUCTURE FROM JSL
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.5: MOVE P1,L.TYPE ;GET LOGOUT TYPE
CAIE P1,LTYPEB ;ARE WE /BATCH?
SKIPL L.OVQT ;NO, ARE WE OVER QUOTA ANYWHERE?
JRST SUMARY ;EITHER BATCH OR UNDER QUOTA
JRST DOEXIT ;WE'RE OVER ON /F
SUBTTL INISTR -- Initialize Structure List
;CALL INISTR TO RECORD THE JOB SEARCH LIST IN L.JSL AND SET UP FOR
; SUBSEQUENT CALLS TO NXTSTR TO RETURN NEXT STRUCTURE IN JOB'S
; SEARCH LIST.
INISTR: SETZM L.NSTR ;CLEAR NUMBER OF STRUCTURES IN JSL
SETO T2, ;START WITH FIRST STRUCTURE
INIS.1: MOVE T1,[3,,T2] ;GET POINTER TO ARGUMENTS
JOBSTR T1, ;ASK FOR NEXT STR IN JOB SEARCH LIST
JRST INIS.2 ;ERROR
CAMN T2,[-1] ;END OF LIST IF -1
POPJ P, ;RETURN
AOS T1,L.NSTR ;BUMP NUMBER OF STRUCTURES
SUBI T1,1 ;WE WANT AN OFFSET
IMULI T1,.DFJBL ;TIMES LENGTH OF AN ENTRY
MOVEM T2,L.JSL+.DFJNM(T1) ;STORE STRUCTURE NAME
MOVEM T3,L.JSL+.DFJDR(T1) ;STORE RESERVED QUOTA
MOVEM T4,L.JSL+.DFJST(T1) ;STORE STATUS BITS
JRST INIS.1 ;ON TO NEXT STRUCTURE
INIS.2: MOVX T1,'LGTJUF' ;PREFIX
MOVE T2,["%",,[ASCIZ /JOBSTR UUO failed - no quota enforcement
/]]
PJRST .ERMSG## ;PRINT THE MESSAGE AND RETURN
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),
; THE NON-SKIP RETURN IS TAKEN.
NXTSTR: AOS T4,L.CSTR ;ADVANCE TO NEXT STRUCTURE
CAML T4,L.NSTR ;GONE PAST THE END?
POPJ P, ;YES, TAKE DONE RETURN
IMULI T4,.DFJBL ;TIMES LENGTH OF AN ENTRY
SKIPN T1,L.JSL+.DFJNM(T4) ;GET STRUCTURE NAME
JRST NXTSTR ;SKIP THE FENCE
MOVEM T1,L.STR ;SAVE FOR POSTERITY
MOVEM T1,L.DCBK ;HERE ALSO
; MOVE T2,L.JSL+.DFJDR(T4) ;GET RESERVED QUOTA
MOVE T3,L.JSL+.DFJST(T4) ;GET STATUS BITS
TXZN T3,DF.SWL ;WAS SOFTWARE WRITE LOCK SET?
JRST NXTS.1 ;NO
MOVX T1,.FSMNW ;LOAD FUNCTION CODE INTO T1
MOVE T2,L.STR ;PICK UP STRUCTURE NAME AGAIN
MOVE T4,[3,,T1] ;POINT AT ARGUMENTS
STRUUO T4, ;CLEAR SOFTWARE WRITE-LOCK
SKIPA T1,['LGTCCW'] ;ERROR, GET PREFIX AND SKIP
JRST NXTS.1 ;SUCCESS, CONTINUE
MOVE T2,["%",,[ASCIZ /Can't clear software write-lock on structure /]]
PUSHJ P,.ERMSG## ;TYPE A MESSAGE
PUSHJ P,TYPSTR ;TYPE STRUCTURE NAME
PUSHJ P,.TCRLF## ;TYPE A CRLF
NXTS.1: MOVE T1,[L.DCBK+1,,L.DCBK+2]
BLT T1,L.DCBK+.DCMAX-1 ;CLEAR THE REST
MOVE T1,[.DCMAX,,L.DCBK] ;POINT AT ARGUMENTS
DSKCHR T1, ;GET DISK CHARACTERISTICS
JFCL ;LOSE, RETURN ZEROED WORDS
JRST .POPJ1## ;SKIP 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]
SETZM 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,L.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
SETZM L.DSTS ;NOT OVER QUOTA, YET
SETZM 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
SETZ 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,UFDRCP ;RECOMP THE STRUCTURE
MOVEM T1,L.USE ;SAVE BLOCKS USED
MOVEM T1,L.UUO+.RBUSD ;AND IN UFD ALSO
SETZM 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 Type Summary Messages
SUMARY: PUSHJ P,GTTABS ;FILL IN ALL THE GETTABS
MOVE T1,L.RTM ;GET RUNTIME IN TICKS
IMULI T1,^D1000 ;CONVERT TO MILLI-TICKS
IDIV T1,L.TIC ;CONVERT TO MILLI-SECONDS
MOVEM T1,L.RTM ;AND STORE RUNTIME
MOVE T1,L.CTI ;GET CTI IN KCTS
IMULI T1,^D100 ;GET CTI IN <KCT>*100
IDIV T1,L.TIC ;DIVIDE BY JIFSEC
MOVEM T1,L.CTI ;YIELDING KILO-CORE-CENTI-SECS
MOVSI T1,777700 ;MASK FOR INCREMENTAL READS AND WRITES
ANDCAM T1,L.DRD ;TURN OFF INCREMENTAL READS
ANDCAM T1,L.DWT ;TURN OFF INCREMENTAL WRITES
SKIPN L.NWRD ;DID HE SAY /N?
JRST SUMAR2 ;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,L.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
MOVE T1,L.NOW ;GET DATE AND TIME
PUSHJ P,.CNTDT## ;TAKE APART
ADDI T1,^D500 ;ROUND TO SECOND FOR PRINTING
CAMG T1,[^D24*^D60*^D60*^D1000];PAST MIDNIGHT?
JRST SUMAR1 ;NO, NORMAL CASE
ADDI T2,1 ;WAS 23:59:59.835, BUMP DAY
SUB T1,[^D24*^D60*^D60*^D1000];MAKE TIME 0:0:0
SUMAR1: PUSH P,T2 ;SAVE DATE
PUSHJ P,.TTIME## ;TYPE TIME
MOVEI T1,[ASCIZ / on /]
PUSHJ P,.TSTRG##
POP P,T1 ;GET DATE
PUSHJ P,.TDATE## ;TYPE DATE
PUSHJ P,.TCRLF## ;AND A CRLF
MOVEI T1,[ASCIZ /Runtime:/]
PUSHJ P,.TSTRG## ;AND A LABEL
MOVE T1,L.RTM ;GET RUNTIME IN MILLI-SECONDS
PUSHJ P,.TTIME## ;TYPE IT
MOVEI T1,[ASCIZ /, KCS:/]
PUSHJ P,.TSTRG##
MOVE T1,L.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,L.DRD ;GET NUMBER OF READS
PUSHJ P,.TDECW## ;AND TYPE IT
MOVEI T1,[ASCIZ /, Writes:/]
PUSHJ P,.TSTRG##
MOVE T1,L.DWT ;GET NUMBER OF WRITES
PUSHJ P,.TDECW## ;TYPE IT
SKIPE L.OJCS ;OTHER JOB CONTAIN CONFLICTING STR?
JRST SUMAR2 ;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
SUMARX:! ;ENTER HERE FOR A JOB WHICH NEVER LOGGED IN
SUMAR2: PUSHJ P,.TCRLF## ;AND A CRLF
MOVEI T1,"." ;GET A DOT
MOVNI T2,1 ;-1 FOR OUR LINE NUMBER
SKIPE L.DET ;ARE WE DETACHED?
TDZA T2,T2 ;YES--CAN'T BE A PTY
GETLCH T2 ;GET LINE CHARACTERISTICS
TXNN T2,GL.ITY ;IS THIS OVER A PTY
PUSHJ P,.TCHAR## ;NO--TYPE DOT
MOVE T1,L.CMD ;LOGOUT COMMAND
CAIN T1,LGTNBY ;IF WAS "BYE" COMMAND
JRST SUMAR3 ;ALWAYS DISCONNECT (EVEN IF BYE/NODISC)
MOVE T1,[2,,T2] ;SET UP UUO AC
MOVEI T2,.TOAPC ;FUNCTION TO READ APC
MOVNI T3,1 ;-1 FOR US
TRMOP. T1, ;GET APC CODE
MOVEI T1,.TOUNK ;???
MOVSI T2,-DISLEN ;-LENGTH OF TABLE
CAME T1,DISTAB(T2) ;MATCH?
AOBJN T2,.-1 ;LOOP
SKIPG T2 ;FOUND A MATCH?
MOVMS L.DISC ;YES
SKIPG L.DISC ;WANT TO DISCONNECT LINE?
JRST BYEBYE ;NO
SUMAR3: MOVE T1,[2,,T3] ;SET UP UUO AC
MOVEI T2,.TOSOP ;SKIP IF OUTPUT IN PROGRESS
MOVNI T3,1 ;-1 FOR OUR LINE
SKIPN L.DET ;DETACHED?
TRMOP. T1, ;TEST
JRST SUMAR4 ;OK TO HANG UP PHONE
MOVEI T1,1 ;TIME TO WASTE
SLEEP T1, ;ZZZZZZ
JRST SUMAR3 ;TRY AGAIN
SUMAR4: MOVEI T1,1 ;OK NOW GIVE THE OUTPUT A CHANCE TO
SLEEP T1, ; MAKE IT THROUGH THE REMOTE STATION
MOVE T1,[2,,T2] ;SET UP UUO
MOVEI T2,.TODSF ;DISCONNECT DATASET FUNCTION
SKIPN L.DET ;DETACHED?
TRMOP. T1, ;DO IT
JFCL ;TOO LATE TO STOP NOW
MOVE T1,[2,,T2] ;SET UP UUO
MOVEI T2,.TODNT ;DISCONNECT NETWORK TERMINAL FUNCTION
SKIPN L.DET ;DETACHED?
TRMOP. T1, ;DO IT
JFCL ;OH WELL
JRST BYEBYE ;GO AWAY
DEFINE X,(APC),<
IRP APC,<EXP .TO'APC>
>
DISTAB: DISC
DISLEN==.-DISTAB
SUBTTL Finishing-Up
BYEBYE: SKIPE .JBDDT ;DEBUGGING ?
EXIT ;YES - EXIT WITHOUT SCREWING UP JOB
LOGOUT ;****END OF JOB****
SUBTTL UFD setup -- SETLOK - Get UFD interlock
SETLOK: PUSHJ P,UFDINI ;SETUP BLOCK
MOVSI T1,UFDSEC ;SECONDS TO WAIT FOR INTERLOCK
SKIPE .JBDDT ;DEBUGGING?
MOVEI T1,1 ;DON'T WAIT SO LONG
SKIPE L.BJOB ;BATCH?
LSH T1,1 ;YES--TWICE AS TOUGH
HRRI T1,^D10 ;MESSAGE AFTER 10 SECONDS
MOVEM T1,L.UFD+.UFLOK ;SAVE LOCK TIMER
MOVEI T1,LOKTYO ;TYPER
MOVEM T1,L.UFD+.UFTYO ;SET
MOVX T1,.UFSUI ;SET UFD INTERLOCK
DPB T1,[POINTR L.UFD+.UFFLG,UF.FNC] ;STORE
MOVEI T1,L.UFD ;POINT TO BLOCK
PUSHJ P,.UFD## ;GET THE INTERLOCK
JFCL ;TOO LONG
POPJ P, ;RETURN
LOKTYO: MOVE T1,L.UFD+.UFERR ;GET ERROR CODE
CAIN T1,UFUBT% ;BUSY TOO LONG?
POPJ P, ;YES--NO MESSAGE
PJRST UFDTYO ;ELSE TYPE THE STANDARD WAY
SUBTTL UFD setup -- CLRLOK - Clear the UFD interlock
CLRLOK: PUSHJ P,UFDINI ;SETUP BLOCK
MOVX T1,.UFCUI ;CLEAR INTERLOCK
DPB T1,[POINTR L.UFD+.UFFLG,UF.FNC] ;STORE CODE
MOVEI T1,L.UFD ;POINT TO ARGS
PUSHJ P,.UFD## ;CLEAR THE INTERLOCK
JFCL ;DONT CARE
POPJ P, ;RETURN
SUBTTL UFD setup -- UFDRCP - Recompute disk usage on random structures
UFDRCP: PUSHJ P,UFDINI ;SETUP ARG BLOCK
MOVX T1,UF.NLK!UF.ARD!INSVL.(.UFRDU,UF.FNC) ;ALWAYS RECOMPUTE
MOVEM T1,L.UFD+.UFFLG ;SAVE FLAGS
MOVEI T1,L.UFD ;POINT TO ARGS
PUSHJ P,.UFD## ;SET IT UP
TDZA T1,T1 ;ERROR, RETURN ZERO BLOCKS USED
MOVE T1,L.UFD+.UFUSD ;GET BLOCKS USED
POPJ P, ;RETURN
SUBTTL UFD setup -- UFDDMO - Dismount structure
UFDDMO: PUSHJ P,UFDINI ;SETUP ARG BLOCK
MOVX T1,UF.NLK!UF.LGO!INSVL.(.UFDMO,UF.FNC) ;DISMOUNT, TURN OFF LOGGED-IN BIT
MOVEM T1,L.UFD+.UFFLG ;SAVE FLAGS
MOVEI T1,L.UFD ;POINT TO ARGS
PUSHJ P,.UFD## ;REMOVE IT
JFCL ;ERROR
POPJ P, ;RETURN
SUBTTL UFD setup -- UFDINI - Initialize block
UFDINI: MOVE T1,[L.UFD,,L.UFD+1] ;SETUP BLT
SETZM L.UFD ;CLEAR FIRST
BLT T1,L.UFD+.UFSIZ-1 ;ZERO THEM ALL
MOVE T1,L.STR ;GET STR NAME
MOVEM T1,L.UFD+.UFSTR ;SAVE STRUCTURE
MOVEI T1,UFDTYO ;ERROR TYPER
MOVEM T1,L.UFD+.UFTYO ;SAVE
SETOM L.UFD+.UFQTR ;DON'T
SETOM L.UFD+.UFQTF ; SET
SETOM L.UFD+.UFQTO ; QUOTAS
SETOM L.UFD+.UFPPN ;DEFAULT PPN
SETOM L.UFD+.UFJOB ;AND JOB
SETOM L.UFD+.UFPRO ;DEFAULT UFD PROTECTION
POPJ P, ;RETURN
SUBTTL UFD setup -- UFDTYO - Handle typeout of errors from .UFD
UFDTYO: SKIPE .JBDDT ;DEBUGGING?
JRST UFDT.1 ;YES, BE VERBOSE
HRRZ T1,L.UFD+.UFPFX ;GET PREFIX
CAIE T1,'MNT' ;MOUNT MSG?
CAIN T1,'AJL' ;ADD S/L MSG?
POPJ P, ;YES--TOO VERBOSE
CAIE T1,'DMO' ;DISMOUNT MSG?
CAIN T1,'NUC' ;NO UFD CREATED MSG?
POPJ P, ;YES--WE DONT WANT EITHER
CAIN T1,'QTA' ;QUOTA MESSAGE?
POPJ P, ;YES--SKIP IT
CAIN T1,'RDU' ;RECOMPUTING?
AOSN L.RDU ;YES--ALREADY SEEN IT?
CAIA ;OK
POPJ P, ;YES--ONCE IS ENOUGH
UFDT.1: HLRZ T1,L.UFD+.UFPFX ;GET ERROR CHAR
PUSHJ P,.TCHAR## ;TYPE
HRRZ T1,L.UFD+.UFPFX ;ERROR PREFIX
HRLI T1,'LGT' ;PREFIX
PUSHJ P,.TSIXN## ;TYPE
PUSHJ P,.TSPAC## ;SPACE OVER
MOVE T1,L.UFD+.UFTXT ;ADDESS OF TEXT
PUSHJ P,.TSTRG## ;TYPE
HLRZ T1,L.UFD+.UFPFX ;ERROR CHAR
CAIN T1,"[" ;INFORMATIONAL?
PUSHJ P,.TRBRK## ;YES--CLOSE IT
PUSHJ P,.TCRLF## ;CRLF
POPJ P, ;AND RETURN
SUBTTL RSTJSL -- Routine to restore job's search list
RSTJSL: SKIPN L.NSTR ;ANY STRUCTURES IN JSL?
POPJ P, ;NO, SO NOTHING TO RESTORE
SETOM L.CSTR ;START AT THE BEGINNING AGAIN
RSTJ.1: PUSHJ P,NXTSTR ;GET NEXT STRUCTURE
JRST RSTJ.2 ;ALL DONE
PUSHJ P,UFDINI ;SETUP ARG BLOCK
MOVE T1,L.CSTR ;CURRENT STRUCTURE NUMBER
IMULI T1,.DFJBL ;TIMES LENGTH OF AN ENTRY
MOVE T2,L.JSL+.DFJST(T1) ;GET STATUS BITS
MOVEM T2,L.UFD+.UFSTS ;SAVE THEM
MOVX T1,UF.LGI!INSVL.(.UFMNT,UF.FNC) ;FUNCTION
MOVEM T1,L.UFD+.UFFLG ;SAVE FLAGS
MOVEI T1,L.UFD ;POINT TO ARGS
PUSHJ P,.UFD## ;SET IT UP
JFCL ;ERROR
JRST RSTJ.1 ;LOOP FOR OTHERS
RSTJ.2: MOVX T1,.FSDSL ;FUNCTION TO DEFINE S/L
MOVEM T1,L.STUU+.FSFCN
MOVE T1,L.JOB ;MY JOB NUMBER
MOVEM T1,L.STUU+.FSDJN
MOVE T1,L.PPN ;MY PPN
MOVEM T1,L.STUU+.FSDPP
SETZM L.STUU+.FSDFL ;NO FLAGS
MOVE T1,L.NSTR ;GET NUMBER OF STRUCTURES
IMULI T1,.DFJBL ;TIMES LENGTH OF AN ENTRY
ADDI T1,.FSDSO ;ADD IN HEADER LENGTH
HRLI T1,L.STUU ;POINT AT ARGUMENTS
MOVSS T1 ;...
STRUUO T1, ;PUT S/L BACK IN ORIGINAL ORDER
JFCL ;WE TRIED
POPJ P, ;RETURN
SUBTTL DELTMP -- Routine to delete job's TMP files
DELTMP: PUSHJ P,.SAVE3## ;SAVE P1-P3
MOVSI T1,'DSK' ;GET "DISK"
MOVE T2,L.PPN ;GET PPN
HRLOI T3,'TMP' ;AND EXT,,MASK
PUSHJ P,.LGTSE## ;SETUP TO READ DSK:*.TMP
SETZM L.NTMP ;AND ZERO THE COUNT
MOVX T1,FO.PRV!FO.UOC!INSVL.(SCR,FO.CHN)!INSVL.(.FODLT,FO.FNC)
;USE PRIVS, CHANNEL OPEN,,CHANNEL AND FUNCTION
MOVEM T1,L.FLP+.FOFNC
MOVEI T1,.IODMP ;DATA MODE
MOVEM T1,L.FLP+.FOIOS
MOVSI T1,L.FLPZ ;A WORD TO WRITE INTO
MOVEM T1,L.FLP+.FOLEB
MOVE T1,L.PPN ;GET PPN
MOVEM T1,L.FLP+.FOPPN
MOVE T1,L.JOB ;GET JOB NUMBER
PUSHJ P,.MKPJN## ;MAKE CCL REPRESENTATION
MOVE P1,T1 ;SAVE HERE
SETZM L.STR ;START WITH NO STRUCTURE
DELT.1: SETZB 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
MOVEM T3,L.FLP+.FODEV ; RESET HERE
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
MOVE T1,[.FOPPN+1,,L.FLP] ;POINT AT BLOCK
FILOP. T1, ;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
MOVX T1,'LGTDTF' ;PREFIX
MOVE T2,["[",,[ASCIZ /Deleted /]]
PUSHJ P,.ERMSG## ;TYPE A MESSAGE
MOVE T1,L.NTMP ;GET NUMBER OF FILES
PUSHJ P,.TDECW## ;TYPE IT
MOVEI T1,[ASCIZ / TMP file/]
PUSHJ P,.TSTRG## ;TYPE MORE
MOVEI T1,"s" ;GET PLURAL
SOSE L.NTMP ;ONLY ONE?
PUSHJ P,.TCHAR## ;NO
PUSHJ P,.TRBRK## ;END WITH RIGHT BRACKET
PJRST .TCRLF## ; AND CRLF
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.
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 L.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 L.CTI>
T <-1,,.GTRCT>,<0>,<MOVEM L.DRD>
T <-1,,.GTWCT>,<0>,<MOVEM L.DWT>
T <-1,,.GTTIM>,<0>,<MOVEM L.RTM>
T <-1,,.GTCNO>,<0>,<MOVEM L.CNO>
T <-1,,.GTJLT>,<0>,<MOVEM L.JLT>
T <-1,,.GTLIM>,<0>,<MOVEM L.JLIM>
T <-1,,.GTEQJ>,<0>,<MOVEM L.EQJ>
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 SCAN ARGUMENT BLOCKS
; .ISCAN
ISCBLK: IOWD LGTN.L,LGTN.T ;POINTER TO INVOKING COMMAND NAMES
XWD L.CCL,'LGO' ;CCL OFFSET,,CCL NAME
XWD TTYINP,TTYOUT ;TYPE-IN,,TYPE-OUT ROUTINES
XWD 0,0 ;INDIRECT COMMAND FILE SCAN BLOCK
XWD 0,DOEXIT ;PROMPT ROUTINE,,MONRET ROUTINE
EXP FS.ICL ;FLAGS
ISCLEN==.-ISCBLK ;LENGTH OF BLOCK
ISCPTR: XWD ISCLEN,ISCBLK ;POINTER TO .ISCAN BLOCK
KEYS (LGTN,<KJOB,LOGOUT,BYE>)
; .PSCAN
PSCBLK: IOWD KJOBL,KJOBN ;POINTER TO SWITCH NAMES
XWD KJOBD,KJOBM ;DEFAULTS,,PROCESSORS
XWD 0,KJOBP ;FUTURE,,STORAGE POINTERS
SIXBIT /LOGOUT/ ;HELP
PSCLEN==.-PSCBLK ;LENGTH OF BLOCK
PSCPTR: XWD PSCLEN,PSCBLK ;POINTER TO .PSCAN BLOCK
; .OSCAN
OSCBLK: IOWD KJOBL,KJOBN ;POINTER TO SWITCH NAMES
XWD KJOBD,KJOBM ;DEFAULTS,,PROCESSORS
XWD 0,KJOBP ;FUTURE,,STORAGE POINTERS
XWD 0,0 ;HELP
XWD 2,LGTN.T ;POINTER TO LIST OF OPTION NAMES
; SPECIFICALLY EXCLUDES "BYE" NAME
OSCLEN==.-OSCBLK ;LENGTH OF BLOCK
OSCPTR: XWD OSCLEN,OSCBLK ;POINTER TO .PSCAN BLOCK
DEFINE SWTCHS,<
SS *BATCH,L.TYPE,LTYPEB
SN *DISCONNECT,L.DISC,
SS FAST,L.TYPE,LTYPEF
SS *NOMESSAGE,L.NWRD,0
IFN TEMPSW,< SN *TEMP,L.TEMP,>
>
DOSCAN (KJOB)
SUBTTL TTYINP -- Read a character from the user's teletype
;CALLED BY .TIAUC ROUTINE IN .SCAN MODULE OF SCAN
TTYINP: SKIPN L.DET ;DETACHED?
INCHSL C ;NO--GET A CHARACTER
MOVE C,[.CHEOL] ;CALL IT EOL
POPJ P, ;RETURN
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
CLRBFO ;CLEAR OUTPUT BUFFER
DEBRK. ;AND RESTORE INTERRUPT LEVEL
JFCL ;??
POPJ P, ;HOPEFULLY CALLED BY PUSHJ
SUBTTL PSICCI -- Interrupt Routine for Control-C
PSICCI: SKIPN .JBDDT ;DEBUGGING ?
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: SKIPN L.JLT ;WAS JOB EVER LOGGED IN?
JRST BYEBYE ;NO, SAY GOODBYE
PUSHJ P,RSTJSL ;RESTORE JOB SEARCH LIST WHILE STILL PRIV'D
MOVE P1,L.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: PUSHJ P,CLRLOK ;CLEAR UFD INTERLOCK
MOVX T1,'LGTOUF' ;GET PREFIX
MOVE T2,["?",,[ASCIZ /OPEN UUO failed for structure /]]
PUSHJ P,.ERMSG## ;TYPE A MESSAGE
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: MOVX T1,'LGTLQE' ;PREFIX
MOVSI T2,"?" ;JUST ERROR CHARACTER, NO TEXT
PUSHJ P,.ERMSG## ;TYPE A 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
/]
PJRST .TSTRG## ;FINISH IT OFF 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: HRRZ T1,L.UUO+.RBEXT ;GET ERROR CODE
JUMPE T1,.POPJ## ;NO UFD-->NO FILES-->UNDER QUOTA
MOVX T1,'LGTULF' ;PREFIX
MOVSI T2,"%" ;JUST ERROR CHARACTER, NO TEXT
PUSHJ P,.ERMSG## ;TYPE A MESSAGE
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
PJRST .TCRLF## ;TYPE A CRLF AND RETURN
SUBTTL T$ENQ -- End job with eternal ENQ. locks set
T$ENQ: MOVX T1,'LGTENQ' ;PREFIX
MOVE T2,["?",,[ASCIZ /Job has outstanding eternal ENQ. locks set/]]
SKIPE L.BJOB ;BATCH MAYBE ?
HRLI T2,"""" ;YES
PUSHJ P,.ERMSG## ;ISSUE MESSAGE
PUSHJ P,.TCRLF## ;AN EXTRA NEW LINE
JRST DOEXIT ;AND EXIT
SUBTTL T$USR -- Report other users still logged in
; Here when we know there are other users
;
T$USR: MOVX T1,'LGTOUL' ;PREFIX
MOVE T2,["[",,[ASCIZ /Other users logged-in under /]]
PUSHJ P,.ERMSG## ;SEND LINE TO USER
MOVE T1,L.PPN ;GET OUR PPN
PUSHJ P,.TPPNW## ;OUTPUT IT
MOVE T1,L.PPN ;GET OUR PPN AGAIN
CAMN T1,L.FFA ;FULL FILE ACCESS PPN ([OPR]) ?
JRST T$USR3 ;YES - KEEP MESSAGE SHORT
MOVEI T1,[ASCIZ /, Jobs: /];MORE TEXT
PUSHJ P,.TSTRG## ;SEND IT
SKIPN P1,L.HJIU ;GET THE HIGHEST JOB IN USE
MOVE P1,L.MXJB ;USE THE HIGHEST JOB IN THE MONITOR
MOVEI P2,1 ;START WITH JOB 1
SETO P3, ;SETUP FLAG
T$USR1: CAMN P2,L.JOB ;OUR JOB ?
JRST T$USR2 ;YES - IGNORE IT
HRLZ T1,P2 ;GET JOB NUMBER AS INDEX
HRRI T1,.GTPPN ;THE PPN TABLE
GETTAB T1, ;GET THAT JOB'S PPN
JRST T$USR2 ;SHOULDN'T HAPPEN
CAME T1,L.PPN ;IS IT OUR PPN ?
JRST T$USR2 ;NO - TRY ANOTHER JOB
AOSE P3 ;FIRST JOB FOUND ?
PUSHJ P,.TCOMA## ;NO - TYPE A COMMA
MOVE T1,P2 ;GET JOB NUMBER
PUSHJ P,.TDECW## ;TYPE IT
T$USR2: CAMGE P2,P1 ;DONE SCANNING JOBS ?
AOJA P2,T$USR1 ;NO - LOOP FOR ANOTHER
T$USR3: PUSHJ P,.TRBRK## ;FINISH OFF COMMENT
PJRST .TCRLF## ;ADD A CRLF AND RETURN
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.CMD: BLOCK 1 ;LOGOUT-INVOKING COMMAND (KJOB, BYE, ETC.)
L.TYPE: BLOCK 1 ;LOGOUT TYPE, /F,/B
L.DISC: BLOCK 1 ;/DISCONNECT
L.TEMP: BLOCK 1 ;/TEMP
L.NWRD: BLOCK 1 ;FLAG = 1 IF /N
L.PSIB:! ;INTERRUPT VECTOR FOR PSI
DETINB: BLOCK 4 ;INTERRUPT CELL FOR DETACH
CCIINB: BLOCK 4 ;INTERRUPT CELL FOR ^C
L.OVQT: BLOCK 1 ;OVER-QUOTA FLAG
L.RDU: BLOCK 1 ;FLAG TO ONLY PRINT RECOMPUTING MSG ONCE
L.FLP: BLOCK .FOMAX ;FILOP. BLOCK FOR DELTMP
L.FLPZ: BLOCK 1 ;A WORD FOR FILOP. DELETE TO WRITE INTO
L.UUO: BLOCK .RBTIM+1 ;LOOKUP BLOCK FOR UFDS
L.DCBK: BLOCK .DCMAX ;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
L.UFD: BLOCK .UFSIZ ;UFDSET ARGUMENT BLOCK
L.NSTR: BLOCK 1 ;NUMBER OF STRUCTURES IN JOB SEARCH LIST
L.CSTR: BLOCK 1 ;CURRENT STRUCTURE NUMBER IN JSL
;*** DO NOT SEPARATE ***
L.STUU: BLOCK .FSDSO ;STRUUO DEFINE STRUCTURE BLOCK
L.JSL: BLOCK <MAXFS*.DFJBL> ;JOB SEARCH LIST
;*** END OF DO NOT SEPARATE ***
;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.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.PPN: BLOCK 1 ;MY PPN
L.RTM: BLOCK 1 ;RUNTIME (IN SECS*100)
L.CTI: BLOCK 1 ;CORE-TIME INTEGRAL IN <KCS>*100
L.DRD: BLOCK 1 ;TOTAL DISK READS
L.DWT: BLOCK 1 ;TOTAL DISK WRITES
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.EQJ: BLOCK 1 ;NON-ZERO FOR ETERNAL ENQ. LOCKS
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
LOWEND==.-1
PRGEND LGOUT
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 LSD,777777
X LSQ,777777
X LST,777777
X LIS,777777
X LPT,777777
X PTP,777777
X PLT,777777
X CDP,777777
X Z??,770000
X FOO,777777
X LOG,777777
X BIN,777777
X DMP,777777
X FIN,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 RNH
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
X DBS
X B16
X B32
X B36
X REQ
X R16
X R36
X PAS
X INI
> ;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
SETZM 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: SETZM L.TOT ;CLEAR ACCUMULATED TOTAL
SETZM L.NQC ;CLEAR # NQC FILES
SETZM 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: SETZB 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
SKIPE .RBSIZ(T2) ;CHECK FOR ZERO BLOCK FILES
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: SETZB 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: SETZB 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: SETZB 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: SETZB 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: SETZB 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: SETZB 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
SETZB T1,T2 ;CLEAR A RENAME BLOCK
SETZB 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?
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: AOS L.NDEL ;ANOTHER ONE DELETED
MOVEI T1,L.OBLK ;GET ADR OF OPEN BLOCK
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)
CAIN T2,ERDNE% ;TRYING TO DELETE NON-EMPTY DIRECTORY?
POPJ P, ;YES - JUST RETURN
PUSH P,T2 ;SAVE ERROR CODE
MOVX T1,'LGTCDF' ;GET PREFIX
MOVE T2,["%",,[ASCIZ |Cannot delete file: |]]
PUSHJ P,.ERMSG## ;TYPE IT
MOVEI T1,L.OBLK ;GET ADDRESS OF OPEN BLOCK
MOVE T2,L.DBLK ;GET ADDRESS OF LOOKUP BLOCK
PUSHJ P,.TOLEB## ;TYPE A FILESPEC
MOVEI T1,[ASCIZ | ; error code |] ;MORE TEXT
PUSHJ P,.TSTRG## ;TYPE IT
POP P,T1 ;GET ERROR CODE
PUSHJ P,.TOCTW## ;TYPE IT
PJRST .TCRLF## ;TYPE A CRLF 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
SETZM 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 .FXLEN ;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