TITLE	LOGOUT	New LOGOUT for GALAXY-10 Systems
SUBTTL	Larry Samberg/LSS	28 Mar 77

;Copyright (C) 1974,1975,1976,1977,
;	Digital Equipment Corp., Maynard, MA.

;ASSEMBLY AND LOADING INSTRUCTIONS
;	.COMPILE LOGOUT
;	.LOAD LOGOUT
;	.SSAVE LOGOUT

	SEARCH	MACTEN,UUOSYM,SCNMAC
		%%MACT==%%MACT
		%%UUOS==%%UUOS
		%%SCNM==%%SCNM

	.REQUE	REL:WILD	;LEVEL-D DISK ROUTINES
	.REQUE	REL:SCAN	;GET .TOUTS FROM SCAN
	.REQUE	REL:HELPER	;DECSYSTEM-10 HELP TEXT TYPER

;VERSION INFORMATION
	LGTVER==102		;MAJOR VERSION
	LGTMIN==0		;MINOR VERSION
	LGTEDT==2027		;EDIT LEVEL
	LGTWHO==0		;WHO LAST PATCHED

	%LGT==<BYTE (3)LGTWHO(9)LGTVER(6)LGTMIN(18)LGTEDT>

	LOC	137
.JBVER:: EXP	%LGT

	TWOSEG			;HISEG PROGRAM
	RELOC	400000		;START IN HISEG


	SALL			;SUPPRESS MACRO EXPANSIONS


;***DEBUGGING TIP***
;
;WHEN DEBUGGING LOGOUT, SET LOCATION "PSICCI" TO A "JFCL" SO YOU
;	CAN CONTROL-C OUT WHENEVER YOU WANT.
SUBTTL	Revision History

;2000	VERSION RELEASED WITH FIRST GALAXY-10 FIELD-TEST RELEASE, JUNE, 1975
;2001	DE-IMPLEMENT /Q SWITCH.  MAKE /F DO A /Q IF STR IS OVER QUOTA
;2002	FIX INCORRECT AC REFERENCE IN PISYS UUO FROM T1 TO T4
;2003	FIX AN EDITTING ERROR IN EDIT 2001
;2004	MAKE THE BATCH DELETION ALGORITM UNDERSTAND NQC FILES AND ALSO
;	RECOVER MORE GRACEFULLY FROM SOME ERROR CONDITIONS
;2005	IF ACCOUNTING SYSTEM FAILURE IN A BATCH JOB, NOTIFY THE OPR AND
;	LOG THE JOB OFF ANYWAY

;2006	MAKE THIS VERSION 101, NOVEMMBER, 1975
;2007	CLEAR L.USE BEFORE DOING QUOTA CHECKING ON EACH STRUCTURE
;2010	ENABLE FOR CONTROL-C INTERRUPTS, AND LET THE USER GET OUT
;	WHILE WE ARE COMMAND SCANNING
;2011	IMPLEMENT /T TO DELETE JOB'S UNPROTECTED TEMP FILES
;2012	ADD A ROUTINE CALLED "TYPSTR" TO TYPE OUT THE CURRENT FILE-STRUCTURE
;2013	REMOVE /T SWITCH AND MAKE TMP FILE DELETION AUTOMATIC
;2014	MOVE "OTHER JOBS SAME PPN" MESSAGE TO THE BEGINNING RATHER
;	THAN PART OF THE SUMMARY MESSAGE
;2015	DO A CLRBFI UPON FINISHING COMMAND-SCAN
;2016	ADD .BLI TO IMPORT TABLE IN LGTBA
;2017	DO A CLRBFI (EDIT 2015) IFF BATCH JOB
;2020	IF WE TRY TO DELETE A FILE BECAUSE A STRUCTURE IS OVER QUOTA
;	ON /B, AND THE DELETE FAILS, MAKE HIS QUOTA LOOK BIGGER BY
;	THE SIZE OF THE FILE UNLESS THE ERROR WAS PROTECTION FAILURE
;	(SEE MOTIVATION SECTION FOR FURTHER INFO).
;2021	IF DAEMON IS NOT RUNNING, A USER CAN LOG OUT IF HE
;	SAYS K/B BECAUSE LOCATION L.BJOB WAS BEING TIMESHARED.
;2022	RATHER THAN DELETING TEMP FILES ON A STRUCTURE BY STRUCTURE
;	BASIS, DELETE THEM ALL AT ONCE.

;2023	MAKE THIS VERSION 102  (NOTE: VERSION 101 WAS NEVER RELEASED).
;2024	FIX SOME MINOR PROBLEMS AND DO SOME CODE CLEANUP.
;2025	TRY HARD TO DELETE EMPTY SFDS IN /B ALGORITHM.

;;FIRST FIELD-TEST RELEASE OF GALAXY VERSION 2, JANUARY 1977
;;SECOND FIELD-TEST RELEASE OF GALAXY VERSION 2, MARCH 1977

;2026	TMP FILES WEREN'T ALWAYS DELETED DUE TO FUZZY CODING IN THE
;	DELTMP ROUTINE (QAR #30).
;2027	IF LOGOUT DELETED TMP FILES, SOME STRUCTURES WERE NOT
;	QUOTA CHECKED AND USERS HAD TO RECOMP NEXT TIME THEY LOGGED IN.
SUBTTL	Motivation for major functional changes

;2011	THE FACILITY TO DELETE A JOB'S TEMP FILES WAS ADDED DUE TO
;	A LARGE NUMBER OF USER REQUESTS FOR SUCH A FACILITY.

;2013	THE DECISION TO MAKE EDIT 2011 SWITCHABLE WAS TO AVOID THE
;	EXTRA DISK OVERHEAD UNLESS THE USER EXPLICITLY REQUESTS IT.
;	IT WAS THEN REALIZED THAT THE OVERHEAD IS MINIMAL SINCE:
;		1) THE JOB IS LOGGED IN
;		2) THE UFD HAS ALREADY BEEN LOOKED-UP OR IS ABOUT
;		   TO BE
;	SO THE OVERHEAD CONSISTS SOLELY OF READING THE UFD AS DATA
;	WHICH IS MINIMAL.

;2020	IF THE DELETE OF A FILE FAILS, THE PROBABLE REASON IS THAT
;	IT IS THE BATCH LOG FILE WHICH IS STILL OPEN BY BATCON.
;	THIS FILE CANNOT BE TREATED AS NON-EXISTANT SINCE LOGOUT
;	WILL THEN SET RIBUSD WRONG, SO BY INTERNALLY CONSIDERING
;	HIS QUOTA TO BE THAT MUCH BIGGER, WE WILL AVOID DELETING
;	OTHER FILES SIMPLY BECAUSE THE LOG FILE IS LARGE.  IT WILL
;	STILL BE COUNTED AGAINST HIS QUOTA ON FUTURE LOGINS SO
;	IF THE  BATCH SYSTEM DOESN'T DELETE THE LOG AFTER ITS
;	PRINTED, IT WILL BE GOTTEN THE NEXT TIME HE LOGS OFF.
SUBTTL	Accumulator Assignments

	T1=1			;T1 THRU T4 ARE TEMPS AND ARE
	T2=2			; ALSO USED BY WILD
	T3=3
	T4=4

	P1=5			;P1 - P4 ARE "MY" ACS AND ARE
	P2=6			; PRESERVED BY ALL EXTERNAL SUBROUTINES
	P3=7
	P4=10

	P=17			;PUSHDOWN POINTER

;I/O Channel Definitions

	FS==1			;CURRENT FILE STRUCTURE
	SCR==2			;SCRATCH I/O CHANNEL FOR .LGTXX


;LOGOUT Types (FOUND IN LOCATION L.TYPE)
	LTYPEF==1		;KJOB/F
	LTYPEB==2		;KJOB/B
SUBTTL	Conditional Assembly Parameters

	ND	PDLSIZ,100		;SIZE OF PUSHDOWN LIST
	ND	TM2TRY,^D300		;NUMBER OF TIMES TO TRY UFD INTERLOCK
	ND	SLTIME,^D500		;NUMBER OF MS TO SLEEP BET TRIES
	ND	TMB4MS,^D60		;NUMBER OF SLEEPS BEFORE TYPING MESSAGE
SUBTTL	Entry and Initialization

LGOUT:	TDZA	T1,T1		;CLEAR T1 FOR NORMAL ENTRY
	MOVEI	T1,1		;SET T1 FOR CCL ENTRY
	RESET			;RESET THE WORLD
	MOVE	P,[IOWD PDLSIZ,L.PDL]

	MOVE	T2,[LOWBEG,,LOWBEG+1]
	CLEARM	LOWBEG		;CLEAR FIRST WORD OF STORAGE AREA
	BLT	T2,LOWEND	;CLEAR THE REST OF THE STORAGE AREA
	MOVEM	T1,L.CCL	;SAVE CCL GLAG
	MOVEI	T1,TTYOUT	;GET ADDRESS OF TYPER
	PUSHJ	P,.TYOCH##	;AND TELL SCAN ABOUT IT
	PUSHJ	P,GTTABS	;FILL IN ALL THE GETTABS
	PJOB	T1,		;GET MY JOB NUMBER
	MOVEM	T1,L.JOB	;AND SAVE IT
	MOVE	T1,L.JLIM	;GET .GTLIM WORD
	TXNE	T1,JB.LBT	;IS IT A BATCH JOB?
	SETOM	L.BJOB		;YES, SET THE FLAG
	SETOM	L.OKCC		;LET ^C THRU RIGHT NOW

	MOVEI	T1,L.PSIB	;GET ADDRESS OF INTERRUPT VECTOR
	PIINI.	T1,		;INITIALIZE THE PI SYSTEM
	  JRST	LGOU.1		;IF THERE IS ONE TO INITIALIZE
	MOVEI	T1,PSIDET	;ADDRESS OF INTERRUPT ROUTINE
	MOVEM	T1,DETINB+.PSVNP ;AND STORE IT IN INTERRPT VECTOR
	HRREI	T1,.PCDAT	;CONDITION=ATTACH/DETACH
	HRLZI	T2,DETINB-L.PSIB;GET VECTOR OFFSET,,0
	CLEAR	T3,		;AND CLEAR RESERVED WORD
	MOVE	T4,[PS.FON+PS.FAC+T1]
	PISYS.	T4,		;TURN ON PIS, ADD NEW CONDITION
	  JFCL			;WE TRIED!!
	MOVEI	T1,PSICCI	;GET ADDRESS OF THE ROUTINE
	MOVEM	T1,CCIINB+.PSVNP;AND STORE IN VECTOR
	HRREI	T1,.PCSTP	;^C CONDITION CODE
	HRLZI	T2,CCIINB-L.PSIB;AND THE OFFSET
	CLEAR	T3,		;CLEAR EXTRA WORD
	MOVE	T4,[PS.FON+PS.FAC+T1]
	PISYS.	T4,		;AND ADD THE CONDITION
	  JFCL			;OH WELL.

LGOU.1:	GETLIN	T1,		;GET TTY NAME
	TLNN	T1,-1		;DETACHED?
	SETOM	L.DET		;YES, SET THE FLAG
	MOVEM	T1,L.TTY	;SAVE TTY NAME
	MOVE	T1,L.CCL	;GET CCL FLAG
	JUMPN	T1,CCLENT	;AND DO CCL ENTRY IF NECESSARY
				;ELSE, FALL THRU AND SCAN COMMAND LINE
SUBTTL	Scan KJOB Command Line

LSCAN:	SKIPE	L.DET		;ARE WE DETACHED?
	JRST	CCLENT		;YES, USE CCL ENTRY
	RESCAN	1		;RESCAN THE COMMAND LINE
	SKPINL			;ANYTHING THERE?
	  JRST	SCDONE		;NO, ASSUME .KJOB/F

LSCA.2:	INCHSL	T1		;GET A CHARACTER
	  JRST	SCDONE		;NOTHING THERE!!
	CAIE	T1,.CHLFD	;LINE-FEED?
	CAIN	T1,.CHESC	;OR ESCAPE?
	  JRST	SCDONE		;YES, EOL!!
	CAIE	T1,.CHFFD	;IS IT A FORMFEED
	CAIN	T1,.CHVTB	;OR A VERTICAL TAB?
	  JRST	SCDONE		;YES, DONE
	CAIE	T1,.CHCNC	;CONTROL C
	CAIN	T1,.CHCNZ	;CONTROL Z
	  JRST	SCDONE		;YES, DONE
	CAIE	T1," "		;A BLANK
	CAIN	T1,.CHCRT	;OR A CARRAIGE-RETURN
	JRST	LSCA.2		;YES, IGNORE IT
	CAIE	T1,"/"		;LOOK FOR A SLASH
	JRST	LSCA.2		;AND KEEP LOOPING

LSCA.3:	INCHSL	T1		;GET CHARACTER AFTER "/"
	  JRST	LSCA.5		;NONE, BAD SYNTAX!!
	CAIL	T1,"A"+40	;GREATER THAN LC A?
	CAILE	T1,"Z"+40	;YES, LESS THAN LC Z?
	  SKIPA			;NO, NOT LOWER-CASE
	SUBI	T1,40		;YES, IT'S LOWER CASE, CONVERT IT
	CLEAR	T2,		;START AT ZERO

	CAIN	T1,"B"		;/B?
	MOVEI	T2,LTYPEB	;YES!!
	CAIN	T1,"F"		;NO, /F?
	MOVEI	T2,LTYPEF	;YES, /F
	JUMPE	T2,LSCA.4	;JUMP IF NOT /F OR /B

	SKIPE	L.TYPE		;DID HE SPECIFY A LOGOUT TYPE ALREADY?
	JRST	LSCA.6		;YES, CONFLICTING SWITCHES
	MOVEM	T2,L.TYPE	;NO, SAVE THIS ONE
	JRST	LSCA.2		;AND GET SOME MORE

LSCA.4:	CAIN	T1,"N"		;/N (NO-TYPEOUT)
	JRST	[SETOM L.NWRD	;YES, SET THE WORD
		 JRST  LSCA.2]	;AND LOOP AROUND
	CAIE	T1,"H"		;OR FINALLY /H?
	JRST	LSCA.7		;NO, UNRECOGNIZED SWITCH
	MOVX	T1,'LOGOUT'	;CALL THE HELPER
	PUSHJ	P,.HELPR##	; !HELP!
	JRST	DOEXIT		;AND EXIT

CCLENT:	MOVEI	T1,LTYPEB	;ASSUME /B FOR CCL ENTRY
	MOVEM	T1,L.TYPE	;STORE IT
;HERE WHEN DONE DOING THE SCAN
SCDONE:	MOVEI	T1,LTYPEF		;LOAD /F CODE
	SKIPN	L.TYPE			;DID HE SPECIFY A SWITCH
	MOVEM	T1,L.TYPE		;NO, SAVE /F AS DEFAULT
	SKIPE	L.BJOB			;IF HE IS A BATCH JOB,
	CLRBFI				; THEN CLEAR TYPE-AHEAD
	CLEARM	L.OKCC			;NO MORE ^C ALLOWED
	SKIPN	L.NWRD			;DON'T TYPE MESSAGE ON /N
	OTHUSR	T1,			;OTHER USERS SAME PPN?
	  JRST	CHKQTA			;NO, CONTINUE ON
	MOVX	T1,'LGTAJL'		;GET THE MESSAGE NAME
	MOVEI	T2,[ASCIZ /Another job is still logged-in under /]
	HRLI	T2,"["			;KEY CHARACTER
	PUSHJ	P,.ERMSG##		;TYPE THE MESSAGE
	MOVE	T1,F.PPN		;GET THE PPN WORD
	PUSHJ	P,.TPPNW##		;AND TYPE IT
	PUSHJ	P,.TRBRK##		;TYPE RIGHT BRACKET
	PUSHJ	P,.TCRLF##		;AND A CRLF
	JRST	CHKQTA			;AND GO CHECK QUOTAS
;COMMAND ERRORS

LSCA.5:	MOVX	T1,'LGTISK'		;GET ERROR CODE
	MOVEI	T2,[ASCIZ /Illegal Syntax in KJOB Command/]
	JRST	DIE			;AND DIE

LSCA.6:	MOVX	T1,'LGTCSK'		;GET THE CODE
	MOVEI	T2,[ASCIZ /Conflicting Switches in KJOB Command/]
	JRST	DIE			;AND GIVE UP

DIE:	HRLI	T2,"?"			;AND A QUESTION MARK
	PUSHJ	P,.ERMSG##		;TYPE A MESSAGE
	PUSHJ	P,.TCRLF##		;TYPE A CRLF
	CLRBFI				;AND CLEAR TYPE AHEAD
	JRST	DOEXIT			;AND EXIT


;HERE ON AN ILLEGAL SWITCH.  GIVE A WARNING AND CONTINUE SCANNING.
;GET HERE WITH T1 CONTAINING THE SWITCH TYPED.
;
LSCA.7:	PUSH	P,T1			;SAVE SWITCH
	MOVX	T1,'LGTURS'		;UNRECOGNIZED SWITCH
	MOVEI	T2,[ASCIZ ?Unrecognized switch ?]
	HRLI	T2,"%"			;MAKE IT A WARNING
	PUSHJ	P,.ERMSG##		;TYPE IT
	MOVEI	T1,"/"			;LOAD A SLASH
	PUSHJ	P,.TCHAR##		;AND TYPE IT
	POP	P,T1			;GET SWITCH BACK
	PUSHJ	P,.TFCHR##		;TYPE IT
	MOVEI	T1,[ASCIZ / - ignored/]
	PUSHJ	P,.TSTRG##		;TELL HIM WHAT WE'RE DOING
	PUSHJ	P,.TCRLF##		;TYPE A CRILIF
	JRST	LSCA.2			;AND CONTINUE SCANNING
SUBTTL	Main Quota Checking Loop

CHKQTA:	CLEARM	L.OVQT			;CLEAR THE OVER-QUOTA FLAG
	PUSHJ	P,DELTMP		;DELETE JOB'S TMP FILES
	SETZM	L.STR			;TO GET FIRST STR FROM NXTSTR

CHKQ.1:	PUSHJ	P,NXTSTR		;GET THE NEXT STRUCTURE IN THE S/L
	SKIPN	L.STR			;IS THERE A STR?
	JRST	CHKQ.6			;NO, DONE
	PUSHJ	P,SETLOK		;SET UFD INTERLOCK
	MOVX	T1,.IODMP+UU.PHS	;GET OPEN BITS
	MOVE	T2,L.STR		;GET STRUCTURE NAME
	CLEAR	T3,			;NO BUFFERS
	OPEN	FS,T1			;OPEN THE STRUCTURE
	  JRST	T$OUF			;LOSE!!
	MOVE	T1,L.DCBK+.DCSMT	;GET MOUNT COUNT
	SOJLE	T1,CHKQ.3		;I'M THE ONLY USER
	OTHUSR	T1,			;OTHER JOBS SAME PPN?
	  JRST	CHKQ.3			;NO, MUST CHECK QUOTA

;THERE IS ANOTHER JOB LOGGED IN UNDER MY PPN.  LOOP THRU TO SEE
;	IF HE (THEM) HAS THIS STR IN HIS S/L.  IF SO, WE'LL GET
;	IT WHEN HE LOGS OFF.

	MOVE	T2,F.PPN		;LOAD MY PPN
	MOVE	T3,L.STR		;AND THE STRUCTURE NAME
	MOVEI	T1,1			;START WITH JOB 1
	SKIPN	P1,L.HJIU		;LOAD HIEST JOB NO. IN USE
	MOVE	P1,L.MXJB		;COULDN'T GET IT, USE JOBN

CHKQ.2:	CAMN	T1,L.JOB		;IS THIS MY JOB?
	JRST	CHKQ2A			;YES, SKIP IT
	MOVE	T4,[3,,T1]		;ARG POINTER FOR GOBSTR
	GOBSTR	T4,			;SEE IF ITS THERE
	  JRST	CHKQ2A			;IT'S NOT, KEEP CHECKING
	SETOM	L.OJCS			;IT IS, SET A FLAG FOR "SUMARY"
	JRST	CHKQ.5			;AND SKIP THE CHECK
CHKQ2A:	CAME	T1,P1			;DONE?
	AOJA	T1,CHKQ.2		;NO, LOOP


				;CONTINUED ON NEXT PAGE
				;CONTINUED FROM PREVIOUS PAGE

CHKQ.3:	PUSHJ	P,DOCHK			;CHECK THE QUOTA
	SKIPN	L.DSTS			;IS STR OVER QUOTA?
	JRST	CHKQ.4			;NO, GET NEXT
	SETOM	L.OVQT			;SET "OVER QUOTA SOMEWHERE" FLAG
	PUSHJ	P,T$LQE			;TYPE OVER-QUOTA MESSAGE
	MOVE	P1,L.TYPE		;GET LOGOUT TYPE
	CAIE	P1,LTYPEB		;BATCH LOGOUT?
	JRST	CHKQ.5			;NO, DON'T FINISH OFF THE UFD
	MOVE	T1,L.STR		;YES, GET STR NAME
	MOVE	T2,F.PPN		;AND THE PPN
	MOVE	T3,L.QOUT		;AND THE QUOTA
	MOVEI	T4,SCR			;AND THE CHANNEL
	PUSHJ	P,.LGTBA##		;PUT HIM UNDER QUOTA
	MOVEM	T1,L.UUO+.RBUSD		;WE DID A RECOMP IN LGTBA
	MOVEM	T1,L.USE		;AND SAVE TO TOTAL
CHKQ.4:	PUSHJ	P,UFDDSP		;FINISH OFF THE UFD
CHKQ.5:	RELEAS	FS,			;RELEASE THE CHANNEL
	PUSHJ	P,CLRLOK		;CLEAR THE UFD INTERLOCK
	MOVE	T1,L.USE		;GET NUMBER OF BLOCKS
	ADDM	T1,L.TBLK		;AND ADD TO TOTAL
	JRST	CHKQ.1			;LOOP
CHKQ.6:	MOVE	P1,L.TYPE		;GET LOGOUT TYPE
	CAIE	P1,LTYPEB		;ARE WE /BATCH?
	SKIPL	L.OVQT			;NO, ARE WE OVER QUOTA ANYWHERE?
	JRST	DOACCT			;EITHER BATCH OR UNDER QUOTA
	JRST	DOEXIT			;WE'RE OVER ON /F
SUBTTL	NXTSTR  --  Get Next Structure in S/L

;CALL NXTSTR WILL THE CURRENT STRUCTURE NAME IN L.STR TO RETURN
;	THE NEXT STRUCTURE IN THE SEARCH LIST IN L.STR.
;
;WHEN THE END OF THE SEARCH LIST IS REACHED (OR IF JOBSTR FAILS),
;	L.STR IS RETURNED CONTAINING 0.

NXTSTR:	SKIPN	T2,L.STR		;GET LAST STRUCTURE
	SETO	T2,			;NULL, BEGINNING OF LIST
NXTS.1:	MOVE	T1,[3,,T2]		;ARG TO JOBSTR
	JOBSTR	T1,			;GET THE NEXT STRUCTURE
	  JRST	NXTS.3			;LOSE!!
	MOVEM	T2,L.STR		;SAVE THE STR NAME
	MOVEM	T2,L.DCBK		;AND SAVE FOR DSKCHR
	JUMPE	T2,NXTS.1		;IGNORE THE FENCE
	AOJE	T2,NXTS.4		;END OF LIST IF -1

	MOVE	T3,T4			;GET STR FLAGS INTO T3
	TXZN	T3,DF.SWL		;WAS SOFTWARE WRITE LOCK SET?
	JRST	NXTS.2			;NO, CONTINUE
	MOVEI	T1,.FSMNW		;LOAD FUNCTION CODE INTO T1
	MOVE	T2,L.STR		;GET STRUCTURE IN T2
	MOVE	T4,[3,,T1]		;LOAD ARGLIST POINTER
	STRUUO	T4,			;CLEAR SOFTWARE WRITE-LOCK
	  PUSHJ	P,[MOVX T1,'LGTCCW'
		   MOVEI T2,[ASCIZ /Can't clear software write-lock on structure /]
		   HRLI  T2,"%"
		   PUSHJ P,.ERMSG##
		   PUSHJ P,TYPSTR
		   PJRST  .TCRLF##]

NXTS.2:	MOVE	T1,[L.DCBK+1,,L.DCBK+2]
	CLEARM	L.DCBK+1		;CLEAR FIRST WORD OF DSKCHR BLOCK
	BLT	T1,L.DCBK+.DCSMT	;CLEAR THE REST
	MOVE	T1,[.DCSMT+1,,L.DCBK]
	DSKCHR	T1,UU.PHY		;GET DISK CHARACTERISTICS
	  JFCL				;LOSE, RETURN ZEROED WORDS
	POPJ	P,			;RETURN


NXTS.3:	MOVX	T1,'LGTJUF'		;GET THE ERROR CODE
	MOVEI	T2,[ASCIZ /JOBSTR UUO Failed - No Quota Enforcement
/]
	HRLI	T2,"%"			;AND THE CHARACTER
	PUSHJ	P,.ERMSG##		;TYPE THE MESSAGE

NXTS.4:	CLEARM	L.STR			;ZERO THE STRUCTURE WORD
	POPJ	P,			;AND RETURN
SUBTTL	DOCHK  --  Routine to Quota-Check a Structure

;DOCHK IS CALLED FROM CHKQTA TO GET ALL THE VITAL STATISTICS
;	ABOUT THE UFD AND DETERMINE WHETHER ITS OVER QUOTA.

DOCHK:	PUSHJ	P,.SAVE1##		;SAVE P1
	MOVE	T1,[L.UUO,,L.UUO+1]
	CLEARM	L.UUO			;CLEAR FIRST WORD OF LOOKUP BLOCK
	BLT	T1,L.UUO+.RBTIM		;CLEAR THE REST

	MOVEI	T1,.RBTIM		;GET LENGTH OF BLOCK
	MOVEM	T1,L.UUO		;STORE RIBCNT
	MOVE	T1,F.PPN		;GET MY PPN
	MOVEM	T1,L.UUO+.RBNAM		;STORE AS FILENAME
	MOVSI	T1,'UFD'		;.UFD
	MOVEM	T1,L.UUO+.RBEXT
	MOVE	T1,L.MFPP		;GET THE MFD PPN
	MOVEM	T1,L.UUO+.RBPPN		;AND STORE IT
	CLEARM	L.DSTS			;NOT OVER QUOTA, YET
	CLEARM	L.USE			;AND NO BLOCKS USED, YET
	LOOKUP	FS,L.UUO		;LOOKUP THE UFD
	  JRST	T$ULF			;LOOKUP FAILED

	MOVX	T1,DC.NPA		;GET "NO PREVIOUS ACCESS" BIT
	CAME	T1,L.DCBK+.DCUFT	;WAS IT SET?
	JRST	DOCH.1			;NO, GO NORMAL ROUTE
	MOVE	T1,L.UUO+.RBUSD		;GET RIBUSD
	JRST	DOCH.2			;AND MEET AT THE PASS

DOCH.1:	MOVE	T1,L.UUO+.RBQTF		;GET FCFS QUOTA
	SUB	T1,L.DCBK+.DCUFT	;SUBTRACT UFBTAL
DOCH.2:	MOVEM	T1,L.USE		;AND SAVE BLOCKS USED
	SETOM	L.UUO+.RBUSD		;LET MONITOR FILL IN RIBUSD
					; TO AVOID ANY RACES
	CLEAR	P1,			;SET "FIRST TIME THRU"

DOCH.3:	MOVE	T1,L.UUO+.RBQTO		;GET LOGGED-OUT QUOTA
	MOVEM	T1,L.QOUT		;AND SAVE IT
	SUB	T1,L.USE		;SUBTRACT USED
	JUMPGE	T1,DOCH.4		;JUMP IF ASSUMPTION WAS CORRECT
	MOVNM	T1,L.DSTS		;ELSE, SAVE OVERAGE
	MOVE	T2,L.TYPE		;GET THE LOGOUT TYPE
	SKIPN	P1			;FIRST TIME THRU?
	CAIN	T2,LTYPEB		;IS THIS NOT /B?
	POPJ	P,			;NO, OR WE'VE BEEN HERE BEFORE
	PUSHJ	P,RECOMP		;RECOMP THE STRUCTURE
	MOVEM	T1,L.USE		;SAVE BLOCKS USED
	MOVEM	T1,L.UUO+.RBUSD		;AND IN UFD ALSO
	CLEARM	L.DSTS			;CLEAR THE OVERAGE FOR ANOTHER TRY
	AOJA	P1,DOCH.3		;SET "BEEN HERE" FLAG AND LOOP
DOCH.4:	POPJ	P,			;AND RETURN
SUBTTL	Accounting

DOACCT:	MOVE	T1,L.TYPE		;GET LOGOUT TYPE
	CAIN	T1,LTYPEB		;IS IT /B
	PUSHJ	P,GTTABS		;YES, CHARGE HIM FOR ALL THAT WORK
	MOVE	T1,L.JOB		;GET MY JOB NUMBER
	DPB	T1,[POINT 9,F.HDR,17]

	SETOB	T1,T2			;ASSUME CTY IN T1, ARG FOR GETLCH IN T2
	SKIPGE	L.DET			;ARE WE DETACHED?
	JRST	DOAC.1			;YES, MAKE IT -2
	GETLCH	T2			;GET LINE CHARACTERISTICS
	TXNE	T2,GL.ITY		;IS THIS OVER A PTY
	SETOM	L.PTY			;YES, SET FLAG
	TXNE	T2,GL.CTY		;IS THIS THE CTY?
	JRST	DOAC.2			;YES, WE ARE ALL DONE
	SKIPA	T1,T2			;GET LINE NUMBER IN T1
DOAC.1:	TRZ	T1,1			;MAKE -1 INTO -2
DOAC.2:	DPB	T1,[POINT 12,F.HDR,29]

	MOVE	T1,F.RTM		;GET RUNTIME IN TICKS
	IMULI	T1,^D1000		;CONVERT TO MILLI-TICKS
	IDIV	T1,L.TIC		;CONVERT TO MILLI-SECONDS
	MOVEM	T1,F.RTM		;AND STORE RUNTIME

	MOVE	T1,F.CTI		;GET CTI IN KCTS
	IMULI	T1,^D100		;GET CTI IN <KCT>*100
	IDIV	T1,L.TIC		;DIVIDE BY JIFSEC
	MOVEM	T1,F.CTI		;YIELDING KILO-CORE-CENTI-SECS

	MOVSI	T1,777700		;MASK FOR INCREMENTAL READS AND WRITES
	ANDCAM	T1,F.DRD		;TURN OFF INCREMENTAL READS
	ANDCAM	T1,F.DWT		;TURN OFF INCREMENTAL WRITES

	MOVEI	T1,.FACT		;GET DAEMON FUNCTION
	MOVEM	T1,F.FUN		;SAVE IN THE FACT BLOCK
	MOVE	T1,[141000,,7]		;GET FUNCTION WORD
	IORM	T1,F.HDR		;AND OR IT IN
	MOVE	T1,[F.LEN,,F.FUN]
	DAEMON	T1,			;CALL THE DAEMON
	  JRST	T$ASF			;STRANGE??
	JRST	SUMARY			;ONWARD AND UPWARD
SUBTTL	Type Summary Messages

SUMARY:	SKIPE	L.NWRD			;DID HE SAY /N?
	JRST	SUMA.2			;YES, HE DOESN'T WANT MESSAGE
	MOVEI	T1,[ASCIZ /Job /]
	PUSHJ	P,.TSTRG##
	MOVE	T1,L.JOB		;GET JOB NUMBER
	PUSHJ	P,.TDECW##		;TYPE IT  "JOB NN"
	MOVEI	T1,[ASCIZ /  User /]
	PUSHJ	P,.TSTRG##
	SKIPE	T1,L.MYN1		;GET FIRST HALF OF MY NAME
	PUSHJ	P,.TSIXN##		;TYPE IT
	SKIPN	T1,L.MYN1		;GET FIRST HALF OF MY NAME BACK
	MOVEI	T1,77			;MAKE THE FOLLOWING TEST FAIL
	TRNN	T1,77			;WAS THE LAST CHARACTER A SPACE?
	PUSHJ	P,.TSPAC##		;YES, TYPE A SPACE
	SKIPE	T1,L.MYN2		;GET SECOND HALF
	PUSHJ	P,.TSIXN##		;TYPE IT
	PUSHJ	P,.TSPAC##		;TYPE A SPACE
	MOVE	T1,F.PPN		;GET MY PPN
	PUSHJ	P,.TPPNW##		;AND TYPE IT
	PUSHJ	P,.TCRLF##		;TYPE A CRLF
	MOVEI	T1,[ASCIZ /Logged-off /]
	PUSHJ	P,.TSTRG##		;TYPE THE STRING
	MOVE	T1,L.TTY		;GET THE TTY NAME
	PUSHJ	P,.TSIXN##		;AND TYPE IT
	MOVEI	T1,[ASCIZ /  at /]
	PUSHJ	P,.TSTRG##		;TYPE IT
	PUSHJ	P,.TTIMN##		;TYPE THE TIME
	MOVEI	T1,[ASCIZ /  on /]
	PUSHJ	P,.TSTRG##
	PUSHJ	P,.TDATN##		;TYPE THE DATE
	PUSHJ	P,.TCRLF##		;AND A CRLF


				;"SUMARY" IS CONTINUED ON THE NEXT PAGE
				;CONTINUED FROM PREVIOUS PAGE

SUMA.1:	MOVEI	T1,[ASCIZ /Runtime:/]
	PUSHJ	P,.TSTRG##		;AND A LABEL
	MOVE	T1,F.RTM		;GET RUNTIME IN MILLI-SECONDS
	PUSHJ	P,.TTIME##		;TYPE IT
	MOVEI	T1,[ASCIZ /, KCS:/]
	PUSHJ	P,.TSTRG##
	MOVE	T1,F.CTI		;GET CORE-TIME INTEGRAL IN KCS*100
	IDIVI	T1,^D100		;CONVERT TO KCS
	PUSHJ	P,.TDECW##		;TYPE IT
	MOVEI	T1,[ASCIZ /, Connect time:/]
	PUSHJ	P,.TSTRG##		;TYPE IT
	MOVE	T1,L.NOW		;GET TIME OF DAY NOW
	SUB	T1,L.JLT		;SUBTRACT JOB LOGIN TIME
	MULI	T1,^D86400		;CONVERT TO SECONDS
	ASHC	T1,^D17			;SHIFT IT IN
	IMULI	T1,^D1000		;CONVERT TO MILLISECS
	PUSHJ	P,.TTIME##		;AND TYPE IT
	PUSHJ	P,.TCRLF##		;AND A CRLF
	MOVEI	T1,[ASCIZ /Disk Reads:/]
	PUSHJ	P,.TSTRG##		;TYPE A LINE
	MOVE	T1,F.DRD		;GET NUMBER OF READS
	PUSHJ	P,.TDECW##		;AND TYPE IT
	MOVEI	T1,[ASCIZ /, Writes:/]
	PUSHJ	P,.TSTRG##
	MOVE	T1,F.DWT		;GET NUMBER OF WRITES
	PUSHJ	P,.TDECW##		;TYPE IT
	SKIPE	L.OJCS			;OTHER JOB CONTAIN CONFLICTING STR?
	JRST	SUMA.2			;YES, WE DIDN'T COUNT EVERYTHING THEN
	MOVEI	T1,[ASCIZ /, Blocks saved:/]
	PUSHJ	P,.TSTRG##
	MOVE	T1,L.TBLK		;GET TOTAL NUMBER OF BLOCKS
	PUSHJ	P,.TDECW##		;AND TYPE IT
SUMA.2:	PUSHJ	P,.TCRLF##		;AND A CRLF
	MOVEI	T1,ENDMSG		;ADDRESS OF FINAL MESSAGE
	SKIPE	L.NWRD			;DID HE SAY /N?
	MOVEI	T1,ENDMS1		;YES, JUST TYPE "."
	SKIPL	L.PTY			;BUT NOT IF THIS IS A PTY
	PUSHJ	P,.TSTRG		;TYPE IT
	JRST	BYEBYE			;AND SAY GOODBYE

ENDMSG:	BYTE (7) .CHLFD,.CHLFD,.CHLFD,.CHLFD,.CHLFD
	BYTE (7) .CHLFD,.CHLFD,.CHLFD,.CHLFD,.CHLFD
ENDMS1:	BYTE (7) ".",0,0
SUBTTL	Finishing-Up

BYEBYE:	CLEARB	T3,T4		;BLOCK FOR TMPCOR UUO
	MOVE	T1,[.TCRDD,,T3]	;DELETE DIRECTORY
	TMPCOR	T1,		;DO IT
	  JFCL			;DOESN'T MATTER

	MOVEI	T1,.FSDSL	;FUNCTION TO DEFINE S/L
	SETOB	T2,T3		;MY JOB, MY PPN
	MOVX	T4,DF.SRM	;DELETE ALL STRS
	MOVE	P1,[4,,T1]	;ARGLIST
	STRUUO	P1,		;DO IT!!
	  JFCL			;OH WELL, AT LEAST WE TRIED


	LOGOUT			;****END OF JOB****
SUBTTL	SETLOK  --  Set UFD Interlock

;SETLOK IS CALLED TO SET THE UFD INTERLOCK FOR THE STR WHOSE NAME IS
;	IN L.STR.  SETLOK WILL MAKE "TM2TRY" TRIES AND SLEEP FOR "SLTIME"
;	MILLISECS BETWEEN EACH TIME, AND THEN FORCE THE INTERLOCK.
;	AFTER "TMB4MS" TRIES, A MESSAGE EXPLAINING THE WAIT IS TYPED.

SETLOK:	PUSHJ	P,.SAVE1##		;SAVE P1
	MOVEI	T1,.FSULK		;FUNCTION IN T1
	MOVE	T2,L.STR		;STRUCTURE IN T2
	MOVE	T3,F.PPN		;AND PPN IN T3
	MOVEI	P1,TM2TRY		;AND NUMBER OF TIMES TO TRY

SETL.1:	MOVE	T4,[3,,T1]		;ARGLIST FOR STRUUO
	STRUUO	T4,			;AND DO IT
	  SKIPA				;COULDN'T GET IT
	POPJ	P,			;GOT IT!!

	CAIE	P1,<TM2TRY-TMB4MS>	;TIME FOR A MESSAGE?
	JRST	SETL.2			;NO, JUST SLEEP
	PUSHJ	P,.PSH4T##		;SAVE T1-T4
	MOVEI	T1,[ASCIZ /[LGTWFI  Waiting for /]
	PUSHJ	P,.TSTRG##		;TYPE THE FIRST PART
	PUSHJ	P,TYPSTR		;TYPE THE STRUCTURE NAME
	MOVEI	T1,[ASCIZ / UFD Interlock]
/]
	PUSHJ	P,.TSTRG##		;AND FINISH OFF
	PUSHJ	P,.POP4T##		;RESTORE T1-T4

SETL.2:	MOVEI	T4,SLTIME		;LOAD THE SLEEP TIME
	HIBER	T4,			;ZZZZZ
	  JFCL
	SOJG	P1,SETL.1		;LOOP FOR ANOTHER TRY
	POPJ	P,			;WE'VE WAITED LONG ENOUGH,
					; FORCE IT
SUBTTL	CLRLOK  --  Clear UFD Interlock

CLRLOK:	MOVEI	T1,.FSUCL		;LOAD FUNCTION,
	MOVE	T2,L.STR		;STRUCTURE NAME
	MOVE	T3,F.PPN		;AND PPN
	MOVE	T4,[3,,T1]		;ARGLIST FOR STRUUO
	STRUUO	T4,			;DO IT
	  POPJ	P,			;PUNT!
	POPJ	P,			;WIN!!
SUBTTL	RECOMP  --  Recompute Blocks Used

;CALLED WITH STRUCTURE NAME IN L.STR.  RETURN WITH BLOCKS USED
;	IN T1.

RECOMP:	MOVEI	T1,[ASCIZ /[LGTRDU  Recomputing Disk Usage on /]
	PUSHJ	P,.TSTRG##	;TYPE THE STRING
	PUSHJ	P,TYPSTR	;TYPE THE STRUCTURE NAME
	MOVEI	T1,"]"		;A CLOSE BRACKET
	PUSHJ	P,.TCHAR##	;TYPE IT
	PUSHJ	P,.TCRLF##	;AND A CRLF
	MOVE	T1,L.STR	;GET STRUCTURE NAME
	MOVE	T2,F.PPN	;GET PPN
	MOVEI	T3,SCR		;SCRATCH CHANNEL
	PJRST	.LGTRC##	;RECOMP AND RETURN
SUBTTL	DELTMP  --  Routine to delete job's TMP files


DELTMP:	PUSHJ	P,.SAVE3##		;SAVE P1-P3
	MOVSI	T1,'DSK'		;GET "DISK"
	MOVE	T2,F.PPN		;GET PPN
	HRLOI	T3,'TMP'		;AND EXT,,MASK
	PUSHJ	P,.LGTSE##		;SETUP TO READ DSK:*.TMP
	CLEARM	L.NTMP			;AND ZERO THE COUNT

	MOVE	P1,L.JOB		;GET JOB NUMBER
	IDIVI	P1,^D100		;START SPLITTING DIGITS
	IDIVI	P2,^D10			;AND THE LAST 2
	LSH	P1,^D12			;SHIFT OVER 2 PLACE
	LSH	P2,^D6			;SHIFT OVER 1 PLACE
	IORI	P1,'000'(P2)		;AND PUT THEM BACK TOGETHER IN 6BIT
	IOR	P1,P3			;AND THE LAST DIGIT
	SETZM	L.STR			;START WITH NO STRUCTURE

DELT.1:	CLEARB	T1,T2			;USE DEFAULT BLOCKS
	PUSHJ	P,.LGTLA##		;GET A FILE
	  JRST	DELT.3			;DONE, FINISH UP
	HLRZ	T3,.RBNAM(T2)		;GET FIRST 3 CHARS OF FILENAME
	CAME	T3,P1			;IS IT FOR THIS JOB?
	JRST	DELT.1			;NO, LOOP AROUND
	MOVE	T3,1(T1)		;GET DEVICE FROM OPEN BLOCK
	CAMN	T3,L.STR		;SAME AS LAST STRUCTURE?
	JRST	DELT.2			;YES, CONTINUE ON
	MOVEM	T3,L.STR		;NO, SAVE STRUCTURE NAME
	MOVEI	T3,.IODMP		;LOAD AN I/O MODE
	MOVEM	T3,0(T1)		;STORE IT IN THE OPEN BLOCK
	OPEN	SCR,0(T1)		;OPEN THE DEVICE
	  JRST	T$OUF			;AND GIVE THE ERROR
DELT.2:	LOOKUP	SCR,(T2)		;YES, LOOKUP IT UP
	  JRST	DELT.1			;LOSE
	LDB	T1,[POINT 9,.RBPRV(T2),8] ;GET PROTECTION
	CAIL	T1,200			;IS IT UNPRESERVED?
	JRST	DELT.1			;NO, IGNORE IT
	CLEARB	T1,T2			;SETUP TO DELETE IT
	CLEARB	T3,T4			; "     "    "   "
	RENAME	SCR,T1			;AND DELETE IT
	  JRST	DELT.1			;LOSE
	AOS	L.NTMP			;WIN, COUNT IT UP
	JRST	DELT.1			;AND LOOP AROUND

DELT.3:	RELEAS	SCR,			;RELEASE THE CHANNEL
	SKIPN	L.NTMP			;ANYTHING DELETED?
	POPJ	P,			;NO, JUST RETURN
	MOVEI	T1,[ASCIZ /[LGTDTF  Deleted /]
	PUSHJ	P,.TSTRG##		;TYPE FIRST PART
	MOVE	T1,L.NTMP		;GET NUMBER OF FILES
	PUSHJ	P,.TDECW##		;TYPE IT
	MOVEI	T1,[ASCIZ / TMP files]
/]
	PJRST	.TSTRG##		;TYPE SECOND PART AND RETURN
SUBTTL	UFDDSP  --  Dispose of UFD

;UFDDSP IS CALLED AFTER QUOTA ENFORCEMENT IS DONE ON A STRUCTURE.  IF
;	THE STRUCTURE STILL HAS FILES ON IT, THE UFD IS JUST RENAMED
;	TO TURN THE LOGGED-IN BIT OFF.  IF THERE ARE NO FILES ON THE
;	STRUCTURE, THE UFD IS DELETED.

UFDDSP:	MOVE	T1,L.UUO+.RBSTS		;GET RIBSTS FOR THE UFD
	TXNE	T1,RP.NDL		;"NO DELETE"?
	POPJ	P,			;YES, ALSO NO RENAME
	TXZ	T1,RP.LOG		;TURN OFF LOGGED-IN BIT
	MOVEM	T1,L.UUO+.RBSTS		;AND SAVE RIBSTS
	HLRZ	T1,F.PPN		;GET MY PROJECT NUMBER
	HRRZ	T2,F.PPN		;GET MY PROGRAMMER NUMBER
	CAILE	T2,10			;AM I [A,B] S.T. B<=10
	CAIGE	T1,10			;OR [A,B] S.T. A<10
	JRST	UFDD.1			;YES, JUST RENAME UFD.
	SKIPN	L.UUO+.RBSIZ		;ANYTHING WRITTEN IN UFD?
	JRST	UFDD.2			;NO, DELETE IT
	SKIPE	L.USE			;ANYTHING IN THE UFD
	JRST	UFDD.1			;DEFINITELY.
	MOVE	T1,L.STR		;GET THE STR NAME
	MOVE	T2,F.PPN		;AND THE PPN
	PUSHJ	P,.LGTSA##		;SETUP TO LOOKUP EVERYTHING UP
	CLEARB	T1,T2			;USE DEFAULTS FOR EVERY THING
	PUSHJ	P,.LGTLA##		;LOOKUP FIRST FILE
	  JRST	UFDD.2			;NOTHING THERE, DELETE UFD

;HERE TO RENAME THE UFD
UFDD.1:	RENAME	FS,L.UUO		;RENAME THE UFD
	  PUSHJ	P,T$URF			;FAILED?
	POPJ	P,			;AND RETURN

;HERE TO DELETE THE UFD
UFDD.2:	PUSHJ	P,.SAVE4##		;SAVE P1-P4
	CLEARB	P1,P2			;MAKE A ZEROED RENAME BLOCK
	CLEARB	P3,P4			; "   "
	RENAME	FS,P1			;DELETE THE UFD
	  JRST	UFDD.1			;CAN'T DELETE, JUST TRY RENAME
	POPJ	P,			;AND RETURN
SUBTTL	GTTABS  --  Routine to do all GETTABs

;GTTABS IS DRIVEN BY THREE TABLES GENERATED BY THE "TABS" MACRO.
;	THE FIRST TABLE CONTAINS THE ARGUMENT TO GETTAB, THE SECOND,
;	CONTAINS DEFAULTS TO USE ON FAILURE, AND THE THIRD CONTAINS
;	AN INSTRUCTION WHICH IS EXECUTED TO STORE THE RESULTS.

;HISTORICAL NOTE:  THE GETTAB UUO (CALLI 41)  IS NEW WITH THE 3.19
;	MONITOR RELEASE.  THE UUO WAS IMPLEMENTED TO ALLOW UNPRIVILEGED
;	PROGRAMS TO EXAMINE VARIOUS MONITOR TABLES.  THE CALL IS:
;		MOVE AC,[INDEX,,TABLE#]
;		GETTAB AC,
;		  ERROR RETURN

GTTABS:	MOVSI	T2,-.NMTAB		;MAKE AOBJN POINTER
GTTAB1:	MOVE	T1,GTAB1(T2)		;GET AN ARGUMENT
	GETTAB	T1,			;DO THE GETTAB
	  MOVE	T1,GTAB2(T2)		;FAIL!! USE DEFAULT
	XCT	GTAB3(T2)		;STORE THE RESULT
	AOBJN	T2,GTTAB1		;AND LOOP
	POPJ	P,			;RETURN WHEN DONE

;THE ARGUMENTS TO THE TABS MACRO ARE:
;	1) ARGUMENT TO GETTAB
;	2) DEFAULT VALUE
;	3) INSTRUCTION TO STORE RESULT
;	     (NOTE: MACRO EXPANSION GENERATES THE CORRECT AC FIELD
;		    THEREFORE IT SHOULD BE BLANK IN THE ARGUMENT)

DEFINE TABS,<
	T	<%LDMFD>,<1,,1>,<MOVEM L.MFPP>
	T	<-1,,.GTPPN>,<0>,<MOVEM F.PPN>
	T	<-1,,.GTNM1>,<0>,<MOVEM L.MYN1>
	T	<-1,,.GTNM2>,<0>,<MOVEM L.MYN2>
	T	<-1,,.GTPRV>,<0>,<MOVEM L.PRIV>
	T	<-1,,.GTKCT>,<0>,<MOVEM F.CTI>
	T	<-1,,.GTRCT>,<0>,<MOVEM F.DRD>
	T	<-1,,.GTWCT>,<0>,<MOVEM F.DWT>
	T	<-1,,.GTTIM>,<0>,<MOVEM F.RTM>
	T	<-1,,.GTCNO>,<0>,<MOVEM L.CNO>
	T	<-1,,.GTJLT>,<0>,<MOVEM L.JLT>
	T	<-1,,.GTLIM>,<0>,<MOVEM L.JLIM>
	T	<%CNSTS>,<0>,<MOVEM L.STS>
	T	<%CNDTM>,<0>,<MOVEM L.NOW>
	T	<%CNTIC>,<^D60>,<MOVEM L.TIC>
	T	<%CNSJN>,<^D64>,<HRRZM L.MXJB>
	T	<%NSHJB>,<0>,<MOVEM L.HJIU>
	T	<%LDFFA>,<1,,2>,<MOVEM L.FFA>
>  ;END OF TABS MACRO
DEFINE T(A,B,C),<
	EXP	<A>
>

GTAB1:	TABS
	.NMTAB==.-GTAB1

DEFINE T(A,B,C),<
	EXP	<B>
>

GTAB2:	TABS

DEFINE T(A,B,C),<
	EXP	<C> + <T1>B12
>

GTAB3:	TABS
SUBTTL	TTYOUT  --  Type a character on the user's teletype

;CALLED BY .TCHAR ROUTINE IN .TOUTS MODULE OF SCAN WITH CHARACTER FOR
;	TYPING IN T1.

TTYOUT:	SKIPL	L.DET			;ARE WE DETACHED?
	OUTCHR	T1			;ELSE TYPE THE CHARACTER
	POPJ	P,			;AND RETURN
SUBTTL	PSIDET  --  Interrupt Routine for DETACH

PSIDET:	SETOM	L.DET			;SET DETACHED FLAG
	DEBRK.				;AND RESTORE INTERRUPT LEVEL
	  JFCL				;??
	POPJ	P,			;HOPEFULLY CALLED BY PUSHJ
SUBTTL	PSICCI  --   Interrupt Routine for Control-C

PSICCI:	SKIPE	L.OKCC			;ARE WE ALLOWING ^C NOW?
	JRST	DOEXIT			;YES, GO AHEAD
	DEBRK.				;NO, DISMISS THE INTERRUPT
	  JFCL
	POPJ	P,			;IF CALLED WITH A PUSHJ
SUBTTL	DOEXIT  --  Routine to LOGIN and EXIT

DOEXIT:	MOVE	P1,F.PPN		;LOAD THE PPN
	MOVE	P2,L.PRIV		;GET JBTPRV WORD
	MOVE	P3,L.MYN1		;GET FIRST HALF OF MY NAME
	MOVE	P4,L.MYN2		;GET SECOND HALF OF MY NAME
	MOVE	P4+1,L.CNO		;GET CHARGE NUMBER
	MOVE	T1,[-5,,P1]		;ARGUMENT LIST
	CLRBFI				;CLEAR ANY TYPE-AHEAD
	LOGIN	T1,			;GET BACK IN
	  JFCL				;ERROR IF WE ARE LOGGED-IN
	RESET				;RESET THE WORLD
	MONRT.				;AND EXIT
	JRST	.-1			;WITH NO CONTINUE ALLOWED
SUBTTL	T$OUF  --  Type OPEN Failure message

;CALLED WITH L.STR CONTAINING THE STRUCTURE NAME.

T$OUF:	MOVEI	T1,[ASCIZ /?LGTOUF  OPEN UUO Failed for structure /]
	PUSHJ	P,.TSTRG##		;TYPE IT
	PUSHJ	P,TYPSTR		;TYPE A STRUCTURE NAME
	PUSHJ	P,.TCRLF##		;AND A CRLF
	JRST	DOEXIT			;AND EXIT
SUBTTL	T$LQE  --  Type Quota-Exceeded message

;CALL WITH STRUCTURE NAME IN L.STR

T$LQE:	PUSHJ	P,.PSH4T##	;SAVE T1-T4
	MOVEI	T1,"?"		;ASSUME A "?"
	MOVE	T2,L.TYPE	;GET LOGOUT TYPE
	CAIN	T2,LTYPEB	;/BATCH?
	MOVEI	T1,"%"		;YES, LOAD A "%"
	PUSHJ	P,.TCHAR##	;TYPE THE INITIAL CHARACTER
	MOVEI	T1,[ASCIZ /LGTLQE  /]
	PUSHJ	P,.TSTRG##	;START TYPING ERROR MESSAGE
	PUSHJ	P,TYPSTR	;TYPE THE STRUCTURE NAME
	MOVEI	T1,[ASCIZ / Logged-out quota /]
	PUSHJ	P,.TSTRG##
	MOVE	T1,L.QOUT	;GET THE QUOTA
	PUSHJ	P,.TDECW##	;AND TYPE IT
	MOVEI	T1,[ASCIZ / exceeded by /]
	PUSHJ	P,.TSTRG##	;TYPE IT
	MOVE	T1,L.DSTS	;GET OVERAGE
	PUSHJ	P,.TDECW##	;TYPE IT
	MOVEI	T1,[ASCIZ / blocks
/]
	PUSHJ	P,.TSTRG##	;FINISH IT OFF
	PUSHJ	P,.POP4T##	;RESTORE T1 THRU T4
	POPJ	P,		;AND RETURN
SUBTTL	T$ULF  --  Type UFD LOOKUP Failure

;CALLED WITH L.STR CONTAINING STRUCTURE NAME AND L.UUO CONTAINING
;	THE LOOKUP BLOCK.

T$ULF:	PUSHJ	P,.PSH4T##	;SAVE T1 THRU T4
	HRRZ	T1,L.UUO+.RBEXT	;GET ERROR CODE
	JUMPE	T1,T$ULF1	;NO UFD-->NO FILES-->UNDER QUOTA
	MOVEI	T1,[ASCIZ /%LGTULF  /]
	PUSHJ	P,.TSTRG##	;TYPE IT
	PUSHJ	P,TYPSTR	;TYPE THE STRUCTURE NAME
	MOVEI	T1,[ASCIZ / UFD LOOKUP Failure /]
	PUSHJ	P,.TSTRG##	;TYPE IT
	HRRZ	T1,L.UUO+.RBEXT	;GET THE CODE
	PUSHJ	P,.TOCTW##	;TYPE IT
	PUSHJ	P,.TCRLF##	;TYPE A CRLF
T$ULF1:	PUSHJ	P,.POP4T##	;RESTORE T1 - T4
	POPJ	P,		;AND RETURN
SUBTTL	T$URF  --  Type UFD RENAME Failure

;CALLED WITH L.STR CONTAINING STRUCTURE NAME, AND L.UUO CONTAINING
;	THE RENAME BLOCK.

T$URF:	PUSHJ	P,.PSH4T##	;SAVE T1-T4
	HRRZ	T1,L.UUO+.RBEXT	;GET ERROR CODE
	SKIPN	T1		;IF ZERO
	JRST	T$URF1		;JUST FORGET IT
	MOVEI	T1,[ASCIZ /%LGTURF  /]
	PUSHJ	P,.TSTRG##	;TYPE THE MESSAGE HEADER
	PUSHJ	P,TYPSTR	;TYPE THE STRUCTURE NAME
	MOVEI	T1,[ASCIZ / UFD RENAME Failure /]
	PUSHJ	P,.TSTRG##
	HRRZ	T1,L.UUO+.RBEXT	;GET ERROR CODE
	PUSHJ	P,.TOCTW##	;TYPE IT
	PUSHJ	P,.TCRLF##	;TYPE A CRLF
T$URF1:	PUSHJ	P,.POP4T##	;RESTORE ACS
	POPJ	P,		;AND RETURN
SUBTTL	T$ASF  -- Tell about accounting failure


T$ASF:	MOVE	P1,T1			;SAVE THE ERROR CODE
	SKIPN	L.BJOB			;IS THIS A BATCH JOB?
	JRST	T$ASF0			;NO, CONTINUE
	MOVEI	T1,""""			;LOAD A DOUBLE QUOTE
	PUSHJ	P,.TCHAR##		;TYPE IT
	PUSHJ	P,.TCRLF##		;AND A CRLF TO PUT JOB INTO DIALOG MODE
T$ASF0:	MOVEI	T1,[ASCIZ /?LGTASF  Accounting System Failure
/]
	PUSHJ	P,.TSTRG##		;TELL HIM IN BROAD TERMS
	MOVEI	T1,[ASCIZ /	DAEMON UUO Failed /]
	PUSHJ	P,.TSTRG##		;NOW BE MORE SPECIFIC
	CAMN	P1,[F.LEN,,F.FUN]	;DID AC CHANGE??
	JRST	T$ASF1			;DO, DAEMONS NOT RUNNING
	MOVEI	T1,[ASCIZ /- error code /]
	PUSHJ	P,.TSTRG
	MOVE	T1,P1			;GET THE ERROR CODE BACK
	PUSHJ	P,.TOCTW##		;AND TYPE IT
	JRST	T$ASF2			;AND FINISH UP

T$ASF1:	MOVEI	T1,[ASCIZ /- DAEMON not running/]
	PUSHJ	P,.TSTRG##

T$ASF2:	PUSHJ	P,.TCRLF##		;TYPE A CRLF
	SKIPE	L.BJOB			;IS THIS A BATCH JOB?
	JRST	T$ASF5			;YES, JUST CONTINUE
	MOVE	T1,F.PPN		;GET MY PPN
	CAMN	T1,L.FFA		;AM I OPR?
	JRST	T$ASF3			;YES, CONTINUE ANYWAY
	MOVE	T1,L.STS		;GET THE STATES WORD
	TXNE	T1,ST%NRT		;SCHED 10?
	JRST	T$ASF4			;YES, LET JMF THRU
	MOVEI	T1,[ASCIZ /	Call the Operator/]
	PUSHJ	P,.TSTRG##		;TELL HIM WHAT HE CAN DO
	PUSHJ	P,.TCRLF##		;AND TYPE A CRLF
	JRST	DOEXIT			;AND EXIT

T$ASF3:	MOVEI	T1,[ASCIZ /	Continuing since you are [OPR]/]
	PUSHJ	P,.TSTRG##		;TELL HIM THE GOOD NEWS
	PUSHJ	P,.TCRLF##		;AND A CRLF
	JRST	SUMARY			;AND GO OFF FOR SUMARY MESSAGES

T$ASF4:	MOVEI	T1,[ASCIZ /	Continuing for system debugging/]
	PUSHJ	P,.TSTRG##		;TYPE IT
	PUSHJ	P,.TCRLF##		;AND A CRLF
	JRST	SUMARY			;AND GIVE SUMARY

T$ASF5:	MOVEI	T1,[ASCIZ /	Continuing LOGOUT of Batch Job/]
	PUSHJ	P,.TSTRG##		;TYPE IT
	PUSHJ	P,.TCRLF##		;A CRLF
	JRST	SUMARY			;AND GIVE SUMARY MESSAGE
SUBTTL	TYPSTR  --  Routine to type current structure name

;TYPSTR IS CALLED TO TYPE THE CURRENT FILE-STRUCTURE NAME ON THE TTY.
;	THE STRUCTURE CONTAINED IN LOCATION L.STR IS USED, AND THE
;	ROUTINE TYPES OUT   "STR:"

TYPSTR:	MOVE	T1,L.STR		;GET THE STRUCTURE NAME
	PUSHJ	P,.TSIXN##		;TYPE IT
	PJRST	.TCOLN##		;TYPE A COLON AND RETURN
SUBTTL	Storage Area

	XLIST			;SO LITERALS DON'T COME OUT
	LIT			;FORCE OUT LITERAL POOL
	LIST			;RESTORE LISTING
	RELOC			;DOWN TO LOW-SEGMENT

LOWBEG:				;BEGINNING

L.PDL:	BLOCK	PDLSIZ		;PUSHDOWN LIST
L.CCL:	BLOCK	1		;CCL ENTRY FLAG
L.TYPE:	BLOCK	1		;LOGOUT TYPE, /F,/B
L.NWRD:	BLOCK	1		;FLAG = -1 IF /N
L.PSIB:	BLOCK	^D8		;INTERRUPT VECTOR FOR PSI
	DETINB==L.PSIB		;INTERRUPT CELL OFFSET FOR DETACH
	CCIINB==L.PSIB+		;INTERRUPT CELL OFFSET FOR ^C
L.OVQT:	BLOCK	1		;OVER-QUOTA FLAG
L.UUO:	BLOCK	.RBTIM+1	;LOOKUP BLOCK FOR UFDS
L.DCBK:	BLOCK	.DCSMT+1	;DSKCHR BLOCK
L.TBLK:	BLOCK	1		;ACCUMULATED TOTAL # BLOCKS
L.OJCS:	BLOCK	1		;OTHER JOB CONTAINS A STRUCTURE
L.OKCC:	BLOCK	1		;-1 IF ALLOWED OUT ON ^C


;STRUCTURE INFORMATION
L.STR:	BLOCK	1		;STRUCTURE NAME
L.QOUT:	BLOCK	1		;LOGGED-OUT QUOTA FOR STR
L.USE:	BLOCK	1		;BLOCKS USED ON STR
L.DSTS:	BLOCK	1		;STATUS
L.NTMP:	BLOCK	1		;NUMBER OF TEMP FILES DELETED

;JOB INFORMATION
L.JOB:	BLOCK	1		;JOB NUMBER
L.TTY:	BLOCK	1		;TTY NAME
L.DET:	BLOCK	1		;DETACHED FLAG
L.PTY:	BLOCK	1		;FLAG =1 IF THIS IS A PTY
L.MYN1:	BLOCK	1		;FIRST HALF OF MY NAME
L.MYN2:	BLOCK	1		;SECOND HALF OF MY NAME
L.CNO:	BLOCK	1		;MY CHARGE NUMBER
L.JLT:	BLOCK	1		;JOB LOGIN TIME IN UDT FORMAT
L.PRIV:	BLOCK	1		;MY PRIVILEGES
L.JLIM:	BLOCK	1		;JOB'S .GTLIM WORD
L.BJOB:	BLOCK	1		;-1 IF A BATCH JOB

;GETTAB INFORMATION
L.MFPP:	BLOCK	1		;MFD PPN
L.STS:	BLOCK	1		;SYSTEM STATES WORD
L.TIC:	BLOCK	1		;TICKS/SECOND
L.MXJB:	BLOCK	1		;MAXIMUM JOB NUMBER
L.HJIU:	BLOCK	1		;HIEST JOB NUMBER IN USE
L.FFA:	BLOCK	1		;FULL-FILE-ACCESS PPN [OPR]
L.NOW:	BLOCK	1		;NOW IN UDT FORMAT

;FACT BLOCK
F.FUN:	EXP	.FACT		;DAEMON FUNCTION
F.HDR:	141000,,000007		;ENTRY TYPE 141, 7 WORDS LONG
F.PPN:	BLOCK	1		;PPN WORD
F.DAT:	BLOCK	1		;DATE-TIME  (FILLED IN BY DAEMON)
F.RTM:	BLOCK	1		;RUNTIME (IN SECS*100)
F.CTI:	BLOCK	1		;CORE-TIME INTEGRAL IN <KCS>*100
F.DRD:	BLOCK	1		;TOTAL DISK READS
F.DWT:	BLOCK	1		;TOTAL DISK WRITES
	F.LEN==.-F.FUN		;LENGTH OF DAEMON BLOCK

	LOWEND==.-1
	PRGEND	LGOUT
TITLE	.LGTRC  --  Recompute Disk Usage on a File-structure
SUBTTL	Larry Samberg	4 Dec 74

;***Copyright (C) 1974,75, Digital Equipment Corp., Maynard MA.***

	SEARCH	MACTEN		;SEARCH MACRO DEFINITIONS
		%%MACT==%%MACT

	SEARCH	UUOSYM		;SEARCH UUO SYMBOLS
	SEARCH	SCNMAC		;SEARCH SCAN-WILD SYMBOLS


	TWOSEG			;HISEG PROGRAM
	RELOC	400000		;START IN HISEG

	SALL			;SUPPRESS MACRO EXPANSIONS

;This module provides a single routine .LGTRC which will
;	recompute disk usage for a specified UFD on a
;	specified file-structure.
SUBTTL	Accumulator Assignments

	T1=1			;T1 - T4 ARE TEMPS WHICH ARE
	T2=2			; NOT PRESERVED
	T3=3
	T4=4

	P1=5			;P1 - P4 MUST BE SAVED BEFORE USING
	P2=6
	P3=7
	P4=10

	P=17			;PUSHDOWN POINTER
SUBTTL	.LGTRC  --  Routine to Recompute Disk Usage

;.LGTRC IS CALLED WITH A FILE-STRUCTURE NAME IN T1, A PPN IN T2
;	AND THE NUMBER OF A FREE I/O CHANNEL IN T3. (CHAN 17 IS
;	USED IF THE ARGUMENT IS NOT BETWEEN 1 AND 16 INCLUSIVE).
;	IT RETURNS THE TOTAL NUMBER OF BLOCKS ALLOCATED ON THE
;	STRUCTURE IN T1.

	ENTRY	.LGTRC

.LGTRC:	SKIPLE	T3		;CHANNEL LE 0?
	CAILE	T3,17		;OR GT 17?
	MOVEI	T3,17		;YES, USE 17 AS DEFAULT
	ROT	T3,-^D13	;POSITION IT IN AC FIELD
	MOVEM	T3,L.CHN	;AND SAVE IT
	MOVX	T4,<LOOKUP (T2)>;BUILD SOME UUOS
	IOR	T4,T3		;OR IN THE CHANNEL FIELD
	MOVEM	T4,L.LKUP	;AND SAVE IT
	MOVX	T4,<CLOSE CL.ACS>;AND THE CLOSE UUO
	IOR	T4,T3		;OR IN THE CHANNEL
	MOVEM	T4,L.CLS	;SAVE IT
	PUSH	P,T1		;SAVE STRUCTURE NAME
	PUSHJ	P,.LGTSA##	;SETUP TO LOOKUP *.*
	POP	P,T2		;GET STRUCTURE NAME BACK
	MOVX	T1,.IODMP+UU.PHS;OPEN BITS
	CLEAR	T3,		;NO BUFFERS
	MOVE	T4,[OPEN T1]	;OPEN UUO
	IOR	T4,L.CHN	;OR IN THE CHANNEL
	XCT	T4		;AND DO IT
	  HALT .		;***FOR NOW
	CLEARM	L.TOT		;CLEAR COUNT

LGTRC1:	CLEARB	T1,T2		;USE DEFAULT OPEN AND LKUP BLOCKS
	PUSHJ	P,.LGTLA##	;GET A FILE
	  JRST	LGTRC2		;DONE
	XCT	L.LKUP		;LOOKUP THE FILE
	  HALT  .		;***FOR NOW
	MOVE	T1,.RBALC(T2)	;GET BLOCKS ALLOCATED
	ADDM	T1,L.TOT	;ADD TO THE TOTAL
	XCT	L.CLS		;CLOSE THE CHANNEL
	JRST	LGTRC1		;AND LOOP

LGTRC2:	MOVX	T1,<RELEAS>	;GET THE UUO
	IOR	T1,L.CHN	;OR IN THE CHANNEL
	XCT	T1		;AND DO THE UUO
	MOVE	T1,L.TOT	;GET THE TOTAL
	POPJ	P,		;AND RETURN
SUBTTL	Storage Area

	XLIST			;SO LITERALS DON'T COME OUT
	LIT			;FORCE OUT LITERAL POOL
	LIST			;RESTORE LISTING
	RELOC			;DOWN TO LOW-SEGMENT

L.TOT:	BLOCK	1		;ACCUMULATED TOTAL
L.CHN:	BLOCK	1		;<CHANNEL>B12
L.LKUP:	BLOCK	1		;LOOKUP UUO
L.CLS:	BLOCK	1		;CLOSE UUO


	PRGEND
TITLE	.LGTBA  --  Batch File Deletion Algorithm
SUBTTL	Larry Samberg	3 Jul 75

;***Copyright (C) 1974,75, Digital Equipment Corp., Maynard MA.***

	SEARCH	MACTEN		;SEARCH MACRO DEFINITIONS
		%%MACT==%%MACT

	SEARCH	UUOSYM		;SEARCH UUO SYMBOL DEFINITIONS
	SEARCH	SCNMAC		;SEARCH SCAN-WILD DEFINITIONS

	TWOSEG			;HISEG PROGRAM
	RELOC	400000		;START IN HISEG

	SALL			;SUPPRESS MACRO EXPANSIONS

;This module provides a deletion algorithm for
;	forcing a user under his logout quota.  The single entry
;	point .LGTBA is called with the structure name, the
;	PPN, and the logout quota for the structure.  Upon
;	return, the user will be under quota on that structure.
SUBTTL	Accumulator Assignments

	T1=1			;T1 THRU T4 ARE TEMPS AND ARE ALSO
				; USED BY WILD
	T2=2
	T3=3
	T4=4

	P1=5			;P1 - P4  CAN BE USED, BUT MUST BE
				; SAVED FIRST.
	P2=6
	P3=7
	P4=10

	P=17			;PUSHDOWN POINTER
SUBTTL	Tables


DEFINE FIRMAC,<
	X	TMP,777777
	X	TEM,777777
	X	SFD,777777
	X	BAK,777777
	X	Q??,770000
	X	MAP,777777
	X	CRF,777777
	X	LS?,777700
	X	LIS,777777
	X	LPT,777777
	X	PTP,777777
	X	PLT,777777
	X	CDP,777777
	X	Z??,770000
	X	FOO,777777
	X	LOG,777777
>  ;END DEFINE FIRMAC


;NOW GENERATE THE "FIRST" TABLE

DEFINE X(A,B),<
	XLIST
	<SIXBIT /A/>+B
	LIST
>  ;END DEFINE X

FIRST:	FIRMAC
	FIRLEN==.-FIRST
DEFINE IMPMAC,<
	X	RNO
	X	RND
	X	CMD
	X	KBD
	X	CED
	X	MCR
	X	SNO
	X	FAI
	X	FOR
	X	F4
	X	MAC
	X	ALG
	X	AID
	X	BLI
	X	B10
	X	B11
	X	COB
	X	CBL
	X	BAS
	X	PAL
	X	P11
	X	SRC
	X	IDA
	X	IDX
	X	DAT
>  ;END DEFINE IMPMAC

;NOW GENERATE THE "IMPORT" TABLE

DEFINE X(A),<
	XLIST
	SIXBIT /A/
	LIST
>  ;END DEFINE X

IMPORT:	IMPMAC
	IMPLEN==.-IMPORT
SUBTTL	.LGTBA  --  Entry to Deletion Algorithm

	ENTRY	.LGTBA

;.LGTBA IS CALLED WITH:
;	T1 CONTAINING THE STRUCTURE NAME
;	T2 CONTAINING THE PPN
;	T3 CONTAINING THE LOGGED-OUT QUOTA
;	T4 CONTAINING THE I/O CHANNEL TO USE
;
;.LGTBA RETURNS WITH:
;	T1 CONTAINING THE NUMBER OF BLOCKS ALLOCATED ON THE STRUCTURE
;		(AND THE STRUCTURE IS UNDER QUOTA)

.LGTBA:	PUSHJ	P,.SAVE4##	;SAVE THE P REGS
	MOVEM	T1,L.STR	;SAVE STRUCTURE NAME
	MOVEM	T2,L.PPN	;SAVE PPN
	MOVEM	T3,L.OUT	;SAVE QUOTA

	LSH	T4,^D23		;PUT CHANNEL INTO AC FIELD
	MOVE	T1,T4		;GET THE CHANNEL
	IOR	T1,[OPEN]	;MAKE AN OPEN UUO
	MOVEM	T1,U.OPEN	;AND SAVE IT
	MOVE	T1,T4		;GET THE CHANNEL
	IOR	T1,[LOOKUP]	;MAKE A LOOKUP
	MOVEM	T1,U.LOOK	;AND SAVE IT
	MOVE	T1,T4		;GET THE CHANNEL
	IOR	T1,[RENAME]	;MAKE A RENAME
	MOVEM	T1,U.RENA	;AND SAVE IT
	MOVE	T1,T4		;GET THE CHANNEL
	IOR	T1,[CLOSE]	;MAKE A CLOSE
	MOVEM	T1,U.CLOSE	;AND SAVE IT
	MOVE	T1,T4		;GET THE CHANNEL
	IOR	T1,[RELEAS]	;MAKE A RELEASE
	MOVEM	T1,U.RELE	;AND SAVE IT

	MOVX	T1,.IODMP+UU.PHS;GET IO MODE
	MOVE	T2,L.STR	;STRUCTURE NAME
	MOVEM	T1,L.OBLK	;AND SAVE IO STATUS
	MOVEM	T2,L.OBLK+1	;STR NAME
	CLEARM	L.OBLK+2	;NO BUFFERS
	MOVE	T4,U.OPEN	;GET THE OPEN UUO
	IORI	T4,L.OBLK	;PUT IN THE RIGHT ADDRESS
	XCT	T4		;OPEN THE CHANNEL
	  JRST	[MOVE T1,L.OUT	;THAT'S ALL WE REALLY KNOW
		 POPJ P,]	;AND RETURN

	PUSHJ	P,STEP1		;GO TO STEP 1
	MOVE	T1,L.TOT	;RETURN HERE WHEN UNDER QUOTA,
				; GET TOTAL BLOCKS ALLOCATED
	ADD	T1,L.NQC	;ADD NUMBER OF NQC FILES
	XCT	U.RELE		;RELEASE THE CHANNEL
	POPJ	P,		;AND RETURN
SUBTTL	Step 1  --  Recomp and Get Large Files

;STEP 1 OF THE FILE-DELETION ALGORITHM DOES A RECOMP OF THE SPECIFIED 
;	UFD, AND DELETES ALL FILES WHICH ARE STRICTLY LARGER THAN THE
;	LOGGED-OUT QUOTA.

STEP1:
	CLEARM	L.TOT			;CLEAR ACCUMULATED TOTAL
	CLEARM	L.NQC			;CLEAR # NQC FILES
	CLEARM	L.NDEL			;AND CLEAR # OF FILES DELETED
	MOVE	T1,L.STR		;GET STRUCTURE NAME
	MOVE	T2,L.PPN		;AND PPN
	PUSHJ	P,.LGTSA##		;SETUP TO GET *.*

STEP1A:
	CLEARB	T1,T2			;USE DEFAULT OPEN-LOOKUP BLOCKS
	PUSHJ	P,.LGTLA##		;GET A FILE TO WORK ON
	  JRST	STEP1C			;NO MORE FILES
	XCT	U.CLOSE			;CLOSE OUT THE CHANNEL
	MOVE	T1,U.LOOK		;GET THE LOOKUP
	HRR	T1,T2			;PUT IN THE ADDRESS
	XCT	T1			;AND DO IT
	  JRST	STEP1A			;LOSE, IGNORE IT
	MOVX	T4,RP.NQC		;GET NQC BIT
	TDNE	T4,.RBSTS(T2)		;IS IT SET?
	JRST	STEP1D			;YES, COUNT THE FILE
	MOVE	T3,.RBALC(T2)		;GET BLOCKS ALLOCATED
	CAMLE	T3,L.OUT		;LARGER THAN QUOTA?
	JRST	STEP1B			;YES, DELETE IT
	ADDM	T3,L.TOT		;NO, ACCUMLATE THE TOTAL
	JRST	STEP1A			;AND LOOP

STEP1B:
	MOVE	T1,T2			;GET ADDRESS OF LKP BLOCK
	PUSHJ	P,DELFIL		;DELETE THE FILE
	JRST	STEP1A			;AND LOOP

STEP1C:
	MOVE	T1,L.TOT		;GET TOTAL BLOCKS
	CAMG	T1,L.OUT		;GREATER THAN QUOTA?
	POPJ	P,			;NO, EXIT THE ALGORITHM
	JRST	STEP2			;YES, GO ON TO STEP 2

STEP1D:
	MOVE	T3,.RBALC(T2)		;GET BLOCKS ALLOCATED
	ADDM	T3,L.NQC		;ADD TO TOTAL
	JRST	STEP1A			;AND LOOP AROUND
SUBTTL	Step 2  --  Delete FIRST Files

;STEP 2 OF THE FILE-DELETION ALGORITHM LOOPS THRU THE 'FIRST' TABLE
;	OF EXTENSIONS IN ORDER, AND FOR EACH EXTENSION, 'EXT', WE
;	BEGIN DELETING ALL UNPROTECTED (<200) *.EXT UNTIL WE ARE
;	UNDER QUOTA.  IF WE DELETE *.EXT AND ARE STILL OVER QUOTA
;	WE GO ON TO THE NEXT EXTENSION.  IF WE REACH THE END OF THE
;	TABLE, ON TO STEP 3.

STEP2:
	MOVEI	P1,FIRST		;START ADR OF TABLE
	HRLI	P1,-FIRLEN		;AND NEGATIVE LENGTH

STEP2A:
	MOVE	T3,(P1)			;GET EXT,,MASK
	MOVE	T1,L.STR		;GET STRUCTURE
	MOVE	T2,L.PPN		;AND PPN
	PUSHJ	P,.LGTSE##		;SETUP TO GET *.EXT

STEP2B:
	CLEARB	T1,T2			;USE DEFAULT OPEN AND LKP BLKS
	PUSHJ	P,.LGTLA##		;GET A FIND
	  JRST	STEP2C			;THAT'S ALL FOLKS
	MOVEI	T1,177			;MAX PROTECTION
	PUSHJ	P,LOKFIL		;LOOKUP AND DELETE
	MOVE	T1,L.TOT		;GET TOTAL BLOCKS USED
	CAMG	T1,L.OUT		;STILL OVER QUOTA?
	POPJ	P,			;NO, RETURN
	JRST	STEP2B			;YES, LOOP

STEP2C:
	AOBJN	P1,STEP2A		;FINISHED THAT EXT,
					; ON TO THE NEXT
	JRST	STEP3			;NO NEXT EXT, ON TO STEP 3
SUBTTL	STEP3  --  Get all other unIMPORTant Files

;STEP 3 DELETES ALL REMAINING UNPROTECTED FILES WHOSE EXTENSIONS DON'T
;	APPEAR IN THE "IMPORT" TABLE.

STEP3:
	MOVE	T1,L.STR		;GET THE STRUCTURE NAME
	MOVE	T2,L.PPN		;AND THE PPN
	PUSHJ	P,.LGTSA##		;SETUP TO READ ABSOLUTELY EVERYTHING

STEP3A:
	CLEARB	T1,T2			;USE DEFAULT BLOCKS
	PUSHJ	P,.LGTLA##		;GET A FILE TO LOOKUP
	  JRST	STEP4			;NO MORE, ON TO STEP 4
	MOVE	P1,[-IMPLEN,,IMPORT]	;POINT TO IMPORT TABLE
	HLLZ	T3,.RBEXT(T2)		;GET THE EXTENSION OF THE FILE

STEP3B:
	CAMN	T3,(P1)			;MATCH???
	JRST	STEP3A			;YES, IT'S IMPORTANT, SKIP IT
	AOBJN	P1,STEP3B		;NO, KEEP LOOPING

STEP3C:
	MOVEI	T1,177			;MAX PROTECTION
	PUSHJ	P,LOKFIL		;AND LOOKUP AND DELETE
	MOVE	T1,L.TOT		;GET THE TOTAL
	CAMG	T1,L.OUT		;STILL OVER QUOTA?
	POPJ	P,			;NO, DONE!!
	JRST	STEP3A			;YES, KEEP GOING
SUBTTL	STEP4  --  Get rest of FIRST files

;STEP FOUR OF THE FILE-DELETION ALGORITHM DELETES ALL REMAINING
;	FILES WHOSE EXTENSION IS IN THE "FIRST" TABLE.  THE TABLE
;	IS, AS IN STEP 2, SCANNED IN ORDER AND THE ALGORITHM STOPS
;	AS SOON AS WE ARE UNDER QUOTA.

STEP4:
	MOVEI	P1,FIRST		;START ADR OF TABLE
	HRLI	P1,-FIRLEN		;AND NEGATIVE LENGTH

STEP4A:
	MOVE	T3,(P1)			;GET EXT,,MASK
	MOVE	T1,L.STR		;GET STRUCTURE
	MOVE	T2,L.PPN		;AND PPN
	PUSHJ	P,.LGTSE##		;SETUP TO GET *.EXT

STEP4B:
	CLEARB	T1,T2			;USE DEFAULT OPEN AND LKP BLKS
	PUSHJ	P,.LGTLA##		;GET A FIND
	  JRST	STEP4C			;THAT'S ALL FOLKS
	MOVEI	T1,1000			;SUPER MAX
	PUSHJ	P,LOKFIL		;LOOKUP AND DELETE
	MOVE	T1,L.TOT		;GET TOTAL BLOCKS USED
	CAMG	T1,L.OUT		;STILL OVER QUOTA?
	POPJ	P,			;NO, RETURN
	JRST	STEP4B			;YES, LOOP

STEP4C:
	AOBJN	P1,STEP4A		;FINISHED THAT EXT,
					; ON TO THE NEXT
	JRST	STEP5			;NO NEXT EXT, ON TO STEP 5
SUBTTL	STEP 5  --  Get unprotected IMPORTANT Files

;STEP FIVE DELETES ALL FILES WHOSE EXTENSIONS APPEAR IN
;	THE "IMPORT" TABLE WHICH ARE UNPROTECTED.

STEP5:
	MOVEI	P1,IMPORT		;START ADR OF TABLE
	HRLI	P1,-IMPLEN		;AND NEGATIVE LENGTH

STEP5A:
	HLLO	T3,(P1)			;GET EXT,,MASK
	MOVE	T1,L.STR		;GET STRUCTURE
	MOVE	T2,L.PPN		;AND PPN
	PUSHJ	P,.LGTSE##		;SETUP TO GET *.EXT

STEP5B:
	CLEARB	T1,T2			;USE DEFAULT OPEN AND LKP BLKS
	PUSHJ	P,.LGTLA##		;GET A FIND
	  JRST	STEP5C			;THAT'S ALL FOLKS
	MOVEI	T1,177			;MAX PROTECTION
	PUSHJ	P,LOKFIL		;LOOKUP AND DELETE
	MOVE	T1,L.TOT		;GET TOTAL BLOCKS USED
	CAMG	T1,L.OUT		;STILL OVER QUOTA?
	POPJ	P,			;NO, RETURN
	JRST	STEP5B			;YES, LOOP

STEP5C:
	AOBJN	P1,STEP5A		;FINISHED THAT EXT,
					; ON TO THE NEXT
	JRST	STEP6			;NO NEXT EXT, ON TO STEP 6
SUBTTL	STEP6  --  Get rest of unIMPORTant files

;STEP 6 IS SIMILAR TO STEP 3 IN THAT IT GETS FILES WHOSE EXTENSIONS
;	DON'T APPEAR IN THE "IMPORT" TABLE, EXCEPT THAT NOW IT
;	IGNORES THE PROTECTION AND JUST DELETES THE FILE.

STEP6:
	MOVE	T1,L.STR		;GET THE STRUCTURE NAME
	MOVE	T2,L.PPN		;AND THE PPN
	PUSHJ	P,.LGTSA##		;SETUP TO READ ABSOLUTELY EVERYTHING

STEP6A:
	CLEARB	T1,T2			;USE DEFAULT BLOCKS
	PUSHJ	P,.LGTLA##		;GET A FILE TO LOOKUP
	  JRST	STEP7			;NO MORE, ON TO STEP 4
	MOVE	P1,[-IMPLEN,,IMPORT]	;POINT TO IMPORT TABLE
	HLLZ	T3,.RBEXT(T2)		;GET THE EXTENSION OF THE FILE

STEP6B:
	CAMN	T3,(P1)			;MATCH???
	JRST	STEP6A			;YES, IT'S IMPORTANT, SKIP IT
	AOBJN	P1,STEP6B		;NO, KEEP LOOPING

STEP6C:
	MOVEI	T1,1000			;SUPER MAX PROTECTION
	PUSHJ	P,LOKFIL		;LOOKUP IT AND DELETE
	MOVE	T1,L.TOT		;GET THE TOTAL
	CAMG	T1,L.OUT		;STILL OVER QUOTA?
	POPJ	P,			;NO, DONE!!
	JRST	STEP6A			;YES, KEEP GOING
SUBTTL	STEP 7  --  Give Up

;STEP 7 SIMPLY DELETES EVERYTHING

STEP7:
	MOVE	T1,L.STR		;GET STRUCTURE NAME
	MOVE	T2,L.PPN		;GET THE PPN
	PUSHJ	P,.LGTSA##		;SETUP TO GET EVERYTHING

STEP7A:
	CLEARB	T1,T2			;USE DEFAULT BLOCKS
	PUSHJ	P,.LGTLA		;GET A FILE
	  POPJ	P,			;WE'RE DONE...
	MOVEI	T1,1000			;GET THEM ALL!!!
	PUSHJ	P,LOKFIL		;LOOKUP AND DELETE
	MOVE	T1,L.TOT		;GET TOTAL
	CAMG	T1,L.OUT		;DONE YET?
	POPJ	P,			;YES, RETURN
	JRST	STEP7A			;NO, LOOP
SUBTTL	LOKFIL  --  Routine to LOOKUP a file

;LOKFIL IS CALLED WITH T1 CONTAINING A PROTECTION, AND T2 CONTAINING
;	THE ADDRESS OF A LOOKUP BLOCK.  THE FILE IS LOOK-ED UP, AND
;	IF THE PROTECTION IS .LE. THAN THE PROTECTION SPECIFIED
;	BY THE USER IN T1, THE FILE IS DELETED, AND ALL COUNTS
;	ARE UPDATED.
;
;IF THE FILE IS ANY SFD, TRY TO DELETE IT IN ANY CASE

LOKFIL:	XCT	U.CLOSE			;CLOSE OUT THE CHANNEL
	MOVE	T3,U.LOOK		;GET THE LOOKUP UUO
	HRR	T3,T2			;OR IN THE ADDRESS
	XCT	T3			;AND DO THE LOOKUP
	  POPJ	P,			;FAILED, FORGET IT
	MOVX	T4,RP.NQC		;GET NQC BIT
	TDNE	T4,.RBSTS(T2)		;IS IT AN NQC FILE?
	POPJ	P,			;YES, IGNORE IT
	HLRZ	T3,.RBEXT(T2)		;GET THE FILE EXTENSION
	MOVEI	T4,0			;LOAD A SMALL PROTECTION
	CAIE	T3,'SFD'		;SKIP IF ITS AN SFD
	LDB	T4,[POINT 9,.RBPRV(T2),8] ;GET THE PROTECTION
	CAMLE	T4,T1			;IS IT LESS?
	POPJ	P,			;YES, JUST RETURN
	MOVN	T3,.RBALC(T2)		;NO, GET RIBALC
	ADDM	T3,L.TOT		;AND DECREMENT TOTAL
	MOVE	T1,T2			;GET ADR OF LOOKUP BLOCK
	PUSHJ	P,DELFIL		;DELETE THE FILE
	POPJ	P,			;AND RETURN
SUBTTL	DELFIL  --  Routine to DELETE a file

;DELFIL IS CALLED WITH T1 CONTAINING THE ADDRESS OF THE LOOKUP BLOCK.
;	A MESSAGE IS TYPED AND THE FILE (WHICH IS ASSUMED TO BE
;	LOOK'ED UP)  IS DELETED.

DELFIL:	PUSHJ	P,.SAVE1##		;SAVE P1
	MOVEM	T1,L.DBLK		;SAVE THE ARGUMENT
	SKIPE	L.NDEL			;DID WE DELETE ANY ALREADY?
	JRST	DELF.1			;YES, SKIP THE EXTRA MESSAGE
	MOVEI	T1,[ASCIZ /Files deleted:
/]
	PUSHJ	P,.TSTRG##		;NO, TYPE THE MESSAGE

DELF.1:	CLEARB	T1,T2			;CLEAR A RENAME BLOCK
	CLEARB	T3,T4			; "        "
	MOVE	P1,U.RENA		;GET A RENAME UUO
	IORI	P1,T1			;PUT IN ADDRESS FIELD
	XCT	P1			;AND DO IT
	  JRST	DELF.2			;FAILED?
	AOS	L.NDEL			;ANOTHER ONE DELETED
	MOVEI	T1,[ASCIZ /   /]	;LOAD SOME SPACES
	PUSHJ	P,.TSTRG##		;AND TYPE THEM
	MOVEI	T1,L.OBLK		;GET ADR OF OPEN BLOCK
	MOVE	T2,L.DBLK		;GET ADR OF LKP BLOCK
	PUSHJ	P,.TOLEB##		;TYPE A FILESPEC
	MOVEI	T1,[ASCIZ /       /]	;LOAD SEVEN SPACES
	PUSHJ	P,.TSTRG##		;TO LINE UP TAB STOPS
	PUSHJ	P,.TTABC##		;A TAB
	MOVE	P1,L.DBLK		;GET ADDRESS OF LOOKUP BLOCK
	MOVE	T1,.RBALC(P1)		;GET BLOCKS ALLOCATED
	PUSHJ	P,.TDECW##		;TYPE IT
	MOVEI	T1,[ASCIZ / blocks freed/]
	PUSHJ	P,.TSTRG##		;AND TYPE IT
	PJRST	.TCRLF##		;AND A CRLF AND RETURN

DELF.2:	MOVE	T1,L.DBLK		;GET ADDRESS OF LOOKUP BLOCK
	MOVE	T1,.RBALC(T1)		;GET BLOCKS ALLOCATED
	ADDM	T1,L.TOT		;ADD BACK IN
	HRRZS	T2			;GET ONLY THE ERROR CODE IN T2
	CAIE	T2,ERPRT%		;IS IT PROTECTION FAILURE?
	ADDM	T1,L.OUT		;NO, MAKE HIS QUOTA BIGGER (SORT OF)
	POPJ	P,			;AND RETURN
SUBTTL	Storage Area

	XLIST			;SO LITERALS DON'T COME OUT
	LIT			;FORCE OUT LITERALS
	LIST			;RESTORE THE LISTING
	RELOC			;DOWN TO LOWSEG

L.STR:	BLOCK	1		;THE STRUCTURE
L.PPN:	BLOCK	1		;THE PPN
L.OUT:	BLOCK	1		;THE QUOTA
L.TOT:	BLOCK	1		;ACCUMULATED TOTAL BLOCKS ALLOCATED
L.NQC:	BLOCK	1		;ACCUMULATED TOT BLKS ALLOC TO NQC FILES
L.NDEL:	BLOCK	1		;NUMBER OF FILES DELETED
L.DBLK:	BLOCK	4		;RENAME BLOCK
L.OBLK:	BLOCK	3		;OPEN BLOCK


;UUOS TO EXECUTE
U.OPEN:	BLOCK	1		;OPEN UUO
U.CLOS:	BLOCK	1		;CLOSE UUO
U.RELE:	BLOCK	1		;RELEASE UUO
U.LOOK:	BLOCK	1		;LOOKUP UUO
U.RENA:	BLOCK	1		;RENAME UUO
	PRGEND
TITLE	.LGTSA  --  LOOKUP All Files in UFD Order
SUBTTL	Larry Samberg	15 Jan 75

;***Copyright (C) 1974, Digital Equipment Corp., Maynard, MA.***

	SEARCH	MACTEN		;SEARCH MACRO DEFINITIONS
		%%MACT==%%MACT

	SEARCH	UUOSYM		;SEARCH UUO SYMBOL DEFINITIONS
	SEARCH	SCNMAC		;SEARCH SCAN-WILD DEFINITIONS


	TWOSEG			;HISEG PROGRAM
	RELOC	400000		;START IN HISEG


	SALL			;SUPPRESS MACRO EXPANSIONS


;This module, .LGTSA, provides a pair of routines, .LGTSA
;	and .LGTLA which are used to LOOKUP all files in
;	a particular UFD on a particular file-structure
;	in UFD order.
;.LGTSA is called first with the PPN and file-structure name
;	to setup the world.  Then, .LGTLA is called to return
;	the name of each file in the specified UFD.

;In addition, a routine .LGTSE is provided to read *.EXT
;	for some extension provided as an argument.
SUBTTL	Accumulator Assignments

	T1=1			;T1 THRU T4 ARE TEMPS AND ARE
	T2=2			; ALSO USED BY WILD
	T3=3
	T4=4

	P1=5			;P1 - P4 CAN BE USED, BUT MUST BE
	P2=6			; SAVE FIRST
	P3=7
	P4=10

	P=17			;PUSHDOWN POINTER
SUBTTL	.LGTSA  --  Setup to LOOKUP STR:*.*[,,*,*,*,*,*]

;.LGTSA IS CALLED TO SETUP A WILD BLOCK TO LOOKUP EVERY FILE ON A
;	STRUCTURE.  CALL WITH THE STRUCTURE NAME IN T1, AND PPN IN T2.
;	USES T1,T2,T3,T4.

;THIS ROUTINE WAS ORIGINALLY WRITTEN BY DON LEWINE FOR LOGIN VERSION
;	55.  MY THANKS TO HIM FOR SUPPLYING IT FULLY DEBUGGED./LSS 


	ENTRY	.LGTSA

.LGTSA:	MOVE	T3,[WILDBK,,WILDBK+1]	;BLT POINTER TO WILD BLOCK
	CLEARM	WILDBK			;CLEAR THE FIRST WORD
	BLT	T3,WILDBK+.FXLEN-1	;AND CLEAR THE REST

	MOVEM	T1,WILDBK+.FXDEV	;SAVE THE STRUCTURE
	MOVEM	T2,WILDBK+.FXDIR	;SAVE THE PPN
	SETOM	WILDBK+.FXDIM		;AND SET DIRECTORY MASK
	MOVX	T1,FX.DIR!FX.PHY!FX.NOM!FX.PRT
	MOVEM	T1,WILDBK+.FXMOD	;STORE ALL THE STATUS BITS
	TXO	T1,FX.STR		;SET ANOTHER BIT
	MOVEM	T1,WILDBK+.FXMOM	;AND THE MASK FOR THE MOD WORD

	MOVSI	T1,'*  '		;CLASSICAL WILDCARD
	MOVEM	T1,WILDBK+.FXNAM	;STORE AS	FILENAME
	MOVEM	T1,WILDBK+.FXEXT	;		EXTENSION
	MOVEM	T1,WILDBK+.FXDIR+2	;		1ST SFD
	MOVEM	T1,WILDBK+.FXDIR+4	;		2ND SFD
	MOVEM	T1,WILDBK+.FXDIR+6	;		3RD SFD
	MOVEM	T1,WILDBK+.FXDIR+10	;		4TH SFD
	MOVEM	T1,WILDBK+.FXDIR+12	;		5TH SFD

	SETOM	WILDBK+.FXBFR		;NO /BEFORE
	SETOM	WILDBK+.FXSNC		;NO /SINCE

	SETZM	WILDPT			;WILD'S POINTER
	POPJ	P,			;RETURN
SUBTTL	.LGTSE  --  Setup to read *.EXT[*,*,*,*,*]

;.LGTSE IS CALLED SIMILARLY TO THE WAY .LGTSA IS CALLED, WITH T1
;	CONTAINING THE STRUCTURE NAME AND T2 CONTAINING THE PPN.
;	IN ADDITION T3 CONTAINS 'EXT,,MASK'.

	ENTRY	.LGTSE

.LGTSE:	PUSH	P,T3			;SAVE EXT,,MASK
	PUSHJ	P,.LGTSA		;SETUP TO READ *.*
	POP	P,WILDBK+.FXEXT		;STORE EXT,,MASK
	POPJ	P,			;AND RETURN
SUBTTL	.LGTLA  --  Routine to call .LKWLD

;.LGTLA IS CALLED WITH T1 CONTAINING THE ADDRESS OF AN OPEN BLOCK,
;	AND T2 CONTAIN XWD SIZE,,ADR WHERE ADR IS THE ADDRESS OF A
;	LOOKUP BLOCK, AND SIZE IS THE LENGTH OF THE BLOCK - 1 
;	(I.E. THE NUMBER OF RIB WORDS DESIRED).  IF ANY OF THESE
;	FIELDS ARE ZERO UPON CALLING .LGTLA, IT IS FILLED IN WITH
;	DEFAULT PARAMETERS.  .LGTLA ALL CALLS .LKWLD TO SETUP
;	THE LOOKUP AND OPEN BLOCK FOR THE NEXT FILE (.LGTSA SHOULD
;	BE CALLED TO SET EVERYTHING UP BEFORE THE FIRST CALL).
;	RETURNS T1 AND T2 UNCHANGED (WITH MISSING FIELDS FILLED).
;	SKIP RETURN WITH NEXT FILE, NON-SKIP IF NO MORE FILES.

	INTERN	.LGTLA

.LGTLA:	SKIPN	T1			;DID HE SPEC AN OPEN BLOCK
	MOVEI	T1,OPENBK		;NO, DEFAULT ONE
	TRNN	T2,-1			;DID HE SPECIFY A LOOKUP BLOCK?
	HRRI	T2,LKUPBK		;NO, USE DEFAULT
	TLNN	T2,-1			;AND SIZE?
	HRLI	T2,.RBTIM		;DEFAULT

	PUSHJ	P,.PSH4T##		;SAVE T1 - T4
	HRRM	T2,WLDARG+1		;SAVE LOOKUP BLOCK ADR
	HRLM	T1,WLDARG+1		;SAVE OPEN BLOCK ADR
	AOBJN	T2,.+1			;INCREMENT SIZE HALF
	HLRZM	T2,WLDARG+2		;SAVE RIBCNT+2
	HRRI	T2,.FXLEN		;AND LOAD LEN OF WILD BLOCK
	MOVSM	T2,WLDARG+2		;AND SAVE THEM SWAPPED
	MOVEI	T1,WILDPT		;GET ADR OF POINTER WORD
	MOVEM	T1,WLDARG+3		;STORE IT
	MOVSI	T1,[WILDBK]		;ADR(ADR(WILDBJ))
	MOVEM	T1,WLDARG		;SAVE IT
	MOVE	T1,[4,,WLDARG]		;ARG POINTER
	PUSHJ	P,.LKWLD##		;CALL WILD
	  JRST	LOKA.1			;NO MORE!!
	PUSHJ	P,.POP4T##		;RESTORE T1-T4
	PJRST	.POPJ1##		;AND SKIP MORE

LOKA.1:	PUSHJ	P,.POP4T##		;RESTORE T1-T4
	POPJ	P,			;AND RETURN
SUBTTL	Storage Area

	XLIST			;SO LITERALS DON'T COME OUT
	LIT			;FORCE OUT LITERAL POOL
	LIST			;RESTORE LISTING
	RELOC			;DOWN TO LOW-SEGMENT

WILDBK:	BLOCK	.FXDIR+14	;WILD BLOCK
WILDPT:	BLOCK	1		;WILD POINTER

OPENBK:	BLOCK	3		;DEFAULT OPEN BLOCK
LKUPBK:	BLOCK	.RBTIM+1	;DEFAULT LOOKUP BLOCK

WLDARG:	BLOCK	4		;ARGBLOCK FOR WILD
	END