Trailing-Edge
-
PDP-10 Archives
-
bb-k345a-sb
-
money.mac
There are 6 other files named money.mac in the archive. Click here to see a list.
TITLE MONEY - DEMO FOR SIMPLE FACT FILE BILLING PROGRAM
SUBTTL R CLEMENTS /DJB/RCC/JSL/PFC
;COPYRIGHT (C) 1975,1978,1979 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.
VMONEY==17
VEDIT==23
VMINOR==2
VWHO==0
JOBVER=137
LOC JOBVER
BYTE (3)VWHO(9)VMONEY(6)VMINOR(18)VEDIT
RELOC
;REVISION HISTORY
;7 CONVERT ALL DATES AND TIMES TO INTERNAL FORMAT
;10 RECOGNIZE "ODD" ENTRY TYPES AS NEW FORMAT DATE/TIME
;11 DISALLOW JIFSEC DEPENDENCY IN NEW FORMAT (BASICALLY, ALL
; KILLO-CORE-TICK VALUES BECOME KILLO-CORE-SECONDS*100)
;12 RECOGNIZE LOGIN/ATTACH FAILURE ENTRIES
;13 REMOVE UNUSED CODE AND LABELS
;14 ROUND PRICES
;15 MINIMAL ERROR MESSAGES
;16 REFORMAT SPOOL LISTING SO PRICE LINES UP
;17 PUT CODE IN FOR SPRINT ENTRIES
;20 RECOVER MORE GRACEFULLY FROM BAD ENTRIES
;21 (10-13462)[PFC] CORRECT ACCUMULATOR REFERENCE
;22 M.M MACRO FOR SSD CODE MISSING RIGHT PAREN.
;23 ADD SUPPORT FOR MOUNT ENTRIES
;ACCUMULATOR DEFINITIONS
F=0 ;FOR FLAGS
A=1 ;A THROUGH D ARE GP REGISTERS, E G LOOKUPS.
B=2
C=3
D=4
E=5
X=7 ;INDEX OF CURRENT FACT ENTRY TYPE
BP=10 ;BYTE POINTER
WD=11 ;WORD
M=12 ;FOR MESSAGES
N=13 ;FOR NUMBERS
N1=N+1
R=15 ;RADIX PRINT RADIX
CH=16 ;CHARS
P=17 ;PUSHDOWN STACK
;FLAGS IN LH OF F
FL.HIA==1 ;HIATUS ENTRY HAS BEEN SEEN
FL.SIX==10 ;TEMP FLAG IN SIXBIT PRINTER
FL.EOF==20 ;LAST FACT ENTRY WAS EOF CODE
FL.NDT==40 ;THIS ENTRY IS IN "NEW" FORMAT.
; DATE/TIME WORD (ENTRY+2) IS INTERNAL FORM
; AND JIFSEC DEPENDENCY IS GONE
;DEVICE CHANNELS
MFD==1
DSK==2
LPT==3
;CALLI DEFINITIONS
RESET=0
GETCHR==1
CORE==11
EXIT==12
DATE==14
MSTIME==23
GETTAB==41
DEVPPN==55
;MISC PARAMETERS
MAXENT==^D25 ;MAXIMUM NUMBER OF WORDS IN A FACT ENTRY
MAXJOB==200 ;MAXIMUM JOB NUMBER IN SYSTEM
PDLL==40 ;STACK LENGTH
;SEE ALSO PRICE CONSTANTS AT END OF PROGRAM
SUM.PP==0 ;OFFSET FOR PPN IN SUMMARY TABLE ENTRY
SUM.IO==1 ;OFFSET FOR ON + OFF COUNTS
SUM.RN==2 ;OFFSET FOR RUN TIME
SUM.KS==3 ;OFFSET FOR KILOCORESECONDS
SUM.CN==4 ;OFFSET FOR CONNECT TIME
SUMSIZ==5 ;SIZE OF ENTRY IN SUMMARY TABLE
;GETTAB CONSTITUENTS
%CNSTS==17,,11 ;SYSTEM STATES
%LDSYS==1,,16 ;SYS PPN
ST.LVD==7B9 ;NON-ZERO IN STATES IF LEVEL D DISK SERVICE
;THE FOLLOWING ARE THE DEFINITIONS AND CONVENTIONS
; OF THE FACT ENTRY TYPE CODES AND DATA.
;
;CODES 400-776 ARE RESERVED FOR CUSTOMERS, 1-377 ARE FOR DEC.
;CODE 777 IS THE EOF CODE.
;ENTRY CODES GO IN BITS 0-8 OF WORD 0 OF FACT ENTRY.
;FOR DEC'S ENTRIES, AN EVEN NUMBERED ENTRY HAS OLD FORMAT (12-24)
; DATE AND TIME WORD, AND TIME INFO MAY BE JIFSEC-DEPENDENT.
;FOR AN ODD-NUMBERED ENTRY, THE DATE AND TIME IS NEW (18-18) FORMAT,
; AND JIFSEC-DEPENDENCY IS ILLEGAL. THE CODES OTHERWISE MEAN THE
; SAME AS THE CORRESPONDING EVEN NUMBERED CODE (I.E., CODE-1).
;ARGUMENTS TO THE M.M MACRO ARE:
; 1 - THREE-LETTER ABBREVIATION FOR ENTRY TYPE
; 2 - CODE VALUE (OCTAL)
; 3 - UP TO SIX CHARACTERS, SIXBIT, FOR LISTING LABEL
;WORD 0 OF ALL FACT ENTRIES HAS THE FOLLOWING REQUIRED FORMAT:
; BITS 0-8 ARE THE FACT TYPE CODE
; BITS 9-17 ARE THE JOB NUMBER. THIS SHOULD NEVER BE ZERO. PLUG
; IN THE REPORTING CUSP'S JOB IF NOTHING ELSE IS
; APPROPRIATE, SO BILLING CAN BE INDIRECTED.
; BITS 18-23 ARE THE TTY LINE NUMBER (BINARY). SAME COMMENT
; AS FOR JOB NUMBER. -1 MEANS THE CTY. -2 MEANS DETACHED
;
;WORD 2 IS THE DATE AND TIME WORD. DAEMON WILL FILL THIS IN FOR YOU
; IF YOU MAKE THE ENTRY VIA DAEMON UUO, FACT SUBFUNCTION, AND YOU
; SUPPLY A ZERO IN THIS WORD.
;ORDER IS NOT SIGNIFICANT.
DEFINE M.FE <
;HEADER FOR A CKPNT ENTRY
M.M(CHK,200,CHK)
;HEADER FOR A LOGIN ENTRY
M.M(LGI,100,ON)
;HEADER FOR LOGIN FAILURE
M.M(LGF,120,LGFAIL)
;HEADER FOR A LOGOUT ENTRY
M.M(LGO,140,OFF)
;HEADER FOR SPACE'S DISK STATISTICS
M.M(SPC,160,SPACE)
;HEADER FOR AN ATTACH ENTRY
M.M(ATT,240,ATT)
;HEADER FOR ATTACH FAILURES
M.M(ATF,260,ATFAIL)
;HEADER FOR SPOOLER STATISTICS
M.M(SPL,250,SPOOL)
;HEADER FOR SPRINT STATISTICS
M.M(INP,230,SPRINT)
;HEADER FOR MOUNT STATISTICS ;[23]
M.M(MNT,270,MOUNT)
;HEADER FOR SYSTEM RESTART
M.M(SRS,370,RESTRT)
;HEADER FOR SCHEDULED SHUTDOWN
M.M(SSD,372,SHUTDN)
;HEADER FOR HIATUS IN FACT FILE
M.M(HIA,377,HIATUS)
;END OF FACT-FILE CODE
M.M(EOF,777,ENDFIL)
>
DEFINE M.M(A,B,C)<
FE.'A=B
>
M.FE
;ASSIGN THE FE. VALUES
SUBTTL INITIALIZATION
;STARTS HERE
MONEY: CALLI RESET
MOVE P,PDP
MOVEI F,0
INIT MFD,14
SIXBIT /DSK/
XWD 0,MFDB
JRST MNYCID ;CAN'T INIT DSK
INIT DSK,14
SIXBIT /DSK/
XWD 0,DSKB
JRST MNYCID ;CAN'T INIT DSK
INIT LPT,0
SIXBIT /LPT/
XWD LPTB,0
JRST MNYCIL ;CAN'T INIT LPT
MOVE B,[%LDSYS]
CALLI B,GETTAB ;GET SYS PPN
SKIPA A,[%CNSTS] ;NOT IMPLEMENTED, SEE IF LEVEL C
JRST SYSDEF ;B=DEFAULT SYS PPN
CALLI A,GETTAB ;GET STATES WORD
SETZ A, ;CANT, MAKE LOOK LIKE LEVEL C (CANT BE D)
MOVE B,[XWD 1,4] ;LEVEL D DEFAULT SYS PPN
TLNN A,(ST.LVD) ;SKIP IF LEVEL D
MOVE B,[XWD 1,1] ;NO, ASSUME LEVEL C DEFAULT SYS PPN
SYSDEF: MOVSI A,(SIXBIT .SYS.)
CALLI A,DEVPPN ;GET PPN FOR SYS
MOVE A,B ;NOT IMPLEMENTED, USE DEFAULT
MOVEM A,SYSPP
INBUF MFD,1
INBUF DSK,1
OUTBUF LPT,2
HRRZ A,.JBFF##
MOVEI A,1(A) ;WORD FOR SAFETY
MOVEM A,SUMBAS
MOVEM A,SUMTOP ;SUMMARY TABLE IS EMPTY
SETOM @SUMBAS ;FIRST ENTRY IN IT IS END
SETZM TABBLK
MOVE A,[XWD TABBLK,TABBLK+1]
BLT A,BLTEND
MOVE A,[SIXBIT /MONEY/]
MOVSI B,(SIXBIT /TXT/)
SETZB C,D
ENTER LPT,A
JRST MNYCEL ;CAN'T ENTER ON LPT
MOVE A,[XWD 17,11]
CALLI A,GETTAB
MOVEI A,0 ;ERROR RETURN
MOVEI B,^D60
TLNE A,4000
MOVEI B,^D50
MOVEM B,JIFSEC
IMULI B,^D24*^D60*^D60 ;JIFFIES PER DAY
MOVEM B,JIFDAY
MOVEI M,[ASCIZ /
ACCOUNTING SUMMARY AT /]
PUSHJ P,MSG ;HEADER FOR THE OUTPUT
CALLI A,MSTIME
PUSHJ P,MSTOUT
MOVEI M,[ASCIZ / ON /] ;DATE AND TIME
PUSHJ P,MSG
CALLI A,DATE
PUSHJ P,DATOUT
PUSHJ P,CRLF2
MOVSI B,(SIXBIT /SYS/) ;FIRST DUMP ACCT.SYS
MOVEM B,EXTEN
PUSHJ P,DUMP
MOVE A,SYSPP
MOVSI B,(SIXBIT /UFD/) ;NOW GET ANY OTHER FACT.XXX
MOVEI C,0
MOVE D,MFDPPN ;LOOK IN MFD
LOOKUP MFD,A
JRST MNYCLS ;CAN'T LOOKUP SYS UFD
ML1: PUSHJ P,RDM
JFCL
MOVE A,WD
PUSHJ P,RDM
JRST TOTALS ;END OF MFD. GO DO TOTALS
MOVE B,WD
CAME A,[SIXBIT /FACT/]
JRST ML1
HLLZM B,EXTEN
HLRZS B
CAIN B,(SIXBIT /SYS/)
JRST ML1
PUSHJ P,FFOUT
PUSHJ P,DUMP ;FOUND ONE. GO DUMP IT
JRST ML1 ;SEARCH FOR MORE
SUBTTL SUBROUTINE TO DUMP ONE FACT FILE
DUMP: MOVEI M,[ASCIZ /
FILE FACT./]
PUSHJ P,MSG ;HEADING FOR A FACT FILE
MOVE WD,EXTEN
PUSHJ P,SIXBP
PUSHJ P,CLRON ;CLEAR ALL ONTIMES
MOVE A,[SIXBIT /FACT/] ;LOOKUP THE FILE
HLLZ B,EXTEN
MOVEI C,0
MOVE D,SYSPP
LOOKUP DSK,A
JRST DUMPX1
MOVEI M,[ASCIZ / CREATED /] ;OUTPUT ITS CREATION TIME
PUSHJ P,MSG
PUSH P,C
LSH B,^D15 ;HIGH ORDER DATE BITS TO B 33,4,5
DPB B,[POINT 3,0(P),23] ;SAVE FOR DATE PRINTING
LDB A,[POINT 11,C,23]
PUSHJ P,MINOUT
PUSHJ P,TAB
POP P,A
ANDI A,77777 ;15-BIT DATE
PUSHJ P,DATOUT ;PRINT IT
PUSHJ P,CRLF2
MOVEI M,HEDMSG ;HEADER FOR TRANSACTIONS
PUSHJ P,MSG
NXTENT: SETZM ENTRY ;CLEAR DATA TABLE FOR THE ENTRY
MOVE A,[XWD ENTRY,ENTRY+1]
BLT A,ENTRY+MAXENT-1
PUSHJ P,DSKRD ;READ HEADER OF ENTRY
MOVEM WD,ENTRY
LDB A,[POINT 9,ENTRY,8]
TRNE A,1 ;NEW-TYPE ENTRY??
TLOA F,FL.NDT ;YES, SET FLAG
TLZ F,FL.NDT ;NO, ENSURE FLAG CLEAR
MOVSI B,-FETABL ;SEARCH FOR THIS TYPE CODE
DMP5L: HLRZ C,FETAB(B) ;GET A CODE
CAIN A,(C) ;MATCH?
JRST DMP5F ;YES
IORI C,1 ;TRY NEW TYPE
CAIN A,(C) ;NOW MATCH?
JRST DMP5F ;YES
AOBJN B,DMP5L ;NO. LOOP THRU TABLE
JRST BADENT ;NO SUCH CODE KNOWN
SUBTTL PER-ENTRY PROCESSING
DMP5F: HRRZ X,FETAB(B) ;GET THE INDEX
ANDI WD,77
JUMPE WD,EOFQ
CAIL WD,MAXENT
JRST BADEND
MOVNS WD
HRLZ A,WD
JRST DUMP03
DUMP02: PUSHJ P,DSKRD ;READ DATA FOR THIS ENTRY
MOVEM WD,ENTRY(A)
DUMP03: AOBJN A,DUMP02
MOVE WD,FESIX(X) ;AND THE PRINT STRING
PUSHJ P,SIXBT
LDB N,[POINT 9,ENTRY,17] ;JOB
PUSHJ P,DECPRT
PUSHJ P,TAB
MOVSI WD,(SIXBIT .TTY.)
HRLZ N,ENTRY ;GET LINE NUMBER
ASH N,-^D24 ;EXTEND SIGN BIT OF LINE NUMBER
JUMPGE N,DMP5B ;JUMP IF TTY LINE
MOVSI WD,(SIXBIT .DET.)
TRNE N,1 ;-2=DETACHED, -1=CTY
MOVSI WD,(SIXBIT .CTY.) ;-1=CTY
DMP5B: PUSHJ P,SIXBP
JUMPL N,DMP5C
CAIGE N,2000 ;SKIP IF SIXBIT
JRST DMP5D
LSH N,6 ;LEFT JUSTIFY
HRLZ WD,N
PUSHJ P,SIXBP
JRST DMP5C
DMP5D: PUSHJ P,OCTPRT ;PRINT TTY IF BINARY TTY LINE
DMP5C: PUSHJ P,TAB
HLRZ N,ENTRY+1 ;PROJ
PUSHJ P,OCTPRT
PUSHJ P,TAB
HRRZ N,ENTRY+1 ;PROG
PUSHJ P,OCTPRT
PUSHJ P,TAB
;LIST DATE, TIME, ETC.
MOVE B,ENTRY+2 ;PICK UP DATE/TIME WORD
TLNN F,FL.NDT ;NEW FORMAT?
PUSHJ P,CDATIM ;NO, CONVERT IT
PUSH P,B ;SAVE INTERNAL FORMAT
HLRZ A,B ;GET DATE IN A RIGHT HALF
PUSHJ P,PRDATE ;PRINT IT
PUSHJ P,SPACE
POP P,A
HRRZS A
PUSHJ P,HRMNSC ;PRINT TIME
CAIN X,X.FUT ;IS IT A PATCH-IN ENTRY?
JRST DMPFUT ;YES, GO DUMP IT
CAIN X,X.INP ;IS IT AN INPUT REQUEST
MOVEI X,X.SPL ;YES, TREAT LIKE SPOOLER FROM NOW ON
CAIN X,X.MNT ;[23] IS IT MOUNT RECORD?
JRST DMP6B ;[23] YES, SKIP NEXT TWO TESTS
CAIE X,X.LGF ;LOGIN FAILURE?
CAIN X,X.ATF ;OR ATTACH FAIL?
JRST EOLX ;YES, LIST NO MORE
CAIE X,X.CHK
CAIN X,X.SPL
SKIPA
JRST [
PUSHJ P,TAB
PUSHJ P,SPACE
JRST DMP6A]
DMP6B: PUSHJ P,SPACE
CAIE X,X.MNT ;[23] IF MOUNT, TREAT ALMOST LIKE SPOOL
CAIN X,X.SPL
SKIPA WD,ENTRY+10 ;PHYSICAL DEVICE SPOOLED
MOVE WD,ENTRY+7 ;PROGRAM RUNNING WHEN CHKPNT
PUSHJ P,SIXALL
DMP6A: PUSHJ P,SPACE
CAIE X,X.MNT ;[23] IF MOUNT, TREAT ALMOST LIKE SPOOL
CAIN X,X.SPL
JRST LSTSPL ;FROM HERE ON, SPOOLER IS A LOT DIFFERENT
;HERE COLLECT PER-JOB DATA
LDB A,[POINT 6,ENTRY,35] ;ENTRY SIZE
CAIG A,3
JRST DUMP07 ;LOGIN, MAY BE
MOVE A,ENTRY+3
IDIVI A,^D1000
CAIL B,^D500 ;ROUND
ADDI A,1
LDB B,[POINT 9,ENTRY,17] ;GET JOB NUMBER
MOVEM A,CJBRNT(B) ;SAVE AS RUN TIME IN CASE CHECKPOINT.
PUSHJ P,RNTOUT ;RUNTIME
PUSHJ P,TAB
MOVE N,ENTRY+4 ;KCT
PUSHJ P,GETKCS ;CONVERT TO KCS
LDB B,[POINT 9,ENTRY,17] ;JOB NUMBER
MOVEM N,CJBKCS(B) ;SAVE FOR CHECKPOINT
PUSHJ P,DECPRT
PUSHJ P,TAB
LDB A,[POINT 6,ENTRY,35] ;GET SIZE OF ENTRY AGAIN
CAIG A,5 ;IF GT 5, HAVE DISK BLOCKS READ AND WRITTEN
JRST EOLA ;NO, FORGET IT
MOVE N,ENTRY+5 ;DISK BLOCKS READ
MOVEM N,CJBRCT(B) ;SAVE IN CASE CHKPNT [21]
PUSHJ P,DECPRT
PUSHJ P,TAB
MOVE N,ENTRY+6 ;DISK BLOCKS WRITTEN
MOVEM N,CJBWCT(B) ;SAVE IN CASE CHKPNT
PUSHJ P,DECPRT
CAIA
EOLA: PUSHJ P,TAB
;HERE TO DO PER-USER ACCOUNTING
EOL: MOVE A,ENTRY+1
LDB B,[POINT 9,ENTRY,17]
MOVEM A,CJBPPN(B) ;SAVE USER PPN
JUMPLE A,NOTOTL ;MAKE SURE POSITIVE
PUSHJ P,SUMFND ;GET TABLE ADDRESS FOR THIS GUY
MOVSI C,1
CAIN X,X.LGI ;LOGIN?
ADDM C,SUM.IO(A) ;YES, COUNT LOGINS IN LEFT HALF
CAIN X,X.CHK ;CHECKPOINT?
JRST CKLST ;YES.
CAIE X,X.LGO ;LOGOUT?
JRST NOTOTL ;NO, DO NOT TOTAL JOB
AOS SUM.IO(A)
MOVE B,ENTRY+3
IDIVI B,^D1000
CAIL C,^D500
ADDI B,1
ADDM B,SUM.RN(A)
MOVE N,ENTRY+4 ;PICK UP KCT
PUSHJ P,GETKCS
ADDM N,SUM.KS(A) ;TOTAL FOR USER
CKLST: PUSHJ P,TAB
LDB N,[POINT 9,ENTRY,17] ;JOB
CAIL N,MAXJOB
JRST EOLX
MOVEI B,0
CAIN X,X.CHK ;IF CHKPOINT, DONT CLEAR JOB ON TIME
MOVE B,JOBON(N) ;LEAVE IT AS IS.
EXCH B,JOBON(N)
JUMPE B,ONZERO
PUSH P,B ;SAVE DATE AND TIME ON
MOVE B,ENTRY+2 ;PICK UP DATE/TIME
TLNN F,FL.NDT ;NEW FORMAT?
PUSHJ P,CDATIM ;CONVERT TO INTERNAL
SUBB B,0(P) ;GET CONNECT TIME
CAIN X,X.CHK ;CHKPNT?
JRST .+3 ;YES, TOTAL LATER
ADDM B,SUM.CN(A) ;NO, TOTAL FOR USER
MOVEI B,0 ;AND CLEAR JOB CONNECT
MOVEM B,CJBCON(N) ; IF CHKPNT, SAVE
MOVE A,0(P) ;GET CONNECT AGAIN
PUSHJ P,HRMNSC ;PRINT HOURS, MINS, SECS
PUSHJ P,TAB
MOVE A,ENTRY+3
IDIVI A,^D1000
CAIL B,^D500 ;ROUND
ADDI A,1
IMUL A,RUNPRC
MOVE N,ENTRY+4
PUSHJ P,GETKCS
IMUL N,KCSPRC
ADD A,N
POP P,B ;RETRIEVE ONTIME
IMULI B,^D24 ;HOURS IN LH, FRACTION IN RH
MUL B,CONPRC ;CENTS IN B AND C LH
ASHC B,^D17 ;CENTS NOW IN B
TLNE C,(1B1) ;ROUND IF GT 1/2 CENT
ADDI B,1
ADD A,B
PUSHJ P,BUXPNT
NOTOTL:
EOLX: PUSHJ P,CRLF
JRST NXTENT
LSTSPL: MOVE A,ENTRY+4
IDIVI A,^D1000
CAIL B,^D500
ADDI A,1
PUSHJ P,RNTOUT ;TYPE RUN TIME OF SPOOLER
PUSHJ P,TAB
MOVE N,ENTRY+5
PUSHJ P,GETKCS
PUSHJ P,DECPRT ;KILO-CORE-SECS
PUSHJ P,TAB
MOVE N,ENTRY+6
PUSHJ P,DECPRT ;DISK READS
PUSHJ P,TAB
MOVE N,ENTRY+7
PUSHJ P,DECPRT ;DISK WRITES
PUSHJ P,TAB
LDB WD,[POINT 12,ENTRY+3,11]
MOVEM WD,SPLCOD ;SAVE SPOOLER QUEUE CODE
ROT WD,-14
PUSHJ P,SIXBP
PUSHJ P,SPACE
MOVSI WD,(SIXBIT /#/)
PUSHJ P,SIXBP
MOVE N,ENTRY+11 ;SEQ NO
PUSHJ P,DECPRT
PUSHJ P,SPAC2
CAIE X,X.MNT ;[23] IS THIS A MOUNT ENTRY
JRST SPL2 ;NO, JUMP
HLRZ N,ENTRY+12 ;[23] GET SUCCESS/FAILURE FLAG
PUSHJ P,DECPRT
PUSHJ P,SPAC2
HRRZ N,ENTRY+12 ;[23] GET ELAPSED TIME
JRST SPL3
SPL2: LDB N,[POINT 27,ENTRY+12,35] ;GET SPOOLER UNITS
SPL3: PUSHJ P,DECPRT
MOVE A,SPLCOD ;GET SPOOLER Q CODE
MOVSI B,-SPLLEN ;SEARCH TABLE FOR IT
HRRZ WD,SPLTAB(B) ;CODE FROM TABLE
CAMN WD,A
JRST SPL1 ;FOUND
AOBJN B,.-3 ;SEARCH TABLE
JRST EOLX ;CAN'T FIND, NO CHARGE
SPL1: HLRZ A,SPLTAB(B) ;GET A PRICE IN TENTHS OF A CENT
IMUL A,ENTRY+12 ;TIMES NUMBER OF UNITS HE USED
IDIVI A,^D10 ;TO CENTS
CAIL B,5 ;ROUND
ADDI A,1 ; ..
PUSHJ P,TAB ;TAB OVER
PUSHJ P,BUXPNT ;LIST THE PRICE
JRST EOLX ;DONE WITH SPOOLER ENTRY
;HERE TO DUMP AN UNKNOWN PATCHED-IN ENTRY TYPE
DMPFUT: MOVEI A,MAXENT-1 ;POINT TO LAST POSSIBLE ENTRY
DMPFT1: SKIPE ENTRY(A) ;IS LOCATION A ZERO?
SKIPA ;NO, WE'VE FOUND LAST NON-0 WORD
SOJG A,DMPFT1 ;YES, KEEP LOOPING
JUMPE A,EOLX ;ALL WORDS ARE ZERO?
MOVEI D,2 ;START AT FIRST WORD AFTER HEADER
DMPFT2: PUSHJ P,SPACE ;PRINT A SPACE
MOVE N,ENTRY(D) ;LOAD THE WORD
PUSHJ P,OCTPRT ;DUMP IT IN OCTAL
CAMGE D,A ;HIT LAST NON-ZERO WORD?
AOJA D,DMPFT2 ;NO, KEEP LOOPING
JRST EOLX ;AND FINISH OFF
SUBTTL SUBROUTINES
;SUBROUTINE TO CONVERT STANDARD SYSTEM DATE TO INTERNAL FORMAT=DAYS SINCE NOV 17,1858
;THIS IS CONTINUOUS INCREASING BY DATE; SYSTEM DATE IS DISCONTINUOUS AT END OF MONTHS
;ARGS B=DATE IN SYSTEM FORMAT
;VALUES B=DATE IN INTERNAL FORMAT
;SAVES A, USES B,C,D,E
RADIX 10
DATOFS==38395 ;DATE OFFSET FOR JAN 1, 1964=DAYS SINCE NOV 17, 1858
INTDAT: PUSH P,A ;SAVE A
IDIVI B,12*31 ;B=YEARS-1964
IDIVI C,31 ;C=MONTHS-JAN, D=DAYS-1
ADD D,DAYTAB(C) ;D=DAYS-JAN 1
MOVEI E,0 ;LEAP YEAR ADDITIVE IF JAN, FEB
CAIL C,2 ;CHECK MONTH
MOVEI E,1 ;ADDITIVE IF MAR-DEC
MOVE A,B ;SAVE YEARS FOR REUSE
ADDI B,3 ;MAKE LEAP YEARS COME OUT RIGHT
IDIVI B,4 ;HANDLE REQULAR LEAP YEARS
CAIE C,3 ;SEE IF THIS IS LEAP YEAR
MOVEI E,0 ;NO--WIPE OUT ADDITIVE
ADDI D,DATOFS(B) ;D=DAYS BEFORE JAN 1,1964 +SINCE JAN 1
; +ALLOWANCE FOR ALL LEAP YEARS SINCE 64
MOVE B,A ;RESTORE YEARS SINCE 1964
IMULI B,365 ;DAYS SINCE 1964
ADD D,B ;D=DAYS EXCEPT FOR 100 YR. FUDGE
HRREI B,64-99(A) ;B=YEARS SINCE 2000
JUMPLE B,INTDT1 ;ALL DONE IF NOT YET 2000
IDIVI B,100 ;GET CENTURIES SINCE 2000
SUB D,B ;ALLOW FOR LOST LEAP YEARS
CAIE C,99 ;SEE IF THIS IS A LOST L.Y.
INTDT1: ADD D,E ;ALLOW FOR LEAP YEAR THIS YEAR
;HERE WITH D CONTAINING CORRECT NUMBER OF DAYS
MOVE B,D ;RETURN IN B
POP P,A ;RESTORE A
POPJ P, ;RETURN
DAYTAB: EXP 0,31,59,90,120,151,181,212,243,273,304,334,365
;*** UNDER RADIX 10 STILL ***
;GETDAT -- SUBROUTINE TO CONVERT FROM INTERNAL DATE/TIME FORMAT
;CALL: MOVE A,DATE
; PUSHJ P,GETDAT
;RETURN: YEAR IN A, MONTH IN B(JAN=0), DAY OF MONTH IN D(1ST=0)
GETDAT: ADDI A,365*400+24*4-<2001-1859>*365-<2001-1859>/4-31-30+17 ;MAKE INTO DAYS SINCE JAN 1, 1601
IDIVI A,365*400+24*4+1 ;SEPARATE UNITS OF 400
LSH A,2 ;MULT ANSWER BY 4
IDIVI B,365*100+24 ;SEPARATE CENTURIES
CAIN B,4 ;SEE IF LAST ONE
SOSA B ;YES--BACK OFF
JRST .+2 ;CONTINUE SKIP
MOVEI C,365*100+24 ;SET TO FULL (LEAP) CENTURY
ADD A,B ;INCLUDE CENTURIES IN RESULT
IMULI A,25 ;MULT ANSWER BY 25
IDIVI C,365*4+1 ;SEPARATE UNITS OF 4
ADD A,C ;INCLUDE IN ANSWER
LSH A,2 ;MULT ANSWER BY 4
MOVE C,D ;PROMOTE AC
IDIVI C,365 ;SEPARATE YEARS
CAIN C,4 ;SEE IF END OF LEAP YEAR
SOSA C ;YES--BACK OFF YEAR
JRST .+2 ;CONTINUE SKIP
MOVEI D,365 ;SET FOR END OF YEAR
ADDI A,1601(C) ;GET REAL YEAR
;A HAS YEAR, D HAS DAY IN YEAR
MOVE B,A ;COPY YEAR TO SEE IF LEAP YEAR
IDIVI B,400 ;SEE IF MULT OF 400
JUMPE C,GETDA1 ;YES--PROCEED
MOVE B,A ;GET NEW COPY
IDIVI B,100 ;SEE IF MULT OF 100
JUMPE C,GETDA2 ;YES, NOT L.Y.
TRNE A,3 ;SEE IF YEAR A MULT OF 4
JRST GETDA2 ;NO, THIS IS NOT A LEAP YEAR
GETDA1: CAIL D,31+29 ;LEAP YEAR--SEE IF BEYOND FEB 29
SOS D ;YES--BACK OFF ONE DAY
GETDA2: MOVSI B,-11 ;LOOP FOR 11 MONTHS
GETDA3: CAML D,DAYTAB+1(B) ;SEE IF BEYOND THIS MONTH
AOBJN B,GETDA3 ;LOOP THROUGH NOVEMBER
SUB D,DAYTAB(B) ;GET DAYS IN THIS MONTH
HRRZS B ;GET MONTH ALONE
POPJ P,
RADIX 8 ;BACK TO REGULAR NUMBERS
MNYCID: JSP M,BOMB ;DIE IF CAN'T INIT DISK
ASCIZ /?MNYCID CAN'T INIT DSK
/
MNYCIL: JSP M,BOMB ;CAN'T INIT LPT
ASCIZ /?MNYCIL CAN'T INIT LPT
/
MNYCEL: JSP M,BOMB
ASCIZ /?MNYCEL CAN'T ENTER LPT:MONEY.TXT
/
MNYCLS: JSP M,BOMB
ASCIZ /?MNYCLS CAN'T LOOKUP SYS UFD
/
BOMB: OUTSTR (M)
CALLI EXIT
DUMPX1: JSP M,MSG ;POPJ FROM DUMP
ASCIZ /
LOOKUP FAILURE
/
BADENT:
BADEND:
EOFQ: MOVE N,ENTRY
CAMN N,[XWD 777000,0]
JRST ENDDMP
JUMPE N,NXTENT
MOVEI M,[ASCIZ /
BAD FACT WORD: /]
PUSHJ P,MSG
PUSHJ P,OCTPRT
PUSHJ P,CRLF
ANDI WD,77 ;AND DOWN TO ENTRY SIZE
CAIL WD,MAXENT ;LESS THAN MAXENT
JRST NXTENT ;NO, IT MUST BE GARBAGE
;ELSE ASSUME ITS REALLY AN ENTRY
MOVEI B,FETABL ;POINT TO "FUTURE" ENTRY
JRST DMP5F ;AND GO PROCESS
ENDDMP: PUSHJ P,TOTCHK ;BILL FOR PARTIALS
TLZ F,FL.HIA ;NO HIATUS ANY MORE.
POPJ P,0 ;EXIT FROM DUMP
DUMP07: LDB N,[POINT 9,ENTRY,17] ;JOB NUMBER
CAIN X,X.LGI ;REALLY A LOGIN?
CAIL N,MAXJOB
JRST EOL
MOVE B,ENTRY+2
TLNN F,FL.NDT
PUSHJ P,CDATIM
EXCH B,JOBON(N)
JUMPE B,EOL
MOVEI M,[ASCIZ /***REENTRY OF JOB***/]
PUSHJ P,MSG
JRST EOL
ONZERO: MOVEI M,[ASCIZ /NO ON TIME/]
PUSHJ P,MSG
CAIE X,X.CHK ;IS THIS A CHECKPOINT?
JRST EOLX
MOVE B,ENTRY+2 ;GET TIME OF THIS ENTRY
TLNN F,FL.NDT
PUSHJ P,CDATIM
MOVEM B,JOBON(N)
JRST EOLX
CLRON: MOVE M,[XWD JOBON,JOBON+1]
SETZM JOBON
BLT M,CLREND ;CLEAR JOB INDEXED TABLES
POPJ P,0
CDATIM: PUSH P,B ;SAVE 12/24 DATE/TIME
LDB B,[POINT 12,B,11] ;GET DATE
PUSHJ P,INTDAT ;CONVERT TO INTERNAL
HRLZS B ;MOVE TO LEFT HALF
MOVEI C,0
POP P,D ;RECOVER TIME
LSH D,^D11 ;DISCARD DATE
ASHC C,^D7 ;MILLISECONDS*2^18
DIV C,JIFDAY ;COMPUTE FRACTION OF DAY
HRR B,C ;COMBINE DAYS WITH FRACTION
POPJ P,
GETKCS: TLNE F,FL.NDT
JRST GTKCSN ;NEW FORM, USE 100 JIFFIES/SEC
IDIV N,JIFSEC ;OLD FORM
LSH N1,1 ;REMAIN*2
CAML N1,JIFSEC ;ROUND
ADDI N,1
POPJ P,
GTKCSN: IDIVI N,^D100
CAIL N1,^D50
ADDI N,1
POPJ P,
PRDATE: PUSHJ P,GETDAT ;CONVERT DAYS TO YR, MON, DAY
MOVEI N,1(D) ;GET DAY OF MONTH
PUSHJ P,DECPR2 ;PRINT 2 DIGITS
MOVE B,MONTAB(B) ;ASCII MONTH
MOVEI C,0
MOVEI M,B ;POINT TO MONTH
PUSHJ P,MSG ;PRINT IT
MOVEI N,-^D1900(A) ;YEAR IN 2 DIGITS
JRST DECPR2 ;PRINT IT
TOTCHK: MOVSI B,-MAXJOB ;COUNT THROUGH JOBS
TOTLUP: SKIPG A,CJBPPN(B) ;IS THERE A USER FOR THIS JOB?
JRST TOTNXT ;NO.
PUSHJ P,SUMFND ;GET ADDRESS FOR THIS
SKIPN CJBCON(B) ;IS THERE A CKPOINT ENTRY?
JRST TOTNXT ;NO.
MOVE C,CJBKCS(B) ;GET KCS AT CHKPOINT.
ADDM C,SUM.KS(A) ;BILL HIM
SETZM CJBKCS(B)
MOVE C,CJBCON(B) ;GET CONNECT TIME
ADDM C,SUM.CN(A) ;AND BILL IT.
SETZM CJBCON(B)
MOVE C,CJBRNT(B) ;NOW RUN TIME.
ADDM C,SUM.RN(A) ;BILL THAT TOO
TOTNXT: AOBJN B,TOTLUP ;MORE?
POPJ P,0
SUBTTL SUMMARY REPORT
TOTALS: PUSHJ P,FFOUT
SETZM BUXTOT ;PREPARE FOR TOTAL MONEY
MOVEI M,HED2
PUSHJ P,MSG
HRRZ D,SUMBAS ;BASE OF ACCTG SUMMARY
TOTAL1: SKIPG A,0(D)
JRST TOTAL2 ;END OF TABLE
HLRZ N,SUM.PP(D) ;GET PROJ NUMBER
PUSHJ P,OCTPRT
PUSHJ P,TAB
HRRZ N,SUM.PP(D)
PUSHJ P,OCTPRT
PUSHJ P,TAB
HLRZ N,SUM.IO(D)
PUSHJ P,DECPRT
PUSHJ P,TAB
HRRZ N,SUM.IO(D)
PUSHJ P,DECPRT
PUSHJ P,TAB
MOVE A,SUM.RN(D)
PUSHJ P,RNTOUT
PUSHJ P,TAB
MOVE A,SUM.CN(D)
PUSHJ P,HRMNSC ;PRINT TIME
PUSHJ P,TAB
MOVE N,SUM.KS(D)
PUSHJ P,DECPRT
MOVE N,SUM.KS(D)
CAMG N,[EXP ^D9999999]
PUSHJ P,TAB
PUSHJ P,TAB
MOVE A,SUM.KS(D)
IMUL A,KCSPRC
MOVE B,SUM.CN(D)
IMULI B,^D24 ;HOURS IN LH, FRAC IN RH
MUL B,CONPRC ;CENTS IN B AND C LH
ASHC B,^D17 ;SHIFT CENTS OUT OF C
TLNE C,(1B1) ;ROUND
ADDI B,1
ADD A,B
MOVE B,SUM.RN(D)
IMUL B,RUNPRC
ADD A,B
ADDM A,BUXTOT ;COUNT THE MONEY
PUSHJ P,BUXPNT
PUSHJ P,CRLF
ADDI D,SUMSIZ
JRST TOTAL1
;HERE AT END
TOTAL2: PUSHJ P,CRLF
MOVEI M,[ASCIZ /TOTAL PRICES /]
PUSHJ P,MSG
MOVE A,BUXTOT ;GET MONEY
PUSHJ P,BUXPNT ;TYPE IT
PUSHJ P,CRLF
CALLI EXIT
RDM: SOSLE MFDB+2
JRST MFDOK
INPUT MFD,0
STATZ MFD,760000
POPJ P,0
MFDOK: ILDB WD,MFDB+1
CPOPJ1: AOS 0(P)
CPOPJ: POPJ P,0
DSKRD: SOSLE DSKB+2
JRST DSKOK
INPUT DSK,0
STATZ DSK,760000
JRST EOFEND
DSKOK: ILDB WD,DSKB+1
POPJ P,0
EOFEND: MOVEI M,[ASCIZ /
BAD END (EOF)
/]
PUSHJ P,MSG
POP P,(P) ;RETURN FROM DSKRD
POPJ P,0 ;RETURN FROM DUMP
MINOUT: IDIVI A,^D60
MOVE N,A
PUSHJ P,DECPR2
MOVEI CH,":"
PUSHJ P,OUCH
MOVE N,B
JRST DECPR2
SUMFND: PUSH P,D ;SAVE SOME ACS
PUSH P,C
PUSH P,B
SUMFN1: MOVEI B,SUMSIZ ;SPACE NEEDED
ADD B,SUMTOP
CAMG B,.JBREL##
JRST SUMFN2
CALLI B,CORE
JRST CORLOS ;NOT THERE
JRST SUMFN1 ;GOT IT. TRY AGAIN
SUMFN2: MOVE B,SUMBAS ;START OF DATA
SUMFN5: SKIPG 0(B) ;TEST ENTRY
JRST SUMFN3 ;END OF TABLE
CAMN A,0(B) ;SAME AS REQUESTED PPN?
JRST SUMFN4 ;YES
CAMG A,0(B) ;NO. PASSED IT?
JRST SUMFN3 ;YES. NEED TO MOVE UP STUFF
ADDI B,SUMSIZ ;ON TO NEXT ENTRY
JRST SUMFN5
SUMFN3: MOVE C,SUMTOP
SUMFN6: MOVE D,0(C)
MOVEM D,SUMSIZ(C) ;MOVE STUFF UP
CAMLE C,B
SOJA C,SUMFN6 ;MORE TO GO
MOVEI C,SUMSIZ ;INCREASE SIZE OF TABLE
ADDM C,SUMTOP
SETZM 0(B) ;CLEAR OUT THE NEW ENTRY
HRLI C,0(B)
HRRI C,1(B)
BLT C,SUMSIZ-1(B)
MOVEM A,SUM.PP(B) ;STORE THE PPN
SUMFN4: MOVE A,B ;ADDRESS OF DATA
POP P,B
POP P,C
POP P,D
POPJ P,0
RNTOUT: IMULI A,^D1000
MSTOUT: SKIPGE A
MOVEI A,0 ;PROTECT AGAINST NEGATIVE VALUES
IDIV A,[EXP ^D60000*^D60]
MOVE N,A
PUSHJ P,DECPR2
PUSHJ P,COLON
MOVE A,B
IDIVI A,^D60000
MOVE N,A
PUSHJ P,DECPR2
PUSHJ P,COLON
MOVE N,B
IDIVI N,^D1000
JRST DECPR2
DECPR6: CAIG N,^D99999
PUSHJ P,SPACE
DECPR5: CAIG N,^D9999
PUSHJ P,SPACE
DECPR4: CAIG N,^D999
PUSHJ P,SPACE
DECPR3: CAIG N,^D99
PUSHJ P,SPACE
DECPR2: CAIG N,11
PUSHJ P,ZEROUT
DECPRT: SKIPA R,[12]
OCTPRT: MOVEI R,10
MOVEI CH,"-"
SKIPGE N
PUSHJ P,OUCH
MOVMS N
RDXPRT: IDIVI N,(R)
HRLM N1,0(P)
SKIPE N
PUSHJ P,RDXPRT
HLRZ CH,0(P)
ADDI CH,"0"
OUCH: SOSG LPTB+2
OUTPUT LPT,0
IDPB CH,LPTB+1
POPJ P,0
MSG: HRLI M,440700
MSG1: ILDB CH,M
JUMPE CH,CPOPJ
PUSHJ P,OUCH
JRST MSG1
CORLOS: MOVEI M,[ASCIZ /
?NOT ENOUGH CORE/]
PUSHJ P,MSG
CALLI EXIT
CRLF2: PUSHJ P,CRLF
CRLF: JSP M,MSG
ASCIZ /
/
FFOUT: MOVEI CH,14
JRST OUCH
ZEROUT: MOVEI CH,"0"
JRST OUCH
TAB: MOVEI CH,11
JRST OUCH
DLRSGN: MOVEI CH,44
JRST OUCH
DOT: MOVEI CH,"."
JRST OUCH
SPAC2: PUSHJ P,SPACE
SPACE: MOVEI CH,40
JRST OUCH
COLON: MOVEI CH,":"
JRST OUCH
HRMNSC: IMULI A,^D24 ;GET HOURS AND FRACTION
;FROM DAYS AND FRACTION
ADDI A,<1B18/<^D60*^D60>> ;ROUND FRACTION UP 1/2 SEC
HLRZ N,A ;SEPARATE HOURS
PUSHJ P,DECPR2
PUSHJ P,COLON
HRRZS A ;DROP HOURS
IMULI A,^D60 ;GET MINUTES FROM FRAC OF HR
HLRZ N,A ;SEPARATE MINUTES
PUSHJ P,DECPR2
PUSHJ P,COLON
HRRZS A
IMULI A,^D60 ;FINALLY GET SECONDS FROM FRAC OF MIN
HLRZ N,A
JRST DECPR2 ;PRINT AND RETURN
SIXBT: PUSHJ P,SIXBP
JRST TAB
SIXALL: TLOA F,FL.SIX
SIXBP: TLZ F,FL.SIX
MOVE BP,[XWD 440600,WD]
SIXBP1: ILDB CH,BP
TLNN F,FL.SIX
JUMPE CH,CPOPJ
ADDI CH,40
PUSHJ P,OUCH
TLNE BP,770000
JRST SIXBP1
POPJ P,0
DATOUT: IDIVI A,^D31
MOVEI N,1(B)
PUSHJ P,DECPR2
IDIVI A,^D12
MOVE B,MONTAB(B)
MOVEI C,0
MOVEI M,B
PUSHJ P,MSG
MOVEI N,^D64(A)
JRST DECPRT
MONTAB:
ASCII /-Jan-/
ASCII /-Feb-/
ASCII /-Mar-/
ASCII /-Apr-/
ASCII /-May-/
ASCII /-Jun-/
ASCII /-Jul-/
ASCII /-Aug-/
ASCII /-Sep-/
ASCII /-Oct-/
ASCII /-Nov-/
ASCII /-Dec-/
BUXPNT: SKIPGE A
MOVEI A,0 ;PROTECT AGAINST NEGATIVE VALUES
PUSHJ P,DLRSGN
IDIVI A,^D100
MOVE N,A
PUSHJ P,DECPR6
PUSHJ P,DOT
MOVE N,B
JRST DECPR2
SUBTTL STORAGE
;MESSAGES FOR HEADERS
HEDMSG: ASCII /
TYPE JOB LINE PRJ /
ASCII /PRG DATE TIME RUN/
ASCIZ /TIME KCS READ WRITTEN CONNECT PRICE
/
HED2: ASCII /
SUMMARY BY USER
PROJ PROG # LOGINS LOGOUTS RUNTIME/
ASCIZ / CONNECT KCS PRICE
/
;STORAGE AND STUFF
PDP: XWD -PDLL,PDL-1
PDL: BLOCK PDLL
MFDB: BLOCK 3
LPTB: BLOCK 3
DSKB: BLOCK 3
MFDPPN: XWD 1,1
SYSPP: XWD 1,1
JIFSEC: 0
JIFDAY: 0
EXTEN: 0
BUXTOT: 0
SUMBAS: 0 ;BASE OF SUMMARY TABLE
SUMTOP: 0 ;TOP OF SUMMARY TABLE
SPLCOD: 0 ;TWO CHARACTER NAME OF SPOOL Q CODE
RUNPRC: EXP ^D8 ;RUN PRICE 8 CENTS PER SECOND
KCSPRC: EXP ^D1 ;K CORE ARE 1 CENT PER RUN SEC
CONPRC: EXP ^D800 ;CONNECT PRICE $8/HR
;TABLE OF PRICES AND NAMES OF SPOOLER OPERATIONS
;UNITS ARE TENTHS OF A CENT PER SPOOLER-UNIT
SPLTAB: XWD ^D50,'LP' ;FIVE CENTS A PAGE FOR THE LPT
XWD ^D5,'CD' ;HALF A CENT PER CARD ON THE CARD PUNCH
XWD ^D150,'PL' ;FIFTEEN CENTS A MINUTE ON THE PLOTTER
XWD ^D30,'PT' ;THREE CENTS A FOOT FOR PAPER TAPE
XWD ^D01,'IN' ;READ 10 CARDS FOR A PENNY
SPLLEN==.-SPLTAB
DEFINE M.M(A,B,C)<
X..==X..+1
X.'A==X..
XWD FE.'A,X.'A
>
X..==0
FETAB: M.FE
FETABL==.-FETAB
FUTTAB: X.FUT==X..+1
XWD -1,X.FUT ;PATCH SPACE
DEFINE M.M(A,B,C)<
<SIXBIT /C/>
>
FESIX: SIXBIT /??????/
M.FE
FUTSIX: SIXBIT /FUTURE/
TABBLK:
JOBON: BLOCK MAXJOB
CJBCON: BLOCK MAXJOB ;CKPNT CONNECT TIME
CJBKCS: BLOCK MAXJOB ;AND KCS PER JOB
CJBRNT: BLOCK MAXJOB ;AND RUN TIME
CJBPPN: BLOCK MAXJOB ;AND USER PPN.
CJBRCT: BLOCK MAXJOB ;AND DISK BLOCKS READ
CJBWCT: BLOCK MAXJOB ;AND DISK BLOCKS WRITTEN
CLREND=.-1 ;FOR CLEARING JOB TABLES.
BLTEND=.-1
ENTRY: BLOCK MAXENT
XLIST ;LITERALS
LIT
LIST
MONEND: END MONEY