Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
utilities/frep.fai
There are no other files named frep.fai in the archive.
IFNDEF BATCH,<BATCH==0> ;Non-0 for batch job
IFE BATCH,<TITLE FREP - Fail REPORT Generator>
IFN BATCH,<TITLE BFREP>
XALL
Comment &
Record changes here
2/83 - Joe Weening (JJW) - added code to handle generalized time periods
and disk accounting.
3/83 - JJW - Added code for nightly batch job.
Current deficiencies:
1. Structure name is not printed out along with directory. This means
disk charging for structures other than PS: won't work.
2. Only one word of structure name, in ASCII, is stored. Should be
changed to sixbit.
3. Disk charging could be more accurate, by using samples on the days just
before the beginning of the period and just after the end, when available.
end of comment &
a=1
b=2
c=3
d=4
w=5
x=6
y=7
z=10
q=11
r=12
s=13
t=14
p=17
Search Monsym
extern .jb41,.JBSYM,.JBUUO
pdlen==200
OPDEF CALL [PUSHJ P,]
OPDEF RET [POPJ P,]
ACADR==400000
EFADR==200000
DEFINE CHKSTG (AC,ADDR)
< CAIL AC,ADDR
JRST BLOAT
>
DEFINE EMSG (XYZZY) <
ERCAL [ERRMSG [ASCIZ\XYZZY\]
RET]
>
Subttl Charge rates and periods
Comment &
FREP computes charges based on a rate schedule which assigns to each of
several time periods a job time charge and a CPU time charge, and also
includes a charge for average disk usage over a period. The macros
below define the time periods. Note that it is not possible to make a
change in rate schedules in the middle of a period for which FREP is run;
in general the program is run for a period of one month and a rate change
is made to take effect on the 1st of a month.
The time periods are numbered 0, 1, 2, etc. Job and CPU times are kept
separately for periods 1, 2, etc. and the times for period 0 can be gotten
by subtracting these from the total times. Period 0 is generally "daytime".
The set of all others may be referred to as "night time", even though some
may occur during the day. A previous version of this program had only
total time and night time.
Currently at Score there are three periods 0, 1, and 2, also referred to
as "A time", "B time", and "C time".
&
RADIX =10 ;Watch out!
HIPERD==2 ;number of highest period
;The following macro generates code for all non-zero periods.
DEFINE ALLNZP <FOR @' I=1,HIPERD,1>
P.CPU==150 ;CPU rate in cents per minute
P.CON==100 ;Connect rate in cents per hour
P.DISK==30 ;Disk rate in 10ths of a cent per page-month
;Because the computation is actually done with CPU and connect times in
;seconds, and disk in milli-page-months, we will multiply each result by an
;appropriate fraction. This also takes into account the discount for non-
;zero periods.
DEFINE FRACTION ' (NAME,NUM,DENOM)<
N.'NAME==NUM
D.'NAME==DENOM
>
FRACTION(CPU0,1,60) ;Convert CPU seconds to minutes
FRACTION(CPU1,2,3*60) ;2/3 rate for period 1 CPU
FRACTION(CPU2,1,3*60) ;1/3 rate for period 2 CPU
FRACTION(CON0,1,3600) ;Convert connect seconds to hours
FRACTION(CON1,2,3*3600) ;2/3 rate for period 1 connect
FRACTION(CON2,1,3*3600) ;1/3 rate for period 2 connect
FRACTION(DISK,1,10*1000);Convert rate to cents and disk to page-months
Comment &
The time periods are defined below. For each day of the week, a word in the
array TIMTAB points to a block of words which have a period number in the left
half and a time in the right half. The meaning is that from the time in the
previous word (or from the beginning of the day, in the case of the first word
for a day) to the time specified, the rates are to be for the period specified.
Note: The program may loop forever or do other bad things if the last interval
for each day defined below doesn't end at 24:00.
&
DEFINE INTRVL (HOUR,MINUTE,PERIOD)<
PERIOD,,<<HOUR*60>+MINUTE>*60
>
;Below are current periods for weekdays and weekends
WKDAY: INTRVL 08,00,2 ;00:00 - 08:00 period 2
INTRVL 18,00,0 ;08:00 - 18:00 period 0
INTRVL 24,00,1 ;18:00 - 24:00 period 1
WKEND: INTRVL 13,00,2 ;00:00 - 13:00 period 2
INTRVL 18,00,1 ;13:00 - 18:00 period 1
INTRVL 24,00,2 ;18:00 - 24:00 period 2
;Monday comes first to agree with the ODCNV% convention.
TIMTAB: WKDAY ;Monday
WKDAY ;Tuesday
WKDAY ;Wednesday
WKDAY ;Thursday
WKDAY ;Friday
WKEND ;Saturday
WKEND ;Sunday
RADIX 8
Subttl UUO DEFINITIONS
UUOTAB:
DEFINE MGEN (UNAM,DISP,FLAGS)
<OPDEF UNAM [ZZ*<1000,,0>]
FLAGS,,DISP
>
ZZ==0
FOR ZOT IN (<ERRUUO,ILLUUO,0>
,<OUTSTR,UUOUTS,EFADR>
,<FILSTR,UFILST,EFADR>
,<ERRMSG,ERMUUO,0>)
<MGEN(ZOT)
ZZ==ZZ+1
>
UUOTLN==ZZ
subttl storage
PDLIST: Block pdlen
UUOH: 0
JRST UUOHAN ;handle user uuos
ACBAS: 0
NAMEHD: 0
RECFF: 0
BASE: 0
OJFN: 0 ;JFN FOR MAIN REPORT FILE
OJFN1: 0 ;jfn for summary file
OJFN2: 0 ;jfn for pigs file
MJFN: 0 ;JFN FOR MASTER FILE
DJFN: 0 ;JFN FOR ACCOUNTING DATA
BJFN: 0 ;input binary data
DOJFN: 0 ;output raw acct data.
CRLF: BYTE(7)15,12
CRLF2: BYTE(7)15,12,15,12
GTJFTB: BLOCK .GJBFP+1 ;BLOCK FOR LONG GTJFN
TEMP: 0 ;TEMP STG FOR LIST MUNCHING
PREV: 0 ;ditto
CHTMP: 0
NMTMP: 0
FUNAME: 0 ;byte pointer to user name read in
FDNAME: 0 ;byte pointer to directory name read in
FSPONS: 0 ;byte pointer to sponsor, or zero
MAJNAM: 0 ;byte pointer to major string
FCATLN==30 ;really!
FCAT: BLOCK FCATLN ;byte pointers to category names read in
FCATPC: BLOCK FCATLN ;fractional allocation of effort/categ.
SRTXCT: 0 ;In SORT, instr to XCT.
SRT.AX: A,,0 ;In SORT, indir wd to fetch next pointer
SRT.CX: C,,0 ;In SORT, indir wd to fetch next pointer
SRT.DX: D,,0 ;In SORT, indir wd to fetch next pointer
SFINPT: 0 ;TEMP CELL FOR SFIND
MBUFLN==60
MBUF1: BLOCK MBUFLN+1
HASHLN== =517
HASHTB: BLOCK HASHLN
CHSHTB: BLOCK HASHLN
BHSHTB: BLOCK HASHLN
LINBLN==40
LINBUF: BLOCK LINBLN+1
BLOCK 1 ;FOR DETACHED LINES
LINUSE: BLOCK 200 ;SAVE AREA FOR TTY NUMBERS
Comment *
;Storage generation macros.
;SSUF is for storage suffixes, SPRF for storage prefixes
;Note the extra 0 and level of pointed brackets are needed
;to force macro expansion when these are passed as arguments.
Prefix
OV Totals pertaining to overhead categories
US User (non-overhead) totals
GT Grand totals
PT Preliminary totals (same as grand, eventually)
CT Category totals
CB Big users in given category
GT. Arguments returned by GTCHRG (also temp during printing)
Suffix WARNING: SUFFIXES CPU thru last CO(i) must be first
AND IN THE SAME ORDER AS IN THE RUSER STRUCTURE
CPU Total CPU milliseconds
CON Total Console seconds
PAG Total Pages
MON Total Money
SES Session Count
DSK Disk integral: =1000 times page-days
CP1 CPU for period 1 (included in total CPU)
CP2 CPU for period 2 (included in total CPU)
...
CO1 Console for period 1 (included in total console)
CO2 Console for period 2 (included in total console)
...
TU Total Active Users
TTU Total users
*
;JJW 2/83 The following defines FORSUF as a FOR-expression that expands into
;all but the TU and TTU suffixes, and is used later several times. See the
;FAIL manual for why it works.
DEFINE FORSF1 <0,<FOR @' SUF IN (CPU,CON,PAG,MON,SES,DSK>>
DEFINE TACKON & (X,Y,Z) <DEFINE FORSF1 <0,<Y&Z>>>
DEFINE ADDON (X) <TACKON(\FORSF1,<X>)>
ALLNZP <
ADDON <,CP'I>
>
ALLNZP <
ADDON <,CO'I>
>
ADDON <)>
DEFINE SEC (X,Y) <Y>
DEFINE FORSUF <SEC(\FORSF1)>
;SSUF is defined to be <0,<CPU,...,SES,DSK,CP1,CP2,...,CO1,CO2,...,TU,TTU>>
DEFINE SSUF <0,<CPU,CON,PAG,MON,SES,DSK>>
DEFINE TACKON & (X,Y,Z) <DEFINE SSUF <0,<Y&Z>>>
DEFINE ADDON (X) <TACKON(\SSUF,<X>)>
ALLNZP <
ADDON <,CP'I>
>
ALLNZP <
ADDON <,CO'I>
>
ADDON <,TU,TTU>
DEFINE SPRF<0,<OV,US,GT,PT,CT,GT.,CB>> ;storage prefixes
DEFINE SGENR(ZOTFOO,XXX,ZOTBAR,YYY) <
FOR ZOT IN (XXX)
<FOR @& FUB IN (YYY)
<ZOT&FUB: 0
>>>
SGENR(\SPRF,\SSUF) ;generate storage locations
GT.DIR: 0 ;DIRECTORY NAME FROM GTCHRG
GT.SVB: 0
ovhd: 0
PIGNUM: 0
PIGPCT: 0
TIBFLN==40
TIBUF: BLOCK TIBFLN
FDATE: 0 ;first date of data accepted
LDATE: 0 ;last date of data accepted
PLDATE: 0 ;previous last date
HIDATE: 0 ;hibound of acceptable dates
LODATE: 0 ;lobound of acceptable dates
DELTA: 0 ;DIFFERENCE BETWEEN DATES IN MINUTES
BUFF: BLOCK 1000 ;buffer for binary file.
RDBDAD: 0
RDBRAD: 0
FBPREV: 0
NITHRS: 0
SESSTT: 0
SESEND: 0
TRIVIA: 0 ;trivial money below which we don't avg
TRX: 0
catcnt: 0 ;count of categories in readus
BWP: 0 ;In binary file, word pointer
NBWP: 0
BPGCNT: 0
BWC: 0 ;Binary file, word count.
BPG: 0 ;Binary file, first page of window
BHDR: 0
BTRL: 0
filcre: 0 ;"creation" date returned by GTFDB
IFN BATCH,<
lstmth: 0 ;year and month of last month
thsmth: 0 ;year and month of this month
thsday: 0 ;day of month and day of week of today
rfname: ASCIZ/PS:<ACCOUNTS>MONTH-TO-DATE.RAW;P777752/ ;raw data file name
sjfn: 0 ;file for end-of-month report
sfname: block 10 ;filename for SJFN
xfname: block 10 ;raw filename at end of month
>;IFN BATCH
patch: block 20
patch1: block 20
patch2: block 20
Subttl Structure definitions
;WARNING: R.RCPU must be first, and RCPU thru RNCP must be
; in the same sequence as in the SSUF definition
RUSER: RU.LEN ;User record LENGTH OF RECORD
Phase 0
R.RCPU:: 0 ;cpu time for this user
R.RCON:: 0 ;console time for this user
R.RPAG:: 0 ;pages printer
R.RMON:: 0 ;total charges for this U.
R.RSES:: 0 ;session count
R.RDSK:: 0 ;disk integral
ALLNZP <
R.RCP'I:: 0 ;night cpu time
>
ALLNZP <
R.RCO'I:: 0 ;night console time
>
R.DNAM:: 0 ;pointer to directory name
R.UNAM:: 0 ;Pointer to user's name
R.UOTH:: 0 ;other info about this user
R.DIRN:: 0 ;directory number
R.XPNT:: 0 ;pointer to rucx record(s) for U
R.DPNT:: 0 ;pointer to the next U in DNAM order
R.UPNT:: 0 ;pointer to the next U in UNAM order
R.PIGP:: 0 ;Pig pointer
R.HASH:: 0 ;LINK ON DPNT HASH CHAIN
RU.LEN==.
DEPHASE
ORG RUSER+1
RUCX: RX.LEN ;Called an RX record
PHASE 0
X.UPTR:: 0 ;User belonging to this category
X.CPTR:: 0 ;Category for this RX
X.NCFU:: 0 ;Next RX for this User
X.NCFC:: 0 ;Next RX for this Category
X.PERC:: 0 ;Percentage use for this C by this U
RX.LEN==.
DEPHASE
ORG RUCX+1
RCAT: RC.LEN ;Category Record
PHASE 0
C.RTYP:: 0 ;category name
C.RNPN:: 0 ;pointer to next category
C.XHED:: 0 ;head of list of RX records
C.XTAI:: 0 ;tail of list of RX records
C.HASH:: 0 ;LINK ON CATEGORY HASH CHAIN
C.MAJR:: 0 ;Byte pointer to Department Code
RC.LEN==.
DEPHASE
ORG RCAT+1
RSCH: RS.LEN ;School Record
PHASE 0
S.RTYP:: 0 ;School Name
S.RNPN:: 0 ;Pointer to next School
S.XHED:: 0 ;Pointer to classes within School
RS.LEN==.
DEPHASE
ORG RSCH+1
BINR: RB.LEN ;Accounting Binary Data
PHASE 0
B.STRU:: 0 ;structure name (ASCII)
B.DNAM:: 0 ;pointer to directory name
B.BCPU:: 0 ;total CPU time for user
B.BCON:: 0 ;total console time for user
B.BPAG:: 0 ;total pages printed for U
B.DSKT:: 0 ;time of last disk sample
B.DSKN:: 0 ;value of last disk sample
B.BDSK:: 0 ;disk integral
ALLNZP <
B.CPU'I:: 0 ;total night cpu (prorated)
>
ALLNZP <
B.CON'I:: 0 ;total night console time
>
B.BJOB:: 0 ;job number of previous login
B.LOGI:: 0 ;last login date and time
B.SCPU:: 0 ;spooler cpu time on behalf of U.
B.BSNM:: 0 ;session count
B.BPNM:: 0 ;print req. count
B.RRED:: 0 ;redundant record count
B.REJR:: 0 ;rejected record count
B.BADJ:: 0 ;JOB NUMBER OF KNOWN REDUNDANT JOB
B.BADL:: 0 ;LOGIN DATE OF KNOWN " "
B.HASH:: 0 ;the hash chain pointer
RB.LEN==.
DEPHASE
ORG BINR+1
Subttl Handle user uuos
uuohan: push p,acbas
push p,uuoh ;save caller's address. be recursive
PUSH P,0 ;save one ac
hrrzm p,acbas ;ac offset address
movei 0,1(p)
HRLI 0,1 ;1,,1(P)
BLT 0,16(p) ;save ac's on stack
move 0,0(p) ;just in case you wanted 0 preserved
add p,[16,,16]
call douuo
jrst .+2
aos -17(p) ;set skip to caller
SUB P,[17,,17]
movsi 16,1(p)
BLT 16,16
pop p,uuoh
pop p,acbas
jrst @uuoh
douuo: LDB A,[point 9,.JBUUO,8]
LDB B,[point 4,.JBUUO,12]
HRRZ C,.JBUUO
CAIL A,UUOTLN ;uuo number in range?
movei a,0 ;no. 0 is a loser too.
move D,UUOTAB(A) ;GET THE DISPATCH ADDRESS
TLNE D,ACADR ;DOES AC CONTAIN DATA FOR THIS UUO?
ADD B,ACBAS ;Yes, relocate to saved acs.
CAIGE C,20
TLNN D,EFADR ;Does effective address contain address?
JRST .+2 ;not address or not in an ac
ADD C,ACBAS ;RElocate address.
JRST (D) ;RETURN VIA POPJ or CPOPJ1
ILLUUO: HRROI A,[ASCIZ/Illegal User UUO detected
/]
ESOUT
HALTF
RET
UUOUTS: HRRO A,C
PSOUT
RET
ERMUUO: HRROI A,[0]
ESOUT
JUMPE C,ERMUU1 ;EFF ADDR = 0 MEANS NO MSG
CAIGE C,20
ADD C,ACBAS ;DON'T EXPECT MESSAGE HERE.
HRRO A,C
PSOUT
ERMUU1: HRROI A,CRLF
PSOUT
MOVEI A,.PRIOU
HRLOI B,.FHSLF ;SELF,,MOST RECENT ERROR
MOVEI C,0
ERSTR
erjmp .+1
ERJMP .+1
HRROI A,CRLF
PSOUT
LDB A,[POINT 4,.JBUUO,12] ;ac field non zero for continue
JUMPN A,CPOPJ
HRROI A,[ASCIZ/Type CONTINUE to try again
/]
PSOUT
HALTF
RET
;FILSTR UUO. AC field decodes as:
; 1=main report
; 2=summary report
; 4=accounting output file
; 10=pigs report
UFILST: MOVE A,OJFN
TRNE B,1 ;PRINT ON MAIN FILE?
CALL UFILSX ;YES
MOVE A,OJFN1
TRNE B,2 ;PRINT ON SUMMARY FILE?
CALL UFILSX ;YES
MOVE A,DOJFN
TRNE B,4
CALL UFILSX ;PRINT ON ACCOUNTING OUTPUT FILE
MOVE A,OJFN2
TRNE B,10
CALL UFILSX ;print on pigs list
RET
UFILSX: PUSH P,B
PUSH P,C
HRRO B,C
MOVEI C,0
SOUT
ERJMP .+1
POP P,C
POP P,B
RET
Subttl MAIN PROGRAM
START: RESET
MOVE P,[-pdlen,,pdlist-1]
MOVE A,[JSR UUOH]
MOVEM A,.JB41 ;store uuo trap instr.
OUTSTR [ASCIZ/
Accounting Report Generation
/]
HRRZ A,.JBSYM ;GET BEGINNING OF SYMBOLS
SKIPE .JBSYM
CAIL A,PRGFF+1000 ;ARE SYMS CLOSE TO PROGRAM?
CALL MOVSYM ;No, move them where they won't be hurt
HRRZ A,.JBSYM
HLRO B,.JBSYM
SUB A,B
ADDI A,200
CAIGE A,PRGFF+1000
MOVEI A,PRGFF+1000
MOVEM A,RECFF ;FIRST FREE LOCATION FOR RECORDS
CALL ICLEAR ;INITIALIZE FOR IO
IFE BATCH,<
MAIN0: MOVEI A,[ASCIZ/Compress Binary files now? (Y or N): /]
CALL YESNO
JRST MAIN1
PUSH P,RECFF ;save origin of free space
CALL RDBIN ;process binary stuff
POP P,RECFF ;throw away all stg used by RDBIN
CALL TTYUSE
MAIN1: MOVEI A,[ASCIZ/Process accounting info? (Y or N): /]
CALL YESNO
JRST MAIN2
MOVEI A,RCAT ;RECORD TYPE
CALL NEWREC
MOVEM B,NAMEHD ;HEAD OF THE CATEGORY LIST
MOVEI A,RUSER
CALL NEWREC
MOVEM B,BASE ;HEAD OF ALL USER RECORDS LISTS
CALL OPNREP ;OPEN OUTPUT FILES
CALL OPMSTR ;OPEN DBEDIT MASTER FILE
CALL OPDATA ;OPEN ACCOUNTING DATA FILE
CALL BLDSCH ;build schools list
CALL BLDULS ;BUILD USER LIST
; call prnuls ;for debugging. print users and cat
CALL RDDATA ;READ DATA AND AUGMENT USER LIST
CALL DSORT ;SORT AUGMENTED USER LIST
; call prnuls ;print user list again (debugging)
CALL PRNREP ;PRINT REPORT
CALL PRNPIG
CALL PRNUNK
CALL FINISH
>;IFE BATCH
IFN BATCH,<
call mthchk ;write summary file if not there
movni a,1 ;release all files
rljfn%
jfcl ;ignore errors
call todate ;process binary files for month-to-date
>;IFN BATCH
MAIN2: OUTSTR [ASCIZ/
Done.
/]
HALTF
JRST START
USEUNK: POINT 7,[ASCIZ/PURPOSE-NOW-OBSOLETE/]
SUBTTL Batch job procedures
IFN BATCH,< ;Whole page
;Here to build name of last month's summary file in SFNAME and see if it exists.
MTHCHK: SETO B, ;For current time
SETZ D,
ODCNV%
MOVEM B,THSMTH ;Save this month
MOVEM C,THSDAY ;Save today
TRNE B,-1 ;Is it January?
SOSA B ;No. Just decrement month
ADD B,[-1,,11] ;Yes. Convert to December of last year
MOVEM B,LSTMTH ;Save last month
MOVE B,[POINT 7,SFNAME]
MOVE A,[POINT 7,[ASCIZ/PS:<ACCOUNTS>SCORE-/]]
CALL COPYST
HRRZ Q,LSTMTH ;Month number
ADDI Q,1
MOVEI S,0
CALL PRNUM
MOVEI A,"-"
IDPB A,B
HLRZ Q,LSTMTH ;Year number
IDIVI Q,=100
MOVE Q,R
MOVEI S,0
CALL PRNUM
MOVE A,[POINT 7,[ASCIZ/.DAT;P777752/]]
CALL COPYST
MOVEI A,0
IDPB A,B ;End with a null
MOVSI A,(GJ%SHT!GJ%OLD)
HRROI B,SFNAME
GTJFN%
CAIA ;Failed to find it
RET ;Already exists. Don't make another one
HRRZ A,A
RLJFN% ;Release the JFN
JFCL
;Here when no summary file for last month exists yet. First we make a
;new name for the raw data file, which will preserve it for posterity.
SUMARY: MOVE B,[POINT 7,XFNAME]
MOVE A,[POINT 7,[ASCIZ/PS:<ACCOUNTS>RAW-/]]
CALL COPYST
HRRZ Q,LSTMTH ;Month number
ADDI Q,1
MOVEI S,0
CALL PRNUM
MOVEI A,"-"
IDPB A,B
HLRZ Q,LSTMTH ;Year number
IDIVI Q,=100
MOVE Q,R
MOVEI S,0
CALL PRNUM
MOVE A,[POINT 7,[ASCIZ/.DAT;P777752/]]
CALL COPYST
MOVEI A,0
IDPB A,B ;End with a null
MOVEI A,XFNAME
MOVEM A,OPNAM+3 ;Change the pointer to be used by OPENDO
MOVE B,LSTMTH ;Set up begining date
SETZB C,D
IDCNV%
ERJMP [ERRMSG
HALTF]
MOVEM B,LODATE
MOVE B,THSMTH ;Set up ending date
SETZB C,D
IDCNV%
ERJMP [ERRMSG
HALTF]
MOVEM B,HIDATE
PUSH P,RECFF
PUSHJ P,RDBIN ;Read binary data and write raw data file
POP P,RECFF
MOVSI A,(GJ%SHT!GJ%OLD)
HRROI B,XFNAME ;Now open raw file for reading
GTJFN%
ERJMP [ERRMSG [ASCIZ/Can't GTJFN raw data file/]
RET]
MOVEM A,DJFN
MOVE B,[070000,,OF%RD]
OPENF%
ERJMP [ERRMSG [ASCIZ/Can't OPENF raw data file/]
RET]
MOVSI A,(GJ%SHT!GJ%FOU!GJ%NEW)
HRROI B,SFNAME ;And open summary file for writing
GTJFN%
ERJMP [ERRMSG [ASCIZ/Can't GTJFN summary file/]
RET]
MOVEM A,SJFN
MOVE B,[070000,,OF%WR]
OPENF%
ERJMP [ERRMSG [ASCIZ/Can't OPENF summary file/]
RET]
HRROI B,[ASCIZ/ Score accounting data written on /]
SETZ C,
SOUT% ;Write header page
SETO B,
ODTIM%
HRROI B,[ASCIZ/
by /]
SOUT%
GJINF% ;What's my name?
MOVE B,A
MOVE A,SJFN
DIRST%
JFCL
HRROI B,[ASCIZ/ using BFREP.
Required Field names
SCOREID SCORE user id.
SCORECOST Total charge
%end of required fields;
Optional Field names
end of optional fields;
/]
SETZ C,
SOUT%
MOVEI B,14 ;Form-feed to end page
BOUT%
SUMAR1: CALL GTCHRG ;Read an accounting record
JRST SUMAR2 ;Done
MOVE A,SJFN
MOVE B,GT.DIR
SETZ C,
SOUT% ;Print user name
HRROI B,CRLF
SOUT%
MOVE B,GT.MON
MOVEI C,=10
NOUT% ;Print the charge
ERJMP [ERRMSG
HALTF]
HRROI B,CRLF2
SETZ C,
SOUT%
JRST SUMAR1
SUMAR2: HRRZ A,SJFN
CLOSF%
EMSG <Can't CLOSF summary file>
HRRZ A,DJFN
CLOSF%
EMSG <Can't CLOSF raw data file>
RET
TODATE: HLLZ C,THSDAY ;Is it the first of the month?
JUMPE C,CPOPJ ;If so, we're done already. Month-to-date
;file contains info for all of last month.
MOVEI A,RFNAME ;Set raw file name
MOVEM A,OPNAM+3
MOVE B,THSMTH
SETZ D,
IDCNV% ;Get midnight this morning
ERJMP [ERRMSG
HALTF]
MOVEM B,HIDATE ;Store it
MOVE B,THSMTH ;Get start of this month
SETZB C,D
IDCNV%
ERJMP [ERRMSG
HALTF]
MOVEM B,LODATE ;Store it
PUSH P,RECFF
CALL RDBIN ;Process binary files for month-to-date
POP P,RECFF
RET
>;IFN BATCH
SUBTTL RDDATA - READ ACCOUNTING DATA FILE
IFE BATCH,<
RDDATA: SETZM PTCPU ;GRAND TOTAL OF CPU TIME
SETZM PTCON ;" CONSOLE
SETZM PTPAG ;" PAGES
SETZM PTMON ;" CHARGES
SETZM PTSES ; sessions
SETZM PTDSK ; disk usage
ALLNZP <
SETZM PTCP'I ; night cpu
SETZM PTCO'I ; night console
>
RDDAT1: CALL GTCHRG ;READ AN ACCOUNTING RECORD
RET ;EOF - DONE
MOVE A,GT.DIR ;DIRECTORY NAME OF USER
CALL FNDUSR ;FIND OR BUILD RECORD FOR THIS USER
MOVE A,GT.CPU
ADDM A,PTCPU
ADDM A,R.RCPU(B)
MOVE A,GT.CON
ADDM A,PTCON
ADDM A,R.RCON(B)
MOVE A,GT.PAG
ADDM A,PTPAG
ADDM A,R.RPAG(B)
MOVE A,GT.MON
ADDM A,PTMON
ADDM A,R.RMON(B)
MOVE A,GT.SES
ADDM A,PTSES
ADDM A,R.RSES(B)
MOVE A,GT.DSK
ADDM A,PTDSK
ADDM A,R.RDSK(B)
ALLNZP <
MOVE A,GT.CP'I
ADDM A,PTCP'I
ADDM A,R.RCP'I(B)
MOVE A,GT.CO'I
ADDM A,PTCO'I
ADDM A,R.RCO'I(B)
>
JRST RDDAT1
FNDUSR: PUSH P,A ;BYTE PTR TO NAME OF USER
CALL HSHCMP ;COMPUTE HASH CODE FOR THIS NAME
MOVE C,HASHTB(B) ;FOLLOW HASH CHAIN
FNDUS1: JUMPE C,FNDUS3 ;NOT ON HASH CHAIN. NOT THERE.
MOVE A,(P) ;BYTE POINTER TO NAME WE SEEK
MOVE B,R.DNAM(C) ;GET POINTER TO DIRECTORY NAME (C)
PUSH P,C
CALL STRCMP ;COMPARE STRINGS
JRST FNDUS2 ;DIFFERENT.
POP P,B ;BLOCKS ARE EQUAL. RETURN THIS ONE
SUB P,[1,,1]
RET
FNDUS2: POP P,C ;RESTORE OLD USER BLOCK
MOVE C,R.HASH(C) ;ADVANCE TO NEXT USER ON HASH CHAIN
JRST FNDUS1
FNDUS3: POP P,FDNAME ;STORE DIRECTORY NAME FOR INSRTU
MOVE A,[POINT 7,[ASCIZ/UNKNOWN/]]
MOVEM A,FCAT ;CATEGORY NAME FOR INSRTU
SETZM FCAT+1 ;no second category
MOVSI A,1
MOVEM A,FCATPC
SETZM FUNAME ;AND NO NAME FOR INSRTU
CALL INSRTU
MOVE B,C ;RETURN ADDRESS OF THIS BLOCK IN B
RET
>;IFE BATCH
GTCHRG: MOVE A,DJFN ;JFN OF ACCOUNTING DATA FILE
HRROI B,MBUF1 ;ADDRESS TO STORE STUFF
MOVEI C,MBUFLN*5-3 ;SIZE OF BUFFER IN CHARACTERS
MOVEI D,12 ;BREAK CHARACTER IS LF.
SIN
ERJMP GTCHE1 ;SOME ERROR
JUMPE C,GTCHE2 ;JUMP IF 0 COUNT. LINE IS TOO LONG.
MOVEI A,0
IDPB A,B ;make sure input ends with null
MOVE Z,[POINT 7,MBUF1] ;SCANNER POINTER
CALL BSKIP ;IGNORE CR AND FF
MOVEM Z,GT.DIR ;POINTER TO START OF USER NAME
MOVE Y,Z
CALL RAISE
MOVE A,GT.DIR
ILDB A,A
CAIN A,"!" ;IS THIS A NEW STYLE COMMENT
JRST GTCMNT ;yes. examine the comment
MOVE Y,[POINT 7,[BYTE(7)11]]
CALL SFIND ;FIND CHARACTER IN STRING
IBP Z ;advance to the tab
MOVEM Z,GT.SVB ;save this pointer
CALL GTNUM ;READ A NUMBER
IDIVI B,1750 ;DIVIDE MILLISECONDS
MOVEM B,GT.CPU
CALL GTNUM
MOVEM B,GT.CON
CALL GTNUM
MOVEM B,GT.PAG
CALL GTNUM
MOVEM B,GT.SES ;session count
CALL GTNUM
MOVEM B,GT.DSK
ALLNZP <
CALL GTNUM
IDIVI B,1750
MOVEM B,GT.CP'I ;night cpu
>
ALLNZP <
CALL GTNUM
MOVEM B,GT.CO'I ;night console
>
MOVEI Y,0
DPB Y,GT.SVB ;END USER NAME WITH NULL
;Compute charges
MOVE A,GT.CPU ;Period 0 CPU
ALLNZP <
SUB A,GT.CP'I
>
IMULI A,P.CPU
MULI A,N.CPU0
DIVI A,D.CPU0
CAIL B,D.CPU0/2 ;Round up if remainder large enough
ADDI A,1
MOVEM A,GT.MON ;Start accumulating charge in cents
MOVE A,GT.CON ;Period 0 Connect
ALLNZP <
SUB A,GT.CO'I
>
IMULI A,P.CON
MULI A,N.CON0
DIVI A,D.CON0
CAIL B,D.CON0/2
ADDI A,1
ADDM A,GT.MON
ALLNZP <
MOVE A,GT.CP'I ;Period I CPU
IMULI A,P.CPU
MULI A,N.CPU'I
DIVI A,D.CPU'I
CAIL B,D.CPU'I/2
ADDI A,1
ADDM A,GT.MON
MOVE A,GT.CO'I ;Period I connect
IMULI A,P.CON
MULI A,N.CON'I
DIVI A,D.CON'I
CAIL B,D.CON'I/2
ADDI A,1
ADDM A,GT.MON
>
MOVE A,GT.DSK ;Average disk for month
IMULI A,P.DISK
MULI A,N.DISK
DIVI A,D.DISK
CAIL B,D.DISK/2
ADDI A,1
ADDM A,GT.MON
JRST CPOPJ1
GTCMNT: IBP GT.DIR ;advance past the !
MOVE B,GT.DIR
MOVE A,[POINT 7,[ASCIZ/DATES/]]
CALL STRCMP ;compare strings
JUMPN W,GTCHRG ;no match
FILSTR 13,MBUF1
JRST GTCHRG
GTCHe1: gtsts ;get status of device
tlne b,(GS%EOF) ;end of file?
JRST GTCHEF ;YES. TEST FOR DANGLING STRING
ERRMSG [ASCIZ/Error while reading accounting data file/]
HALTF
JRST .-1
GTCHEF: CAIL C,MBUFLN*5-3 ;ANYTHING READ THIS TIME?
RET ;NOPE. RETURN QUIETLY
MOVEI C,0
IDPB C,B
OUTSTR MBUF1
OUTSTR [ASCIZ/
Dangling characters after last line
/]
HALTF
jrst .-1
GTCHe2: IDPB C,B
OUTSTR MBUF1
OUTSTR [ASCIZ/
Accounting Data file line is too long
/]
HALTF
JRST .-1
GTNUM: ILDB A,Z ;GET A BYTE
CAIL A,"0"
CAILE A,"9"
JRST .+2 ;not a num
JRST GTNUM1 ;go accumulate number
CAIE A,12
CAIN A,14
JRST .+2 ;end of line and no number
JRST GTNUM ;SKIP LEADING WHATEVER
OUTSTR [ASCIZ/
GTNUM at end of line in Accounting Data.
/]
OUTSTR MBUF1 ;output the line
OUTSTR [ASCIZ/
CONTINUE to skip this record.
/]
haltf
JRST GTCHRG
GTNUM1: MOVEI B,-"0"(A)
GTNUM2: ILDB A,Z
CAIL A,"0"
CAILE A,"9"
RET
IMULI B,=10
ADDI B,-"0"(A)
JRST GTNUM2
SUBTTL READUR - READ USER RECORD FROM MASTER FILE
IFE BATCH,<
READUR: CALL REDMLN ;read line from master file
RET ;eof
MOVE Z,[POINT 7,MBUF1] ;SCANNER POINTER
CALL BSKIP ;IGNORE CR AND FF
MOVEM Z,FUNAME ;POINTER TO START OF USER NAME
MOVE Y,[POINT 7,[ASCIZ/,/]]
CALL SFIND ;skip to end of last name
MOVE Y,[POINT 7,[ASCIZ/(/]]
CALL SFIND ;FIND CHARACTER IN STRING
MOVEI Y,0
IDPB Y,Z ;CLOBBER ( TO NULL
SETZM CATCNT ;category count for this user
readuc: CALL BSKIP
CAIN A,")" ;at the end yet?
JRST REDU00 ;yes.
aos a,catcnt
MOVEM Z,FCAT-1(A) ;POINTER TO CATEGORY
setzm fcatpc-1(a) ;no percentage allocation yet
MOVE Y,[POINT 7,[ASCIZ/ [).,/]] ;break characters
CALL SFIND ;find a break
MOVEI Y,0
IDPB Y,Z ;smash the break character
CAIE A," " ;did we stop at blank?
JRST READU4
MOVE Y,[POINT 7,[ASCIZ/[).,/]] ;advance to next thing
CALL SFIND
IBP Z ;advance past break
READU4: CAIN A,")"
JRST READU0 ;end at parens
CAIE A,"[" ;number follows?
JRST READUD ;nope. get another category
movei b,0 ;get a number
runum: ildb a,z
cail a,"0"
caile a,"9"
jrst runum1
imuli b,=10
addi b,-"0"(a)
jrst runum
runum1: move a,catcnt
hrlz b,b
idivi b,=100
movem b,fcatpc-1(a)
READUD: MOVE A,CATCNT ;get the category count
MOVE A,FCAT-1(A) ;get the byte pointer
ILDB A,A ;check for null category name
JUMPN A,READUC ;jump if ok
SOS CATCNT ;backup to reject this category
JRST READUC
redu00: ibp z ;throw out the parens
READU0: IBP Z ;THROW OUT ONE SPACE
ILDB A,Z ;GET THE SPECIAL CODE
MOVSI B,-CSPECN
HLRZ C,CSPECT(B)
CAIE C,(A)
AOBJN B,.-2
JUMPGE B,READU2
HRRZ C,CSPECT(B)
CALL (C) ;PROCESS FOR SPECIAL CHARACTER
READU2:
CALL GTMAJR ;Get the major code in []
IBP Z ;throw out one space following "]"
MOVEM Z,FDNAME ;SAVE POINTER TO DIRECTORY NAME
MOVE Y,[POINT 7,[BYTE(7)15,40,"("]]
CALL SFIND
MOVEI Y,0
IDPB Y,Z ;END DIRECTORY NAME WITH NULL
CAIN A,15 ;broke at cr?
MOVEI Z,0
MOVEM Z,FSPONS ;save sponsor field.
JUMPN Z,REDU2A ;jump if no sponsor
MOVE Y,[POINT 7,[BYTE(7)15]]
CALL SFIND
MOVEI Y,0
IDPB Y,Z ;end sponsor field with null
REDU2A: MOVE Y,FDNAME
CALL RAISE
SKIPG A,CATCNT
JRST READU3 ;no categories given
SETZM FCAT(A) ;zero to end category list
move y,fcat
ILDB A,Y ;SEE IF THE CATEGORY IS NULL
JUMPE A,READU3 ;YUP. SET IT TO "UNKNOWN"
zdis2: SETZB B,CATCNT
MOVEI C,0 ;counts zero entries
crlp: aos a,catcnt
SKIPN Y,FCAT-1(A)
JRST CRLPX
SKIPN FCATPC-1(A) ;any amount recorded here?
AOJA C,.+2 ;nope. count a free slot
ADD B,FCATPC-1(A)
CALL RAISE
JRST CRLP
;Here, CATCNT is one too big. C=number of categories w/zero allocation
;and B=sum of non-zero allocations.
CRLPX: MOVSI A,1
SUB A,B ;a:=unallocated effort
JUMPL A,ZDIS ;someone's pulling a fast one
JUMPE A,CPOPJ1 ;nothing left to distribute
JUMPE C,ADIS ;everyone has some, but not enough.
IDIV A,C ;Distribute among zero entries
sos b,catcnt
skipn fcatpc-1(b)
movem a,fcatpc-1(b)
SOJG b,.-2
JRST CPOPJ1
ZDIS: MOVEI A,0 ;allocs wrong. zero all, and redistrib
ZDIS1: SKIPN FCAT(A)
JRST zdis2
setzm fcatpc(A)
AOJA A,zdis1
ADIS: SOS CATCNT
IDIV A,CATCNT ;this is how much to add
sos b,CATCNT
ADDM A,FCATPC(B)
SOJGE B,.-1
JRST CPOPJ1
READU3: MOVE Y,USEUNK
MOVEM Y,FCAT
MOVSI Y,1
MOVEM Y,FCATPC
SETZM FCAT+1
JRST CPOPJ1
;read line from the MASTER file
REDMLN: MOVE A,MJFN ;JFN OF MASTER FILE
HRROI B,MBUF1 ;ADDRESS TO STORE STUFF
MOVEI C,MBUFLN*5-3 ;SIZE OF BUFFER IN CHARACTERS
MOVEI D,12 ;BREAK CHARACTER IS LF.
SIN
ERJMP redue1 ;some error
JUMPN C,REDMOK ;return unless count remaining is zero
IDPB C,B
OUTSTR MBUF1
OUTSTR [ASCIZ/
Master file line is too long
/]
HALTF
JRST .-1
REDMOK: MOVEI C,0
IDPB C,B
JRST CPOPJ1
redue1: gtsts ;get status of device
tlne b,(GS%EOF) ;end of file?
JRST REDUEF ;YES. TEST FOR DANGLING STRING
ERRMSG [ASCIZ/Error while reading master file/]
HALTF
JRST .-1
REDUEF: CAIL C,MBUFLN*5-3 ;ANYTHING READ THIS TIME?
RET ;NOPE. RETURN QUIETLY
MOVEI C,0
IDPB C,B
OUTSTR MBUF1
OUTSTR [ASCIZ/
Dangling characters after last line
/]
HALTF
jrst .-1
>;IFE BATCH
BSKIP: ILDB A,Z ;GET A BYTE OF INPUT
CAIE A,40
CAIN A,15
JRST BSKIP
CAIE A,14
CAIN A,11
JRST BSKIP
SFINDB: ADD Z,[070000,,0] ;BACKUP THE BYTE POINTER
RET
SFIND: MOVEM Y,SFINPT ;SAVE THE BYTE POINTER TO BREAK CHARS
SFIND1: ILDB A,Z ;GET A BYTE
CAIN A,12
JRST SFINDB ;ALWAYS BREAK ON LF
MOVE Y,SFINPT
SFIND2: ILDB B,Y ;LOOK AT A BREAK BYTE
CAIN B,(A) ;INPUT MATCHES A BREAK?
JRST SFINDB ;YES. BREAK HERE
JUMPN B,SFIND2 ;JUMP UNLESS WE'RE OUT OF BREAKS
JRST SFIND1 ;NOT A BREAK. TRY NEXT ONE
IFE BATCH,<
CSPECT: " ",,CPOPJ
"F",,CSET.F
"G",,CSET.G
"S",,CSET.S
"U",,CSET.U
"L",,CSET.L
CSPECN==.-CSPECT
CSET.F: SKIPA Y,[POINT 7,[ASCIZ/FACULTY/]]
CSET.G: MOVE Y,[POINT 7,[ASCIZ/GUEST/]]
setyc: MOVEM Y,FCAT
movei y,1
movem y,catcnt
movsm y,fcatpc
RET
CSET.S: SKIPA Y,[POINT 7,[ASCIZ/STAFF/]]
CSET.U: MOVE Y,[POINT 7,[ASCIZ/OVERHEAD/]]
jrst setyc
CSET.L: MOVE Y,[POINT 7,[ASCIZ/LOTS-STAFF/]]
jrst setyc
>;IFE BATCH
RAISE: ILDB A,Y
JUMPE A,CPOPJ
CAIL A,"A"+40
CAILE A,"Z"+40
JRST RAISE
SUBI A,40
DPB A,Y
JRST RAISE
IFE BATCH,<
GTMAJR: ILDB A,Z ;get the major code
CAIE A,"["
JRST GTMAJE ;error in record
MOVEM Z,MAJNAM ;save pointer to major name
GTMAJ1: ILDB A,Z
CAIN A,"]" ;end yet?
JRST GTMAJ2
JUMPN A,GTMAJ1 ;loop until done
GTMAJE: OUTSTR [ASCIZ/
Error parsing major field
/]
HALTF
GTMAJ2: MOVEI A,0
DPB A,Z ;end majorwith null
RET
>;IFE BATCH
Subttl BLDSCH Build a list of schools, courses by school
IFE BATCH,<
DEFINE SCHOOL <
XXX (A,<Graduate School of Business>)
XXX (B,<School of Earth Sciences>)
XXX (C,<School of Education>)
XXX (D,<School of Engineering>)
XXX (E,<School of Humanities and Sciences>)
XXX (G,<School of Law>)
XXX (H,<School of Medicine>)
XXX (J,<Unaffiliated Programs>)
XXX (K,<Unaffiliated Programs>)
XXX (U,<Undeclared>)
XXX (@,<Overhead>)
XXX (Z,<Not Accounted by School>)
>
BLDSCH: CALL REDMLN ;Build list of courses by school
RET ;this is really an error
MOVE A,MBUF1
CAMN A,[ASCII/-----/]
RET
;format is CLASS-NAME<tab>DEPT-CODE<tab>DEPT-NAME<eol>
;Aa213 D10 Aeronautics-And-Astronautics
;this obviously needs help here.
JRST BLDSCH
>;IFE BATCH
SUBTTL PRINT REPORT
IFE BATCH,<
DEFINE PUTSTR (AAA) <
MOVE A,[POINT 7,[ASCIZ"AAA"]]
CALL COPYST
>
DEFINE EXPSUF(ZZZ,XXX,YYY)
<FOR @' ZZZ IN (YYY)>
LINSET: MOVE A,[ASCII/ /] ;5 SPACES
MOVEM A,LINBUF ;INTO THE LINE BUFFER
MOVE A,[LINBUF,,LINBUF+1]
BLT A,LINBUF+LINBLN-2
SETZM LINBUF+LINBLN-1
RET
;Here to print header.
;HDRMSG: ASCIZ / CPU Time Console Time LPT .... Sessions/
HDRMSG: ASCIZ / Charge Sessions LPT Disk Total CPU Total Console/
PRNHDR: MOVE A,[POINT 7,HDRMSG]
MOVE B,[POINT 7,LINBUF+6,6]
CALL COPYST ;COPY IT.
ALLNZP <
MOVE A,[POINT 7,[ASCIZ/ /]]
CALL COPYST
MOVEI A,"A"+I
IDPB A,B
MOVE A,[POINT 7,[ASCIZ/ CPU/]]
CALL COPYST
>
ALLNZP <
MOVE A,[POINT 7,[ASCIZ/ /]]
CALL COPYST
MOVEI A,"A"+I
IDPB A,B
MOVE A,[POINT 7,[ASCIZ/ Console/]]
CALL COPYST
>
MOVE A,[POINT 7,CRLF]
CALL COPYST
RET
PRUDT1: MOVE A,R.DNAM(Y) ;PRINT directory name
MOVE B,[POINT 7,LINBUF+1,27] ;start user in column 5
JRST COPYST ;copy string and return
PRUDAT: CALL PRUDT1 ;PRINT USER NAME
PRUDT2: MOVEI A,40
MOVE B,[POINT 7,LINBUF+6] ;Start data in col 31
IDPB A,B
MOVE Q,R.RMON(Y)
MOVEI S,10
CALL PRNUM ;show charge in cents
MOVE Q,R.RSES(Y)
MOVEI S,10
CALL PRNUM
MOVE Q,R.RPAG(Y)
MOVEI S,10
CALL PRNUM
MOVE Q,R.RDSK(Y)
IDIVI Q,=1000 ;disk usage in tracks
CAIL R,=500
ADDI Q,1 ;rounded
MOVEI S,10
CALL PRNUM
MOVE Q,R.RCPU(Y)
CALL PRHMS
MOVE Q,R.RCON(Y)
CALL PRHMS
ALLNZP <
MOVE Q,R.RCP'I(Y)
CALL PRHMS
>
ALLNZP <
MOVE Q,R.RCO'I(Y)
CALL PRHMS
>
RET
PRNREP: ;print report. zero storage
FOR PRF IN (OV,US,GT)
<EXPSUF(SUF,\SSUF)
<SETZM PRF'SUF
>>
MOVE Z,NAMEHD
MOVEM Z,NMTMP
PRNRP1: MOVE Z,NMTMP ;ADVANCE TO NEXT CATEGORY
SKIPN Z,C.RNPN(Z)
JRST PRNRP5 ;GRAND TOTALS TO PRINT
MOVEM Z,NMTMP ;TEMP CELL FOR CURRENT CATE.
;clear storage for category stuff
EXPSUF (SUF,\SSUF)
<SETZM CT'SUF
SETZM CB'SUF
>
MOVE A,C.RTYP(Z) ;CATEGORY NAME
CALL CHKOVH ;CHECK FOR OVERHEAD CATEGORY
CALL LINSET ;SETUP LINE BUFFER
MOVE A,C.RTYP(Z) ;NAME OF THIS CATEGORY
MOVE B,[POINT 7,LINBUF]
CALL COPYST ;COPY CATEGORY NAME
CALL PRNHDR
MOVEI A,0
IDPB A,B ;END WITH NULL
; FILSTR 3,LINBUF ;PRINT STRING TO BOTH
MOVE Z,C.XHED(Z) ;POINTER TO THE FIRST RX IN CAT
JRST PRNRP3
PRNRP2: MOVE Z,CHTMP
MOVE Z,X.NCFC(Z) ;next RX for category
PRNRP3: MOVEM Z,CHTMP
JUMPE Z,PRNR3A ;Start pass 2 in category
MOVE Y,X.UPTR(Z) ;Get user for this RX
AOS CTTTU ;COUNT A USER IN THIS CAT
SKIPE X.PERC(Z) ;don't if no alloc for cat
SKIPN R.RMON(Y)
JRST PRNRP2 ;NOT AN ACTIVE USER
AOS CTTU ;COUNT AN ACTIVE USER
FORSUF <
MOVE Q,R.R'SUF(Y)
MUL Q,X.PERC(Z) ;MULTIPLY BY PERCENTAGE OF EFFORT
DIV Q,[1,,0] ;DIVIDE TO MAKE IT REASONABLE
ADDM Q,CT'SUF
ADDM Q,GT'SUF
SKIPE OVHD
ADDM Q,OV'SUF
SKIPN OVHD
ADDM Q,US'SUF
>
JRST PRNRP2
PRNR3A: MOVE Q,CTTU ;active users in category
ADDM Q,GTTU
SKIPE OVHD
ADDM Q,OVTU
SKIPN OVHD
ADDM Q,USTU
MOVE Q,CTTTU ;total number of users
ADDM Q,GTTTU
SKIPE OVHD
ADDM Q,OVTTU
SKIPN OVHD
ADDM Q,USTTU
SKIPG CTTU ;no output for inactive categ
JRST PRNRP1 ;so advance to next category
FILSTR 3,LINBUF ;YES. OUTPUT HEADING
MOVE A,CTMON ;category total money
IDIV A,CTTU ;divided by number of people
IDIVI A,5 ;threshold of triviality
MOVEM A,TRIVIA ;save it
MOVE a,ptmon ;grand total of charges
IDIVI A,=1000 ;anyone who uses more than this
CAILE A,=1000 ;anyone who uses more than this.
MOVEI A,=1000 ;is non-trivial
CAMGE A,TRIVIA
MOVEM A,TRIVIA
MOVE Z,NMTMP
MOVE Z,C.XHED(Z) ;start at first RX for this Cat
JRST PRNR3C
PRNR3B: MOVE Z,CHTMP
MOVE Z,X.NCFC(Z) ;advance to next RX for this cat
PRNR3C: MOVEM Z,CHTMP
JUMPE Z,PRNRP4
MOVE Y,X.UPTR(Z) ;POINT TO RUSER of this RX
AOS CBTTU ;count a user
SKIPE X.PERC(Z) ;skip user if no alloc in categ
SKIPN R.RMON(Y) ;skip user if nothing used
JRST PRNR3B
CALL LINSET
MOVEI A,"-"
DPB A,[POINT 7,LINBUF,6] ;assume trivial and flag it.
MOVE Q,X.PERC(Z) ;GET PERCENTAGE OF EFFORT
CAMN Q,[1,,0] ;IS THIS THE EASY CASE?
JRST PRNR3E ;YUP. DO IT THE EASY WAY.
MOVE B,[POINT 7,LINBUF,6]
CALL PREFRT ;PRINT FRACTION OF EFFORT
FORSUF <
MOVE Q,R.R'SUF(Y)
MUL Q,X.PERC(Z) ;MULTIPLY BY PERCENTAGE OF EFFORT
DIV Q,[1,,0] ;DIVIDE TO MAKE IT REASONABLE
MOVEM Q,GT.'SUF ;SAVE IN SPECIAL PLACE
>
CALL PRUDT1 ;PRINT USER NAME
MOVEI Y,GT.CPU ;POINT TO "USER"
CALL PRUDT2 ;PRINT "USER" DATA
JRST PRNR3F
PRNR3E: CALL PRUDAT ;PRINT USER DATA
PRNR3F: MOVE A,R.RMON(Y)
CAMGE A,TRIVIA ;is this a non-trivial user?
JRST PRNR3D ;nope. trivial
AOS CBTU
MOVEI A," "
DPB A,[POINT 7,LINBUF,6] ;clear trivial flag
FORSUF <
MOVE Q,R.R'SUF(Y)
ADDM Q,CB'SUF
>
PRNR3D: MOVE A,[POINT 7,CRLF]
CALL COPYST
MOVEI A,0
IDPB A,B
FILSTR 1,LINBUF
JRST PRNR3B
PRNRP4: CALL LINSET ;SETUP LINE BUFFER
MOVE Z,NMTMP ;category pointer
MOVE A,C.RTYP(Z) ;NAME OF THIS CATEGORY
MOVE B,[POINT 7,LINBUF]
CALL COPYST ;COPY CATEGORY NAME
MOVE A,[POINT 7,CRLF]
CALL COPYST
MOVEI A,0
IDPB A,B ;END WITH NULL
FILSTR 1,LINBUF ;the name of the category again
CALL LINSET
MOVE B,[POINT 7,LINBUF]
PUTSTR <Total for >
MOVE Q,CTTU
MOVEI S,0
CALL PRNUM
PUTSTR < / >
MOVE Q,CTTTU
CALL PRNUM
PUTSTR < user>
MOVEI A,"s"
MOVE Q,CTTTU
CAILE Q,1
IDPB A,B
MOVEI A,":"
IDPB A,B
MOVEI Y,CTCPU ;ADDRESS OF "USER" BLOCK
CALL PRUDT2 ;PRINT USER STUFF
MOVE A,[POINT 7,[ASCIZ/ Overhead/]]
SKIPE OVHD
CALL COPYST
MOVE A,[POINT 7,CRLF]
CALL COPYST
MOVEI A,0
IDPB A,B
FILSTR 3,LINBUF
CALL LINSET
MOVE B,[POINT 7,LINBUF]
PUTSTR <As percent of all use>
MOVE B,[POINT 7,LINBUF+6] ;start in col 31.
MOVEI A,40
IDPB A,B
define pxpct (XX,DIVISO,SPACE)<
MOVE Q,XX
MULI Q,=10000
DIV Q,DIVISO
MOVEI S,SPACE-3
CALL PRPCT
>
PXPCT (CTCPU,PTCPU,16)
PXPCT (CTCON,PTCON,16)
PXPCT (CTPAG,PTPAG,10)
PXPCT (CTMON,PTMON,10)
PXPCT (CTSES,PTSES,10)
ALLNZP <
PXPCT (CTCP'I,PTCP'I,16)
>
ALLNZP <
PXPCT (CTCO'I,PTCO'I,16)
>
MOVE A,[POINT 7,CRLF]
CALL COPYST
MOVEI A,0
IDPB A,B
FILSTR 3,LINBUF
MOVE A,CBTU
CAIGE A,2 ;Should we show average?
JRST PRNR4X ;nope can't average 1 user
CALL LINSET ;SET UP NEW OUTPUT LINE
MOVE B,[POINT 7,LINBUF]
PUTSTR <Average of >
MOVEI S,0
MOVE Q,CBTU
CALL PRNUM
PUTSTR < non-trivial users: >
EXPSUF(SUF,\SSUF)
< MOVE Q,CB'SUF
IDIV Q,CBTU
MOVEM Q,GT.'SUF
>
MOVEI Y,GT.CPU ;GT.XXX is in use as a temp set
CALL PRUDT2 ;PRINT DATA.
MOVE A,[POINT 7,crlf]
CALL COPYST
MOVEI A,0
IDPB A,B
FILSTR 3,LINBUF
PRNR4X: FILSTR 3,CRLF
JRST PRNRP1 ;ADVANCE TO NEXT CATEGORY
PRNRP5: CALL LINSET
MOVE B,[POINT 7,LINBUF]
PUTSTR <Grand Total for >
MOVE Q,GTTU
MOVEI S,0
CALL PRNUM
PUTSTR < / >
MOVE Q,GTTTU
MOVEI S,0
CALL PRNUM
PUTSTR < users>
MOVEI Y,GTCPU
CALL PRUDT2
MOVE A,[POINT 7,CRLF]
CALL COPYST
MOVEI A,0
IDPB A,B
FILSTR 13,LINBUF
CALL LINSET
MOVE B,[POINT 7,LINBUF]
PUTSTR <Total Ovhd for >
MOVE Q,OVTU
MOVEI S,0
CALL PRNUM
PUTSTR < / >
MOVE Q,OVTTU
MOVEI S,0
CALL PRNUM
PUTSTR < users>
MOVEI Y,OVCPU
CALL PRUDAT
MOVE A,[POINT 7,CRLF]
CALL COPYST
MOVEI A,0
IDPB A,B
FILSTR 13,LINBUF
CALL LINSET
MOVE B,[POINT 7,LINBUF]
PUTSTR <Total Non-Ovhd >
MOVE Q,GTTU
SUB Q,OVTU
MOVEI S,0
CALL PRNUM
PUTSTR < / >
MOVE Q,GTTTU
SUB Q,OVTTU
MOVEI S,0
CALL PRNUM
PUTSTR < users>
MOVEI Y,USCPU
CALL PRUDT2
MOVE A,[POINT 7,CRLF]
CALL COPYST
MOVEI A,0
IDPB A,B
FILSTR 13,LINBUF
RET
CHKOVH: PUSH P,A ;SAVE ARGUMENT
MOVSI Y,-NOVHNM ;number of overhead category names
CHKOV1: MOVE A,(p) ;category name
MOVSI B,440700
HRR B,OVHNAM(Y) ;name of an overhead category
CALL STRCMP ;compare strings
AOBJN Y,CHKOV1
JUMPL Y,.+2
TDZA A,A
MOVNI A,1
MOVEM A,OVHD
SUB P,[1,,1]
RET
OVHNAM: [asciz/OVERHEAD/]
[ASCIZ/LOTS-STAFF/]
[ASCIZ/LOTS-VOLUNTEER/]
[ASCIZ/CONSULTANT/]
NOVHNM==.-OVHNAM
>;IFE BATCH
PRHMS: idivi q,=60
push p,r
idivi q,=60
push p,r ;minutes
MOVEI s,10
CALL PRNUM
POP P,q ;
MOVEI A,":"
IDPB A,B
MOVEI S,2 ;2 characters
CALL PRNUMF ;zero fill
POP P,Q
MOVEI S,2
MOVEI A,":"
IDPB A,B ;stuff colon and print with 0 fill
PRNUMF: SKIPA A,["0"] ;leading 0 fill
prnum: movei a," "
PRNUM0: idivi q,=10
hrlm r,(p)
subi s,1
skipe q
call prnum0
prnum1: jumple s,prnum2
idpb a,b
soja s,prnum1
prnum2: hlrz a,(p)
addi a,"0"
idpb a,b
ret
IFE BATCH,<
PRMON: ADDI Q,=50 ;round to nearest $
IDIVI Q,=100 ;whole $
MOVEI S,10
JRST PRNUM
PRPCT: IDIVI Q,=100
PUSH P,R
CALL PRNUM
MOVEI A,"."
IDPB A,B
POP P,q
MOVEI S,2
JRST PRNUMF
prefrt: movei a,"["
CAMN Q,[1,,0] ;don't print 100
RET
idpb a,b
imuli q,=100
addi q,400000
hlrz q,q
movei s,0
call prnum
movei a,"]"
idpb a,b
ret
>;IFE BATCH
SUBTTL PRNPIG - LIST OF THE LARGEST USERS
IFE BATCH,<
PRNPIG: SETZM PIGNUM
MOVE Y,BASE
MOVE Y,R.PIGP(Y) ;HEAD OF THE LIST.
FILSTR 1,[byte(7)14] ;Start new page
FILSTR 11,[ASCIZ/Largest users
/]
CALL LINSET
CALL PRNHDR
SETZB A,PIGPCT ;cumulative pig percentage
IDPB A,B
FILSTR 11,LINBUF
PRNPG1: CALL LINSET ;INITIALIZE NEW LINE
MOVE B,[POINT 7,LINBUF]
MOVEI S,3
AOS Q,PIGNUM
CALL PRNUM ;pig number
CALL PRUDAT ;PRINT USER DATA
MOVE Q,R.RMON(Y)
ADDM Q,PIGPCT ;cumulative amt eaten
PXPCT (Q,PTMON,6)
PXPCT (PIGPCT,PTMON,6)
MOVE A,[POINT 7,CRLF]
CALL COPYST
MOVEI A,0
IDPB A,B
FILSTR 11,LINBUF
CALL LINSET
MOVE B,[POINT 7,LINBUF]
PUTSTR < >
MOVE A,R.UNAM(Y) ;get the user's name
CALL COPYST ;Store the user name
MOVE B,[POINT 7,LINBUF+7] ;LEAVE LOTS OF SPACE
MOVE Z,R.XPNT(Y) ;get rx
pcatlp: MOVE A,X.CPTR(Z) ;pointer to category record
MOVE A,C.RTYP(A)
CALL COPYST
MOVE Q,X.PERC(Z)
CALL PREFRT ;print effort
SKIPN Z,X.NCFU(Z) ;advance to next category for this user
JRST PCATLX ;none there
PUTSTR <, >
JRST PCATLP
PCATLX: MOVE A,[POINT 7,CRLF]
CALL COPYST
MOVE A,[POINT 7,CRLF]
CALL COPYST
MOVEI A,0
IDPB A,B
FILSTR 11,LINBUF
MOVE A,PIGPCT ;cumulative pig percentage
LSH A,1 ;times 2
CAML A,ptmon ;compare to total eaten
RET ;we have passed 50% point
MOVE A,PIGNUM
CAILE A,=199 ;up to 200 users
RET
MOVE Y,R.PIGP(Y)
JUMPN Y,PRNPG1
RET ;fewer than 100 users
>;IFE BATCH
SUBTTL PRNUNK - PRINT USAGE-UNKNOWN USERS
IFE BATCH,<
PRNUNK: MOVE A,USEUNK ;LOCATE CATEGORY BLOCK FOR USAGE-UNKNOWN
CALL HSHCMP ;COMPUTE HASH CODE FOR THIS NAME
MOVE Z,CHSHTB(B) ;FOLLOW HASH CHAIN
PRNUK1: JUMPE Z,CPOPJ ;NOT ON HASH CHAIN. NOT THERE.
MOVE A,USEUNK ;BYTE POINTER TO NAME WE SEEK
MOVE B,C.RTYP(Z) ;GET POINTER TO CATEGORY NAME (Z)
CALL STRCMP ;COMPARE STRINGS
JRST [MOVE Z,C.HASH(Z)
JRST PRNUK1]
MOVE Z,C.XHED(Z) ;FIRST RX FOR USER IN THIS CATEGORY
FILSTR 1,[byte(7)14] ;Start new page
FILSTR 1,[ASCIZ/Present Usage Unknown
/]
PRNUK2: CALL LINSET ;INITIALIZE NEW LINE
MOVE B,[POINT 7,LINBUF]
MOVE Y,X.UPTR(Z) ;get to the RU from the RX
CALL PRUDT1 ;PRINT directory name only
MOVE B,[POINT 7,LINBUF+6,6]
MOVE A,R.UNAM(Y) ;get the user name
CALL COPYST ;Store the user name
MOVE A,[POINT 7,CRLF]
CALL COPYST
MOVEI A,0
IDPB A,B
FILSTR 1,LINBUF
MOVE Z,X.NCFC(Z) ;advance to next RX for this c.
JUMPN Z,PRNUK2
RET
>;IFE BATCH
SUBTTL PRNULS - DEBUGGING CODE - PRINT ULS
IFE BATCH,<
PRNULS: MOVE A,BASE
MOVEM A,NMTMP
PRNUS1: MOVE A,NMTMP
MOVE A,R.DPNT(A)
MOVEM A,NMTMP
JUMPE A,CPOPJ
CALL PRNTUS
JRST PRNUS1
PRNTUS: MOVE Z,A
MOVE A,R.DNAM(Z) ;directory name
MOVE B,[POINT 7,LINBUF]
CALL COPYST
MOVE A,[POINT 7,[ASCIZ/ /]]
CALL COPYST
MOVE A,R.UNAM(Z) ;user name
CALL COPYST
MOVE A,[POINT 7,[ASCIZ/ /]]
CALL COPYST
MOVE Y,R.XPNT(Z) ;pointer to rx (categories)
PRNULC: MOVE A,X.CPTR(Y)
MOVE A,C.RTYP(A)
CALL COPYST
MOVE Q,X.PERC(Y) ;get the effort count
call prefrt
SKIPN Y,X.NCFU(Y) ;advance to next rx
JRST PRNTUX ;none there
PUTSTR <, >
JRST PRNULC
PRNTUX: MOVE A,[POINT 7,CRLF]
CALL COPYST
MOVEI A,0
IDPB A,B
FILSTR 1,LINBUF
RET
>;IFE BATCH
SUBTTL BLDULS - BUILD IN-CORE DATA BASE
IFE BATCH,<
;INSERT A USER INTO IN-CORE DATA BASE
INSRTU: MOVEI A,RUSER ;NAME OF THE NODE THAT WE WANT TO MAKE
CALL NEWREC
MOVEM B,TEMP ;ADDRESS OF THE NEW NODE
MOVE A,PREV ;ADDR OF PREVIOUS, I.E., LAST, NODE
MOVEM B,R.DPNT(A) ;STORE LINK OUT OF "PREV"
MOVEM B,R.UPNT(A) ;NEW NODE IS LAST IN DPNT, UPNT, PIGP
MOVEM B,R.PIGP(A)
MOVE A,FDNAME ;SOURCE OF STRING TO COPY
MOVE C,RECFF ;ADDRESS OF FIRST FREE WORD
CHKSTG (C,600000)
HRLI C,440700 ;make it a byte pointer
MOVEM C,R.DNAM(B) ;Store pointer to directory name str
MOVE B,C ;Destination of string to copy
CALL COPYST ;COPY STRING. SOURCE IN A, DEST in B
MOVEI A,0 ;END DEST WITH NULL
IDPB A,B
MOVE C,TEMP ;ADDRESS OF THIS NODE
MOVEM B,R.UNAM(C) ;SAVE POINTER TO USER NAME STR.
MOVE A,FUNAME
CALL COPYST
MOVEI A,0
IDPB A,B
MOVEI B,1(B)
MOVEM B,RECFF ;ADVANCE RECFF past the str we stored
MOVE A,FDNAME
CALL HSHCMP ;COMPUTE HASH VALUE INTO B
MOVE A,TEMP
MOVE C,HASHTB(B) ;LINK OUT OF HASH TABLE
MOVEM C,R.HASH(A) ;STORE OLD LINK OUT IN NEW NODE
MOVEM A,HASHTB(B) ;AND NEW NODE ADDRESS IN HASHTB
MOVEI A,RUCX ;build an RX block for this user
CALL NEWREC
MOVE A,TEMP ;RU pointer
MOVEM A,X.UPTR(B) ;Make RX point to RU
MOVEM B,R.XPNT(A) ;Make RU point to RX
MOVEM B,TRX ;save rx pointer.
MOVE A,FCAT ;POINTER TO CATEGORY STRING
CALL FNDCAT ;FIND or build THE CATEGORY BLOCK
MOVE C,TRX
MOVEM B,X.CPTR(C) ;POint to appropriate category block
MOVE B,FCATPC
MOVEM B,X.PERC(C) ;percentage of effort
SETZM CATCNT ;category counter
INSCAT: AOS A,CATCNT ;advance to next category
SKIPN A,FCAT(A) ;is there another category?
JRST INSCAX ;nope
MOVEI A,RUCX ;build a new RX block for this cate.
CALL NEWREC
MOVE A,TEMP ;RU pointer
MOVEM A,X.UPTR(B) ;make RX point to RU
MOVE A,TRX ;RX pointer to previous RX for this RU
MOVEM B,X.NCFU(A) ;store new RX as next RX for this ru
MOVEM B,TRX ;save as current rx
MOVE A,CATCNT
MOVE A,FCAT(A)
CALL FNDCAT
MOVE C,TRX
MOVEM B,X.CPTR(C) ;make this rx point to category
MOVE B,CATCNT
MOVE B,FCATPC(B)
MOVEM B,X.PERC(C) ;percentage of effort
JRST INSCAT
INSCAX: MOVE C,TEMP
MOVEM C,PREV ;make new record the "previous" record
RET
>;IFE BATCH
COPYST: ILDB C,A ;READ A BYTE
JUMPE C,CPOPJ
IDPB C,B
JRST COPYST
CPOPJ1: AOS (P)
CPOPJ: RET
IFE BATCH,<
BLDULS: MOVE A,BASE
MOVEM A,PREV ;Address of "previous" node
SETZM HASHTB
MOVE A,[HASHTB,,HASHTB+1]
BLT A,HASHTB+HASHLN-1
SETZM CHSHTB
MOVE A,[CHSHTB,,CHSHTB+1]
BLT A,CHSHTB+HASHLN-1
BLDUL1: CALL READUR ;READ user record
RET ;END OF FILE. DONE WITH MASTER LIST
CALL INSRTU ;INSERT USER RECORD
JRST BLDUL1
;SORT DPNT LIST BY DIRECTORY NAME ORDER
DSORT: MOVE A,BASE
MOVE A,R.DPNT(A)
MOVE B,[CALL SRDPNT]
MOVEI C,R.DPNT
CALL SORT
MOVE B,BASE
MOVEM A,R.DPNT(B)
; CALL PRNULS ;FOR DEBUGGING ONLY
MOVE A,NAMEHD ;SORT CATEGORY LIST BY NAME
MOVE A,C.RNPN(A) ;HEAD OF LIST
MOVE B,[CALL SRCPNT]
MOVEI C,C.RNPN
CALL SORT
MOVE B,NAMEHD
MOVEM A,C.RNPN(B)
MOVE A,BASE
MOVE A,R.PIGP(A)
MOVE B,[CALL PIGSRT]
MOVEI C,R.PIGP
CALL SORT
MOVE B,BASE
MOVEM A,R.PIGP(B)
;BUILD category lists by directory sorted order
MOVE A,BASE
BLDUL3: SKIPN A,R.DPNT(A) ;advance to next in DPNT list
RET ;EXIT IF END OF LIST
MOVE Y,R.XPNT(A) ;RX POINTER
BLDUL4: MOVE Z,X.CPTR(Y) ;CATEGORY POINTER
SKIPE W,C.XTAI(Z) ;GET TAIL POINTER OUT OF CAT
MOVEM Y,X.NCFC(W) ;Store link out.
SKIPN W ;Is head of list set yet?
MOVEM Y,C.XHED(Z) ;no. make first record
MOVEM Y,C.XTAI(Z) ;Store new tail of CAt list
SKIPE Y,X.NCFU(Y) ;advance to next RX
JRST BLDUL4 ; if any
JRST BLDUL3 ;advance to next RU
>;IFE BATCH
HSHCMP: MOVEI B,0
HSHCM1: ILDB C,A
JUMPE C,HSHCM2
IMULI B,203
ADDI B,(C)
JRST HSHCM1
HSHCM2: IDIVI B,HASHLN
MOVM B,C ;RETURN POSITIVE RESULT IN B
RET
IFE BATCH,<
FNDCAT: PUSH P,A ;BYTE PTR TO NAME OF CATEGORY
CALL HSHCMP ;COMPUTE HASH CODE FOR THIS NAME
SKIPA C,CHSHTB(B) ;FOLLOW HASH CHAIN
FNDCA1: MOVE C,C.HASH(C) ;ADVANCE TO NEXT CATEGORY ON HASH CHAIN
JUMPE C,FNDCA3 ;NOT ON HASH CHAIN. NOT THERE.
MOVE A,(P) ;BYTE POINTER TO NAME WE SEEK
MOVE B,C.RTYP(C) ;GET POINTER TO CATEGORY NAME (C)
CALL STRCMP ;COMPARE STRINGS
JRST FNDCA1 ;DIFFERENT.
MOVE B,C ;BLOCKS ARE EQUAL. RETURN THIS ONE
SUB P,[1,,1]
RET
FNDCA3: MOVEI A,RCAT
CALL NEWREC ;BUILD A CATEGORY RECORD
PUSH P,B ;SAVE ADDRESS OF NEW RECORD
MOVE A,NAMEHD
MOVE C,C.RNPN(A) ;LINK OUT OF HEAD OF LIST
MOVEM C,C.RNPN(B) ;SAVE AS OUR LINK OUT
MOVEM B,C.RNPN(A) ;STORE THIS NODE AS NEW HEAD
MOVE A,-1(P) ;GET THE NAME OF THIS CATEGORY
MOVE C,RECFF
CHKSTG (C,600000)
HRLI C,440700
MOVEM C,C.RTYP(B) ;POINTER TO NEW STRING INTO THIS CAT
MOVE B,C ;SOURCE IN A, DEST IN B.
CALL COPYST ;COPY CATEGORY NAME STRING
MOVEI A,0
IDPB A,B ;END WITH A NULL
MOVEI B,1(B)
MOVEM B,RECFF ;NEW FIRST AVAILABLE ADDRESS
MOVE A,-1(P)
CALL HSHCMP ;COMPUTE HASH CODE
MOVE A,(P) ;ADDRESS OF THIS NODE
MOVE C,CHSHTB(B) ;GET FIRST LINK IN HASH TBL
MOVEM C,C.HASH(A) ;STORE AS LINK OUT OF NEW NODE
MOVEM A,CHSHTB(B) ;STORE NEW AS IN FIRST LINK IN HASH TBL
POP P,B ;RETURN ADDRESS OF CATEGORY BLOCK
SUB P,[1,,1]
RET
>;IFE BATCH
STRCMP: ILDB W,A
ILDB X,B
CAIE W,(X)
RET ;DIFFERENT
JUMPN W,STRCMP
JRST CPOPJ1
SUBTTL SORT
IFE BATCH,<
SORT: MOVEM B,SRTXCT ;THIS IS THE COMPARE INSTRUCTION
HRRM C,SRT.AX
HRRM C,SRT.CX
HRRM C,SRT.DX
SORT0: SKIPN B,@SRT.AX ;GET LINK TO NEXT GUY
RET ;NO NEXT GUY, THUS, LIST IS SORTED
MOVE C,B ;TAIL OF THE B-LIST
MOVE D,A ;TAIL OF THE A-LIST
SORT1: MOVE W,@SRT.CX ;LINK OUT OF THE B LIST
MOVEM W,@SRT.DX ;STORE IN TAIL OF THE A LIST
SKIPN D,W ;SKIP UNLESS DONE
JRST SORT2 ;NONE LEFT
MOVE W,@SRT.DX ;LINK OUT OF THE A-LIST
MOVEM W,@SRT.CX ;STORE IN TAIL OF THE B-LIST
SKIPE C,W ;SKIP IF DONE
JRST SORT1 ;NOT DONE YET. KEEP DIVIDING THE LIST
SORT2: PUSH P,B ;SAVE THE B LIST
CALL SORT0 ;SORT THE A-SUBLIST
EXCH A,(P) ;GET B-LIST, SAVE SORTED A-LIST
CALL SORT0 ;SORT THE B-LIST
POP P,B
;NOW, THE SITUATION IS THAT THERE ARE TWO LISTS, A AND B, BOTH SORTED.
;NOW, MERGE THEM. (THIS REALLY DOES THE HARD WORK).
HRRZ D,SRT.DX ;D:=OFFSET TO LIST HEAD
SUBI D,C ;D:=OFFSET-C
MOVN D,D ;D:=C-OFFSET. THUS, @SRT.DX ADDRESSES
;REGISTER C, WHICH WILL BE THE LIST-HEAD
;OF THE RESULT
SCOMP: XCT SRTXCT ;COMPARE HEAD(A) AND HEAD (B)
EXCH A,B ;B WAS SMALLER
MOVEM A,@SRT.DX ;STORE LINK OUT OF NEW LIST.
MOVE D,A ;ADVANCE TAIL POINTER
SKIPE A,@SRT.AX ;ADVANCE IN A LIST. SKIP IF EMPTY
JRST SCOMP ;LOOP. REDUCE BOTH LISTS
MOVEM B,@SRT.DX ;STORE REST OF B LIST IN TAIL
MOVE A,C
RET
SRDPNT: MOVE W,R.DNAM(A)
MOVE X,R.DNAM(B)
SRDPN1: ILDB Y,W
JUMPE Y,CPOPJ1 ;A name EXHAUSTED FIRST a small
ILDB Z,X
JUMPE Z,CPOPJ ;B name exhausted first B Small
CAIGE Y,(Z)
JRST CPOPJ1 ;A is smaller than B
CAIN Y,(Z) ;are they the same?
JRST SRDPN1 ;yes, read more
RET ;DONE, B smaller than A
SRCPNT: MOVE W,C.RTYP(A)
MOVE X,C.RTYP(B)
JRST SRDPN1
PIGSRT: MOVE W,R.RMON(A)
CAML W,R.RMON(B)
JRST CPOPJ1 ;A greater than B for pig sort
RET
>;IFE BATCH
SUBTTL CORE MANAGEMENT
;GET FREE STORAGE FOR RECORDS.
; CALL WITH RECORD DESCRIPTOR IN A.
; RETURNS RECORD POINTER IN B.
NEWREC: MOVE C,(A) ;GET THE LENGTH OF THE RECORD
MOVE B,RECFF ;FIRST FREE ADDRESS AVAILABLE
ADDB C,RECFF ;INCREMENT NEXT AVAIL FREE ADDR
CHKSTG (C,600000)
SETZM (B)
MOVSI D,(B)
HRRI D,1(B)
BLT D,-1(C)
RET
BLOAT: OUTSTR [ASCIZ/
PROGRAM IS TOO BLOATED.
/]
HALTF
JRST .-1
SUBTTL OPEN FILES FOR INPUT/OUTPUT
OPMSG: [ASCIZ/Name of the master file of user names & categories: /]
[ASCIZ/Name of the accounting data file: /]
[ASCIZ/Name of the binary accounting data file(s): /]
[ASCIZ/Output raw accounting data to: /]
OPJFN: MJFN
DJFN
BJFN
DOJFN
IFE BATCH,<
OPGBIT: GJ%OLD!GJ%XTN!GJ%CFM
GJ%OLD!GJ%XTN!GJ%CFM
GJ%OLD!GJ%XTN!GJ%CFM!GJ%IFG!GJ%FLG ;* ok on binary data file
GJ%XTN!GJ%CFM!GJ%FOU ;Output file
>;IFE BATCH
IFN BATCH,<
OPGBIT: GJ%OLD!GJ%XTN
GJ%OLD!GJ%XTN
GJ%OLD!GJ%XTN!GJ%IFG!GJ%FLG
GJ%XTN!GJ%FOU
OPNAM: 0
0
[ASCIZ/PS:<ACCOUNTS>SYSTEM-DATA.BIN.*/]
0 ;Changed by code at SUMARY and TODATE
>;IFN BATCH
OPNBIT: 070000,,OF%RD ;Read 7 bit bytes
070000,,OF%RD
440000,,OF%RD
070000,,OF%WR
OPENBI: SKIPA Z,[2]
OPENDO: MOVEI Z,3
JRST GETIJF
OPMSTR: TDZA Z,Z
OPDATA: MOVEI Z,1
GETIJF: MOVEI A,GTJFTB ;GTJFN TABLE
IFE BATCH,<
OUTSTR @OPMSG(Z)
MOVEI B,0
MOVE C,[.PRIIN,,.PRIOU]
>;IFE BATCH
IFN BATCH,<
HRRO B,OPNAM(Z)
MOVE C,[.NULIO,,.NULIO]
>;IFN BATCH
MOVEM C,.GJSRC(A)
MOVE C,OPGBIT(Z) ;bits for GTJFN
MOVEM C,.GJGEN(A)
SETZM .GJDEV(A)
SETZM .GJDIR(A)
SETZM .GJNAM(A)
SETZM .GJEXT(A)
SETZM .GJPRO(A)
SETZM .GJACT(A)
SETZM .GJJFN(A)
MOVE C,[g1%rnd+.GJBFP-.GJF2]
MOVEM C,.GJF2(A) ;size of extra area
SETZM .GJCPP(A)
SETZM .GJCPC(A)
HRRO C,OPMSG(Z)
MOVEM C,.GJRTY(A)
SETZM .GJBFP(A)
GTJFN
ERJMP [caie a,gjfx37 ;skip message if merely ^u
ERRMSG 1,[ASCIZ/Cannot get JFN/]
JRST GETIJF]
MOVEM A,@OPJFN(Z) ;SAVE FLAGS
cain z,2 ;is this for binary input files?
ret ;yes, open will be done separately
HRRZ A,A
GETIOF: MOVE B,OPNBIT(Z)
OPENF
ERJMP [ERRMSG [ASCIZ/Cannot OPENF file/]
MOVE A,@OPJFN(Z)
JRST GETIOF]
RET
OPNXXX: XCT OPENBI ;SETUP Z - open next binary file
JFCL ;IGNORE SKIP
HRRZ A,A ;CONTINUE HERE FROM OPNXXX
MOVE B,OPNBIT(Z)
OPENF
ERJMP [caie a,opnx9 ;invalid simultaneous access expected on last file
ERRMSG [ASCIZ/Cannot OPENF binary input file/]
MOVE A,@OPJFN(Z)
RET] ;return indication of failure
JRST CPOPJ1
SUBTTL MISCELLANEOUS ROUTINES
MOVSYM: SKIPN .JBSYM
JRST MOVSY1 ;THERE ARE NO SYMBOLS
HLRZ A,.JBSYM ;ORIGIN OF SYMBOLS TO LH
HRRI A,PRGFF+200 ;LEAVE ROOM FOR GROWTH
HLRO B,.JBSYM ;GET THE SIZE OF SYMS
MOVN B,B ;MAKE IT POSITIVE
ADDI B,PRGFF+200-1 ;LAST ADDRESS IN SYMBOL TBL
BLT A,(B) ;MOVE SYMBOLS TO NEW HOME
MOVEI A,PRGFF+200
HRRM A,.JBSYM ;TELL DDT THE NEW HOME
RET
MOVSY1: MOVE A,[-2,,PRGFF+200]
SETZM PRGFF+200
SETZM PRGFF+201
MOVEM A,.JBSYM
RET
OPNREP: MOVSI A,(GJ%FOU!GJ%SHT)
HRROI B,[ASCIZ/ACCT-REPORT.OUT/]
GTJFN
ERJMP [ERRMSG
JRST OPNREP]
HRRZM A,OJFN
OPNRP1: MOVE B,[070000,,OF%WR]
OPENF
ERJMP [ERRMSG [ASCIZ/Can't OPENF report file/]
MOVE A,OJFN
JRST OPNRP1]
OPNRP2: MOVSI A,(GJ%FOU!GJ%SHT)
HRROI B,[ASCIZ/ACCT-REPORT.SUM/]
GTJFN
ERJMP [ERRMSG
JRST OPNRP2]
HRRZM A,OJFN1
OPNRP3: MOVE B,[070000,,OF%WR]
OPENF
ERJMP [ERRMSG [ASCIZ/Can't OPENF report summary file/]
MOVE A,OJFN1
JRST OPNRP3]
OPNRP4: MOVSI A,(GJ%FOU!GJ%SHT)
HRROI B,[ASCIZ/ACCT-REPORT.PIG/]
GTJFN
ERJMP [ERRMSG
JRST OPNRP4]
HRRZM A,OJFN2
OPNRP5: MOVE B,[070000,,OF%WR]
OPENF
ERJMP [ERRMSG [ASCIZ/Can't OPENF report pigs file/]
MOVE A,OJFN2
JRST OPNRP5]
RET
ICLEAR: SETZM OJFN
SETZM OJFN1
setzm ojfn2
SETZM MJFN
SETZM DJFN
SETZM DOJFN
SETZM BJFN
RET
FINISH: MOVEI A,OJFN
CALL FIN1
MOVEI A,OJFN1
CALL FIN1
MOVEI A,OJFN2
CALL FIN1
MOVEI A,MJFN
CALL FIN1
MOVEI A,DJFN
CALL FIN1
RET
FIN1: SKIPN (A)
RET
PUSH P,A
MOVE A,(A)
CLOSF
ERJMP [ERRMSG [ASCIZ/Can't CLOSF file/]
MOVE A,@(P)
RLJFN
JFCL
JRST .+1]
POP P,A
SETZM (A)
RET
SUBTTL Process BINARY ACCOUNTING FILES
IFE BATCH,<
RDBIN: OUTSTR [ASCIZ/
Processing binary files now
/]
MOVEI A,[ASCIZ/Enter starting date and time: /]
MOVEI B,0 ;default start
CALL GTDATE
MOVEM B,LODATE
MOVEI A,[ASCIZ/Enter ending date and time: /]
HRLOI B,377777 ;default end
CALL GTDATE
MOVEM B,HIDATE
>;IFE BATCH
IFN BATCH,<
RDBIN: OUTSTR [ASCIZ/Reading binary data from /]
MOVEI A,.PRIOU
MOVE B,LODATE
MOVEI C,0
ODTIM%
OUTSTR [ASCIZ/ to /]
MOVE B,HIDATE
ODTIM%
OUTSTR CRLF
>;IFN BATCH
CALL OPENBI ;OPEN BINARY INPUT
CALL OPENDO ;OPEN TEXT DATA OUTPUT
SETZM BHSHTB
MOVE A,[BHSHTB,,BHSHTB+1]
BLT A,BHSHTB+HASHLN-1
SETZM FDATE ;first date of data processed
SETZM LDATE ;last date of data processed
rdbnyy: hrrz a,bjfn
move b,[1,,.fbwrt] ;time of last write
movei c,d ;result location
gtfdb%
add d,[1,,0] ;file written on day X might contain data for
;day X+1 (this assumes new file each day)
camge d,lodate ;could there be data within range?
jrst rdbnyz ;no
CALL OPNXXX ;OPEN THE FILE WHOSE JFN IS IN A.
JRST RDBNYZ ;Can't open file.
OUTSTR [ASCIZ/Processing Binary file /]
MOVEI A,.PRIOU
HRRZ B,BJFN
MOVEI C,0
JFNS
OUTSTR CRLF
CALL READBF ;READ & PROCESS ONE FILE
MOVSI A,400000 ;DON'T RELEASE JFN
HRR A,BJFN
CLOSF
EMSG <Can't CLOSF Binary Input file>
RDBNYZ: MOVE A,BJFN
GNJFN ;IS THERE ANOTHER JFN AVAILABLE?
JRST RDBINF ;NOPE
JRST RDBNYY
RDBINF: HRRZ A,BJFN ;release JFN of the binary file
RLJFN
NOP
IFE BATCH,<
MOVEI A,[ASCIZ/Are there any more binary files? (Y or N): /]
CALL YESNO
JRST RDBING ;no. write raw data
CALL OPENBI
JRST RDBNYY
>;IFE BATCH
RDBING: CALL DRECOT ;WRITE ACCOUNTING RECORDS
HRRZ A,DOJFN
CLOSF
EMSG <Can't CLOSF Raw Data Output File>
RET
GTDATE: PUSH P,A
PUSH P,B
GTDAT1: OUTSTR @-1(P)
HRROI A,TIBUF
MOVEI B,TIBFLN*5-4
HRRO C,-1(P)
RDTTY
JRST GTDAT1
MOVE A,[POINT 7,TIBUF]
GTDAT2: ILDB B,A
CAIE B,15
CAIN B,12
JRST GTDAT3
CAIN B,33
JRST GTDAT3
CAIE A,40
CAIN A,11
JRST GTDAT2
HRROI A,TIBUF
MOVEI B,0
IDTIM
JRST [OUTSTR [ASCIZ/Please try again. /]
JRST GTDAT1]
SUB P,[2,,2]
RET
GTDAT3: POP P,B ;return default
SUB P,[1,,1]
RET
YESNO: PUSH P,A
YESNO1: OUTSTR @(P)
HRROI A,TIBUF
MOVEI B,TIBFLN*5-4
HRRO C,(P)
RDTTY
JRST YESNO1
SUB P,[1,,1]
MOVE A,[POINT 7,TIBUF]
YESNO2: ILDB B,A
CAIE B,40
CAIN B,11
JRST YESNO2 ;skip leading spaces
CAIE B,"Y"
CAIN B,"Y"+40
AOS (P)
RET
DRECOT: HRROI A,LINBUF
HRROI B,[ASCIZ/!DATES This Report Dates from: /]
MOVEI C,0
SOUT
MOVE B,FDATE
ODTIM
HRROI B,[asciz/ to: /]
SOUT
MOVE B,LDATE
ODTIM
HRROI B,CRLF
SOUT
FILSTR 4,LINBUF
MOVSI W,-HASHLN
DRECO1: SKIPA Y,BHSHTB(W) ;GET A HASH POINTER
DRECO2: MOVE Y,B.HASH(Y) ;ADVANCE TO NEXT IN LIST
JUMPE Y,DRECO3 ;JUMP IF NONE LEFT ON LIST
CALL DROUSR ;DUMP ONE USER
JRST DRECO2
DRECO3: AOBJN W,DRECO1
RET
DROUSR: MOVE A,B.DNAM(Y)
MOVE B,[POINT 7,LINBUF]
CALL COPYST
MOVEI A,11
IDPB A,B
MOVE Q,B.BCPU(Y)
MOVEI S,0
CALL PRNUM
MOVEI A,11
IDPB A,B
MOVE Q,B.BCON(Y)
IDIVI Q,=1000 ;CONVERT TO SECONDS
CALL PRNUM
MOVEI A,11
IDPB A,B
MOVE Q,B.BPAG(Y)
CALL PRNUM
MOVEI A,11
IDPB A,B
MOVE Q,B.BSNM(Y) ;NUMBER OF SESSIONS
CALL PRNUM
movei a,11
idpb a,b
;For disk usage, we have to compute the part of the integral between
;the last sample and the end of the period. It is assumed here that the
;period starts and ends at midnight.
move q,hidate
sub q,b.dskt(y) ;time since last sample
move s,b.dskn(y) ;amount of last sample
imuli s,=1000 ;convert to milli-pages
mul q,s
ashc q,-=18
addb r,b.bdsk(y) ;final value of integral
move s,hidate
sub s,lodate
hlrzs s ;number of days in the period
div q,s ;average use for the period (milli-pages)
movei s,0
call prnum
ALLNZP <
MOVEI a,11
IDPB A,b
MOVE Q,B.CPU'I(Y)
CALL PRNUM
>
ALLNZP <
MOVEI A,11
IDPB A,B
MOVE Q,B.CON'I(Y)
IDIVI Q,=1000
CALL PRNUM
>
MOVEI A,15
IDPB A,B
MOVEI A,12
IDPB A,B
MOVEI A,0
IDPB A,B
FILSTR 4,LINBUF
move b,y
skipe B.RRED(B)
CALL PRREJM ;print rejected records message
skipg B.REJR(Y) ;are there any rejected records
RET
move a,dojfn
hrroi b,[asciz/!REJECT Total of /]
movei c,0
sout
move b,b.rejr(y)
movei c,12
nout
erjmp .+1
hrroi b,[asciz/ rejected records for /]
movei c,0
sout
move b,b.dnam(y)
sout
hrroi b,crlf
sout
ret
SUBTTL READBF - READ & PROCESS ONE BINARY FILE
READBF: HRRZ A,BJFN
SIZEF ;get word count of file
ERJMP [ERRMSG [ASCIZ/SIZEF Failure. Binary Input File/]
setzb b,c
JRST .+1]
MOVEM B,BWC ;wc of binary file.
MOVEM C,BPGCNT ;page count of binary file
SETZM BWP ;WP of binary file.
SETOM BPG ;currently mapped page....
REDBF1: CALL READBR ;READ BINARY RECORD
RET ;END OF FILE
HLRZ A,(D) ;GET THE RECORD TYPE
SKIPN FRMTBL(A) ;IS THIS TYPE OF RECORD KNOWN?
JRST REDBF1 ;NOPE, IGNORE IT.
MOVE B,1(D) ;DATE AND TIME OF THIS ENTRY
CAMGE B,LODATE
JRST REDBF1 ;THROW OUT RECORD THAT'S TOO EARLY
CAMLE B,HIDATE
JRST REDBF1 ;RECORD'S TOO LATE
SKIPN FDATE ;IS FIRST DATE SET YET?
MOVEM B,FDATE ;NOPE. SET IT FROM HERE.
MOVE C,LDATE
MOVEM C,PLDATE ;previous last date
CAMLE B,LDATE ;LATER THAN LAST WE'VE SEEN SO FAR?
MOVEM B,LDATE ;YES, STORE LATEST DATE SEEN
MOVEI W,10(D) ;ADDRESS OF FIRST WORD OF USR NAME
LDB X,[POINT 5,6(D),5] ;GET SIZE OF USR NAME
ADD W,X
LDB X,[POINT 6,6(D),11] ;Size of acct name
ADD W,X
LDB X,[POINT 6,6(D),17] ;size of session remark
ADD W,X ;pointer to first data beyond names
MOVEM D,RDBRAD ;RECORD ADDRESS
MOVEM W,RDBDAD ;RECORD DATA ADDRESS
MOVE A,1(D)
CAML A,[126505,,445253] ;4/28/80 6:45AM
CAMLE A,[126506,,225253];4/29/80 midnight
CAIA
JRST REDBF1 ;release 5 CPU accounting bug
CALL FILTER ;decide whether to keep record
JRST REDBF1 ;discard this record
MOVE D,RDBRAD ;RECORD ADDRESS
MOVE W,RDBDAD ;RECORD DATA ADDRESS
MOVSI A,440700
HRRI A,10(D) ;GET THE USER NAME
CALL FBUSR ;FIND OR MAKE (B:=A USER RECORD.)
MOVE D,RDBRAD
HLRZ A,(D)
MOVE W,RDBDAD
CALL @FRMTBL(A) ;B=USER RECORD, D=RECORD, W=DATA PART
JRST REDBF1
FILTER: JRST CPOPJ1 ;normal filter, accept anything.
LINFI: HRRZ A,6(D) ;GET TTY NUMBER
CAIN A,61 ;special line?
JRST LINFI1 ;yes
CAIE A,75 ;special line?
RET ;no....
MOVE A,1(D)
CAML A,[125502,,252525] ;NOV 30, 1978 0000
CAMLE A,[125504,,352525] ;DEC 2, 1978 0300
RET
JRST LINFI2
LINFI1: MOVE A,1(D)
CAML A,[125464,,252525] ;Nov 16, 1978 0000
CAMLE A,[125467,,652525] ;Nov 19, 1978 1200
RET
LINFI2: JRST PRBHDR
RET
DIALFI: ;dial-in lines filter
HRRZ A,6(D) ;line number
MOVSI B,-NREMLN
CAMN A,REMLTB(B)
JRST CPOPJ1
AOBJN B,.-2
RET
;300 baud filter
DIALF2: HRRZ A,6(D) ;line number
CAIL A,51
CAILE A,60 ;300 baud?
JRST .+2
JRST DILF2A ;yes. one of ours
DILF2A: JRST PRBHDR ;yes. print header.
DIALF3: HRRZ A,6(D) ;line number
CAIE A,35
CAIN A,36
JRST PRBHDR
CAIL A,41 ;1200/150?
CAILE A,50
ret
JRST PRBHDR ;yes. print record
REMLTB: 35
36
41
42
43
44
45
46
47
50
51
52
53
54
55
56
57
60
NREMLN==.-REMLTB
UFILT: MOVE D,RDBRAD
MOVSI A,440700
HRRI A,10(D)
PUSH P,A
MOVSI D,-UFLTLN
UFILT1: PUSH P,D
MOVE A,-1(P)
MOVE B,UFLTAB(D)
CALL STRCMP
JRST UFILT2 ;no match
SUB P,[2,,2]
MOVE D,RDBRAD
MOVE W,RDBDAD
JRST PRBHDR ;print this one
UFILT2: POP P,D
AOBJN D,UFILT1
SUB P,[1,,1]
RET
UFLTAB: POINT 7,[ASCIZ/D.DAN/]
UFLTLN==.-UFLTAB
SUBTTL I/O For Binary File
DEFINE PNOUT (CCCC)
< MOVEI A,.PRIOU
MOVE C,[CCCC]
NOUT
ERJMP .+1
>
;read one record. verify it is of reasonable format.
;Return D:=address of the record and skip. on eof, no skip
READBR: MOVE A,BWP ;Current word pointer in file
CALL MAPW ;make sure this word is in map
JUMPE D,CPOPJ ;Not accessible - eof
SKIPN B,(D) ;is this a reasonable header?
JRST RDBRZE ;no. flush zeroes.
HLRZ C,B ;get the record type
JUMPE C,RDBRUK ;zero is no goof
CAIL C,MXRTYP ;within the known types?
JRST RDBRUK ;nope. ignore this record
HRRZ C,B
CAILE C,10 ;is record length too small?
CAILE C,777 ;or too large?
JRST RDBRUK ;not so good
MOVE A,BWP
MOVE B,BWP
ADD B,C
MOVEM B,NBWP ;new BWP if all goes well
CALL MAPR ;map range of file to contiguous mem
HRRZ A,(D)
ADDI A,-1(D)
MOVE B,(D)
MOVEM B,BHDR
CAMN B,(A)
JRST [PUSH P,NBWP
POP P,BWP
JRST CPOPJ1]
MOVE A,(A)
MOVEM A,BTRL
OUTSTR [ASCIZ/%FREP: At word /]
MOVE B,BWP
PNOUT (NO%MAG!10)
OUTSTR [ASCIZ/, Header [/]
MOVE B,BHDR
PNOUT (NO%MAG!10)
OUTSTR [ASCIZ/] differs from trailer [/]
MOVE B,BTRL
PNOUT (NO%MAG!10)
OUTSTR [ASCIZ/].
Will resync...
/]
HRRZ C,(D) ;count of bad words...
RDBRY1: AOS BWP ;toss a bad word
ADDI D,1 ;advance to next word
SOJLE C,RDBRY2 ;Decrement wc. Restart if empty
HLRZ A,(D) ;IS THERE ANYTHING GOOD HERE.
SKIPE A
CAIL A,MXRTYP
JRST RDBRY1
HRRZ A,(D)
CAILE A,10 ;this is too small
caile a,777 ;and this is too big
JRST RDBRY1 ;this is no good.
OUTSTR [ASCIZ/Resync will be attempted at word /]
MOVE B,BWP
PNOUT (NO%MAG!10)
OUTSTR [ASCIZ/ [/]
MOVE B,(D)
PNOUT (NO%MAG!10)
OUTSTR [ASCIZ/]
/]
JRST READBR ;Reread this word and the ones following
RDBRY2: OUTSTR [ASCIZ/Resync will be attempted beyond failing record
At word /]
MOVE B,BWP
PNOUT (NO%MAG!10)
OUTSTR [ASCIZ/ [/]
MOVE A,BWP
CALL MAPW
JUMPE D,RDBRY3
MOVE B,(D)
PNOUT (NO%MAG!10)
OUTSTR [ASCIZ/]
/]
JRST READBR
RDBRY3: OUTSTR [ASCIZ/eof]
/]
RET
RDBRUK: OUTSTR [ASCIZ/?FREP: At word /]
MOVE B,BWP
PNOUT (NO%MAG!10)
OUTSTR [ASCIZ/ [/]
MOVE B,(D)
PNOUT (NO%MAG!10)
OUTSTR [ASCIZ/], Bad Header in file. Will Skip.
/]
AOS BWP
JRST READBR
RDBRZE: OUTSTR [ASCIZ/%FREP: At word /]
MOVE B,BWP
PNOUT (NO%MAG!10)
OUTSTR [ASCIZ/, Will skip zeroes in the file
/]
RDBRE1: AOS A,BWP
CALL MAPW
JUMPE D,RDBRE9 ;eof while skipping zeroes
SKIPN (D)
JRST RDBRE1
OUTSTR [ASCIZ/%FREP: At word /]
MOVE B,BWP
PNOUT (NO%MAG!10)
OUTSTR [ASCIZ/ [/]
MOVE B,(D)
PNOUT (NO%MAG!10)
OUTSTR [ASCIZ/], found end of zeroes
/]
JRST READBR
RDBRE9: OUTSTR [ASCIZ/%FREP: Eof while skipping zeroes
/]
RET
;Call with A:=Word number in file that we want to read
;Return D:=Address of that word in core, or 0 for EOF.
MAPW: CAML A,BWC ;is request in range?
JRST UNMAP ;no. clear map and return eof
PUSH P,A
LSH A,-=9 ;convert to page number
CALL CHKPAG ;get the desired page mapped in.
LSH D,=9 ;convert page number to core addr
POP P,A
SKIPE D
DPB A,[POINT 9,D,35]
RET
GOMAP: MOVEI B,(A) ;first page we want to map
SUB B,BPGCNT ;-page count of file
MOVN B,B ;#of pages at or after our first page
JUMPLE B,UNMAP ;Jump if no pages there
CAILE B,12
MOVEI B,12
HRRZM A,BPG
HRLM A,BPG
ADDM B,BPG
MOVSS BPG
MOVE C,B
TDO C,[PM%CNT!PM%RD!PM%CPY!PM%PLD]
MOVE B,[.FHSLF,,601]
HRL A,BJFN
PMAP
EMSG <PMAP error, reading Binary Input File>
HRRZ A,BPG
CHKPAG: SKIPG BPG ;anything mapped yet?
JRST GOMAP ;no.
HRRZ B,BPG ;first page that is now mapped
HLRZ C,BPG ;first page not yet mapped
CAML A,B ;are we above the bottom range?
CAML A,C ;and within the top?
JRST GOMAP ;nope. change map
SUB A,B ;the page number within the map
MOVEI D,601(A)
RET
UNMAP: MOVEI D,0
PUSH P,A ;save argument
PUSH P,B
SETO A,
MOVE B,[.FHSLF,,601]
MOVE C,[PM%CNT+12]
PMAP ;unmap stuff
EMSG <PMAP failure, unmapping Binary input file>
SETOM BPG
POP P,B
POP P,A
RET
;Enter with A:=First word number that we want to read,
; B:=Last word number that we want to read + 1
;Returns D:=Address in core of the first word.
MAPR: PUSH P,B
MOVE C,B ;Last word + 1
SUBI C,1 ;Wd number of last word to map
LSH C,-=9
CAML C,BPGCNT ;is desired page attainable?
JRST MAPR0 ;no. so why bother?
HLRZ D,BPG ;page num of first pg not in
CAML C,D ;is it already mapped in?
JRST MAPR1 ;no, this is harder
MAPR0: CALL MAPW
POP P,B
RET
MAPR1: PUSH P,A
CALL MAPW ;get the map for A
JUMPE D,MAPR4
PUSH P,D
TRZ D,777 ;start at page beginnimg
HRLZ D,D
HRRI D,600000
BLT D,600777 ;move the A-page.
ADDI A,1000 ;advance to next page
TRZ A,777 ;but not too far onto it.
CALL MAPW ;make this page come in.
SKIPN D
OUTSTR [ASCIZ/?FREP: Error at MAPR1 from MAPW
/]
POP P,D
MOVEI A,600
DPB A,[POINT 9,D,26]
MAPR2: POP P,A
POP P,B
RET
MAPR4: OUTSTR [ASCIZ/?FREP: Error at MAPR4
/]
JRST MAPR2
SUBTTL PROCESS INDIVIDUAL BINARY RECORDS
comment &
;Format of binary data:
0/ record type,,record length
1/ date and time of this entry
2/ byte(6)dec rev,cust rev,tty type(18)job number
3/ program name (sixbit)
4/ program version number (std form)
5/ monitor version number (std form)
6/ byte(1)b/ts(5)uname len(6)acct len,remark len(18)line number
7/ node name (sixbit)
10/ first word of user name is stored here. (length in word 6)
then the account string
then the session remark
then anything else,
finally, a word that matches word 0.
Actually, the above is correct only for session records. For disk records,
the "user name" will be the name of the user running the CHKPNT program,
namely OPERATOR; the "account string" will be the structure name, and the
"session remark" will be the directory name.
&
FRMTBL: 0 ;0 - illegal. can't happen
BRESTR ;1 - restart record
BSESSI ;2 - session entry
BSESSI ;3 - checkpoint entry
0 ;4 - illegal
BSDTIM ;5 - set date/time
0 ;6 - batch processor
BISPOO ;7 - input spooler
BOSPOO ;10 - output spooler
BDISKU ;11 - disk storage usage
0 ;12 - disk spindle usage
0 ;13 - structure mount
0 ;14 - magtape mount
0 ;15 - dectape mount
0 ;16 - file command
0 ;17 - file retrieve
0 ;20 - file archived
0 ;21 - file migrated
0 ;22 - file collected
MXRTYP==.-FRMTBL
BOSPOO: HLLZ A,4(W) ;GET THE QUEUE NAME
CAME A,['LPT ']
JRST PRBHDR
SKIPGE A,7(W) ;PAGES PRINTED
JRST PRBHDR ;throw out losing record; print it
ADDM A,B.BPAG(B) ;STORE IT
SKIPL A,0(W)
MOVEM A,B.SCPU(B) ;SPOOLER RUNTIME
AOS B.BPNM(B)
RET
BSESSI: move a,0(w) ;session start time
came a,b.logi(b) ;same as previous one?
jrst bses1 ;nope. accept this
hrrz a,2(d)
came a,b.bjob(b) ;same job number too?
jrst bses1 ;accept this data.
skipe b.rred(B) ;is this the first redundant record?
jrst bsrred ;nope.
AOS B.RRED(B)
MOVEM A,B.BADJ(B) ;SAVE BAD JOB NUMBER
MOVE A,0(W)
MOVEM A,B.BADL(B) ;SAVE BAD LOGIN TIME TOO.
filstr 4,[asciz/!reject redundant session record(s):
/]
JRST prbhdr
bsrred: aos b.rred(B)
ret
bsrej: aos b.rejr(b)
filstr 4,[asciz/!reject bad session record:
/]
JRST PRBHDR
Bses1: MOVE A,0(W) ;session start again
came a,B.BADL(B)
JRST BSES1A
HRRZ A,2(D)
CAMN A,B.BADJ(B)
JRST BSRRED ;FLUSH THIS RECORD
BSES1A: move a,1(d) ;get the record date
sub a,0(w) ;less session start date
jumpl a,bsrej ;reject if negative
camle a,[10,,0] ;must be less than 8 days!
jrst bsrej
imuli a,^d400 ;convert to milliseconds and leave room
camge a,1(w) ;compare with system's console time.
jrst bsrej ;reject. console .gt. elapsed time.
SKIPGE c,2(w) ;get run time (ms)
JRST BSREJ ;fuck this. CPU time can't be negative
camle c,1(w) ;mustn't be greater than console time
JRST BSREJ
;this record has passed our simple filters. allow it.
skipe b.rred(b) ;have there been red. rejects for u?
call prrejm ;yes. print them
move a,0(w) ;session start
movem a,B.LOGI(B) ;store it
hrrz a,2(d) ;get job number
movem a,B.bjob(b)
move a,1(W) ;console time MILLISECONDS
PUSH P,B
HRRZ B,6(D)
ADDM A,LINUSE(B) ;RECORD LINE USAGE
POP P,B
addm a,B.BCon(B)
MOVE a,2(W)
addm a,b.bcpu(b) ;run time milliseconds
AOS B.BSNM(B) ;SESSION COUNT
;JJW 2/83 Compute charges for non-zero periods.
move z,b ;temporarily use Z instead of B
push p,d
push p,w
move a,1(w) ;chargeable console time in msec
mul a,[1,,0] ;convert to days,,fraction of days
div a,[=24*=3600000]
movem a,sesend
move a,0(w) ;session start time
movem a,sesstt
addm a,sesend ;session end time
move b,a
bses1b: call getprd ;get period in C, period end in B
jumpe c,bses1c ;period 0 not accounted separately
addi c,b.cpu1-1(z) ;address for CPU time for this period
move a,b
camle a,sesend
move a,sesend
sub a,sesstt ;amount of time spent in period
push p,b
mul a,[=24*=3600000] ;convert to milliseconds
div a,[1,,0]
addm a,b.con1-b.cpu1(c) ;add console to appropriate word
muli a,=1000 ;times 1000
div a,1(w) ;%of nitetime * 1000
mul a,2(w) ;*cpu time
divi a,=1000
addm a,(c) ;stuff this too.
pop p,b
bses1c: movem b,sesstt ;set up for next period
camge b,sesend
jrst bses1b
pop p,w ;done computing charges for session
pop p,d
move b,z
ret
;Here with internal time in B. Returns with corresponding period number in C,
;and internal time of end of period in B. Register Z preserved.
getprd: setz d,
odcnv% ;convert to separate parts
hrrz x,d ;seconds since midnight
move y,timtab(c) ;get table for the day
getpr1: hrrz a,(y) ;end of a period
caml x,a ;compare time to end of period
aoja y,getpr1 ;not in period. try next one.
hrr d,a
idcnv% ;get internal end of period (TOPS-20 converts
; midnight to beginning of next day!)
erjmp [errmsg
haltf]
hlrz c,(y) ;period number
ret
;Here to process a disk record
bdisku: skipge a,1(w) ;total disk space used
jrst bdrej ;reject if negative
move x,1(d) ;date/time of this record
skipn y,b.dskt(b) ;is this the first sample?
jrst bdsk2 ;yes. Handle specially
movem x,b.dskt(b) ;save sample time
sub x,y ;elapsed time since last sample
exch a,b.dskn(b) ;store current sample for next time
add a,b.dskn(b) ;A = 2 * average for interval
imuli a,=500 ;A = average for interval, in milli-pages
bdsk1: jumple x,bdrej ;reject when time not positive
mul x,a ;compute disk usage
ashc x,-=18 ;now in milli-page-days
addm y,b.bdsk(b) ;add to integral
ret
bdsk2: movem x,b.dskt(b) ;save sample time
sub x,lodate ;time since beginning of month
movem a,b.dskn(b) ;save current sample amount
imuli a,=1000 ;"average" for interval, in milli-pages
jrst bdsk1
bdrej: filstr 4,[asciz/!reject bad disk record:
/]
jrst prbhdr
prrejm: filstr 4,[asciz/!Total of /]
move a,dojfn
move c,b.rred(b)
addm c,b.rejr(b)
setzm b.rred(b)
push p,b
move b,c
movei c,12
nout
erjmp .+1
filstr 4,[asciz/ redundant records, rejected, for user /]
move b,(p) ;retrieve record pointer
move b,b.dnam(b)
movei c,0
sout
pop p,b
filstr 4,crlf
RET
BRESTR: HRROI A,LINBUF
HRROI B,[ASCIZ/!RESTART /]
movei c,0
sout
MOVE B,1(D) ;date of record
ODTIM
erjmp .+1
HRROI B,[ASCIZ/ previous activity: /]
SOUT
MOVE B,PLDATE
ODTIM
ERJMP .+1
MOVEI B," "
IDPB B,A
LDB B,[POINT 5,6(D),5] ;LENGTH IN WORDS OF USER NAME
ADDI B,10(D) ;BASE OF USER NAME
HRRO B,B ;MONITOR NAME IN RESTART RECRD
SOUT
PRBHDX: HRROI B,CRLF
MOVEI C,0
SOUT
FILSTR 4,LINBUF
RET
BSDTIM: HRROI A,LINBUF
HRROI B,[ASCIZ/!SETDATE New date is: /]
movei c,0
sout
MOVE B,1(D) ;date of record
ODTIM
erjmp .+1
HRROI B,[ASCIZ/ Old date was: /]
SOUT
MOVE B,0(W)
ODTIM
ERJMP .+1
HRROI B,[ASCIZ/ Performed by: /]
SOUT
HRROI B,10(D) ;user name
SOUT
JRST PRBHDX
BISPOO:
PRBHDR: HRROI A,LINBUF
HLRZ B,(D) ;record type
HRRO B,BRECNM(B) ;GET THE STRING
movei c,0
sout
movei b," "
IDPB B,A
MOVE B,1(D) ;date of record
ODTIM
erjmp .+1
HRROI B,[ASCIZ/ JN = /]
sout
HRRZ B,2(D) ;JOB NUMBER
MOVEI C,12
NOUT
ERJMP .+1
HRROI B,[ASCIZ/ /]
movei c,0
sout
MOVE B,3(D) ;JOB NAME
CALL SIXOUT
HRROI B,[ASCIZ/ LN = /]
movei c,0
sout
HRRZ B,6(D)
MOVEI C,10
NOUT
ERJMP .+1
MOVEI B," "
IDPB B,A
IDPB B,A
HRROI B,10(D) ;user name
MOVEI C,0
SOUT
HLRZ B,(D)
CAIE B,2 ;session rec?
CAIN B,3 ;or checkpoint?
CAIA ;Yes, show information
JRST PRBHDX ;NOPE
HRROI B,crlf
SOUT
; filstr 4,linbuf
; HRROI A,LINBUF
HRROI B,[asciz/! /]
MOVEI C,0
SOUT
move b,0(w) ;session start
movei c,0
odtim
ERJMP .+1
hrroi b,[asciz/ con sec = /]
sout
move b,1(w)
idivi b,=1000
movei c,12
nout
erjmp .+1
hrroi b,[asciz/ cpu sec = /]
movei c,0
sout
move b,2(w)
idivi b,=1000
movei c,12
nout
erjmp .+1
hrroi b,crlf
movei c,0
sout
filstr 4,linbuf
ret
SIXOUT: LDB C,[POINT 6,B,5]
ADDI C,40
IDPB C,A
LSH B,6
JUMPN B,SIXOUT
RET
BRECNM: POINT 7,[ASCIZ/!ILLEG-0/]
POINT 7,[ASCIZ/!RESTART/]
POINT 7,[ASCIZ/!SESSION/]
POINT 7,[ASCIZ/!CHEKPNT/]
POINT 7,[ASCIZ/!ILLEG-4/]
POINT 7,[ASCIZ/!SETDATE/]
POINT 7,[ASCIZ/!ILLEG-6/]
POINT 7,[ASCIZ/!INSPOOL/]
POINT 7,[ASCIZ/!O-SPOOL/]
POINT 7,[ASCIZ/!DISKUSE/]
SUBTTL FBUSR - FIND USER RECORD FOR BINARY STUFF
FBUSR: hlrz b,(d) ;JJW 2/83
cain b,11 ; Is this a disk record?
jrst fbdisk ; Yes. Handle differently.
PUSH P,A ;byte pointer to the user name
CALL HSHCMP ;compute hash
HRLZM B,FBPREV ;SAVE HASH VALUE & NO PREVIOUS NODE
MOVE C,BHSHTB(B) ;GET THE BASE OF THE HASH TABLE
JRST FBUSR3
FBUSR1: HRRM C,FBPREV ;THIS IS THE PREVIOUS NODE
MOVE C,B.HASH(C) ;ADVANCE TO NEXT ITEM IN HASH TBL
FBUSR3: JUMPE C,FBUSR2 ;IF AT END OF LIST, THIS USER IS NEW
MOVE A,(P) ;GET BACK THE NAME WE SEEK
MOVE B,B.DNAM(C) ;GET NAME FROM THIS BLOCK
CALL STRCMP ;COMPARE STRINGS
JRST FBUSR1 ;STRINGS ARE DIFFERENT.
move b,b.stru(c) ;JJW 2/83 Structure must be PS
came b,[ascii/PS/]
jrst fbusr1 ;it isn't.
MOVE A,FBPREV ;IS THERE A PREVIOUS NODE?
TRNN A,-1 ;?
JRST FBUSR4 ;NOPE. THIS IS FIRST NODE ON HSH CHAIN
HRRZ A,A ;ADDRESS OF PREVIOUS
MOVE B,B.HASH(C) ;GET OUR LINK OUT
MOVEM B,B.HASH(A) ;STORE IN LINK OUT OF PREVIOUS
HLRZ A,FBPREV ;GET HASH NUMBER
MOVE B,BHSHTB(A) ;LINK OUT OF HASH TBL
MOVEM B,B.HASH(C) ;STUFF AS THIS NODE'S LINK OUT
MOVEM C,BHSHTB(A) ;STUFF THIS NODE AS FIRST IN HSH CHAIN
FBUSR4: MOVE B,C ;MATCH. RETURN ADDRESS OF BLOCK IN B
SUB P,[1,,1]
RET
FBUSR2: MOVEI A,BINR ;MAKE A NEW RECORD
CALL NEWREC
PUSH P,B ;ADDRESS OF THE NEW RECORD
MOVE A,-1(P)
CALL HSHCMP ;COMPUTE HASH VALUE
MOVE A,(P) ;ADDRESS OF THIS NODE
MOVE C,BHSHTB(B) ;GET LINK OUT OF THE HASH TBL
MOVEM C,B.HASH(A) ;STUFF IT IN THIS NODE
MOVEM A,BHSHTB(B) ;STORE NEW NODE IN TABLE.
MOVE B,RECFF
CHKSTG (B,600000)
HRLI B,440700
MOVEM B,B.DNAM(A)
move c,[ascii/PS/] ;JJW 2/83 Set structure name to PS
movem c,b.stru(a)
MOVE A,-1(P) ;GET THE NAME AGAIN.
CALL COPYST
MOVEI A,0
IDPB A,B
MOVEI B,1(B)
MOVEM B,RECFF
POP P,B ;RETURN THE ADDRESS OF THIS BLOCK
SUB P,[1,,1] ;FLUSH STRING POINTER
RET
SUBTTL FBDISK - FIND USER RECORD FOR A DISK RECORD
;JJW 2/83. Hashing is done only on the directory name, but a separate
;check is made to be sure the structures are correct.
FBDISK: LDB B,[POINT 5,6(D),5] ;length of user name
ADD A,B ;now A points to structure name
MOVE C,(A)
PUSH P,C ;save it
LDB B,[POINT 6,6(D),11] ;length of structure name
ADD A,B ;now A points to directory name
PUSH P,A ;save it
CALL HSHCMP ;compute hash
HRLZM B,FBPREV ;SAVE HASH VALUE & NO PREVIOUS NODE
MOVE C,BHSHTB(B) ;GET THE BASE OF THE HASH TABLE
JRST FBDSK3
FBDSK1: HRRM C,FBPREV ;THIS IS THE PREVIOUS NODE
MOVE C,B.HASH(C) ;ADVANCE TO NEXT ITEM IN HASH TBL
FBDSK3: JUMPE C,FBDSK2 ;IF AT END OF LIST, THIS USER IS NEW
MOVE A,(P) ;GET BACK THE NAME WE SEEK
MOVE B,B.DNAM(C) ;GET NAME FROM THIS BLOCK
CALL STRCMP ;COMPARE STRINGS
JRST FBDSK1 ;STRINGS ARE DIFFERENT.
move b,b.stru(c) ;compare structures
came b,-1(p)
jrst b,fbdsk1 ;structures are different.
MOVE A,FBPREV ;IS THERE A PREVIOUS NODE?
TRNN A,-1 ;?
JRST FBDSK4 ;NOPE. THIS IS FIRST NODE ON HSH CHAIN
HRRZ A,A ;ADDRESS OF PREVIOUS
MOVE B,B.HASH(C) ;GET OUR LINK OUT
MOVEM B,B.HASH(A) ;STORE IN LINK OUT OF PREVIOUS
HLRZ A,FBPREV ;GET HASH NUMBER
MOVE B,BHSHTB(A) ;LINK OUT OF HASH TBL
MOVEM B,B.HASH(C) ;STUFF AS THIS NODE'S LINK OUT
MOVEM C,BHSHTB(A) ;STUFF THIS NODE AS FIRST IN HSH CHAIN
FBDSK4: MOVE B,C ;MATCH. RETURN ADDRESS OF BLOCK IN B
SUB P,[2,,2]
RET
FBDSK2: MOVEI A,BINR ;MAKE A NEW RECORD
CALL NEWREC
PUSH P,B ;ADDRESS OF THE NEW RECORD
MOVE A,-1(P)
CALL HSHCMP ;COMPUTE HASH VALUE
MOVE A,(P) ;ADDRESS OF THIS NODE
MOVE C,BHSHTB(B) ;GET LINK OUT OF THE HASH TBL
MOVEM C,B.HASH(A) ;STUFF IT IN THIS NODE
MOVEM A,BHSHTB(B) ;STORE NEW NODE IN TABLE.
MOVE B,RECFF
CHKSTG (B,600000)
HRLI B,440700
MOVEM B,B.DNAM(A)
move c,-2(p) ;copy structure name
movem c,b.stru(a)
MOVE A,-1(P) ;GET THE NAME AGAIN.
CALL COPYST
MOVEI A,0
IDPB A,B
MOVEI B,1(B)
MOVEM B,RECFF
POP P,B ;RETURN THE ADDRESS OF THIS BLOCK
SUB P,[2,,2] ;FLUSH STRING POINTERs
RET
SUBTTL TTY USAGE STATISTICS
TTYUSE: MOVE A,LDATE ;LAST DATE COVERED
SUB A,FDATE ;DAYS,,FRACTION OF DAYS IN PERIOD
MULI A,^D24*^D60 ;FORM INTEGRAL NUMBER OF MINUTES
DIV A,[1,,0] ;AND TOSS OUT FRACTION OF MINUTES
TRNE B,400000 ;ROUND UP 30 SECONDS TO NEXT MINUTE
ADDI A,A
MOVEM A,DELTA
MOVSI A,(GJ%SHT!GJ%FOU!GJ%NEW)
HRROI B,[ASCIZ/TTY-USAGE-REPORT.OUT/]
GTJFN%
ERJMP [ERRMSG [ASCIZ/Can't GTJFN TTY usage file/]
RET]
MOVE B,[070000,,OF%WR]
OPENF%
ERJMP [ERRMSG [ASCIZ/Can't OPENF TTY usage file/]
RET]
HRROI B,[ASCIZ/TTY usage report
Line Console time % utilized
DET /]
SETZB C,D
SOUT%
MOVE B,LINUSE-1 ;START WITH DETACHED JOBS
CALL TTYOU1
MOVSI D,-200
TTYULP: SKIPE T,LINUSE(D)
CALL TTYOUT
AOBJN D,TTYULP
CLOSF%
ERJMP [ERRMSG [ASCIZ/Can't CLOSF TTY usage file/]
RET]
RET
TTYOUT: HRRZ B,D ;FIRST THE LINE NUMBER
MOVE C,[NO%LFL!<^D3,,^D8>]
NOUT%
HALTF%
MOVEI B,"I"-100 ;TAB
BOUT%
MOVE B,T
TTYOU1: IDIVI B,^D60000 ;MILLISECONDS
CAIL B,^D30000
ADDI B,1 ;ROUND UP 30 SECONDS TO NEXT MINUTE
PUSH P,B
IDIVI B,^D60
PUSH P,C ;MINUTES
MOVE C,[NO%LFL!<^D4,,^D10>]
NOUT% ;OUTPUT HOURS
HALTF%
MOVEI B,":"
BOUT%
MOVE C,[NO%LFL!NO%ZRO!<^D2,,^D10>]
POP P,B ;OUTPUT MINUTES
NOUT%
HALTF%
MOVEI B,"I"-100
BOUT%
BOUT%
POP P,B
MULI B,^D100 ;CONVERT TO PERCENTAGE OF ALL TIME
DIV B,DELTA
MOVE C,[NO%LFL!<^D3,,^D10>]
NOUT%
HALTF%
HRROI B,[ASCIZ/
/]
SETZ C,
SOUT%
RET
SUBTTL END OF PROGRAM AND CLEANUP
XLIST ;OMIT THE LITERALS
LIT
VAR
LIST
PRGFF:: ;FIRST FREE LOCATION AFTER PROGRAM
END START