TITLE	SPCUSG -- DISK STORAGE ACCOUNTING PROGRAM  %3(71)
	SUBTTL	CLEMENTS/WLH/PFC		9-FEB-81

;COPYRIGHT (C) 1971,1975,1979,1981 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;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.
; THIS PROGRAM IS ACTUALLY "SPACE" MODIFIED TO PRODUCE USAGE ENTRIES AS
; WELL AS FACT ENTRIES.  THIS "EXAMPLE" WAS DONE FOR 2 REASONS.  FIRST,
; IF A SITE IS CONVERTING FROM FACT TO USAGE ACCOUNTING, THERE IS A GOOD
; CHANCE THAT THE SITE HAS INCLUDED LOCAL FACT ENTRY TYPES FOR THEIR OWN
; ACCOUNTING.  FOR TOTAL CONVERSION, PROGRAMS MAKING THOSE FACT ENTRIES
; MUST MAKE USAGE ENTRIES INSTEAD.  TO PROVIDE AN EXAMPLE OF THE CONVERSION
; THE SITE PROGRAMMERS MUST DO, WE DID THE CONVERSION ON A PROGRAM MOST SITES
; ARE FAMILIAR WITH.  THIS INCLUDES INSTRUCTIONS FOR ADDING LOCAL ENTRY
; DEFINITIONS FOR ACTDAE TO MAKE A RECORD CONTAINING THE SAME DATA THAT THE
; OLD FACT FILE RECORD CONTAINED.  THE SECOND REASON WAS THE SEVERAL FIELD TEST
; SITES INDICATED THAT ALTHOUGH THE DATA FROM SPACE WAS LESS ACCURATE THAN
; THE DISK UTILIZATION RECORDS PRODUCED FROM BACKUP (/USAGE), IT WAS SUFFICIENT
; FOR THEIR PURPOSES.  SINCE OTHER SITES MAY FEEL THE SAME WAY,  CHANCES ARE
; VERY GOOD THAT "SPACE" WILL BE THE FIRST PROGRAM MODIFIED BY SITES.  THE
; READER IS DIRECTED TO THE SUBROUTINE "MAKUSG" FOUND IN THIS PROGRAM FOR
; ADDITIONAL CCMMENTS AND INSTRUCTIONS.

; THIS PROGRAM IS PROVIDED AS A CONVIENENCE TO SITES AND DOES NOT CONSTITUTE
; SUPPORT OF THIS "EXAMPLE".



; THIS PROGRAM ACCEPTS AN OPERATOR COMMAND.  BASED ON THIS, IT
; LOOKS AT THE UFD'S FOR EACH USER ON ONE OR ALL STRUCTURES AND
; PRINTS THEIR QUOTAS AND SPACE USED.  OPTIONALLY, IT WILL
; MAKE FACT.SYS ENTRIES (VIA DAEMON) OR SUBMIT BATCH JOBS
; TO RECOMPUTE THEIR QUOTAS.

	TWOSEG			;REENTRANT
	SEARCH	MACTEN,UUOSYM,QPRM

	ND	FTUSAGE,-1	;DEFAULT TO USAGE ACCOUNTING IN THIS EXAMPLE

IFN FTUSAGE,<
	SEARCH	ACTSYM		;ACCOUNTING SYMBOLS
>
	SALL			;CLEAN LISTING

	.REQUE	REL:QUEUER	;USES QUEUER.REL
	.REQUE	REL:HELPER	;USES HELPER.REL

SPCWHO==0	;LAST PATCHER
SPCVER==3	;MAJOR VERSION
SPCMIN==0	;MINOR VERSION
SPCEDT==71	;EDIT LEVEL

	LOC	137
	BYTE	(3)SPCWHO (9)SPCVER (6)SPCMIN (18) SPCEDT
	RELOC	400000

;DEFAULT VALUES

ND FLGUSR,^D500		;FLAG USER IF GREATER THAN THIS
ND LN$PDL,60		;PUSH DOWN LIST LENGTH
ND OQDELT,^D100		;IF THIS MUCH OVER QUOTA, SEND BATCH JOB
	SUBTTL	REVISION HISTORY

;%2(45) APRIL, 1972

;46	REPLACE HALTS WITH MESSAGES
;47	FIND BIGGEST USER UNDER 100K BLOCKS
;50	HANDLE NEGATIVE USED BLOCKS AND LARGE USED BLOCKS
;51	DATE 75 FIXES
;52	FLAG USERS OVER 500 BLOCKS
;53	EXIT WHEN DONE
;54	USE C AS A UNIVERSAL
;55	TYPE STR.TXT
;56	MAKE REENTRANT
;57	REMOVE _ AND ALTMODE IN COMMAND SCANNER
;60	CLEAN UP LISTING AND SOME SYMBOL NAMES
;61	CHANGE TO NEW FORMAT SPACE FACT FILE ENTRY (161)
;62	(10-7286) ALSO BATCH USERS ABOVE QUOTA
;63	(10-7286) ALLOW .CTL TO BE READ BY ALL
;64	(10-7286) ADD .DIRECT/F/W TO CTL FILE SUBMITTED
;65	(10-7286) CLEAN UP Q REQUEST BLOCK
;66	IMPLEMENT ERROR MESSAGE STANDARD WITH MONITOR /VERB:NOPREFIX
;67	ALLOW DEFAULT PROJECT OR PROGRAMMER
;70	USE QPRM
;71	ADD FTUSAGE TO ALLOW USAGE RECORDS. THIS IS DEFAULTED TO OFF SINCE
;	THE STANDARD ACTDAE DOESN'T KNOW ABOUT ANY USER DEFINED ENTRIES AND
;	THIS MAKES ONE OF THOSE.  SEE MAKUSG ROUTINE FOR DIRECTIONS.
	SUBTTL	DEFINITIONS

; AC'S
F=0
A=1
B=2
C=3
D=4
T=5
T1=6
T2=7
T3=10
N=11
N1=12
M=13
TMP1=14
TMP2=15
CH=16
P=17

; I/O CHANNELS

MFD==1
UFD==2
LST==3
CTL==4
TXT==5		;STR.TXT READING

DEFINE $MSG (A)<
	MOVEI	T,[ASCIZ \A\]
	PUSHJ	P,MSG
>
; FLAG AC BITS

R.USG==1B19	; MAKE USAGE ENTRIES
R.QUUR==1B18	; REPORTED QUEUE. UUO ERROR

L.TTY==(1B17)	; OUTPUT TO TTY
L.GOD==(1B16)	; RUNNING UNDER 1,2
L.BATC==(1B15)	; BATCH SWITCH
L.FACT==(1B14)	; FACT SWITCH
L.ARO==(1B13)	; ARROW SEEN ON INPUT
L.DSK==(1B12)	; PROCESS ALL STRUCTURES
L.BKT==(1B11)	; LEFT BRACKET SEEN ON INPUT
L.DOT==(1B10)	; DOT SEEN ON INPUT
L.ANY==(1B9)	; SOMETHING SEEN ON INPUT
L.DAER==(1B8)	; REPORTED DAEMON ERROR
L.TTL==(1B7)	; PRINTED HEADING LINE
L.TTLD==(1B6)	; PRINTED NAME OF THIS STRUCTURE
L.ISIN==(1B5)	; THIS USER IS LOGGED IN
L.FPAG==(1B4)	; HEADER FLAG
L.EVAL==(1B3)	; NUMBER COULD NOT BE EVALUATED
L.COMA==(1B2)	; COMMA TYPED

FE$SPC==161	; FACT FILE ENTRY (DATE-75 FORMAT)
	SUBTTL	INITIALIZE

SPCUSG:	JFCL			; DEFEND AGAINST CCL RUN
	RESET
	MOVE	P,PDP
	MOVEI	F,0		; CLEAR FLAGS

	MOVX	T,%LDMFD
	GETTAB	T,		; GET MFD PPN
	  MOVE	T,[1,,1]
	MOVEM	T,MFDPPN	; AND SAVE IT

	MOVX	T,%LDSYS
	GETTAB	T,		;GET SYS PPN
	  MOVE	T,[1,,1]
	MOVEM	T,SYSPPN	;AND SAVE IT

	GETPPN	T,		;GET OUR PPN
	  JFCL
	MOVEM	T,MYPPN

	MOVX	T1,%LDFFA
	GETTAB	T1,		; GET GOD'S PPN
	  MOVE	T1,[1,,2]
	MOVEM	T1,FFAPPN	; AND SAVE IT

	CAMN	T,T1		; ARE WE GOD?
	TLO	F,L.GOD		; YES, LET'S REMEMBER THAT
	PUSHJ	P,COMAND	; GO GET COMMAND LINE
	MOVE	T,IDEV		; DETERMINE IF SPECIFIED DEVICE IS A DSK
	MOVE	T1,[1,,T]
	DSKCHR	T1,
	JRST	[MOVEI T,IDEV
		 JRST  UNIERR]
	TXNN	T1,DC.TYP
	TLO	F,L.DSK

	SETZB	A,D		; INITIALIZE DEFAULTS FOR LIST DEVICE
	SKIPN	OFILE
	SKIPE	OEXT
	MOVSI	D,'DSK'
	SKIPE	OPPN
	MOVSI	D,'DSK'
	SKIPN	D
	MOVSI	D,'TTY'
	SKIPN	B,ODEV
	MOVE	B,D
	MOVSI	C,OHED
	OPEN	LST,A
E$$ODA:	JRST	[PUSHJ P,ERR
		   ASCII /ODA/
		 OUTSTR [ASCIZ / Output device not available/]
		 JRST COMERX]
	DEVCHR	B,		; LIST DEVICE'S CHARACTERISTICS
	TXNE	B,DV.TTA
	TLO	F,L.TTY
	SKIPN	A,OFILE
	MOVE	A,['SPCUSG']	; DEFAULT FILENAME FOR DIRECTORY DEVICE
	SKIPN	B,OEXT
	MOVSI	B,'TXT'
	HLLZS	B
	MOVEI	C,0
	MOVE	D,OPPN
	ENTER	LST,A
E$$CWO:	  JRST	[PUSHJ P,ERR
		   ASCII /CWO/
		 OUTSTR [ASCIZ / Can't write output file/]
		 JRST COMERX]
	OUTBUF	LST,0
	MOVE	T,.JBFF
	MOVEM	T,SJBFF
	TLNE	F,L.TTY		; ENTER SPACE VERSION LINE IF NOT A TTY
	JRST	SKPTIT

	$MSG <
SPCUSG v>
	LDB	T,[POINT 9,.JBVER,11]
	SKIPE	T
	PUSHJ	P,OCTOUT
	LDB	T,[POINT 6,.JBVER,17]
	MOVEI	CH,"A"-1(T)
	SKIPE	T
	PUSHJ	P,TYO
	HRRZ	T,.JBVER
	JUMPE	T,V1
	MOVEI	CH,"("
	PUSHJ	P,TYO
	HRRZ	T,.JBVER
	PUSHJ	P,OCTOUT
	MOVEI	CH,")"
	PUSHJ	P,TYO
V1:	LDB	T,[POINT 3,.JBVER,2]
	JUMPE	T,V2
	MOVEI	CH,"-"
	PUSHJ	P,TYO
	LDB	T,[POINT 3,.JBVER,2]
	PUSHJ	P,OCTOUT
V2:	PUSHJ	P,TAB
	DATE	A,
	IDIVI	A,^D31
	MOVEI	T,1(B)
	PUSHJ	P,DECOUT
	$MSG	<->
	IDIVI	A,^D12
	MOVE	C,MONTAB(B)
	MOVEI	D,0
	MOVEI	T,C
	PUSHJ	P,MSG
	$MSG	<->
	MOVEI	T,^D64(A)
	IDIVI	T,^D100		;ALLOW FOR .GT. 2000
	MOVE	T,T1
	PUSHJ	P,DECOUT
	PUSHJ	P,TAB
	MSTIME	A,
	IDIVI	A,^D60000
	IDIVI	A,^D60
	MOVEI	T,(A)
	PUSHJ	P,DECPR2
	PUSHJ	P,COLON
	MOVEI	T,(B)
	PUSHJ	P,DECPR2

	PUSHJ	P,TAB		; SPACE OVER SOME
	MOVSI	T,-5		; SET FOR 5 WORD LINE
SV1:	HRLZ	T1,T		; GET INDEX IN TABLE
	HRRI	T1,.GTCNF	; SET FOR CONFIGURATION TABLE
	GETTAB	T1,		; READ SYSTEM HEADER
	  MOVEI	T1,0		; (JUST IN CASE)
	MOVEM	T1,SYSHDR(T)	; SAVE FOR MESSAGE
	AOBJN	T,SV1		; LOOP UNTIL DONE
	SETZM	SYSHDR(T)	; CLEAR EXTRA WORD
	MOVEI	T,SYSHDR	; POINT TO MESSAGE
	PUSHJ	P,MSG		; TYPE IT TO USER
SKPTIT:	MOVX	A,%LDQUS	; QUE STR
	GETTAB	A,
	  MOVSI	A,'DSK'
	MOVEM	A,QSTR
	SETZM	TOTUSD		; ZERO TOTAL AND SUBTOTAL
	SETZM	TOTFRE
	SETZM	STRUCT
	TLNE	F,L.DSK
	JRST	SPACEL

SPCCAL:	MOVE	B,IDEV
	DEVNAM	B,0
E$$DUF:	JRST	[RELEAS LST,
		 PUSHJ P,ERR
		   ASCII /DUF/
		 OUTSTR [ASCIZ / DEVNAM UUO FAILURE
/]
		 EXIT]
	MOVEM	B,STRUCT	; SAVE REAL STRUCTURE
	JRST	SPC1
	SUBTTL	MAIN PROCESSING LOOP

SPACEL:	MOVE	B,STRUCT
	SYSSTR	B,
E$$SUF:	JRST	[RELEAS LST,
		 PUSHJ P,ERR
		   ASCII /SUF/
		 OUTSTR [ASCIZ	/ SYSSTR UUO Failure
/]
		 EXIT]
	MOVEM	B,STRUCT
	TLNE	F,L.DSK
	SKIPN	B
	JRST	EOSYS
SPC1:	SETZM	BADUSR		; CLEAR WORST CASE USERS
	SETZM	WSTCAS
	MOVE	A,[3,,IOB2]	; ARG TO DSKCHR
	MOVEM	B,IOB2		; STRUCTURE WANTED
	DSKCHR	A,UU.PHY
	  SETZB	A,IOB2+.DCFCT	; CLEAR ANSWER IF WE CANT GET IT
	LDB	T,[POINTR (A,DC.TYP)]
	CAIE	T,.DCTFS
	JRST	[MOVEI T,IOB2
		 JRST  UNIERR]
	MOVE	A,IOB2+.DCFCT	; GET FREE ON STR
	MOVEM	A,STRTAL	; SAVE FOR TYPEOUT AND FACT
	SETZM	STRUSD
	TLNN	F,L.TTY
	PUSHJ	P,CRLF
	TLZ	F,L.TTLD	; CLEAR TITLE FOR STR FLAG
	MOVEI	A,.IODMP
	TXO	A,UU.PHS	; PHYSICAL STR
	MOVEI	C,0
	OPEN	UFD,A
	  JRST	NOSTR
	SKIPE	T,IPPN
	JRST	NOPMFD
	OPEN	MFD,A
	  JRST	OPNHLT
	MOVE	A,MFDPPN
	MOVSI	B,'UFD'
	MOVEI	C,0
	MOVE	D,MFDPPN
	LOOKUP	MFD,A
	  JRST	LOKHLT
NOPMFD:	MOVE	A,SJBFF
	MOVEM	A,.JBFF
	TLNN	F,L.BATC
	JRST	CTL1		; DONT NEED CONTROL FILES
	MOVX	A,UU.PHS
	MOVE	B,QSTR
	MOVSI	C,CTLHED
	OPEN	CTL,A
	  JRST	CTL1
	MOVE	A,STRUCT
	LSH	A,-6
	TLO	A,'Q  '
	MOVEM	A,QFILN
	MOVSI	B,'CTL'
	MOVSI	C,(055B8)	;FRIENDLY PROTECTION
	MOVE	D,FFAPPN
	ENTER	CTL,A
	  JRST	CTL1
	MOVEI	A,CTLM1
	PUSHJ	P,CTLMSG
	MOVE	A,[POINT 6,STRUCT]
CTLL1:	ILDB	CH,A
	JUMPE	CH,CTL2
	ADDI	CH,40
	PUSHJ	P,CTLTYO
	TLNE	A,77B23
	JRST	CTLL1
CTL2:	MOVEI	A,CTLM2
	PUSHJ	P,CTLMSG
	RELEAS	CTL,
CTL1:
	SUBTTL	LOOP FOR EACH USER

	SKIPE	IPPN
	JRST	ONEUSR

ML:	MOVE	T,IOL
	MOVEI	T1,0
	IN	MFD,T
	  JRST	GOTBLK		; PROCEED IF OK
	STATZ	MFD,IO.EOF	; NO--CHECK FOR END OF FILE
	JRST	EOSTR
GOTBLK:	MOVSI	M,-200
LOOP:	HLRZ	T,IOB+1(M)
	CAIE	T,'UFD'
	JRST	NEXT
	MOVE	T,IOB(M)
ONEUSR:	STORE	T1,IOB2,IOB2+25,0
	MOVEM	T,USER
	MOVEM	T,IOB2+.RBNAM
	MOVSI	T,'UFD'
	MOVEM	T,IOB2+.RBEXT
	MOVE	T,MFDPPN
	MOVEM	T,IOB2+.RBPPN
	MOVEI	T,25
	MOVEM	T,IOB2
	LOOKUP	UFD,IOB2
	  JRST	NEXT
	CLOSE	UFD,CL.DAT!CL.ACS  ; THROW AWAY NAME BLOCKS, ETC.
	PUSHJ	P,DHEAD		; GO TYPE HEADER FOR THIS STR
	MOVE	T,IOB2+.RBNAM
	MOVEM	T,TMPPPN	; SAVE AS TMP PPN FOR WORST USER
	PUSHJ	P,PPNOUT	; OUTPUT THE PPN
	PUSHJ	P,TAB
	MOVE	T,IOB2+.RBQTF
	PUSHJ	P,DECTAB	; OUTPUT QTA IN
	MOVE	T,IOB2+.RBQTO
	PUSHJ	P,DECTAB	; QTA OUT
	MOVE	T,IOB2+.RBUSD
	MOVE	T1,IOB2+.RBSTS	;GET RIB STATUS
	TRNE	T1,RP.NDL	;SEE IF NEVER-DELET
	JRST	ISINF		;YES--NOT QUOTA COUNTED EITHER
	JUMPGE	T,OVRZER	;JUMP IF POS USED
	MOVM	T,T
	ADD	T,IOB2+.RBQTO
	MOVEM	T,IOB2+.RBUSD

OVRZER:	CAIG	T,^D99999	; VERY LARGE NUMBER?
	JRST	TLOT		; NO
ISINF:	$MSG	<     ? + >
	TLO	F,L.EVAL	; SET FLAG
	JRST	PDON
TLOT:	MOVEM	T,TMPSIZ	; SAVE BLOCKS USED TEMPORARILY
	CAMG	T,WSTCAS	; IS THIS WORSE THAN WORST CASE?
	JRST	NOCAS		; NO
	MOVEM	T,WSTCAS	; YES, SAVE IT
	MOVE	TMP1,TMPPPN
	MOVEM	TMP1,WSTPPN

NOCAS:	PUSH	P,T		; SAVE # USED
	PUSHJ	P,DECOU6	; PRINT USED
	POP	P,T		; RESTORE # USED
	JUMPGE	T,CHKOVR	; NEGATIVE USED?
	$MSG	< ? >
	JRST	PDON

CHKOVR:	CAXG	T,FLGUSR	; OVER 500 BLOCKS USED?
	JRST	OKUSED		; NO
	$MSG	< * >
	JRST	PDON

OKUSED:	$MSG	<   >
PDON:	MOVE	T,IOB2+.RBDEV	; GET UNIT
	PUSHJ	P,SIXOUT	; AND OUTPUT IT
	PUSHJ	P,TAB
	SKIPGE	IOB2+.RBSTS	; LOGGED OUT USER?
	JRST	STATCK		;NO--SEE IF LOGGED IN
	MOVSI	T,'OUT'		;YES--SET LOGGED OUT
	MOVE	T1,IOB2+.RBUSD	;GET AMOUNT USED
	SUB	T1,IOB2+.RBQTO	;LESS QUOTA
	CAXGE	T1,OQDELT	;IF WORSE THAN OQDELT,
	JRST	CHKBAD		;(NO--LOOK FOR WORST USER)
	TLNE	F,L.BATC	;YES--SEE IF /BATCH
	PUSHJ	P,QJOB		;YES--START IT
	JRST	CHKBAD		;THEN GO LOOK FOR WORST USER
STATCK:	TLO	F,L.ISIN	; NOTE THAT USER IS LOGGED IN
	MOVX	T,%NSHJB
	GETTAB	T,
	  JFCL
	MOVE	N,T
STATL:	HRLZ	T,N
	HRRI	T,.GTPPN
	GETTAB	T,
	  SETOB	N,T
	CAMN	T,IOB2+.RBNAM
	JRST	STATP1
	SOJG	N,STATL
	TLNE	F,L.BATC
	PUSHJ	P,QJOB
	TLZ	F,L.ISIN	; NOT REALLY LOGGED IN SO CLEAR FLAG
	SKIPA	T,['RECOMP']
STATP1:	MOVSI	T,'IN '
STATPT:	MOVEM	T,INOURE	; SAVE FOR FACT FILE ITEM
	PUSHJ	P,SIXOUT	; OUTPUT IN,OUT, OR RECOMP
	MOVE	T,IOB2+.RBQTO
	TLNE	F,L.ISIN	; SEE IF GOING TO ISSUE DATE
	CAME	T,[.INFIN]  ; NO--SEE IF GOING TO DO FREE
	PUSHJ	P,TAB		; YES--SPACE OVER TO IT
	CAMN	T,[.INFIN]
	JRST	NOFREE
	SUB	T,IOB2+.RBUSD	; QUOTA OUT-USED=FREE
	PUSHJ	P,DECOU6	; OUTPUT BLOCKS FREE
NOFREE:	TLZE	F,L.ISIN	; SEE IF LOGGED IN
	JRST	ISIN		; YES--DON'T GIVE DATE
	PUSHJ	P,TAB		; SPACE OVER FOR DATE
	LDB	N,[POINTR (IOB2+.RBEXT,RB.CRX)] ; DATE(75) CODE
	LSH	N,WID(RB.CRD)
	LDB	N1,[POINTR (IOB2+.RBPRV,RB.CRD)]
	IOR	N,N1
	IDIVI	N,^D31*^D12	; GET DATE IN YEAR
	MOVE	N,N1		; POSITION IT
	IDIVI	N,^D31		; GET MONTH
	MOVEI	T,MONTAB(N)	; GET ASCII OF MONTH
	PUSHJ	P,MSG		; TYPE IT
	$MSG	< >
	MOVEI	T,1(N1)		; GET DAY IN MONTH
	PUSHJ	P,DECOUT	; TYPE IT IN DECIMAL
ISIN:	PUSHJ	P,CRLF
	TLNE	F,L.FACT
	PUSHJ	P,MAKFCT
IFN FTUSAGE,<
	TRNE	F,R.USG		;WANT TO MAKE USAGE ENTRIES
	PUSHJ	P,MAKUSG	;YES, MAKE ONE
>
	MOVE	N,IOB2+.RBSTS	;GET RIB STATUS
	TRNE	N,RP.NDL	;SEE IF NEVER-DELETE
	TDZA	N,N		;YES--CLEAR FROM COUNT
	MOVE	N,IOB2+.RBUSD
	CAIG	N,^D99999
	SKIPG	N
	MOVEI	N,0
	ADDM	N,TOTUSD
	ADDM	N,STRUSD
NEXT:	SKIPE	IPPN
	JRST	SPACEL
	AOBJN	M,.+1
	AOBJN	M,LOOP
	JRST	ML

OPNHLT:	PUSHJ	P,WRN
E$$OFU:	  ASCII	/OFU/
	OUTSTR	[ASCIZ	/ Open/]
	TLNE	F,L.TTY
	JRST	CERR
	$MSG	<
% Open>
	JRST	CERR
LOKHLT:	PUSHJ	P,WRN
E$$LFU:	  ASCII	/LFU/
	OUTSTR	[ASCIZ	/ Lookup/]
	TLNE	F,L.TTY
	JRST	CERR
	$MSG	<
% Lookup>

CERR:	OUTSTR	[ASCIZ	/ failure for /]
	TLNE	F,L.TTY
	JRST	TYERR
	$MSG	< failure for >

	MOVE	T,STRUCT
	PUSHJ	P,SIXOUT
TYERR:	MOVEI	T,STRUCT
	PUSHJ	P,TYSIX
	OUTSTR	[ASCIZ	/:[1,1].UFD
/]
	TLNE	F,L.TTY
	JRST	SPACEL
	$MSG	<:[1,1].UFD
>
	JRST	SPACEL
	; HERE TO SAVE WORST LOGGED OUT USER
CHKBAD:	MOVE	TMP1,TMPSIZ	; GET BLOCKS OF LAST USER
	CAMG	TMP1,BADUSR	; .GT. BADUSR?
	JRST	STATPT		; NO, CONTINUE
	MOVEM	TMP1,BADUSR	; YES, SAVE HIS BLOCKS
	MOVE	TMP1,TMPPPN	; AND REMEMBER THIS GUY
	MOVEM	TMP1,BADPPN
	JRST	STATPT

EOSTR:	CLOSE	MFD,CL.ACS	; DONE WITH MFD
	RELEAS	MFD,
	RELEAS	UFD,
	$MSG <
Structure used total  >
	MOVE	T,STRUSD
	PUSHJ	P,DECOU6
	$MSG <
	  free        >
	MOVE	T,STRTAL
	ADDM	T,TOTFRE
	PUSHJ	P,DECOU6
	SETZB	T,T1		; CLEAR ACCUMULATION AND STR
EOS1:	SYSPHY	T1,		; GET NEXT UNIT
	  JRST	EOS2		; GIVE UP
	JUMPE	T1,EOS2		; DONE
	MOVEM	T1,IOB2		; SAVE FOR DSKCHR
	MOVE	T2,[7,,IOB2]	; POINT TO DSKCHR
	DSKCHR	T2,UU.PHY	; GET INFO
	  JRST	EOS1		; GIVE UP IF FAILS
	MOVE	T2,IOB2+.DCSNM	; GET STR NAME
	CAMN	T2,STRUCT	; SEE IF THIS STR
	ADD	T,IOB2+.DCUSZ	; YES--INCLUDE IT'S SIZE
	JRST	EOS1		; LOOP UNTIL DONE

EOS2:	JUMPE	T,EOST		; GIVE UP IF NO SPACE
	PUSH	P,T		; SAVE SPACE
	$MSG	<
	  system+lost >
	MOVE	T,(P)		; GET SPACE
	SUB	T,STRUSD	; SUBTRACT AMOUNT USED
	SUB	T,STRTAL	; AND AMOUNT FREE
	PUSHJ	P,DECOU6	; TYPE IT
	$MSG	<
	  total       >
	POP	P,T		; RESTORE TOTAL SPACE
	PUSHJ	P,DECOU6	; TYPE IT

EOST:	$MSG	<

* Using over 500 blocks
>
	TLZN	F,L.EVAL	; DID WE ENCOUNTER A # WE COULDN'T EVALUATE?
	JRST	EVAL		; NO
	$MSG	<+ Could not be evaluated
>
EVAL:	$MSG	<
Logged out user holding most space:  [>
	HLRZ	T,BADPPN
	PUSHJ	P,OCTOUT
	$MSG	<,>
	HRRZ	T,BADPPN
	PUSHJ	P,OCTOUT
	$MSG	<]
User with most space overall:  [>
	HLRZ	T,WSTPPN
	PUSHJ	P,OCTOUT
	$MSG	<,>
	HRRZ	T,WSTPPN
	PUSHJ	P,OCTOUT
	$MSG	<]
>
	TLZN	F,L.COMA
	JRST	SPACEL
	SETZM	FILE
	SETZM	EXT
	PUSHJ	P,COML1
	JRST	SPCCAL
EOSYS:	TLNN	F,L.DSK
	JRST	EOSY2
	$MSG <
Total used on all structures : >
	MOVE	T,TOTUSD
	PUSHJ	P,DECOUT
	SKIPE	IPPN
	JRST	EOSY1
	$MSG <
Total free on all structures : >
	MOVE	T,TOTFRE
	PUSHJ	P,DECOUT
EOSY1:	PUSHJ	P,CRLF
EOSY2:	PUSHJ	P,CRLF
	RELEAS	LST,		; CLOSE THE LISTING FILE
	CALLI	1,12		; EXIT
	JRST	SPCUSG		; IN CASE OF CONTINUE

CTLMSG:	HRLI	A,(POINT 7,)
CTLML1:	ILDB	CH,A
	JUMPE	CH,CPOPJ
	PUSHJ	P,CTLTYO
	JRST	CTLML1

CTLTYO:	SOSG	CTLHED+2
	OUTPUT	CTL,
	IDPB	CH,CTLHED+1
	POPJ	P,
CTLM1:	ASCIZ	\; Dummy job submitted by SPCUSG
;  because your quota had not been recomputed
;  or because you exceeded your logged out disk quota.

.MOUNT \
CTLM2:	ASCIZ	\:
.DIRECT /F/W
.R QUOLST
\
	SUBTTL	SUBROUTINES

COLON:	MOVEI	CH,":"
	JRST	TYO
TAB:	MOVEI	CH,11
TYO:	SOSLE	OHED+2
	JRST	TYOOK
	OUT	LST,
	  SKIPA
	JRST	LSTERR
TYOOK:	IDPB	CH,OHED+1
	TLNN	F,L.TTY
	POPJ	P,
	CAIN	CH,12
	OUTPUT	LST,
CPOPJ:	POPJ	P,

LSTERR:	PUSHJ	P,ERR
E$$OEL:	  ASCII	/OEL/
	OUTSTR	[ASCIZ / Output error on listing device
/]
	EXIT

MSG:	HRLI	T,(POINT 7,)
MSGL:	ILDB	CH,T
	JUMPE	CH,CPOPJ
	PUSHJ	P,TYO
	JRST	MSGL

CRLF:	JSP	T,MSG
	ASCIZ	/
/
MONTAB:	ASCIZ	/Jan/
	ASCIZ	/Feb/
	ASCIZ	/Mar/
	ASCIZ	/Apr/
	ASCIZ	/May/
	ASCIZ	/Jun/
	ASCIZ	/Jul/
	ASCIZ	/Aug/
	ASCIZ	/Sep/
	ASCIZ	/Oct/
	ASCIZ	/Nov/
	ASCIZ	/Dec/

UNIERR:	PUSHJ	P,ERR
E$$IND:	  ASCII	/IND/
	OUTSTR	[ASCIZ	/ Input device /]
	PUSHJ	P,TYSIX
	OUTSTR	[ASCIZ	/: not a DSK structure/]
	JRST	COMERX

	; OUTPUT SIXBIT WORD ON TTY
	; T POINTS TO SIXBIT WORD
TYSIX:	HRLI	T,(POINT 6,)	; SIXBIT BP
TYS:	ILDB	CH,T
	JUMPE	CH,CPOPJ
	ADDI	CH,40		; MAKE ASCII
	OUTCHR	CH
	TLNE	T,77B23
	JRST	TYS
	POPJ	P,0
NOSTR:	PUSHJ	P,WRN
E$$CAS:	  ASCII	/CAS/
	OUTSTR	[ASCIZ / Can't access structure "/]
	MOVEI	T,STRUCT	; TYPE OUT THE LOSING STR
	PUSHJ	P,TYSIX
	OUTSTR	[ASCIZ /"
/]
	JRST	SPACEL

MINUS:	MOVEI	CH,"-"
	JRST	TYO

DECPR2:	MOVEI	CH,"0"
	CAIG	T,11
	PUSHJ	P,TYO
DECOUT:	CAMN	T,[.INFIN]
	JRST	INFINI
	SKIPGE	T
	PUSHJ	P,MINUS
	MOVMS	T
	IDIVI	T,12
	HRLM	T1,(P)
	SKIPE	T
	PUSHJ	P,DECOUT
	HLRZ	CH,(P)
	ADDI	CH,"0"
	JRST	TYO

PPNOUT:	PUSH	P,T		; LINE-UP THE PROJECT CODE
	HLRZ	T,T
..Z==7B20
REPEAT 5,<	TRNN T,..Z
	PUSHJ	P,BLANK
..Z==<..Z!<..Z_<-3>>>>
	HLRZ	T,(P)
	PUSHJ	P,OCTOUT
	MOVEI	CH,","
	PUSHJ	P,TYO
	HRRZ	T,(P)
	PUSHJ	P,OCTOUT
	POP	P,T
	POPJ	P,

OCTOUT:	SKIPGE	T
	PUSHJ	P,MINUS
	MOVMS	T
	IDIVI	T,10
	HRLM	T1,(P)
	SKIPE	T
	PUSHJ	P,OCTOUT
	HLRZ	CH,(P)
	ADDI	CH,"0"
	JRST	TYO

SIXOUT:	MOVE	T3,[POINT 6,T]
SIXOUL:	ILDB	CH,T3
	JUMPE	CH,CPOPJ
	ADDI	CH,40
	PUSHJ	P,TYO
	TLNE	T3,77B23
	JRST	SIXOUL
	POPJ	P,

BLANK:	MOVEI	CH,40
	JRST	TYO
DHEAD:	TLOE	F,L.TTLD	; SEE IF STR TITLE DONE YET
	POPJ	P,		; YES--RETURN
	SKIPN	IPPN		; SEE IF SINGLE USER
	PUSHJ	P,CRLF		; NO--SET IT OFF FROM PREVIOUS LINES
	PUSHJ	P,HEAD		; GIVE MASTER TITLE IF NEEDED
	TLNE	F,L.TTY	; TTY?
	JRST	DHT		; YES
	MOVEI	T,STRUCT	; MONITOR STR PROCESSING
	PUSHJ	P,TYSIX
	OUTSTR	[ASCIZ	/
/]

DHT:	SKIPN	IPPN		; IF MULTI-USER,
	PUSHJ	P,CRLF		; END LINE
	PJRST	CRLF		; GIVE A BLANK LINE

HEAD:	MOVEI	CH,.CHFFD	; OUTPUT A FORM-FEED
	TLOE	F,L.FPAG	; FIRST PAGE HEADER?
	PUSHJ	P,TYO		;NO--OUTPUT
	PUSH	P,.JBFF##	;SAVE .JBFF
	MOVX	A,UU.PHY	;INDICATE ASCII/PHYSICAL
	MOVE	B,STRUCT	;GET DEVICE
	MOVEI	C,IHED		;POINT TO BUFFER POINTERS
	OPEN	TXT,A		;OPEN DEVICE
	  JRST	HD4		;CAN'T!
	MOVSI	A,'STR'		;GET STR
	MOVSI	B,'TXT'		; .TXT
	MOVEI	C,0		;
	MOVE	D,SYSPPN	; [1,4]
	LOOKUP	TXT,A		;OPEN FILE
	  JRST	HD4		;NOT THERE

HD2:	SOSGE	IHED+.BFCTR	;COUNT DOWN BYTES
	JRST	[INPUT TXT,	;GET ANOTHER BUFFER
		 STATO TXT,IO.EOF ;SEE IF DONE
		   JRST HD2	;NO--LOOP ON
		 JRST  HD3]	;YES--DONE
	ILDB	CH,IHED+.BFPTR	;GET NEXT BYTE
	MOVE	T,@IHED+.BFPTR	;GET WORD
	TRNE	T,1		;SEE IF SEQUENCED
	JRST	[AOS   IHED+.BFPTR ;YES--ADVANCE ANOTHER WORD
		 MOVNI T,5	;AND TOTAL OF 6 CHARS
		 ADDM  T,IHED+.BFCTR ; ..
		 JRST  HD2]	;AND TRY AGAIN
	JUMPE	CH,HD2		;DISCARD NULLS
	PUSHJ	P,TYO		;OUTPUT IT
	JRST	HD2		;LOOP UNTIL DONE

HD3:	PUSHJ	P,CRLF		;END OF LINE
	PUSHJ	P,CRLF		;AND A BLANK

HD4:	RELEAS	TXT,		;CLEAR CHANNEL
	POP	P,.JBFF##	;RESTORE .JBFF
	$MSG	<			*** >
	MOVE	T,STRUCT	; GET STR NAME
	PUSHJ	P,SIXOUT	; TYPE IN SIXBIT
	$MSG	< ***>
	JSP	T,MSG
	ASCIZ	/

  Proj,Prog	Qta in	Qta out	  Used	 Unit	Login?	 Free	Last In
/
DECTAB:	PUSH	P,T
	PUSHJ	P,DECOU6
	POP	P,T
	CAME	T,[.INFIN]
	CAMG	T,[EXP ^D9999999]
	JRST	TAB
	JRST	BLANK

INFINI:	JSP	T,MSG
	ASCIZ	/+Infin/
QJOB:	MOVE	T,[QDATAH,,QDATA]	;COPY TO LOW SEG
	BLT	T,QEND-1
	MOVE	T,QFILN
	MOVEM	T,QFNAM
	MOVE	T,USER
	MOVEM	T,QUSER
	MOVEM	T,QUSR2
	MOVEM	T,QUSR3
	MOVE	T,STRUCT	;GET THIS STRUCTURE
	MOVEM	T,LSTR		;USE FOR LOG FILE
	MOVE	T,QSTR		;GET QUE STR
	MOVEM	T,CSTR		;THAT'S WHERE CTL IS
	MOVE	A,[QSIZ,,QDATA]
	PJRST	.QUEER##

DECOU6:	MOVM	N1,T
	JUMPL	T,DECOX6
	CAIG	N1,^D99999
	PUSHJ	P,BLANK

DECOX6:	CAIG	N1,^D9999
	PUSHJ	P,BLANK
	CAIG	N1,^D999
	PUSHJ	P,BLANK
	CAIG	N1,^D99
	PUSHJ	P,BLANK
	CAIG	N1,^D9
	PUSHJ	P,BLANK
	JRST	DECOUT
MAKFCT:	MOVEI	A,.FACT		;GET FACT FUNCTION
	MOVEM	A,FACTH		;SET FOR DAEMON
	MOVEI	A,FE$SPC
	DPB	A,[POINT 9,FACTB,8]
	PJOB	A,
	DPB	A,[POINT 9,FACTB,17]
	MOVNI	A,1
	GETLCH	A
	MOVEI	T,(A)
	TXNE	A,GL.CTY
	MOVNI	T,1
	GETLIN	A,
	TLNN	A,-1
	MOVNI	T,2
	DPB	T,[POINT 12,FACTB,29]
	MOVEI	T,FACTBL
	DPB	T,[POINT 6,FACTB,35]
	MOVE	A,IOB2+.RBNAM	; USER'S PPN
	MOVEM	A,FACTB+1
	SETZM	FACTB+2
	MOVE	A,STRUCT
	MOVEM	A,FACTB+3
	MOVE	A,IOB2+.RBSTS
	TRNE	A,RP.NDL	; SEE IF NON-RENAMEABLE
	POPJ	P,		; YES--GIVE UP
	MOVEM	A,FACTB+4
	MOVE	A,IOB2+.RBQTF
	MOVEM	A,FACTB+5
	MOVE	A,IOB2+.RBQTO
	MOVEM	A,FACTB+6
	MOVE	A,IOB2+.RBQTR
	MOVEM	A,FACTB+7
	MOVE	A,IOB2+.RBUSD
	MOVEM	A,FACTB+10
	MOVE	A,STRTAL
	MOVEM	A,FACTB+11
	MOVE	A,INOURE
	MOVEM	A,FACTB+12
	MOVE	A,[FACTBL+1,,FACTH]
	DAEMON	A,
	  TLOE	F,L.DAER
	POPJ	P,
	$MSG	<
% DAEMON UUO failed
>
	POPJ	P,
IFN FTUSAGE,<

;HERE TO MAKE A USAGE ENTRY SIMILAR TO THE FACT ENTRY.  SINCE THIS DISTRIBUTED
;	ACTDAE DOES NOT HAVE ANY PREDEFINED USER ENTRIES, MODIFICATIONS WILL
;	HAVE TO BE MADE TO ACTRCD.MAC TO INCLUDE A DEFINITION FOR THE RECORD
;	THAT WILL BE PRODUCED FROM THIS SUBROUTINE.  THE RECORD TYPE (NUMBER)
;	OF THIS RECORD WILL DEPEND ON OTHER CUSTOMER DEFINED ENTRIES YOU PUT
;	IN ACTRCD AND THE ORDER THEY ARE ENTERED SO THIS ROUTINE WILL MAKE A
;	9999 RECORD WHICH IS SURELY ILLEGAL AND WILL HAVE TO BE CHANGED.  SO
;	THAT MODIFICATIONS WILL NOT BE REQUIRED TO ACTSYM.MAC TO DEFINE DEFUS
;	ITEM NUMBERS, ITEM NAMES CHOSEN HERE ARE THOSE CLOSE TO ONES ALREADY
;	DEFINED BUT IN SOME CASES ARE NOT MNEMONICALLY MEANINGFUL, THEY JUST
;	CAUSE THE CORRECT DATA CONVERSION.

;THE FOLLOWING LINES SHOULD BE PLACED IN ACTRCD.MAC TO ACCOMODATE THIS EXAMPLE.
;	THEY SHOULD BE PLACED IN THE "ENLIST" AND "RCLIST" MACRO DEFINITIONS
;	DESIGNATED AS THOSE DEFINING USER ENTRIES 5000-9999.

;ENLIST -	ENTRY	(FO2,<UEH,BA2>)	;ENTRY xxxx - SPACE EXAMPLE
;RCLIST -	RECORD	(BA2,1,1,<PPN,DFS,LIQ,LOQ,RIN,TUS,TAL,DSP>)

MAKUSG:	MOVE	T1,IOB2+.RBSTS	;GET RIB STATUS
	TRNE	T1,RP.NDL	;NON-DELETABLE
	POPJ	P,		;YES, NO SPACE ENTRY SO NO USAGE ENTRY
	PJOB	T1,		;GET OUT JOB NUMBER
	MOVEM	T1,MONJNO	;STORE IT FOR QUEUE.
	SETZM	MONNOD		;ASSUME DETACHED
	SETZM	MONLNO		;...
	MOVSI	T,(ASCIZ/D/)	;ASSUME DETACHED
	TRMNO.	T1,		;GET TERMINAL DESIGNATOR
	  JRST	SETTN1		;DETACHED
	DPB	T1,[POINT 9,MONLNO,35] ;STORE IN CASE NO NETWORKS
	GETLCH	T1		;GET LINE CHARACTERISTICS
	MOVSI	T,(ASCIZ/T/)	;ASSUME REGULAR TTY
	TXNE	T1,GL.CTY	;THE SYSTEM CTY
	MOVSI	T,(ASCIZ/C/)	;YES
	TXNE	T1,GL.ITY	;INVISIBLE (PSEUDO) TTY
	MOVSI	T,(ASCIZ/P/)	;YES
	HRRZS	T1		;GET RID OF GETLCH BITS
	GTNTN.	T1,		;CONVERT TO NODE AND LINE
	  JRST	SETTN1		;NO NETWORKS
	HRRZM	T1,MONLNO	;STORE REAL LINE NUMBER
	HLRZ	T3,T1		;ISOLATE NODE NUMBER
	MOVEI	T2,2		;NUMBER OF ARGUMENTS
	MOVE	T1,[.NDRNN,,T2]	;RETURN NODE NAME FOR NUMBER
	NODE.	T1,		;ASK TODD
	  SKIPA			;FAILED?
	MOVEM	T1,MONNOD	;STORE SIXBIT NODE NAME
SETTN1:	MOVEM	T,MONTDE	;STORE TERMINAL DESIGNATOR
	MOVE	T1,[ACBLEN,,ACTBLK] ;LENGTH,,ADDRESS OF PARAMETERS
	QUEUE.	T1,		;ASK ACTDAE TO MAKE THE RECORD
	  TROE	F,R.QUUR	;ONLY TELL ONCE
	POPJ	P,
	$MSG	<
% QUEUE. UUO failed
>
	POPJ	P,


;Use the macros from ACTSYM to generate a DEFUS list for the supplied data items

ACTBLK:	USENT.	(^D9999,1,1,20,RESBLK) ;ENTRY TYPE, VERSION NUMBERS
				;AND LENGTH,ADDRESS OF RESPONSE BLOCK.

;The DEFUS list proper.  These do not have to be in any particular order.  They
;	are entered here in the order of the data items described in the record
;	definitions in ACTRCD.

;Record 1 - Entry Header

	USJNO.	(MONJNO)	;THE JOB NUMBER
	USTRM.	(MONTDE)	;TERMINAL DESIGNATOR
	USLNO.	(MONLNO)	;LINE NUMBER
	USPNM.	(<SIXBIT/SPCUSG/>,US%IMM) ;PROGRAM NAME (IMMEDIATE DATA ITEM)
	USPVR.	(.JBVER##)	;PROGRAM VERSION NUMBER
	USNOD.	(MONNOD)	;NODE NAME

;Record 2 - User Data

	USPPN.	(IOB2+.RBNAM)	;PPN
	USDFS.	(STRUCT)	;STRUCTURE
	USLIQ.	(IOB2+.RBQTF)	;LOGGED IN QUOTA
	USLOQ.	(IOB2+.RBQTO)	;LOGGED OUT QUOTA
	USRIN.	(IOB2+.RBQTR)	;RESERVED QUOTA
	USTUS.	(IOB2+.RBUSD)	;TOTAL BLOCKS USED
	USTAL.	(STRTAL)	;STRUCTURE FREE SPACE
	USDSP.	(INOURE)	;IN/OUT/RECOMP

ACBLEN==.-ACTBLK		;LENGTH OF QUEUE. ARGUMENT BLOCK

	RELOC			;SWITCH TO LOW SEGMENT
RESBLK:	BLOCK	20		;ROOM FOR A RESPONSE
MONJNO:	BLOCK	1		;JOB NUMBER
MONTDE:	BLOCK	1		;TERMINAL DESIGNATOR
MONLNO:	BLOCK	1		;LINE NUMBER
MONNOD:	BLOCK	1		;NODE NAME
	RELOC			;BACK TO CODE SEGMENT

> ;END FTUSAGE
	RELOC			;SWITCH TO LOW SEG
QDATA:!				;LABEL IT
	RELOC			;BACK TO HI SEG

QDATAH:	PHASE	QDATA

QDATA:!	0
	REPEAT .QIHED+2*<Q.FMOD+1>,<XLIST
					0>
	LIST

	DEFINE	Q$ ($QLOC,$SPEC),<
	$$Q==0
	IFIDN <$SPEC><C>,<$$Q==1+.QIHED>;;CTL FILE
	IFIDN <$SPEC><L>,<$$Q==1+.QIHED+<Q.FMOD+1>>;;LOG FILE
	RELOC	QDATAH+$$Q+Q.'$QLOC
	PHASE	QDATA+$$Q+Q.'$QLOC
>

	DEFINE	B$ (ARGS$),<
BB$==0
IRP ARGS$,<
BB$==BB$!<BBB$ (ARGS$) >
>
	BB$
>
	DEFINE	BBB$ (ARG$), < BBBB$ (ARG$) >
	DEFINE	BBBB$ (MASK$,VAL$), < INSVL.	(VAL$,MASK$) >

	Q$	OPR
	B$	<<QO.CSP,11>,<QO.ROP,.QORCR>>	;SPACE PROGRAM,CREATE
	Q$	LEN
	B$	<<QL.HLN,.QIHED>,<QL.FLN,Q.FMOD+1>,<QL.NFL,2>>  ;HEADER LENGTH,FILE LEN,NUM FILES
	Q$	DEV
	SIXBIT	/INP/
	Q$	PPN
QUSER:!	0
	Q$	JOB
	SIXBIT	/SPCUSG/		; JOB NAME
	Q$	PRI
	B$	<<QP.PRI,1>>	; PRIORITY
	Q$	USER
	SIXBIT	/SYSTEM-ADMIN/	;USER NAME
	Q$	IDEP
	B$	<<QI.UNI,.QIUSD>,<QI.OUT,.QIOLG>>	;UNIQUE, /Z:1
	Q$	ILIM
	B$	<<QM.COR,2000>,<QM.TIM,^D300>> ;/CORE:1K,/TIME:300
	Q$	ILM2
	B$	<<QM.LPT,^D10>>		;/PAGES:10
	Q$	IDDI
QUSR3:!	0
	Q$	FSTR,C
CSTR:!	0		;CTL STRUCTURE
	Q$	FDIR,C
	1,,2		;CTL DIRECTORY
	Q$	FNAM,C
QFNAM:!	'SPCUSG'	;CTL FILE NAME
	Q$	FEXT,C
	'CTL   '	;CTL EXTENSION
	Q$	FMOD,C
	B$	<<QF.SPC,1>,<QF.PFM,%QFLAR>,<QF.FFM,.QFFAS>,<QF.DSP,.QFDPR>,<QF.COP,1>>
			;/SPAC:1,/PRINT:ARROW,/FILE:ASCII,/DISP:PRES,/COP:1;CTL MODIFIERS
	Q$	FSTR,L
LSTR:!	0		;LOG STRUCTURE
	Q$	FDIR,L
QUSR2:!	0		;LOG DIRECTORY
	Q$	FNAM,L
	'SPCUSG'	;LOG FILE NAME
	Q$	FEXT,L
	'LOG   '	;LOG EXTENSION
	Q$	FMOD,L
	B$	<<QF.LOG,1>,<QF.DEF,1>,<QF.SPC,1>,<QF.PFM,%QFLAR>,<QF.FFM,.QFFAS>,<QF.DSP,.QFDDE>,<QF.COP,1>>
			;/LOG,/NEW,/SPAC:1,/PRINT:ARROW,/FILE:ASCII,/DISP:DEL,/COP:1 ;LOG MODIFIERS
QEND==QDATA+1+.QIHED+2*<Q.FMOD+1>
QSIZ==QEND-QDATA

	DEPHASE
	RELOC	QDATA		;SWITCH TO LOW SEG
QDATA:!	BLOCK	QSIZ		;MAKE ROOM
	RELOC	QDATAH+QSIZ	;BACK TO HI SEG


QUEUEM==:'SPA'
QUEUEN==:'CE '
	SUBTTL	COMMAND ACQUISITION

COMAND:	SKPINL			; CLEAR ^O
	  JFCL
	OUTSTR	[ASCIZ /*/]
	SETZM	COMDAT		; ZERO COMMAND BLOCK
	MOVE	T,[COMDAT,,COMDAT+1]
	BLT	T,COMDX
	TLZ	F,L.ARO+L.ANY	; CLEAR COMMAND FLAGS
COML1:	PUSHJ	P,FILSPC	; GO GET A FILE SPECIFICATION
COM2:	CAIN	CH,"/"
	JRST	SWITCH		; SWITCH BREAK
	CAIN	CH,"="
	JRST	ARROW		; ARROW BREAK
	CAIE	CH,","		; MULTIPLE UNITS?
	CAIG	CH,33
	JRST	BREAK		; BREAK BREAK
COMERR:	PUSHJ	P,ERR		;ISSUE ERROR
E$$CME:	  ASCII	/CME/
	OUTSTR	[ASCIZ / Command error/]
COMERX:	OUTSTR	[ASCIZ \
  Type /HELP for help
\]	; DON'T TELL USER WHAT'S WRONG, JUST TELL'EM HE NEEDS HELP!
	JRST	SPCUSG		; REENTER
SWITCH:	PUSHJ	P,SIXBRD	; GO GET A SIXBIT SWITCH IN A
	JUMPE	A,COMERR	; ERROR IF NO SWITCH FOUND
	SETOB	B,N1
	TDNN	B,A		; MAKE SWITCH MASK IN B
	JRST	SW2
	LSH	B,-6
	JRST	.-3
SW2:	MOVSI	N,-SWITCN	; MAKE TABLE POINTER
SW2A:	MOVE	C,SWTAB(N)	; LOAD RECOGNIZED SWITCH
	TDZ	C,B		; CLEAR UNUSED BITS FOR LEGAL ABBREVIATIONS
	CAMN	A,C		; LEGAL SWITCH?
	JRST	SW1		; YES
SW3:	AOBJN	N,SW2A		; NO, LOOP UNLESS WE'RE DONE
	MOVEI	A,0		; CLEAR SWITCH
	JUMPL	N1,COMERR	; BAD SWITCH TYPED
	JUMPE	N1,HELP		; HELP TYPED
	TDO	F,SWTAB1(N1)	; GET PRIV. FLAGS
	TLNN	F,L.GOD		; IF HE'S GOD .
	TDNN	F,[L.FACT!L.BATC,,R.USG] ;  OR ONE OF HIS APOSTLES .
	JRST	COM2		;   THEN HE'S A GOOD GUY!
	PUSHJ	P,ERR		;ERROR
E$$SIU:	  ASCII	/SIU/
	OUTSTR	[ASCIZ / Switch illegal unless logged in as [1,2]/]
	JRST	COMERX		; IF NOT - TELL HIM

SW1:	JUMPGE	N1,COMERR	; ILLEGAL SWITCH?
	HRRZ	N1,N		; NO, VALIDATE USER PRIV.
	JRST	SW3

SWTAB:	SIXBIT	/HELP/
	SIXBIT	/BATCH/
	SIXBIT	/FACT/
IFN FTUSAGE,<SIXBIT/USAGE/>
SWITCN==.-SWTAB
SWTAB1:	0
	L.BATC,,0
	L.FACT,,0
IFN FTUSAGE,<0,,R.USG>

HELP:	MOVE	A,['SPACE ']	; HERE WHEN HELP TYPED
	PUSHJ	P,.HELPR##
	JRST	SPCUSG
ARROW:	TLOE	F,L.ARO
	JRST	COMERR
	MOVE	T,DEV
	MOVEM	T,ODEV
	MOVE	T,FILE
	MOVEM	T,OFILE
	MOVE	T,EXT
	MOVEM	T,OEXT
	MOVE	T,PPN
	MOVEM	T,OPPN
	JRST	COML1

BREAK:	SKIPN	FILE
	SKIPE	EXT
	JRST	COMERR
	MOVE	T,PPN
	MOVEM	T,IPPN
	SKIPN	T,DEV
	MOVSI	T,'DSK'
	MOVEM	T,IDEV
	TLNN	F,L.ANY!L.ARO!L.COMA
	JRST	BREAK1
	POPJ	P,

BREAK1:	CAIE	CH,3
	CAIN	CH,32
	MONRT.
	JRST	COMAND
SIXBRD:	MOVEI	A,0		; PREPARE SIXBIT BYTE POINTER TO A
	MOVE	B,[POINT 6,A]
SIXBRL:	PUSHJ	P,TYI		; GET ASCII CHARACTER
	CAIN	CH,","
	TLO	F,L.COMA
	CAIG	CH,"Z"		; ALPHA?
	CAIGE	CH,"A"
	SKIPA			; NO
	JRST	SIXLTR		; YES
	CAIG	CH,"9"		; DIGIT?
	CAIGE	CH,"0"
	JRST	[SKIPE A
		TLO F,L.ANY
		POPJ P,]	; NO
SIXLTR:	SUBI	CH,40		; MAKE SIXBIT
	TLNE	B,77B23		; OVERFLOW?
	IDPB	CH,B		; NO, DEPOSIT SIXBIT CHARACTER INTO A
	JRST	SIXBRL		; LOOP

TYI:	INCHWL	CH		; GET TERMINAL CHARACTER
	CAIE	CH,.CHDEL	; IGNORE RUBOUTS AND CARRIAGE RETURNS
	CAIN	CH,.CHCRT
	JRST	TYI
	JUMPE	CH,TYI		; IGNORE NULLS
	CAIG	CH,"Z"+40	; CONVERT LOWER CASE TO UPPER
	CAIGE	CH,"A"+40
	SKIPA
	SUBI	CH,40
	CAIE	CH,40		; IGNORE SPACES AND TABS
	CAIN	CH,.CHTAB
	JRST	TYI
	POPJ	P,		; RETURN WITH SIXBIT CHARACTER IN CH
FILSPC:	SETZM	FILE		; FIRST CLEAR APPROPRIATE WORDS
	SETZM	DEV
	SETZM	EXT
	SETZM	PPN
	TLZ	F,L.BKT+L.DOT	; AND FLAGS
FILSPL:	PUSHJ	P,SIXBRD	; GO GET FILE SPEC., CONVERTED TO SIXBIT IN A
FILSP2:	CAIN	CH,":"		; DEVICE?
	JRST	CCOLON		; YES
	CAIN	CH,"."		; FILE?
	JRST	DOT		; YES
	CAIN	CH,"["		; PPN?
	JRST	BRAKET		; YES
FSTHRU:	TLNE	F,L.ARO
	JRST	CCOLON
	TLZN	F,L.DOT		; CLEAR FLAG & SKIP IF ALREADY SET
	JRST	FSTHR1		; FLAG NOT PREVIOUSLY SET
	HLLOM	A,EXT		; SAVE EXTENSION
	MOVEI	A,0		; CLEAR WORD
FSTHR1:	SKIPN	A		; DO WE HAVE A SPECIFICATION?
	POPJ	P,		; NO
	SKIPE	FILE		; YES, DO WE HAVE A FILENAME YET?
	JRST	COMERR		; YES, ERROR
	MOVEM	A,FILE		; SAVE THE FILENAME
	POPJ	P,		; RETURN

DOT:	TLOE	F,L.DOT		; SET DOT FLAG AND GIVE ERROR IF PREVIOUSLY SET
	JRST	COMERR
	SKIPN	A		; DO WE HAVE A SPECIFICATION?
	JRST	FILSPL		; NO
	SKIPE	FILE		; DO WE ALREADY HAVE A FILENAME?
	JRST	COMERR		; YES, ERROR
	MOVEM	A,FILE		; SAVE FILENAME
	JRST	FILSPL		; LOOP

CCOLON:	CAIE	CH,":"
	JUMPE	A,CPOPJ
	SKIPE	A
	SKIPE	DEV
	JRST	COMERR
	MOVEM	A,DEV
	CAIL	CH,33
	CAIN	CH,","
	POPJ	P,0
	JRST	FILSPL
BRAKET:	SKIPE	PPN		; ERROR IF WE ALREADY HAVE A PPN
	JRST	COMERR
	PUSHJ	P,FSTHRU	; SAVE ANY REMAINING SPECIFICATION
	PUSHJ	P,OCTIN		; GO GET THE PROJECT
	SKIPN	N1		;NULL?
	HLRZ	N,MYPPN		;YES--USE LOGGED IN PROJECT
	JUMPE	N,COMERR	; ERROR IF NULL
	TLNN	N,-1		; ERROR IF OVERFLOW OR IF NEXT CHAR. NOT A COMMA
	CAIE	CH,","
	JRST	COMERR
	HRLM	N,PPN		; SAVE THE PROJECT
	PUSHJ	P,OCTIN		; GO GET THE PROGRAMMER #
	SKIPN	N1		;NULL?
	HRRZ	N,MYPPN		;YES--USE LOGGED IN PROGRAMMER
	JUMPE	N,COMERR	;ERROR IF NULL
	TLNE	N,-1		; ERROR ON OVERFLOW
	JRST	COMERR
	HRRM	N,PPN		; SAVE PROGRAMMER #
	CAIN	CH,"]"		; TERMINATING RIGHT BRACKET?
	PUSHJ	P,TYI		; NO, GET ANOTHER CHARACTER
	CAIN	CH,","
	TLO	F,L.COMA
	TLO	F,L.ANY		; SET FLAG
	JRST	FILSP2		; AND PROCEED

OCTIN:	SETZB	A,N		; CLEAR AC'S
	MOVEI	N1,0		; ..
OCTINL:	PUSHJ	P,TYI		; GET TERMINAL CHARACTER
	CAIG	CH,"7"		; DIGIT?
	CAIGE	CH,"0"
	POPJ	P,		; NO RETURN
	LSH	N,3		; ROUND UP
	ADDI	N,-"0"(CH)	; AND ADD IN THIS ONE
	AOJA	N1,OCTINL	; LOOP BACK
;ERR AND WARNING PREFIX PRINTERS
;PRESERVE ALL ACS

ERR:	CLRBFI			;CLEAR TYPE AHEAD
	SKPINL			;SUPPRESS ^O
	  JFCL			; ..
	OUTSTR	[ASCIZ \?\]
	JRST	ERRWRN

WRN:	OUTCHR	[ASCIZ \%\]

ERRWRN:	PUSH	P,T		;SAVE TEMP
	GTMSG.	T		;GET VERBOSITY
	TXNN	T,JW.WPR	;SEE IF PREFIX
	JRST	ERRWRX		;NO--THAT'S ALL
	OUTSTR	[ASCIZ \SPC\]	;YES--ISSUE SPACE
	OUTSTR	@-1(P)		;ISSUE PREFIX
ERRWRX:	POP	P,T		;RESTORE TEMP
CPOPJ1:	AOS	(P)		;SKIP PREFIX
	POPJ	P,		;RETURN
	SUBTTL	STORAGE

PDP:	XWD	-LN$PDL,PDL-1
IOL:	XWD	-200,IOB-1

	XLIST		;LITERALS
	LIT
	LIST

	RELOC
PDL:	BLOCK	LN$PDL+1
IHED:	BLOCK	3
OHED:	BLOCK	3
STRUSD:	BLOCK	1
TOTUSD:	BLOCK	1
INOURE:	BLOCK	1		; SIXBIT IN OR OUT OR RECOMP
STRTAL:	BLOCK	1		; FREE ON STRUCTURE FROM DSKCHR
TOTFRE:	BLOCK	1		; TOTAL FREE ON ALL STRUCTURES
STRUCT:	BLOCK	1
USER:	BLOCK	1
IOB2:	BLOCK	26
IOB:	BLOCK	200
FACTBL==13
FACTH:	BLOCK	1		; FACT FUNCTION
FACTB:	BLOCK	FACTBL
CTLHED:	BLOCK	3
QSTR:	BLOCK	1
QFILN:	BLOCK	1
SJBFF:	BLOCK	1
FFAPPN:	BLOCK	1
MFDPPN:	BLOCK	1
SYSPPN:	BLOCK	1
MYPPN:	BLOCK	1		;LOGGED IN PPN
SYSHDR:	BLOCK	6	; ROOM FOR SYSTEM HEADER LINE

COMDAT:
DEV:	BLOCK	1
FILE:	BLOCK	1
EXT:	BLOCK	1
PPN:	BLOCK	1
IDEV:	BLOCK	1
IPPN:	BLOCK	1
ODEV:	BLOCK	1
OFILE:	BLOCK	1
OEXT:	BLOCK	1
OPPN:	BLOCK	1
BADPPN:	BLOCK	1	; LOGGED OUT USER HOLDING MOST SPACE (PPN)
BADUSR:	BLOCK	1	; BLOCKS
TMPPPN:	BLOCK	1	; TEMPORARY PPN AND BLOCKS
TMPSIZ:	BLOCK	1
WSTPPN:	BLOCK	1	; USER HOLDING MOST SPACE OVERALL (PPN)
WSTCAS:	BLOCK	1
COMDX==.-1

	END	SPCUSG