.TITLE DSKLOG - ACCOUNTING FOR DISK SPACE USAGE .IDENT /V01.00/ .ENABLE LC ; ; This program is run to enter usage accounting records in the accounting ; file for disk space. The format of the record written is described in ; detail in the companion LOG utility source, and is also defined below. ; In essence, one record will be written for each owner UIC on each disk ; that is billed. The number of blocks used is recorded in such a way that ; the "SAMPLES" field times the "TICKS/SAMPLE" field (using 32-bit integers) ; will give the number of blocks for that UIC on the particular disk. The ; "Task" name is logged as "DVnn$$" (Rad50). The date-time field is also ; given. All other fields are meaningless, and will generally be zero. ; ; Three logical units are used by this program as follows: ; ; Unit 1 (LUNLOG) - Used to open SY0:[6,10]DSKLOG.DAT for writing ; the accounting records out. This file will be appended, or created ; if necessary. ; Unit 2 (LUNDSK) - Used to open Dxn:[0,0]INDEXF.SYS for each disk ; in order to read the bitmap and file headers ; Unit 5 (LUNCON) - Used to communicate with TI: (for errors and such) ; ; To start this program, give a command line consisting of all the disk ; devices to be logged, separated by commas. They will be processed one ; by one in the order given. ; ; Steven G. Duff for Santa Fe Engineering Services R&D 01-JULY-80 ; ; This software is unlicensed and uncopyrighted and permission is hereby ; granted by the author to anyone to make use of it in any manner. However, ; no claim or warranty, express or implied, is made as to its fitness or ; merchantability for any particular purpose or use. Neither the author, ; nor SFESCO assume any liability for consequences arising out of the use ; of this software. ; .PAGE .SBTTL GLOBAL DEFINITIONS .MCALL CCML$,CLOSE$,CSI$,CSI$1,CSI$2 .MCALL EXIT$S .MCALL FDAT$R,FDBDF$,FDBK$A,FDBK$R,FDRC$A,FDOP$A .MCALL FHDOF$ .MCALL FINIT$,FSRSZ$ .MCALL GCML$,GCMLB$,GTIM$S .MCALL HMBOF$ .MCALL NMBLK$,OPNS$A,OPNS$R,OPNS$W .MCALL PUT$ .MCALL QIOW$S .MCALL READ$,WAIT$ CSI$ ; Define CSI control block offsets FHDOF$ ; Define file header block offsets HMBOF$ ; Define home block offsets FSRSZ$ 3. ; Three files for record I/O ; ; Logical units as described in the preamble... ; LUNCON == 5 ; TI: unit LUNDSK == 2 ; Dxn:[0,0]INDEXF.SYS (for each disk) LUNLOG == 1 ; SY0:[6,10]DSKLOG.DAT LUNMCR == 5 ; Used by MGCML for command lines ; ; MINGRP defines the smallest group number that will be considered for ; billing. It is a simple way to exclude system accounts, etc. which ; are generally below [100,*]. ; ;MINGRP == 0 ; Defined at task build time ; ; MINBLK defines the smallest number of blocks that a UFD must accumulate ; before a log record will be written for it. This allows a small number ; of blocks to be allocated to a user without charge. Note that this ; amount is not subtracted from the allocations, it only defines a ; threshold. ; ;MINBLK == 10. ; Defined at task build ; ; FILADD is a penalty factor added into the block count for each file ; header (and extension header). Zero means that you don't want to charge ; users for file header space, and one means you do. Higher values are ; effectively a penalty charge for each file. Negative values, while ; possible, seem to make no sense. ; ;FILADD == 0. ; Defined at task build .PAGE ; ; These are the constant parameters for the hash table indexed by UIC. ; It is constructed for a disk as the file headers for that disk are ; being read, in order to total the blocks for each billable UFD. Too ; small a value will result in table overflow, which will prevent the ; disk from being accounted. ; NHB == 103. ; Number of hash bucket headers NHE == 500. ; Number of entries (max. # of UICs). HLINK == 0 ; Hash entry link word offset (must be zero) HINDEX == HLINK+2 ; Hash entry UIC index word offset HVALHO == HINDEX+2 ; High order block count total HVALLO == HVALHO+2 ; Ditto for low order HELEN == HVALLO+2 ; Length of hash table entry. ; .PAGE .SBTTL LOG DATA STRUCTURE DEFINITION ; ; This is identical to the definition in the LOG utility task, in order ; that the record format be compatible. ; L.PNTO = 0. ;POINTER WORD (MUST BE AT OFFSET 0) L.PNTL = 2. ;POINTER WORD LENGTH L.FLGO = L.PNTO+L.PNTL ;FLAG WORD OFFSET L.FLGL = 2. ;FLAG WORD LENGTH L.TIMO = L.FLGO+L.FLGL ;TIME FIELD OFFSET L.TIML = 16. ;TIME FIELD LENGTH (YR-MO-DA-HR-MN-SEC-TIC-T/S) L.TPSO = L.TIMO+L.TIML ;TICKS PER SAMPLE L.TPSL = 2. ;TICKS PER SAMPLE LENGTH L.TNMO = L.TPSO+L.TPSL ;TASKNAME OFFSET L.TNML = 4. ;TASKNAME LENGTH (RAD50) L.UICO = L.TNMO+L.TNML ;UIC OF TASK L.UICL = 2. ;UIC FIELD LENGTH L.PRIO = L.UICO+L.UICL ;PRIORITY OF TASK L.PRIL = 2. ;PRIORITY LENGTH L.MEMO = L.PRIO+L.PRIL ;MEMORY ALLOCATED TO TASK L.MEML = 2. ;MEMORY FIELD LENGTH (64-BYTE BLOCKS) L.SMPO = L.MEMO+L.MEML ;TICKED EACH SAMPLE L.SMPL = 2. ;TICK FIELD OFFSET L.SPNO = L.SMPO+L.SMPL ;TICKED IF TASK SUSPENDED L.SPNL = 2. ;ONE WORD L.WFRO = L.SPNO+L.SPNL ;TICKED IF TASK IN WAITFOR L.WFRL = 2. ;ONE WORD L.CKPO = L.WFRO+L.WFRL ;TICKED IF TASK CHECKPOINTED L.CKPL = 2. ;ONE WORD L.STPO = L.CKPO+L.CKPL ;TICKED IF TASK IS STOPPED L.STPL = 2. ;ONE WORD L.CPUO = L.STPO+L.STPL ;TICKED FOR TASK IN CNTRL OF CPU L.CPUL = 2. ;ONE WORD L.LPCO = L.CPUO+L.CPUL ;TICKED FOR LP: OUTPUT BUSY L.LPCL = 2. ;ONE WORD L.D$CO = L.LPCO+L.LPCL ;TICKED FOR DP: OR DK: I/O BUSY L.D$CL = 2. ;ONE WORD LOGLEN == L.D$CL+L.D$CO ;LENGTH OF ONE LOG RECORD .PAGE .SBTTL DIRTY DATA AREAS ; ; This is the impure data structure for the hash table (see constants) ; HBSTRT == . ; Start of hash table entry buckets .BLKW NHB ; Define buckets HBEND == . ; End of buckets ; HTSTRT == . ; Start of table proper .BLKB NHE*HELEN ; Define table entry area HTEND == . ; End of table. ; HTFREE::.WORD 0 ; Entry into hash table free chain ; ; LOGBUF is a construction area for outgoing disk log records. ; LOGBUF::.BLKB LOGLEN ; ; NAMBUF is a temporary assembly area for RAD50 name building ; NAMBUF::.BLKB 6 ; ; INFBUF is the block buffer for reading file headers ; INFBUF::.BLKB 512. ; ; FHSTRT holds the starting virtual block for the file headers ; in the index file. Note that there is no file #0, so the header for ; file number 1 will be at virtual block FHSTRT ; FHSTRT::.BLKW 1 ; ; BITBUF is the block buffer for reading of the file header bitmap ; BITBUF::.BLKB 512. ; ; INFBKN is used to hold the file block number for I/O transfers ; INFBKN::.BLKW 2 ; ; RESTRT is a word that contains the "entry" stack pointer which allows ; restarting with the next disk in case of an error. It should always ; contain the restart stack pointer. ; RESTRT::.BLKW 1 ; ; FNNPTR is the state variable for the FNNZBM (co)-routine ; FNNPTR::.WORD 0 ; ; FNNCNT is a state variable for the FNNZBM routine which is initialized with ; -(# of blocks in bitmap + 1), and is used by FNNZBM to decide when it has ; finished with the bitmap (logical eof) ; FNNCNT::.WORD 0 ; ; CSIBLK is the area used by the CSI routines ; CSIBLK::.BLKB C.SIZE ; ; GCLBLK is the MCR Get Command Line control block and work area ; GCLBLK::GCMLB$ 1,DLG,,LUNMCR ; Prompt on unit LUNMCR with DAC (1 lev) ; .PAGE .SBTTL FCS I/O CONTROL STRUCTURES .NLIST BEX ; ; FDB FOR [0,0]INDEXF.SYS ; INFFDB::FDBDF$ ; Define FDB FDRC$A FD.RWM ; Block I/O operations FDBK$A INFBUF,512.,,2 ; Define Buffer FDOP$A LUNDSK,CSIBLK+C.DSDS,INFDFN,FO.RD!FA.SHR ; Filename Parms INFSTA::.BLKW 5 ; Statistics block INFDFN: NMBLK$ INDEXF,SYS ; Default Filename INFUIC: .ASCII /[0,0]/ ; UIC for file INFULN = .-INFUIC DEVNAM = INFFDB+F.FNB+N.DVNM ; Symbolic name for curr. dev. DEVNUM = INFFDB+F.FNB+N.UNIT ; Symbolic name for current dev. unit .EVEN ; ; FDB for Accounting Log data file ; LOGFDB::FDBDF$ ; Define FDB FDOP$A LUNLOG,LOGDSD,,FO.APD!FA.SHR ; Defile File Open Parms LOGDSD: .WORD LOGDVL,LOGDVS,LOGDIL,LOGDIS,LOGNML,LOGNMS ; File Descriptor LOGDVS: .ASCII /SY0:/ LOGDVL = .-LOGDVS LOGDIS: .ASCII /[6,10]/ LOGDIL = .-LOGDIS LOGNMS: .ASCII /DSKLOG.DAT/ LOGNML = .-LOGNMS .LIST BEX .PAGE .SBTTL STARTUP CODE ; ; Program entry point ; DSKLOG:: MOV SP,RESTRT ; Set stack base in case error FINIT$ ; Initialize FCS OPNS$A #LOGFDB ; Try to open Log file Append/Shared BCC DSK01 ; OK if Carry Clear FDAT$R #LOGFDB,#R.FIX,,#LOGLEN,#-50.,#-50. ; Else create OPNS$W #LOGFDB ; And try to Create/Open for Write BCC DSK01 ; OK if Carry Clear JMP ERINI1 ; Else can't open - fatal error. ; ; Here when Log file open ; DSK01: GCML$ #GCLBLK ; Get MCR Command Line BCC DSK02 ; OK if Carry Clear JMP ERINI2 ; Else no command line - fatal error. ; ; Here when we have the command line ; DSK02: CCML$ #GCLBLK ; Close out command file CSI$1 #CSIBLK,GCLBLK+G.CMLD+2,GCLBLK+G.CMLD ; Scan command line BCC DSK03 ; Branch if OK JMP ERINI3 ; Else syntax problem - fatal ; ; Here when command line syntax OK ; DSK03: BITB #CS.EQU,C.STAT+CSIBLK ; Check for "=" in command line BEQ DSK04 ; Branch if none JMP ERINI3 ; Else syntax problem if so. ; ; Loop here on successive disk specs. in command line. ; DSK04: CSI$2 #CSIBLK,OUTPUT ; Scan out next disk spec. BCC DSK05 ; Branch if OK JMP ERINI4 ; Else scan error ; ; Here when disk spec scanned out ; DSK05: BITB #CS.EQU!CS.NMF!CS.DIF!CS.WLD,CSIBLK+C.STAT ; Any invalid stuff? BEQ DSK06 ; OK if no JMP ERINI4 ; Else report scan error if so. .PAGE ; ; Here when we have the device spec. Merge in the rest of the spec for ; the index file, and open it. ; DSK06: MOV #INFUIC,CSIBLK+C.DIRD+2 ; Set pointer to UIC string MOV #INFULN,CSIBLK+C.DIRD ; Set length too. MOV #INFSTA,F.STBK+INFFDB ; Get info in statistics block OPNS$R #INFFDB ; Open index file on device BCC DSK07 ; Press on if OK JMP ERINI5 ; Else report problem. ; ; Here when index file opened. The index file does not always have ; the user file attribute area set, so we use the statistics block to ; provide the eof info, and fill it in manually so as to be sure it is ; correct. ; DSK07: MOV 4+INFSTA,F.HIBK+INFFDB ; Set high vbn (high-order) MOV 6+INFSTA,F.HIBK+2+INFFDB ; Set high vbn (low-order) MOV 4+INFSTA,F.EFBK+INFFDB ; Set eof vbn (high-order) MOV 6+INFSTA,F.EFBK+2+INFFDB ; Set eof vbn (low-order) INC F.HIBK+INFFDB ; Eof is one past max allocated ADC F.HIBK+2+INFFDB ; Carry possible slop MOV #512.,F.RSIZ+INFFDB ; Record size is 512. bytes MOV #1,F.RTYP+INFFDB ; Fixed size records CLR F.FFBY+INFFDB ; First available byte is byte zero MOV SP,RESTRT ; Save restart stack pointer JSR PC,DVCALC ; Calculate storage for device JSR PC,FLUSHT ; ...And write out to log file. ; ; Come here to restart with next spec. ; RERUN:: MOV RESTRT,SP ; Restore stack pointer in case rerun CLOSE$ #INFFDB ; Close index file on this device BITB #CS.MOR,CSIBLK+C.STAT ; See if more specs. in command line BNE DSK04 ; Loop back if so. ; ; Merge here to exit ; EXIT: CLOSE$ #LOGFDB ; Close log file EXIT$S ; Out the door. .PAGE .SBTTL DVCALC - COMPUTE DISK STORAGE FOR A GIVEN DEVICE ; ; This routine is invoked in order to fill the hash table with the ; storage occupied by the "billable" UFDs for a given disk. ; ; Calling sequence: ; ; JSR DVCALC ; (Hash Table) - Filled with storage mapped by each UFD on disk ; (R0...R5) - Unpredictable ; DVCALC:: CLR INFBKN ; Zap high ord block # for home blk rd MOV #2,INFBKN+2 ; Block number for home block read FDBK$R #INFFDB,#INFBUF,,#INFBKN ; Set pointers for block read READ$ R0 ; Issue read BCC DVC00A ; Check for problem JMP ERDVC1 ; Error if not CC DVC00A: WAIT$ R0 ; Wait for completion BCC DVC00 ; Skip on if OK JMP ERDVC1 ; Else report error ; ; Here after reading home block ; DVC00: MOV H.IBSZ+INFBUF,R0 ; Get size (in blocks) of bitmap MOV R0,FHSTRT ; Set initial file hdr block # as that ADD #3,FHSTRT ; But be sure to bias past initial stuff COM R0 ; Get -(IBSZ+1) for FNNCNT MOV R0,FNNCNT ; Store counter for FNNZBM MOV #-1,FNNPTR ; We want to start with bit 0. MOV #HTSTRT,R1 ; Point to start of hash table MOV R1,HTFREE ; Initialize free list pointer ; ; Loop here to chain free list through hash table entries ; DVC01: MOV R1,R0 ; Hold onto ptr to entry to store into ADD #HELEN,R1 ; Point R1 at next entry MOV R1,@R0 ; Chain up next entry CLR HINDEX(R0) ; Mark entry as free (for FLUSHT) CMP R1,#HTEND ; Are we at the end? BLO DVC01 ; Branch back if not CLR @R0 ; If so, cauterize end of chain MOV #HBSTRT,R0 ; Point to start of buckets ; ; Loop here to zero out the hash buckets ; DVC02: CLR (R0)+ ; Clear a bucket and point to next CMP R0,#HBEND ; Check for being at the end BLO DVC02 ; Back if not ; ; Loop here on successive (undeleted) file headers to map storage ; DVC03: JSR PC,FNNZBM ; Get index of next alloc. file hdr. BCS DVC04 ; If error, stop right here JSR PC,FLCALC ; Else enter storage in table BR DVC03 ; And back for another header. ; ; Here when done with loop to return normally. Also merge from error ; to exit normally with whatever was put into hash table up to the time ; of the error. ; DVC04: CLC ; Indicate A-OK RTS PC ; Back to caller .PAGE .SBTTL FHCALC - CALCULATE STORAGE MAPPED BY SINGLE FILE HEADER BLOCK ; ; This routine computes the storage mapped by one valid file header block, ; either primary or extension. ; ; Calling Sequence: ; ; R0 - Pointer to file header area ; JSR FHCALC ; R1 - Block count (0...26112) ; FHCALC:: MOV R0,-(SP) ; Save entry R0 MOV R2,-(SP) ; Save entry R2 MOV R3,-(SP) ; Save entry R3 MOVB H.MPOF(R0),R3 ; Get offset to map area ASL R3 ; Convert to byte offset ADD R3,R0 ; Point R0 at it MOVB M.USE(R0),R2 ; Get # wds. of rtvl. ptrs in use BIC #^O177400,R2 ; Mask out sign extension ASR R2 ; Convert to # of 2-word pointers ADD #M.RTRV,R0 ; Point R0 to start of retrieval ptrs MOV R2,R1 ; Initial block count ; ; Loop here on each retrieval pointer in header block. ; ; R0 - Points to current retrieval pointer ; R1 - Accumulated block count. Since the block counts are stored in the ; retrieval pointers in "n-1" form, R1 is initially set to the ; number of pointers to compensate for this. ; R2 - Number of retrieval pointers left to process. ; R3 - Scratch reg. ; FHC01: TST R2 ; Any more pointers? BEQ FHC02 ; If EQ, no. Exit loop. MOVB 1(R0),R3 ; Else get mapped count in R3 BIC #^O177400,R3 ; Mask sign-extension ADD R3,R1 ; Add into running total DEC R2 ; One less to go ADD #4,R0 ; Point to next BR FHC01 ; Back for another shot ; ; Here at loop exit to leave routine ; FHC02: MOV (SP)+,R3 ; Restore entry R3 MOV (SP)+,R2 ; Restore entry R2 MOV (SP)+,R0 ; Restore entry R0 RTS PC ; Back to caller .PAGE .SBTTL FLADUP - FIGURE STORAGE MAPPED FOR FILE ; ; This routine is called after INFBUF has been filled with a primary ; header for a file, in order to accumulate a total for all headers for ; the file. This routine will read any extant extension headers for the ; file. ; ; Calling Sequence: ; ; FHSTRT - Offset block to start of file headers in index file ; INFBUF - Primary file header for file ; R0 - Points to INFBUF ; JSR FLADUP ; (R2,R3) - Doub. Prec. integer count of blocks (R2 high-order) ; INFBKN, INFBUF - May be overwritten if extension headers read ; INFFDB - May be used if extension headers read in ; FLADUP:: MOV R0,-(SP) ; Save entry R0 MOV R1,-(SP) ; Save entry R1 CLR R2 ; Zero out total (high-ord) CLR R3 ; Zero low-order too ; ; Loop here on all headers of the file in sequence ; FLA01: JSR PC,FHCALC ; Total map area for this header ADD #FILADD,R1 ; Add in charge for header. ADD R1,R3 ; Add to accumulating total ADC R2 ; Carry any low-order overflow MOVB H.MPOF(R0),R1 ; Get bias to map area of header ASL R1 ; Convert to byte offset ADD R1,R0 ; Point at it MOV M.EFNU(R0),R0 ; Get next ext. hdr. file # BEQ FLA03 ; Exit if no more headers DEC R0 ; Compensate for 1s origin CLR INFBKN ; Clear high-order block # for READ$ MOV R0,INFBKN+2 ; Stuff file number as block number ADD FHSTRT,INFBKN+2 ; Add in block bias to headers ADC INFBKN ; Carry any unlikely slopover FDBK$R #INFFDB,#INFBUF,,#INFBKN ; Set up FDB for read READ$ R0 ; Issue read for block # BCC FLA01A ; No error if CC JMP ERFLA1 ; Else problem - issue diagnostic FLA01A: WAIT$ R0 ; Wait for completion BCC FLA02 ; Branch if ok JMP ERFLA1 ; Else report error ; ; Here when read of extension header is complete ; FLA02: MOV #INFBUF,R0 ; Point to buffer JMP FLA01 ; Back to account it ; ; Here to exit module ; FLA03: MOV (SP)+,R1 ; Restore entry R1 MOV (SP)+,R0 ; Restore entry R0 CLC ; No error RTS PC ; BACK! .PAGE .SBTTL FLCALC - COUNT FILE BLOCKS AND UPDATE TABLE ENTRY FOR UIC ; ; This module is called to count the blocks for a given file number, and ; update the total for the owner UIC in the hash table. It will return with UIC ; and count equal to zero under these circumstances: ; - File is marked for delete ; - "File" is actually an extension header ; - File owner group of UIC is below MINGRP ; ; Calling Sequence: ; ; R0 - File # to be totalled ; JSR PC,FLCALC ; R1 - Owner UIC ; (R2,R3) - Block Count for file (R2 High-Order) ; INFFDB, INFBUF, INFBKN - modified by reading file headers ; FLCALC:: MOV R0,-(SP) ; Save entry file # CLR INFBKN ; Clear High-Order Bucket # ADD FHSTRT,R0 ; Bias to start of file headers MOV R0,INFBKN+2 ; Set Low-Order Bucket # ADC INFBKN ; Carry possible slop bit FDBK$R #INFFDB,#INFBUF,,#INFBKN ; Set FCB for READ$ READ$ R0 ; Read file header block BCC FLC00 ; Branch if no error JMP ERFLC1 ; Else problem FLC00: WAIT$ R0 ; Wait for READ$ completion BCC FLC01 ; Branch to carry on if OK JMP ERFLC1 ; Else flag error ; ; Here with primary header in File Header Buffer ; FLC01: MOV #INFBUF,R0 ; Point to buffer MOVB H.MPOF(R0),R1 ; Get bias to map area in buffer ASL R1 ; Convert to byte offset ADD R0,R1 ; Add in buffer start TSTB M.ESQN(R1) ; Check for ext. header BNE FLC01A ; If so, then forget it BITB #SC.MDL,H.SCHA(R0) ; Test mark-for-delete bit BNE FLC01A ; If set then forget it CMPB H.PROJ(R0),#MINGRP ; Compare file owner UIC against min BHIS FLC02 ; Go ahead if owner above or = min. ; ; Here to exit with nothing ; FLC01A: CLR R1 ; Else zero owner UIC for exit CLR R2 ; Also zap high-order block count CLR R3 ; And low-order count BR FLC04 ; Go to exit .PAGE ; ; Here to continue when UIC is above or equal to minimum. ; FLC02: MOV H.FOWN(R0),R1 ; Primary header - save UIC in R1 JSR PC,FLADUP ; Call to total all blocks ; ; Here to add block count to total for owner ; FLC03: JSR PC,OWHASH ; Add to UIC's plex in hash table ; ; Merge to exit module ; FLC04: MOV (SP)+,R0 ; Restore entry R0 CLC ; Signal no error RTS PC ; Back to caller .PAGE .SBTTL FLUSHT - WRITE HASH TABLE TO DISK ACCOUNTING FILE ; ; This module is called after the hash table has been filled in with the ; block totals for the UFDs on a given disk. It writes out this table in ; the format described at the beginning. ; ; Calling Sequence: ; ; (Hash Table) - Correctly Filled with all entries to be logged ; JSR PC,FLUSHT ; (R0...R3) - Destroyed ; (LOGBUF) - Used to format output data ; (DEVBUF) - Used to format output device name ; FLUSHT:: MOV #LOGLEN,R0 ; Get size of output buffer MOV #LOGBUF,R1 ; Point to start FLU01: CLRB (R1)+ ; Clear all bytes SOB R0,FLU01 ; Loop to do 'em all ; MOV DEVNAM,NAMBUF ; Move device name (ASCII) to buffer MOV DEVNUM,R0 ; Get device number for convert BIC #^O177707,R0 ; Mask out all but high digit ASH #-3,R0 ; Get in low digit ADD #'0,R0 ; Add in character bias MOVB R0,NAMBUF+2 ; Move into name buffer MOV DEVNUM,R0 ; Get device unit number again BIC #^O177770,R0 ; Mask out all but low digit ADD #'0,R0 ; Add in ASCII bias MOVB R0,NAMBUF+3 ; Move into buffer MOV #"$$,NAMBUF+4 ; Move in identifying "$$" to suffix MOV #NAMBUF,R0 ; Point to start of buffer JSR PC,$CAT5 ; Convert first 3 chars to RAD50 MOV R1,LOGBUF+L.TNMO ; Move to output buffer name (1st part) JSR PC,$CAT5 ; Convert last part to RAD50 MOV R1,LOGBUF+L.TNMO+2 ; Move to output buffer GTIM$S #L.TIMO+LOGBUF ; Fill in time/date stamp in output bfr MOV L.TIMO+14.+LOGBUF,L.TPSO+LOGBUF ; Set 'sample' interval MOV #HTSTRT,R3 ; Point to start of hash table .PAGE ; ; Loop here, scanning hash table entries sequentially. If the index ; part is non-zero, then an entry exists, and it is output. Otherwise, we ; just move on to the next entry. ; ; Register Usage: ; R0 - Scratch ; R1 - Loaded with HVALHO for entry ; R2 - Loaded with HVALLO for entry ; R3 - Table entry pointer ; FLU02: MOV HINDEX(R3),LOGBUF+L.UICO ; Check for valid entry here BEQ FLU03 ; Skip if not MOV HVALHO(R3),R1 ; Get high order part MOV HVALLO(R3),R2 ; Get low order part CMP R2,#MINBLK ; See if we have reached the minimum BHI FLU02A ; If so, write the record TST R1 ; Else make sure its not really big BEQ FLU03 ; If not ,then no go ; ; Loop here when number of blocks is above threshold. This loop ; is normally executed once, unless the number of blocks is so large as ; to cause the high-order part to be non-zero. In this case, we output ; multiple entries that total up to the full amount. ; FLU02A: MOV R2,LOGBUF+L.SMPO ; Assume low-order is sufficient TST R1 ; Check high-order part to make sure BEQ FLU02B ; If zero then it is MOV #^O177777,LOGBUF+L.SMPO ; Else output max. FLU02B: SUB LOGBUF+L.SMPO,R2 ; Subtract from total SBC R1 ; Pull down carry from high order part PUT$ #LOGFDB,#LOGBUF,#LOGLEN ; Write to file BCC FLU02C ; Go on if OK JMP ERFLU1 ; Else signal error ; ; Here to see if another iteration of the output loop is required for entry ; FLU02C: TST R1 ; Check high-order part of remaining BGT FLU02A ; If still something, then loop again TST R2 ; High-order is zero, check low-order BNE FLU02A ; If non-zero, go back ; ; Merge here when we have processed this entry ; FLU03: ADD #HELEN,R3 ; Point to next entry CMP R3,#HTEND ; Check for falling of edge of world BLO FLU02 ; If not, go on. CLC ; Signal no error RTS PC ; Return to caller .PAGE .SBTTL FNNZBM - FIND NEXT NON-ZERO BIT IN FILE HEADER BIT MAP ; ; This routine operates in co-routine fashion in that on each call it ; returns the number of the next "1" bit in the file header bit map. ; This permits sequential processing of only allocated file headers. ; The co-routine state is maintained in FNNPTR, which should always ; contain the bit number of the last bit found in order that FNNZBM can ; continue the search from that point. ; ; Calling Sequence: ; ; (FNNPTR) - Bit number of last bit found ; JSR PC,FNNZBM ; (R0) - Copy of FNNPTR ; FNNPTR - New Bit # ; FNNCNT - If new bitmap block read, then = oldFNNCNT+1 ; BITBUF - Map block containing found bit ; INFBKN - Destroyed ; Carry Set - EOF on bit map (else clear). (R0=0 on eof) ; FNNZBM:: MOV R1,-(SP) ; Save entry R1 MOV R2,-(SP) ; Save entry R2 MOV R3,-(SP) ; Save entry R3 MOV R4,-(SP) ; Save entry R4 MOV FNNPTR,R1 ; Load initial bit number ; ; Loop here until "1" bit found. We will read the next bit map block if ; we cross into a new one. We abort to exit if there is an error while ; reading the bit map. We perform an optimization of sorts in that ; if we are dealing with a word = zero (all zero bits), the loop skips ; directly to bit 15 without examining intervening bits. ; ; Register Usage: ; R0 - Scratch, for FCS ; R1 - Bit number to be examined ; R2 - Word offset in buffer ; R3 - Bit offset in word ; R4 - Block number (if needed for READ$) ; FNN01: INC R1 ; Move to next bit MOV R1,R3 ; R3 will be bit offset in word BIC #^O177760,R3 ; Mask to get bit (0..15) in R3 MOV R1,R2 ; Figure word offset using bit # BIC #^O170000,R2 ; Mask to get bit offset (in buffer) BNE FNN03 ; If not bit 0, then skip READ$ INC FNNCNT ; Count up to zero BEQ FNN06 ; If reached limit then exit with eof CLR INFBKN ; Else need new block. Zap block # MOV R1,R4 ; Get bit number in scratch reg ASH #-12.,R4 ; Shift down to get block # BIC #^O177760,R4 ; Mask out possible sign extension ADD #3,R4 ; Add in bitmap start bias MOV R4,INFBKN+2 ; Set as block number to read (low ord) FDBK$R #INFFDB,#BITBUF,,#INFBKN ; Get set for block read READ$ R0 ; Issue read (asynch) BCC FNN01A ; Go to wait if OK JMP ERFNN1 ; Else error FNN01A: WAIT$ R0 ; Wait for completion BCC FNN03 ; Continue on if READ went OK JMP ERFNN1 ; Else report and handle as error ; ; Merge here with the proper block set in BITBUF. ; ; Register state: ; R1 - Bit number ; R2 - Bit offset in block (BITBUF) ; R3 - Bit offset in word ; FNN03: ASH #-4,R2 ; Shift bit offset in buffer... ASL R2 ; ...to get word offset TST BITBUF(R2) ; Check for word of zeros BNE FNN04 ; If not, can't optimise - branch MOV #15.,R3 ; Else optimise by skipping to bit 15 BIS #15.,R1 ; Update bit number also ; ; Merge here to check the bit we (finally) have ; FNN04: MOV #1,R4 ; Get a single bit ASH R3,R4 ; Shift it to get single bit bit mask BIT R4,BITBUF(R2) ; Check for "1" bit in that position BNE FNN05 ; If so, then exit the loop JMP FNN01 ; Else another iteration ; ; Here to exit module with "1" bit found ; FNN05: MOV R1,FNNPTR ; Save context MOV R1,R0 ; Set return value MOV (SP)+,R4 ; Restore entry R4 MOV (SP)+,R3 ; Restore entry R3 MOV (SP)+,R2 ; Restore entry R2 MOV (SP)+,R1 ; Restore entry R1 CLC ; Signal A-OK RTS PC ; Back! ; ; Here to exit on end-of-bitmap (set carry) ; FNN06: MOV R1,FNNPTR ; Save context CLR R0 ; No bit found MOV (SP)+,R4 ; Restore entry R4 MOV (SP)+,R3 ; Restore entry R3 MOV (SP)+,R2 ; Restore entry R2 MOV (SP)+,R1 ; Restore entry R1 SEC ; Signal A-notOK RTS PC ; Back. .PAGE .SBTTL OWHASH - ADD COUNT TO HASH TABLE ENTRY FOR OWNER ; ; The OWHASH routine is called with a (double precision) integer block ; count and an owner UIC. The entry for that owner in the hash table ; has its count updated by the given amount. (If no entry yet exists, ; a zero-count entry is first created). ; ; Calling Sequence: ; (R1) - Owner UIC ; (R2,R3) - Block count to be added in ; JSR PC,OWHASH ; (HTFREE) - Updated to next free entry if one was needed ; Carry Set - If no free space, and free space needed (else Carry clr) ; ; WARNING: Meddle carefully with stack save on entry/exit, since offsets ; on the stack are assumed in the code for this module ; OWHASH:: MOV R0,-(SP) ; Save entry R0 MOV R1,-(SP) ; Save entry R1 CLR R0 ; Get set to hash DIV #NHB,R0 ; Hash UIC value ASL R1 ; Convert to byte offset MOV #HBSTRT,R0 ; Get start of buckets ADD R1,R0 ; Add in offset to get desired bucket MOV (R0),R1 ; Get value pointer in bucket ; ; Loop here to tra-la-la down hash chain to find entry, or bump into ; the end if none. ; ; Register usage: ; R0 - "Previous" Entry (or bucket) examined ; R1 - "Current" Entry under scrutiny ; Z bit of CC set if R1=0 ; OWH01: BEQ OWH02 ; If link=0 then no such entry yet CMP HINDEX(R1),0(SP) ; See if entry matches with stacked val BEQ OWH04 ; Branch out if it does MOV R1,R0 ; Else make current into previous MOV @R1,R1 ; Get new current BR OWH01 ; And back for another shot .PAGE ; ; Come here from loop above when entry not found. We get a free entry, ; initialize it and splice it on to the entry pointed to by R0 (previous) ; OWH02: TST HTFREE ; Check for available free entry BNE OWH03 ; Branch if there is one JMP EROWH1 ; Else report error (no free space) ; ; Here when there is an entry pointed to by HTFREE to be allocated ; OWH03: MOV HTFREE,@R0 ; Link previous to new entry MOV @HTFREE,HTFREE ; Unlink new entry from free list MOV @R0,R1 ; Point R1 to new entry CLR @R1 ; Cauterize chain in new entry MOV 0(SP),HINDEX(R1) ; Set UIC index value from saved entry CLR HVALLO(R1) ; Clear low order count CLR HVALHO(R1) ; Clear high order count too ; ; Merge here with R1 pointing to the entry to be updated. ; OWH04: ADD R3,HVALLO(R1) ; Add in low-order to count ADC HVALHO(R1) ; Carry any slop into high order ADD R2,HVALHO(R1) ; Add in high order (must be BIG file) MOV (SP)+,R1 ; Restore entry R1 MOV (SP)+,R0 ; Restore entry R0 CLC ; Signal no error RTS PC ; Back to caller .PAGE .SBTTL ERROR APPENDAGES ; ; The following ERxxxn labels are entry points from the code that are ; entered to process error conditions. These appendages generally print ; a message, and then have several options as regards transfer of control ; out of the handler... ; ; 1 - JMP to EXIT which will terminate execution entirely. This ; should only be used when no other alternatives are possible. ; 2 - JMP to RERUN. This will abort processing of the current disk, ; but allow it to continue with the next one (if any) in the ; command string. ; 3 - Execute a return (RTS PC), generally after setting the carry ; flag. This simulates an 'error' return from whatever routine ; incurred the error, and is the least harsh of all the possibilities ; as it allows processing to (probably) continue. ; .NLIST BEX ; MTINI1: .ASCIZ "CANNOT OPEN ACCOUNTING LOG" .EVEN ERINI1:: MOV #MTINI1,R5 ; Point to message JSR PC,ERRLOG ; Log the message MOVB F.ERR+LOGFDB,R5 ; Get FCS error code JSR PC,FCSLOG ; Log the message JMP EXIT ; FATAL ; ERINI2:: JMP EXIT ; No command line - just exit gracefully ; MTINI3: .ASCII "COMMAND LINE SYNTAX ERROR: " M1INI3: .BLKB 65.-<.-MTINI3> M1IN3L = .-M1INI3 .EVEN ERINI3:: MOV C.FILD+CSIBLK,R0 ; Get length of cmd line error seg. CMP R0,#M1IN3L ; Compare against message field BLT ERIN3A ; If less, OK MOV #M1IN3L-1,R0 ; Else give it the max. ERIN3A: MOV C.FILD+2+CSIBLK,R1 ; Get address of cmd line seg. MOV #M1INI3,R2 ; Point to start of message field ERIN3B: MOVB (R1)+,(R2)+ ; Move in a character SOB R0,ERIN3B ; Go back if more CLRB (R2) ; Set end of string marker MOV #MTINI3,R5 ; Get address of full string JSR PC,ERRLOG ; Report it JMP EXIT ; FATAL .PAGE ; MTINI4: .ASCII "DEVICE SPEC. ERROR - DEVICE IGNORED: " M1INI4: .BLKB 65.-<.-MTINI4> M1IN4L = .-M1INI4 .EVEN ERINI4:: MOV C.FILD+CSIBLK,R0 ; Get length of cmd line error segment CMP R0,#M1IN4L ; Compare against message field length BLT ERIN4A ; If less, OK MOV #M1IN4L-1,R0 ; Else give it as much as possible ERIN4A: MOV C.FILD+2+CSIBLK,R1 ; Get address of command line segment MOV #M1INI4,R2 ; Point to start of message field ERIN4B: MOVB (R1)+,(R2)+ ; Move in a character SOB R0,ERIN4B ; Loop if more CLRB (R2) ; Set end of string marker MOV #MTINI4,R5 ; Get address of full string JSR PC,ERRLOG ; Report it JMP RERUN ; RESTART with next disk ; MTINI5: .ASCIZ "OPEN ERROR ON [0,0]INDEXF.SYS" .EVEN ERINI5:: MOV #MTINI5,R5 ; Point to message JSR PC,ERRLOG ; Print it MOVB F.ERR+INFFDB,R5 ; Get FCS error number JSR PC,FCSLOG ; Log it JMP RERUN ; RESTART ; .EVEN ERFLC1:: JMP ERFNN1 ; Block read error on INDEXF.SYS ; MTFLU1: .ASCIZ "WRITE ERROR ON ACCOUNTING LOG - LOG ABENDED FOR DEVICE" .EVEN ERFLU1:: MOV #MTFLU1,R5 ; Point at message JSR PC,ERRLOG ; Print it MOVB F.ERR+LOGFDB,R5 ; Get FCS error JSR PC,FCSLOG ; Print FCS error message SEC ; Indicate error RTS PC ; Return from FLUSHT routine .PAGE ; MTOWH1: .ASCIZ "TOO MANY UFD'S ON DEVICE - DEVICE NOT LOGGED" .EVEN EROWH1:: MOV #MTOWH1,R5 ; Point to message JSR PC,ERRLOG ; Print it JMP RERUN ; RESTART ; MTFNN1: .ASCIZ "READ ERROR ON [0,0]INDEXF.SYS - DEVICE NOT LOGGED" .EVEN ERFNN1:: MOV #MTFNN1,R5 ; Point to message JSR PC,ERRLOG ; Print it MOVB F.ERR+INFFDB,R5 ; Get error message code JSR PC,FCSLOG ; Print FCS error message JMP RERUN ; RESTART ; ERFLA1::JMP ERFNN1 ; Treat the same as ERFNN1 ; MTDVC1: .ASCIZ "ERROR READING HOME BLOCK - DEVICE NOT LOGGED" .EVEN ERDVC1:: MOV #MTDVC1,R5 ; Point to message JSR PC,ERRLOG ; Print it MOVB F.ERR+INFFDB,R5 ; Get error message number from FCS JSR PC,FCSLOG ; Print FCS message JMP RERUN ; Do next device .PAGE ; ; This routine will print a .ASCIZ formatted string on the terminal, ; prefixed by the text "DLG -- [dvnn:] ". An optional entry point ; ERLOG2 will print the argument text without this header. ; ; Calling Sequence: ; (R5) - Pointer to text ; JSR PC,ERRLOG (or ERLOG2) ; (R0,R1,R2,R5) - Destroyed ; .EVEN MTERL: .ASCIZ "DLG -- " MBERL: .BLKB 80. MBLERL = .-MBERL ERRLOG:: MOV #MBERL,R0 ; R0 is current end-of-message ptr MOV #MTERL,R1 ; Point to start of prefix id ; ; Loop here to move in characters of prefix message ; ERL00: MOVB (R1)+,(R0)+ ; Move a character BNE ERL00 ; Back unless end DEC R0 ; Back over zero char MOV C.DEVD+CSIBLK,R2 ; Get length of device spec in R2 BEQ ERL02 ; If not, then skip it MOVB #'[,(R0)+ ; Else stick in an open bracket MOV C.DEVD+CSIBLK+2,R1 ; Point R1 at start of string ; ; Loop here to move in all characters of device spec. (as it appears in ; the command line). ; ERL01: MOVB (R1)+,(R0)+ ; Move in a character SOB R2,ERL01 ; Loop until all moved MOVB #':,(R0)+ ; Put colon after device spec MOVB #'],(R0)+ ; Close off with bracket MOVB #' ,(R0)+ ; Insert a space BR ERL02 ; Go to copy user text ; ; Entry point to print unprefixed message ; ERLOG2:: MOV #MBERL,R0 ; Point to start of buffer & merge ; ; Merge here to move in text of user message. ; ERL02: CMP R0,#MBLERL+MBERL ; Be sure not to overflow BHIS ERL03 ; Done if at buffer end MOVB (R5)+,(R0)+ ; Else move in a character BNE ERL02 ; Loop if not end of string MOVB #'.,(R0)+ ; Finishing touch! ; ; Merge here when message in buffer. R0 points just past the end of ; the text in MBERL. ; ERL03: SUB #MBERL,R0 ; Get length of message in R0 QIOW$S #IO.WVB,#LUNCON,#1,,,,<#MBERL,R0,#40> ; Write message RTS PC ; Return to caller .PAGE ; ; This module will print a message on the terminal giving the FCS ; error number passed in R5 ; ; Calling Sequence: ; (R5) - FCS error message number ; JSR PC,FCSLOG ; (R0,R1,R2,R5) - Destroyed ; MTFCS: .ASCII " FCS ERROR NUMBER " MTFCS1: .ASCIZ "NNNNN" .EVEN FCSLOG:: MOV #MTFCS1,R0 ; Point to place to format number MOV R5,R1 ; Get number to convert CLR R2 ; For $CBDSG JSR PC,$CBDSG ; Convert the number CLRB (R0)+ ; Cauterize string MOV #MTFCS,R5 ; Point to message JSR PC,ERLOG2 ; Print it RTS PC ; Back to caller .LIST BEX .END DSKLOG ; The end is only the beginning