1
0
mirror of https://github.com/PDP-10/stacken.git synced 2026-01-31 05:42:03 +00:00
Files
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/usage/spcusg.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images.
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

1417 lines
33 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
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