Google
 

Trailing-Edge - PDP-10 Archives - bb-jr93d-bb - 7,6/ap014/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