.TITLE	DISK
	.IDENT	/V7.14/

;**********************************************************************
;
;	DISK.TSK
;
;	MULTI-VOLUME DISK ACCOUNTING SYSTEM TASK DISK.TSK.
;	THIS TASK IS INSTALLED UNDER THE NAME DSK... AND IS ENTERED
;	INTO THE CLOCK QUEUE AT SYSTEM BOOT:
;
;		RUN DSK... 5H/RSI=5H
;
;		(TIMES MAY BE DIFFERENT)
;
;	THIS TASK READS THE ACCOUNT FILE AND DETERMINES THE NUMBER OF
;	BLOCKS USED BY EACH USER ON THE RELEVANT VOLUME. THERE IS NO
;	RESTRICTION ON THE NUMBER OF DIFFERENT DEVICES ON WHICH ACCOUNTS
;	MAY APPEAR, BUT SINCE STORAGE IS REQUIRED INTERNALLY FOR EACH
;	USER, THE MAXIMUM NUMBER OF USERS THAT DSK... CAN HANDLE IS
;	DEPENDENT ON THE SIZE OF THE PARTITION IN WHICH DSK... IS
;	INSTALLED. INSTALLING WITH AN INCREMENT INCREASES THE AMOUNT
;	OF WORK SPACE AVAILABLE.
;	THE INFORMATION GATHERED BY THIS TASK IS WRITTEN TO THE ACCOUNTING
;	SYSTEM DATA FILE LB:[0,0]ACCOUNTS.DAT. THE FORMAT OF THE INFORMATION
;	THEREIN CAN BE FOUND BY CONSULTING THE DOCUMENTATION.
;	THIS VERSION OF DSK... ALSO SUPPORTS THE ACCOUNT CHAINING FEATURE.
;
;	FOR USE WITH ACCOUNTING SYSTEM VERSION 7 ONLY.
;
; VERSION:	V6	MARCH 1980
; VERSION:	V7	JANUARY 1981
;
;	STEVE THOMPSON	SCHOOL OF CHEMICAL ENGINEERING
;			OLIN HALL
;			CORNELL UNIVERSITY
;			ITHACA NY 14853
;
;	REVISION HISTORY
;	----------------
;
;	SMT720	23-JUL-81	CORRECT A BUG IN THE "CHAIN" ROUTINE WHICH
;				CAUSED DISK CHARGES FOR MEMBER ACCOUNTS TO
;				BE LOST IF THEY OCCURRED EARLIER IN THE
;				ACCOUNT FILE THAN THE MASTER ACCOUNT.
;
;	SMT721	24-JUL-81	LEADING ZEROES REMOVED FROM THE ACCOUNT
;				NUMBER COLUMN AND AN "M" FLAG ADDED TO SHOW
;				A MASTER ACCOUNT.
;
;	SMT739	12-AUG-81	CHANGED REFERENCES TO $DDEC TO FM.QIO.
;
;	SMT753	 7-OCT-81	CHANGED NAMES OF CONDITIONAL ASSEMBLY
;				PARAMETERS; SEE THE FILES MODIFY.TXT AND
;				CONDEF.MAC FOR DETAILS.
;
;	SMT763	10-OCT-81	CORRECTED A BUG WHERE THE NUMBER OF BLOCKS
;				IN THE INDEX FILE WAS NOT CORRECTLY
;				ACCOUNTED IF THE SUM OF FILES OWNED BY BOTH
;				MASTER AND MEMBER ACCOUNTS EXCEEDED 32767
;				AND THE AA$CFL OPTION IS SUPPORTED.
;
;	SMT764	10-OCT-81	ADDED THE SIZE OF THE DIRECTORY FILE TO THE
;				SIZE OF ALL USER FILES SO THAT AN OTHERWISE
;				"IDLE" ACCOUNT WITH NO FILES PAYS FOR THE
;				SPACE TAKEN UP BY THE DIRECTORY FILE. THIS
;				FEATURE IS INCLUDED BY DEFINING THE SYMBOL
;				"AA$UFD" IN ACCPRE.MAC (THE DEFAULT).
;
;	SMT771	13-OCT-81	ADDED THE MINIMUM CHARGE FEATURE. SEE THE
;				COMMENTS IN DISKBLD.CMD AND IN THE "GETDLR"
;				ROUTINE BELOW. THIS FEATURE ALSO AFFECTS
;				THE "MACNT" PROGRAM.
;
;	SMT784	 8-NOV-81	ADDED A FILE ID/SEQUENCE NUMBER CHECK
;
;	SMT785	 8-NOV-81	FIXED MULTIPLE CHARGING FOR SYNONYMS.
;
;	SMT792	16-NOV-81	CORRECTION OF A BUG IN PATCH SMT785 WHICH
;				CAUSED FILES TO BE IGNORED IF THEY WERE
;				RENAMED. THE FIX REQUIRES READING IN THE
;				INDEX FILE BIT MAP (OR AS MUCH AS WILL FIT)
;				AND USING IT TO CONTROL THE EXAMINATION
;				OF FILE HEADER BLOCKS.
;
;	SMT814	12-APR-82	LOWER CASE MESSAGE TEXT FOR RSX-11M V4.0
;
;	SMT818	19-APR-82	CHANGED TEXT "CHAINED TO A/C" IN OUTPUT
;				LISTING TO "MASTER=".
;
;	SMT821	23-APR-82	CHANGED ENTRY POINT NAMES OF ACCOUNTING
;				SUPPORT ROUTINES (SEE MODIFY.TXT)
;
;	SMT822	26-APR-82	FIXED A BUG CAUSING TKB ERROR IF AA$CFL IS
;				DEFINED.
;
;	SMT836	 6-SEP-82	CHANGED "CALLR" TO "JMP" SINCE RSXMC.MAC
;				IS NO LONGER INVOLVED IN THE ASSEMBLY.
;				DETERMINE TICKS/SECOND FROM EXECUTIVE
;				RATHER THAN FROM ASSEMBLY.
;
;***********************************************************************
	.PAGE
	.SBTTL	MACRO LIBRARY CALLS

	.MCALL	GTSK$S,GTIM$S,DIR$,QIOW$,MRKT$S,STSE$S,EXIT$S
	.MCALL	ALUN$,GLUN$
	.MCALL	FINIT$,FDBDF$,FDAT$A,FDRC$A,FDBK$A,FDOP$A
	.MCALL	FDBF$A,FDAT$R
	.MCALL	READ$,WAIT$,OPNS$R
	.MCALL	FHDOF$,HMBOF$
	.MCALL	GET$,PUT$
	.MCALL	OPEN$M,CLOSE$,OPEN$A,OPEN$W,EXST$S


	ACTDF$	<:>,<=>	; DEFINE ADDITIONAL ACCOUNT FILE OFFSETS
	FILDF$		; DEFINE RECORDS FILE OFFSETS

	FHDOF$	DEF$L	; DEFINE INDEX FILE OFFSETS
	HMBOF$	DEF$L	; DEFINE HOME BLOCK OFFSETS
	.PAGE
	.SBTTL	LOCAL CONSTANTS

;
;	CONSTANTS
;

EFN1	=	1	; EVENT FLAG FOR TI: I/O
EFN2	=	2	; EVENT FLAG FOR A/C FILE I/O
EFN3	=	3	;
EFN4	=	4	; EVENT FLAG FOR DIRECTORY FILE I/O
EFN5	=	5	; EVENT FLAG FOR INDEX FILE I/O

LUN1	=	1	; TI: LUN
			; LUN2 (GLOBALLY DEFINED IN ACTFIL.MAC) IS FOR
			; LUN3 IS USED FOR ACCOUNTING DATA FILE.
			; ACCOUNT FILE I/O
LUN4	=	4	; USED TO FIND TRUE DEVICE NAMES FOR DIRECTORY ENTRIES
LUN5	=	5	; LUN FOR DIRECTORY FILES
LUN6	=	6	; LUN FOR INDEX FILES

SPA	=	40	; SPACE
COLON	=	':	; COLON
DPT	=	'.	; DECIMAL POINT

CR	=	15	; CARRIAGE RETURN
LF	=	12	; LINEFEED
BELL	=	7	; BELL (CTRL/G)
FF	=	14	; FORM FEED
	.PAGE
	.SBTTL	CONTROL BLOCK DEFINITION

;
;	MACROS
;

	.MACRO	DSKDF$,L,B
;
;	DISK ACCOUNTING CONTROL BLOCK OFFSET DEFINITIONS
;	THE ORDER OF THESE DEFINITIONS IS NOT ARBITRARY,
;	BUT DEPENDS ON THE DEFINITIONS IN THE FILDF$ MACRO.
;	HENCE THEY MUST NOT BE CHANGED.
;
	.ASECT
.=0
D.UIC:'L'	.BLKW	3	; ASCII USER IDENTIFICATION CODE
D.SYDV:'L'	.BLKW	2	; ASCII SYSTEM DEVICE FROM A/C FILE
D.ACNO:'L'	.BLKW	1	; ACCOUNT NUMBER
D.CHWD:'L'	.BLKW	1	; ACCOUNT CHAINING WORD
D.MSTR:'L'	.BLKW	1	; MASTER A/C NO. FROM SEARCH
D.DEVN:'L'	.BLKW	1	; ASCII TRUE SYSTEM DEVICE NAME
D.DEVU:'L'	.BLKW	1	; BINARY TRUE DEVICE NUMBER
D.PREV:'L'	.BLKW	2	; # BLOCKS FOUND LAST TIME
				; (FOUND FROM ACCOUNT FILE)
D.BLOK:'L'	.BLKW	2	; TOTAL BLOCKS ALLOCATED
D.NFIL:'L'	.BLKW	1	; NUMBER OF FILES
D.ABLK:'L'	.BLKW	2	; AVERAGE BLOCKS THIS PERIOD

	.IF DF	AA$BLK

D.BALL:'L'	.BLKW	2	; BLOCK ALLOCATION

	.ENDC	; DF AA$BLK

D.NDA:'L'	.BLKW	1	; NUMBER OF DISK ACCOUNTINGS FOR THIS ACCOUNT
D.DCHG:'L'	.BLKW	2	; DISK CHARGE (ACC. UNITS)
D.NBLK:'L'	.BLKW	2	; # BLOCKS FOR CHARGING PURPOSES

	.IF DF	AA$CFL

D.NFLC:'L'	.BLKW	2	; # FILES FOR CHARGING PURPOSES

	.ENDC	; DF AA$CFL

D.FLAG:'L'	.BLKW	1	; INTERNAL PROCESSING FLAGS

D.LGTH='B'.			; LENGTH OF DATA PACKET

DD.ERR='B'1		; ERROR DURING ACCOUNT PROCESSING
DD.ACN='B'2		; THIS CONTROL BLOCK ALREADY DONE
DD.EDP='B'4		; ACCOUNT SCANNED FOR DUPLICATIONS
DD.DUP='B'10		; ACCOUNT DUPLICATION FOUND
DD.WRT='B'20		; ACCOUNT HAS BE REWRITTEN IN ACCOUNT FILE
DD.CHW='B'40		; ACCOUNT HAS BEEN SCANNED IN CHAIN ROUTINE

	.PSECT
	.MACRO	DSKDF$,X,Y
	.ENDM
	.ENDM


	.MACRO	PRINT	MSG,MSGSZ

	MOV	MSG,TIDPB+Q.IOPL

	.IF B	MSGSZ

	MOV	MSG'SZ,TIDPB+Q.IOPL+2

	.IFF

	MOV	MSGSZ,TIDPB+Q.IOPL+2

	.ENDC

	DIR$	#TIDPB

	.ENDM


;
;	DEFINE CONTROL BLOCK OFFSETS AND BITMASK DEFINITIONS
;

	DSKDF$
	.PAGE
	.SBTTL	LOCAL STORAGE

;
;	LOCAL STORAGE
;

TASKSZ:	.LIMIT			; TKB DEFINES ADDRESS LIMITS
LUNBUF:				; BUFFER FOR GLUN$ INFORMATION
TASKBF:	.BLKW	16.		; TASK PARAMETERS BUFFER
TIMBUF:	.BLKW	8.		; TIME BUFFER
DSKINP:	.BLKW	8.		; DISK INPUT RECORD BUFFER
NUSER:	.WORD	0		; NUMBER OF USERS IN BUFFER
BUFADR:	.WORD	0		; CONTAINS START ADDRESS OF USER BUFFER
BUFNUM:	.WORD	0		; CONTAINS MAX. NUMBER OF USERS IN BUFFER
ELAPS:	.WORD	0		; TIME SINCE LAST ACCOUNTING (MINUTES)
MONEY:	.WORD	0,0		; TOTAL DISK CHARGES
				; (INTERNAL ACCOUNTING UNITS)
CHGBLK:				; 2 WORD BUFFER USED IN CHARGE CALCULATION
				; (SHARES STORAGE WITH "FSIZE")
FSIZE:	.WORD	0,0		; FILE SIZE FOR FILSIZ ROUTINE
UFDADR:	.BLKW	1		; SAVED BUFFER ADDRESS IN UFD SCAN
UFDAD2:	.BLKW	1		; COPY OF UFDADR FOR USE IN FILSIZ ROUTINE
SYNFLG::.WORD	0		; PRINT SYNONYM CHECK MESSAGE 0=NO 1=YES
FDBADR:	.BLKW	1		; FDB ADDRESS FOR FCS ERROR PROCESSOR
DSKBLK:	.WORD	$DSK1		; CHARGE CALCULATION, ARGUMENT BLOCK
	.WORD	$DSK2		;

DEVN:	.ASCII	/  /		; DEVICE NAME FOR NEXT INDEX FILE
DEVU:	.WORD	0		; DEVICE UNIT FOR NEXT INDEX FILE
IDXFHD:	.WORD	0		; VIRTUAL BLOCK NUMBER OF INDEX FILE HEADER
				; WITHIN THE INDEX FILE
IDXMAP:	.WORD	0		; "EFFECTIVE" SIZE OF INDEX FILE BITMAP

OUTBUF:	.BLKB	132.		; OUTPUT BUFFER (MUST BE EVEN LENGTH)
IDXBUF:	.WORD	$ACTBF		; BLOCK BUFFER ADDRESS FOR INDEX FILE
DIRBUF:	.WORD	$ACTBF+512.	; BLOCK BUFFER ADDRESS FOR DIRECTORY FILE
				; THE INDEX FILE AND DIRECTORY FILE BUFFERS
				; OVERLAY THE ACCOUNT FILE BUFFER ALLOCATED
				; IN MODULE "ACTFIL". THE DIRECTORY FILE
				; BUFFER IS 3 BLOCKS (1536. BYTES) LONG
				; SINCE THE ACCOUNT FILE BUFFER IS 4 BLOCKS
				; (2048. BYTES) LONG.
;
; ALLOCATE BUFFER FOR INDEX FILE BITMAP I/O
;

	.PSECT	BITMP0		; BITMAP I/O BUFFER (ALLOCATED BY TKB)
$BMAP0:
	.PSECT	BITMP1
$BMAP1:	.WORD	<<$BMAP1-$BMAP0>/512.> ; SIZE OF BUFFER IN DISK BLOCKS
$BMAP2:	.BLKW	1		; HIGHEST FILE I.D. IN BUFFERED BITMAP
	.PSECT
BITMSK:	.WORD	1		; BITMASK TABLE FOR INDEX FILE BITMAP CHECK
	.WORD	2		;
	.WORD	4		;
	.WORD	10		;
	.WORD	20		;
	.WORD	40		;
	.WORD	100		;
	.WORD	200		;
	.WORD	400		;
	.WORD	1000		;
	.WORD	2000		;
	.WORD	4000		;
	.WORD	10000		;
	.WORD	20000		;
	.WORD	40000		;
	.WORD	100000		;
	.PAGE
	.SBTTL	TEXT MESSAGES

;
;	TEXT MESSAGES
;

	.NLIST	BEX

	.ENABL	LC

INTRO:	.ASCII	<CR><FF><BELL><BELL>/** Disk Accounting Package V7.14 /
INTR1:	.ASCII	/  -   -   0 :0 :0  **/<CR><LF>
INTRSZ=.-INTRO
BUFSP:	.ASCII	/Buffer space for /
BUFSP1:	.ASCII	/     users/
BUFSPS=.-BUFSP
ELAPT:	.ASCII	/Elapsed time = /
ELAPT1:	.ASCII	/NNH NNM NNS/
NUMUSR:	.ASCII	/Number of users in buffer = /
NUMUS1:	.ASCII	/0000/
ISIZE:	.ASCII	/Size of Index File on /
ISIZEA:	.ASCII	/XX00: is 0000. blocks/
BLK:	.ASCIZ	/ blocks/
TOTAL:	.ASCII	/Total of above disk charges: /
TOTAL1:	.ASCII	/$000.0000 units/
TOTAL2:	.ASCII	/Charges made to Account File: /
TOTAL3:	.ASCII	/$000.0000 units/
CHTXT:	.ASCIZ	/Master=/

END:	.ASCII	<BELL><BELL>/** End of Disk Accounting **/
ENDSZ=.-END
HEAD:	.BYTE	LF,CR
HEAD1:	.ASCII	/Device/
OUFD=.-HEAD1
	.ASCII	/   UFD      A/
OACN=.-HEAD1
	.ASCII	%/c No. %
OFIL=.-HEAD1
	.ASCII	/Files /
OBLK=.-HEAD1
	.ASCII	/Blocks  /
OTST=.-HEAD1
	.ASCII	/Charge/<CR><LF>
HEADSZ=.-HEAD
FCS:	.ASCIZ	/  FCS /
DIR:	.ASCIZ	/  DIR /
	.PAGE
	.SBTTL	ERROR MESSAGES

;
;	ERROR MESSAGES
;

	.IIF NDF AA$V40, .DSABL LC

ERR0:	.ASCIZ	/** Error Detected **/
ERR1:	.ASCII	/DSK -- *FATAL* no buffer space/
ERR1SZ=.-ERR1
ERR2:	.ASCII	/DSK -- Open error on LB:[0,0]DISK.TIM;1/
ERR2A:	.ASCII	/  FCS -000./
ERR3:	.ASCII	/DSK -- Read error on LB:[0,0]DISK.TIM;1/
ERR3A:	.ASCII	/  FCS -000./
ERR4:	.ASCII	/DSK -- Write error on LB:[0,0]DISK.TIM;1/
ERR4A:	.ASCII	/  FCS -000./
ERR5:	.ASCII	/DSK -- *FATAL* account file open failure/
ERR5SZ=.-ERR5
ERR6:	.ASCII	/DSK -- Buffer full - install with larger increment/
ERR6SZ=.-ERR6
ERR7:	.ASCII	/DSK -- Index file open failure on /
ERR7A:	.ASCII	/XX000:  FCS -000./
ERR8:	.ASCII	/DSK -- Directory file open failure: /
ERR8A:	.ASCII	/XX00:[000,000]  FCS -000./
ERR9:	.ASCII	/DSK -- Home block read error on /
ERR9A:	.ASCII	/XX000:  FCS -000./
ERR10:	.ASCII	/DSK -- Read error on index file on /
ERR10A:	.ASCII	/XX000:  FCS -000./
ERR11:	.ASCII	/DSK -- Read error on directory file /
ERR11A:	.ASCII	/XX00:[000,000]  FCS -000./
ERR12:	.ASCII	/DSK -- Assign LUN4 failed: /
ERR12A:	.ASCII	/XX00:[000,000]/
ERR13:	.ASCII	/DSK -- Get LUN4 information failed: /
ERR13A:	.ASCII	/XX00:[000,000]/
ERR14:	.ASCII	/DSK -- Open error on LB:[0,0]ACCOUNTS.DAT/
ERR14A:	.ASCII	/  FCS -000./
ERR15:	.ASCII	"DSK -- File ID/Sequence number check - "
ERR15A:	.ASCII	/DDNN:[GGG,MMM]FILENAME.TYPE;VERS/
ERR16:	.ASCII	"DSK -- Skipping file synonym - "
ERR16A:	.ASCII	/DDNN:[GGG,MMM]FILENAME.TYPE;VERS/
ERR17:	.ASCII	/DSK -- *WARNING* Index file bitmap truncated on /
ERR17A:	.ASCII	/XX000:/
ERR18:	.ASCII	/DSK -- *WARNING* Read error on index file bitmap on /
ERR18A:	.ASCII	/XX000:  FCS -000./

	.ENABL	LC
	.PAGE
	.SBTTL	FILE RELATED STORAGE

;
;	FILE RELATED STORAGE
;

	.EVEN

TIMFDB:	FDBDF$			; FILE DESCRIPTOR BLOCK FOR LB:[0,0]DISK.TIM;1

DIRFDB:	FDBDF$			; FILE DESCRIPTOR BLOCK FOR UFD
	FDAT$A	R.FIX,,512.	; ([0,0]XXXXXX.DIR)
	FDRC$A	FD.RWM!FD.RAN!FD.PLC
	FDBK$A	<$ACTBF+512.>,<3*512.>,,EFN4,DFSTAT
	FDOP$A	LUN5,DIRDSP
	FDBF$A	EFN4

IDXFDB:	FDBDF$			; FILE DESCRIPTOR BLOCK FOR INDEX FILE
	FDAT$A	R.FIX,,512.	;
	FDRC$A	FD.RWM!FD.RAN!FD.PLC
	FDBK$A	$ACTBF,512.,,EFN5,IFSTAT
	FDOP$A	LUN6,IDXDSP
	FDBF$A	EFN5

IFSTAT:	.BLKW	2		; I/O STATUS BLOCK: INDEX FILE
DFSTAT:	.BLKW	2		; I/O STATUS BLOCK: DIRECTORY FILE

IDXDSP:	.WORD	IDXDSZ,IDXDEV	; DATASET DESCRIPTOR FOR INDEX FILE
	.WORD	DIRSIZ,DIR00	;
	.WORD	DXFSIZ,INDEXF	;

DIRDSP:	.WORD	IDXDSZ,IDXDEV	; DATASET DESCRIPTOR FOR DIRECTORY FILE
	.WORD	DIRSIZ,DIR00	;
	.WORD	DIRECS,DIRECF	;

DSKT:	.WORD	DEVSIZ,DEVNAM	; DATASET DESCRIPTOR FOR LB:[0,0]DISK.TIM;1
	.WORD	DIRSIZ,DIR00	;
	.WORD	FILESZ,FILNAM	;

DEVNAM:	.ASCII	/LB0:/
DEVSIZ=.-DEVNAM

	.EVEN

IDXDEV:	.ASCII	/SY000:/	; FOR INDEX AND DIRECTORY FILES
				; (MUST BE 3 CHARACTERS IN UNIT NUMBER)
IDXDSZ=.-IDXDEV
DIR00:	.ASCII	/[0,0]/		; DIRECTORY STRING
DIRSIZ=.-DIR00
INDEXF:	.ASCII	/INDEXF.SYS/	; INDEX FILE NAME
DXFSIZ=.-INDEXF

;	"DIRECF" MUST START ON A WORD BOUNDARY

	.EVEN

DIRECF:	.ASCII	/000000.DIR/	; DIRECTORY FILE NAME
DIRECS=.-DIRECF
FILNAM:	.ASCII	/DISK.TIM;1/	; FILE FOR TIME PARAMETERS
FILESZ=.-FILNAM

;
;	DIRECTIVE PARAMETER BLOCKS
;

	.EVEN

ALUN:	ALUN$	LUN4,SY,0	; ASSIGN LUN DPB
GLUN:	GLUN$	LUN4,LUNBUF	; GET LUN INFORMATION DPB
TIDPB:	QIOW$	IO.WVB,LUN1,EFN1,,,,<0,0,40>
TIATT:	QIOW$	IO.ATT,LUN1,EFN1
TIDET:	QIOW$	IO.DET,LUN1,EFN1
	.PAGE
	.SBTTL	MAIN PROGRAM

$DSKEP:				; ENTRY POINT

;
;	PRINT INTRODUCTORY MESSAGE
;

	MOV	#TIMBUF,R1	; GET ADDRESS OF TIME BUFFER
	GTIM$S	R1		; FIND OUT WHAT TIME IT IS
	MOV	#INTR1,R0	; GET BUFFER ADDRESS FOR FORMATTED TIME
	CALL	$DAT		; FILL IN THE DATE
	INC	R0		; STEP PAST THE SPACE
	MOV	#3,R2		; SET TIME FORMAT TO HH:MM:SS
	CALL	$TIM		; FILL IN THE TIME
	PRINT	#INTRO,#INTRSZ	; TYPE OUT THE INTRODUCTION
	FINIT$			; INITIALISE FSR

;
;	DETERMINE SIZE OF USER BUFFER REGION. SPACE USED IS FROM THE END OF
;	CODE UP TO THE END OF THE PARTITION. THE BUFFER IS ZEROED TO
;	INITIALISE ALL CONTROL BLOCKS.
;

	GTSK$S	#TASKBF		; GET TASK PARAMETERS
	MOV	TASKSZ+2,R1	; GET END OF CODE ADDRESS
	ADD	#2,R1		; BUMP UP BY TWO
	MOV	R1,BUFADR	; SAVE START OF USER BUFFERS
	MOV	TASKBF+G.TSTS,R0 ; GET SIZE OF TASK (END OF PARTITION ADDR.)
	SUB	#<5*2>,R0	; ALLOCATE A 5 WORD SAFETY ZONE
	SUB	R1,R0		; CALCULATE USER BUFFER SIZE
	BLE	10$		; LE IS ERROR
	MOV	R0,R3		; SAVE SIZE
	INC	R3		; DON'T FORGET A BYTE
	ASR	R3		; CONVERT TO WORDS
	MOV	#D.LGTH,R1	; GET LENGTH OF ONE CONTROL BLOCK
	CALL	$DIV		; CALCULATE MAX. NO OF CONTROL BLOCKS
	MOV	R0,BUFNUM	; SAVE RESULT
	BGT	30$		; POSITIVE IS OK
10$:	PRINT	#ERR1,#ERR1SZ	; NO BUFFER SPACE
20$:	CLOSE$	#TIMFDB		; CLOSE DISK.TIM (IF IT IS OPEN)
	JMP	EXSEV		; EXIT WITH SEVERE ERROR
30$:	MOV	BUFADR,R0	; GET START ADDR. OF USER BUFFER
40$:	CLR	(R0)+		; ZERO A WORD
	DEC	R3		; DONE YET?
	BNE	40$		; IF NE NO, LOOP
	MOV	BUFNUM,R1	; GET NUMBER OF CONTROL BLOCKS
	MOV	#BUFSP1,R0	; AND BUFFER ADDRESS FOR MESSAGE
	CALL	DE.CML		; CONVERT TO DECIMAL
	PRINT	#BUFSP,#BUFSPS	; SEND IT TO USER

;
;	CALCULATE ELAPSED TIME SINCE LAST DISK ACCOUNTING
;

	MOV	#TIMFDB,FDBADR	; SET FDB ADDRESS FOR ERROR PROCESSOR
	OPEN$M	#TIMFDB,#LUN2,#DSKT,#0 ; OPEN LB:[0,0]DISK.TIM
	BCC	50$		; GOOD
	MOV	#ERR2,R5	; SET MESSAGE ADDRESS
	MOV	#ERR2A,R0	; AND LOCATION FOR FCS CODE
45$:	CALL	FCSERR		; FILL IN ERROR DETAILS
	SUB	R5,R0		; CALCULATE MESSAGE SIZE
	PRINT	R5,R0		; PRINT OUT MESSAGE
	BR	20$		; WE BLEW IT
50$:	GET$	,#DSKINP,#<2*8.> ; GET INPUT DATA FROM FILE
	BCC	60$		; GOOD
	MOV	#ERR3,R5	; SET UP MESSAGE PARAMETERS
	MOV	#ERR3A,R0	;
	BR	45$		; GO DO IT
60$:	CLR	R1		; SET UP TO REWIND FILE
	MOV	#1,R2		; (FIRST BYTE OF RECORD)
	CALL	.POINT		; REWIND FILE
	PUT$	#TIMFDB,#TIMBUF,#<2*8.> ; WRITE NEW DATA TO FILE
	BCC	70$		; GOOD
	MOV	#ERR4,R5	; SET UP MESSAGE PARAMETERS
	MOV	#ERR4A,R0	;
	BR	45$		; DO IT
70$:	CLOSE$	R0		; CLOSE THE FILE
	MOV	TIMBUF+G.TIHR,R0 ; GET CURRENT HOUR
	SUB	DSKINP+G.TIHR,R0 ; SUBTRACT PREVIOUS HOUR
	BGE	75$		; IF GE SAME DAY
	ADD	#24.,R0		; POINT TO PREVIOUS DAY
75$:	CALL	MUL.60		; CONVERT TO MINUTES
	ADD	TIMBUF+G.TIMI,R0 ; DEAL WITH MINUTES
	SUB	DSKINP+G.TIMI,R0 ;
	MOV	R0,ELAPS	; SAVE THE RESULT FOR THE CHARGE CALCULATION

;
;	NOW WE CONVERT THE RESULT TO TICKS AND DISPLAY IT
;

	MOV	#60.,R1		; SET MINUTES TO SECONDS CONVERSION
	CALL	$MUL		; CONVERT TO SECONDS
				; WE DO NOT USE MUL.60 HERE BECAUSE OF
				; POSSIBLE OVERFLOW PROBLEMS
	ADD	TIMBUF+G.TISC,R1 ; ADD IN SECONDS
	ADC	R0		 ;
	SUB	DSKINP+G.TISC,R1 ;
	SBC	R0		;
	MOV	R1,R3		; COPY LOW ORDER SECONDS TO R3
	MOV	R0,R2		; AND HIGH ORDER TO R2
	MOV	TIMBUF+G.TICP,R0 ; SET SECONDS TO TICKS CONVERSION FACTOR
	CALL	$DMUL		 ; CONVERT TO TICKS
	ADD	TIMBUF+G.TICT,R1 ; ADD IN ELAPSED TICKS
	ADC	R0		 ;
	SUB	DSKINP+G.TICT,R1 ;
	SBC	R0		;
	MOV	#MONEY+2,R2	; GET TEMPORARY BUFFER ADDRESS + 2 FOR TIME
	MOV	R1,(R2)		; SAVE THE TIME
	MOV	R0,-(R2)	;
	MOV	R2,R1		; SET UP ADDRESS FOR FM.CON ROUTINE
	MOV	#ELAPT1,R0	; GET BUFFER ADDRESS FOR RESULT
	CALL	FM.CON		; FORMAT ELAPSED TIME
	SUB	#ELAPT,R0	; CALCULATE MESSAGE LENGTH
	PRINT	#ELAPT,R0	; TYPE IT OUT
	TST	ELAPS		; DID LESS THAN 1 MINUTE ELAPSE?
	BNE	90$		; IF NE NO, CONTINUE
	JMP	EXIT		; LESS THAN 1 MINUTE, FORGET THIS RUN
90$:				; REF. LABEL

;
;	OPEN ACCOUNT FILE AND FILL USER BUFFERS
;	ALSO WE FILL IN THE TRUE DEVICE NAMES AND NUMBERS AS REPRESENTED IN
;	THE ACCOUNT FILE ENTRIES.
;

	CLR	$ACTFL+F.FNB+N.FID ; DON'T OPEN BY FILE ID
	CALL	OPENAF		; OPEN THE ACCOUNT FILE
				; (THIS ROUTINE DOES NOT RETURN CONTROL
				;  IF ANY ERRORS ARE DETECTED)
	MOV	BUFADR,R5	; GET USER BUFFERS ADDRESS
	MOV	BUFNUM,R4	; AND NUMBER OF CONTROL BLOCKS
100$:	CALL	$AFGET		; READ DATA FROM THE ACCOUNT FILE
	BNE	110$		; IF NE WE GOT SOME DATA
	JMP	130$		; NO WORDS READ
110$:	TST	A.GRP(R0)	; ENTRY IN USE?
	BEQ	120$		; IF EQ NO
	TST	A.ACNO(R0)	; ENTRY ENABLED FOR ACCOUNTING?
	BEQ	120$		; IF EQ NO
	INC	NUSER		; SHOW ONE MORE USER IN BUFFER
	MOV	A.GRP(R0),D.UIC(R5) ; SAVE UIC IN USER BUFFER
	MOV	A.GRP+2(R0),D.UIC+2(R5) ;
	MOV	A.GRP+4(R0),D.UIC+4(R5) ;
	MOV	A.ACNO(R0),D.ACNO(R5)	; SAVE ACCOUNT NUMBER
	MOV	A.CHWD(R0),D.CHWD(R5)	; AND ACCOUNT CHAIN WORD
	MOV	A.SYDV(R0),D.SYDV(R5) ; SAVE SYSTEM DEVICE (ASCII)
	MOV	A.SYDV+2(R0),D.SYDV+2(R5) ;
	MOV	A.ABLK(R0),D.ABLK(R5)	; SAVE AVERAGE BLOCKS
	MOV	A.ABLK+2(R0),D.ABLK+2(R5) ;
	MOV	A.PREV(R0),D.PREV(R5) ; SAVE BLOCKS FOUND LAST TIME
	MOV	A.PREV+2(R0),D.PREV+2(R5) ;
	MOV	A.NDA(R0),D.NDA(R5)   ; SAVE NUMBER OF DSK... RUNS

	.IF DF	AA$BLK

	MOV	A.BALL(R0),D.BALL(R5)	; SAVE BLOCK ALLOCATION
	MOV	A.BALL+2(R0),D.BALL+2(R5) ;

	.ENDC	; DF AA$BLK

	MOV	D.SYDV(R5),ALUN+A.LUNA ; SET UP DEVICE NAME IN DPB
	CALL	UNITNM		; CONVERT UNIT NUMBER TO BINARY
	MOV	R1,ALUN+A.LUNU	; STORE IT IN THE ALUN$ DPB
	BIS	#DD.ERR,D.FLAG(R5) ; ASSUME THERE WILL BE AN ERROR
	DIR$	#ALUN		; ASSIGN THE LUN
	BCC	114$		; OK
	MOV	R0,-(SP)	; SAVE R0
	MOV	#ERR12A,R0	; SET UP ERROR MESSAGE POINTERS
	MOV	#ERR12,R1	;
112$:	MOVB	D.SYDV(R5),(R0)+ ; MOVE IN DEVICE SPEC.
	MOVB	D.SYDV+1(R5),(R0)+ ;
	MOVB	D.SYDV+2(R5),(R0)+ ;
	MOVB	D.SYDV+3(R5),(R0)+ ;
	MOVB	#COLON,(R0)+	; DEVICE/UFD SEPARATOR
	CALL	FMTUIC		; FILL IN UFD AS [GGG,MMM]
	SUB	R1,R0		; CALCULATE MESSAGE SIZE
	PRINT	R1,R0		; PRINT IT OUT
	MOV	(SP)+,R0	; RESTORE R0
	BR	115$		; CONTINUE WITH NEXT USER
114$:	DIR$	#GLUN		; GET LUN INFO.
	BCC	116$		; OK
	MOV	R0,-(SP)	; SAVE R0
	MOV	#ERR13A,R0	; SET UP ERROR MESSAGE PARAMETERS
	MOV	#ERR13,R1	;
	BR	112$		; SEND ERROR MESSAGE
116$:	BIC	#DD.ERR,D.FLAG(R5) ; OK, CLEAR ERROR FLAG
	MOV	LUNBUF+G.LUNA,D.DEVN(R5) ; STORE DEVICE NAME
	BISB	LUNBUF+G.LUNU,D.DEVU(R5) ; AND UNIT NUMBER
115$:	ADD	#D.LGTH,R5	; POINT TO NEXT CONTROL BLOCK
	DEC	R4		; ANY LEFT?
	BNE	120$		; IF NE YES
	PRINT	#ERR6,#ERR6SZ	; NO, SAY OVERFLOW
	BR	140$		; THAT'S IT
120$:	ADD	#A.LEN,R0	; POINT TO NEXT ACCOUNT ENTRY
	SUB	#A.LEN,R2	; ANY DATA LEFT IN BUFFER?
	BLOS	130$		; IF LOS NO, DON'T LOOP
	JMP	110$		; GIVE THE NEXT USER THE TREATMENT
130$:	CMPB	#IE.EOF,$AFIOS	; END OF FILE?
	BEQ	140$		; IF EQ YES
	TSTB	$AFIOS		; NO, ANY ERRORS?
	BMI	140$		; IF MI YES
	CALL	$AFNXB		; POINT TO NEXT BLOCK IN A/C FILE
	JMP	100$		; GO DO IT
140$:	CALL	$AFCLS		; CLOSE THE ACCOUNT FILE
	MOV	NUSER,R1	; SET NUMBER OF USERS COPIED INTO BUFFER
	MOV	#NUMUS1,R0	; GET BUFFER ADDRESS FOR MESSAGE
	CALL	DE.CML		; CONVERT TO DECIMAL
	SUB	#NUMUSR,R0	; CALCULATE STRING LENGTH
	PRINT	#NUMUSR,R0	; AND TYPE IT OUT
	TST	NUSER		; DID WE GET ANYTHING?
	BNE	150$		; IF NE YES
	JMP	EXIT		; NO, JUST EXIT

;
;	NOW WE SCAN THE INTERNAL BUFFER ENTRY BY ENTRY. THE SCAN IS SUCH THAT WE
;	DO IT DEVICE BY DEVICE SO THAT THE INDEX FILE FOR EACH VOLUME HAS TO BE
;	OPENED ONLY ONCE. FOR EACH VOLUME, THE BLOCKS IN USE BY EACH USER REPRESENTED
;	IN THE ACCOUNT FILE IS DETERMINED. ANY UFDS THAT ARE ON THE VOLUME BUT DO
;	NOT HAVE A CORRESPONDING ACCOUNT IN THE ACCOUNT FILE WILL BE IGNORED.
;

150$:	CALL	NXTDEV		; GET THE NEXT DEVICE TO EXAMINE
	BCS	170$		; IF CS NO MORE DEVICES
	CALL	INDEXV		; OPEN THE INDEX FILE ON THIS VOLUME AND
				; SET IT UP FOR FCS I/O
	BCS	150$		; OPEN FAILURE ON INDEX FILE, GET NEXT DEVICE
160$:	CALL	NXTUSR		; GET THE NEXT USER ON THIS VOLUME
	BCS	150$		; IF CS THERE AREN'T ANY MORE
	CALL	UFDSIZ		; FIND USAGE PARAMETERS FOR THIS USER
	BR	160$		; REPEAT FOR NEXT USER
170$:	CALL	CHAIN		; FOLLOW CHAIN LINKAGES TO ACCUMULATE CORRECT
				; NUMBER OF BLOCKS FOR CHARGING.
	CALL	GETDUP		; EXAMINE FOR DUPLICATED ACCOUNTS
	CALL	GETDLR		; CALCULATE CHARGES
	CALL	LIST		; SHOW WHAT WE'VE GOT SO FAR
	MOV	#TOTAL1,R0	; GET BUFFER ADDRESS FOR TOTAL CHARGES
	MOV	#MONEY,R1 	; SET UP TOTAL CHARGE POINTER FOR FM.CHG
	CALL	FM.CHG		; FORMAT TOTAL CHARGES
	SUB	#TOTAL,R0	; CALCULATE MESSAGE LENGTH
	PRINT	#TOTAL,R0	; TYPE IT OUT

;
;	NOW WE REOPEN THE ACCOUNT FILE AND UPDATE THE ACCOUNT STATISTICS
;

	TST	NUSER		; ANY CHARGES TO DEAL WITH?
	BNE	180$		; IF NE YES
	JMP	EXIT		; NO, JUST EXIT
180$:	CALL	OPENAF		; OPEN ACCOUNT FILE

;
;	THE FOLLOWING CODE MAY LOOK LIKE A LOT OF CHURNING IS GOING ON,
;	BUT USUALLY THE ORDER OF THE ENTRIES IN THE ACCOUNT FILE WILL NOT
;	HAVE CHANGED WHILE THE DISK SCAN WAS RUNNING. THIS CODE, HOWEVER,
;	ALLOWS FOR THE FACT THAT THE ENTRY ORDER MAY HAVE CHANGED, AND
;	EVEN FOR THE DELETION OF ACCOUNTS OR THE ADDITION OF NEW ONES.
;	THE ACCOUNT CHAINING FEATURE IS SUPPORTED.
;

	CLR	MONEY		; CLEAR MONEY TOTALS FOR SCAN
	CLR	MONEY+2		;
200$:	CALL	$AFGET		; READ DATA FROM THE ACCOUNT FILE
	BEQ	250$		; IF EQ SOMETHING IS UP (NO WORDS READ)
210$:	TST	A.GRP(R0)	; THIS ENTRY ACTIVE?
	BEQ	230$		; IF EQ NO
	TST	A.ACNO(R0)	; ENTRY ENABLED FOR ACCOUNTING?
	BEQ	230$		; IF EQ NO
	CALL	MATCH		; SEARCH FOR A MATCH FOR THIS ACCOUNT
	BCS	230$		; THERE WASN'T ONE
	BIS	#DD.WRT,D.FLAG(R3) ; OK, MARK IT AS USED
	MOV	D.NDA(R3),A.NDA(R0) ; REWRITE NUMBER OF DISK ACCOUNTINGS
	MOV	D.ABLK(R3),A.ABLK(R0) ; REWRITE AVERAGE BLOCK USE
	MOV	D.ABLK+2(R3),A.ABLK+2(R0) ;
	MOV	D.NBLK(R3),A.PREV(R0) ; SET UP PREVIOUS BLOCKS FOR NEXT TIME
	MOV	D.NBLK+2(R3),A.PREV+2(R0) ;
	SUB	D.DCHG+2(R3),A.CASH+2(R0) ; UPDATE ACCOUNT BALANCE
	SBC	A.CASH(R0)	;
	SUB	D.DCHG(R3),A.CASH(R0) ;
	ADD	D.DCHG+2(R3),MONEY+2 ; UPDATE MONEY TOTAL
	ADC	MONEY		;
	ADD	D.DCHG(R3),MONEY ;
	DEC	NUSER		; ANY USERS LEFT TO SCAN?
	BEQ	260$		; IF EQ NO, END OF CONTROL BLOCK LIST BEFORE
				; END OF ACCOUNTING BUFFER
230$:	ADD	#A.LEN,R0	; POINT TO NEXT ENTRY IN ACCOUNT BUFFER
	SUB	#A.LEN,R2	; ANY ENTRIES LEFT IN THIS BUFFER?
	BHI	210$		; IF HI YES
	CALL	$AFPUT		; NO, REWRITE THIS BUFFER TO A/C FILE
250$:	CMPB	#IE.EOF,$AFIOS	; END OF ACCOUNT FILE?
	BEQ	270$		; IF EQ YES
	TSTB	$AFIOS		; NO, ANY I/O ERRORS?
	BMI	270$		; IF MI YES
	BR	200$		; NO, TRY AGAIN
260$:	CALL	$AFPUT		; REWRITE BUFFER IF PREMATURE END-OF-LIST
270$:	CALL	$AFCLS		; CLOSE ACCOUNT FILE
	MOV	#TOTAL3,R0	; GET BUFFER ADDRESS FOR TOTAL MONEY MESSAGE
	MOV	#MONEY,R1	 ; SET UP MONEY POINTER
	CALL	FM.CHG		; FORMAT MONEY
	SUB	#TOTAL2,R0	; CALCULATE MESSAGE LENGTH
	PRINT	#TOTAL2,R0	; TYPE IT OUT

;
;	THE CONTENTS OF THE CONTROL BLOCK LIST ARE NOW WRITTEN TO THE FILE
;	LB:[0,0]ACCOUNTS.DAT FOR LATER USE IN REPORT PREPARATION. IF THE FILE
;	DOES NOT EXIST, IT IS CREATED WITH SYSTEM OWNERSHIP AND SUITABLE
;	ACCESS RIGHTS.
;

	MOV	#$RFFDB,FDBADR	; SET FDB ADDRESS FOR ERROR PROCESSOR
	CALL	$RFOPN		; OPEN ACCOUNTING RECORDS FILE
	BCC	300$		; OK
	MOV	#ERR14,R5	; OPEN ERROR, GET MESSAGE PARAMETERS
	MOV	#ERR14A,R0	;
	JMP	45$		; SEND ERROR MESSAGE AND EXIT
300$:	MOV	#FF.DSK,$RFREC+F.CODE ; SET DISK ACCOUNTING CODE IN
				; RECORD CODE WORD
	MOV	#F.LDSK,$RFLEN	; SET PROPER RECORD SIZE

;
;	NOW WRITE ALL THE RECORDS INTO THE DISK FILE
;

	MOV	BUFADR,R5	; GET CONTROL BLOCK LIST ADDRESS
	MOV	BUFNUM,R4	; GUESS WHAT
310$:	TST	D.UIC(R5)	; ACTIVE ENTRY?
	BEQ	350$		; IF EQ NO, SKIP
	BIT	#DD.ERR,D.FLAG(R5) ; YES, ANY ERRORS?
	BNE	350$		; IF NE YES, SKIP
	MOV	#$RFREC+F.UIC,R0	; GET ADDRESS OF DATA BUFFER (UIC LOCATION)
	MOV	R5,-(SP)	; SAVE CONTROL BLOCK POINTER
	CALL	CVTUIC		; CONVERT UIC TO BINARY AND INSERT IN
				; THE OUTPUT BUFFER
	CMP	(R5)+,(R5)+	; SKIP A/C FILE SYSTEM DEVICES
	MOV	(R5)+,(R0)+	; INSERT ACCOUNT NUMBER
	MOV	(R5)+,(R0)+	; INSERT ACCOUNT CHAIN WORD
	MOV	(R5)+,(R0)+	; INSERT MASTER A/C FOUND FROM A/C FILE SCAN
	MOV	(R5)+,(R0)+	; INSERT ASCII SYSTEM DEVICE NAME
	MOV	(R5)+,(R0)+	; AND BINARY DEVICE NUMBER
	CMP	(R5)+,(R5)+	; SKIP PREVIOUS BLOCKS
	MOV	(R5)+,(R0)+	; INSERT CURRENT BLOCKS
	MOV	(R5)+,(R0)+	;
	MOV	(R5)+,(R0)+	; INSERT NUMBER OF FILES
	MOV	(R5)+,(R0)+	; INSERT AVERAGE BLOCKS
	MOV	(R5)+,(R0)+	;

	.IF DF	AA$BLK

	MOV	(R5)+,(R0)+	; INSERT BLOCK ALLOCATION
	MOV	(R5)+,(R0)+	;

	.IFF

	CMP	(R0)+,(R0)+	; SKIP 2 WORDS IN OUTPUT BUFFER (THE $RFOPN
				; ROUTINE WILL ALREADY HAVE ZEROED THEM)

	.ENDC	; DF AA$BLK

	MOV	(R5)+,(R0)+	; INSERT NUMBER OF DISK ACCOUNTINGS
	MOV	(R5)+,(R0)+	; AND CHARGE
	MOV	(R5)+,(R0)+	;
	MOV	(SP)+,R5	; YES, RESTORE CONTROL BLOCK ADDRESS
	CALL	$RFPUT		; WRITE THE DATA TO THE RECORDS FILE
350$:	ADD	#D.LGTH,R5	; POINT TO NEXT CONTROL BLOCK
	DEC	R4		; ANY MORE TO DO?
	BNE	310$		; IF NE YES, DO IT
	CALL	$RFCLS		; NOW CLOSE THE RECORDS FILE
	BR	EXIT		; AND EXIT
EXSEV:	PRINT	#END,#ENDSZ	; END OF DISK ACCOUNTING
	EXST$S	#EX$SEV		; EXIT WITH SEVERE ERROR
EXIT:	PRINT	#END,#ENDSZ	; END OF DISK ACCOUNTING
	EXIT$S			; NORMAL EXIT
	.PAGE
	.SBTTL	ROUTINE TO OPEN ACCOUNT FILE

;+
; *** OPENAF
;
;	THIS ROUTINE OPENS THE RSX11 SYSTEM ACCOUNT FILE. IF THERE
;	ARE ERRORS, AN ERROR MESSAGE IS PRINTED AND A JUMP IS MADE
;	TO EXSEV TO GENERATE A SEVERE ERROR.
;
;-

OPENAF:	CALL	$AFOPN		; CALL A/C FILE OPEN ROUTINE
	BCC	10$		; GOOD
	PRINT	#ERR5		; ERROR, PRINT MESSAGE
	JMP	EXSEV		; AND GENERATE A SEVERE ERROR EXIT
10$:	RETURN			; RETURN TO CALLER
	.PAGE
	.SBTTL	ROUTINE TO CONVERT DISK UNIT NUMBER

;+
; *** UNITNM
;
;	THIS ROUTINE CONVERTS A TWO-DIGIT ASCII DISK UNIT NUMBER TO
;	BINARY.
;
;	INPUTS:
;		R5	ADDRESS OF DISK CONTROL BLOCK
;
;	OUTPUTS:
;		R1	BINARY UNIT NUMBER
;		ALL OTHER REGISTERS ARE (MUST BE) PRESERVED
;
;-

UNITNM:	CLR	-(SP)		; CLEAR LOCATION READY FOR UNIT NUMBER
	BISB	D.SYDV+2(R5),(SP) ; GET FIRST DIGIT OF UNIT NUMBER
	SUB	#'0,(SP)	; SUBTRACT BIAS TO GET A NUMBER
	ASL	(SP)		; MULTIPLY BY EIGHT
	ASL	(SP)		;
	ASL	(SP)		;
	CLR	R1		; ZERO R1 FOR SECOND DIGIT
	BISB	D.SYDV+3(R5),R1	; GET SECOND DIGIT OF UNIT NUMBER
	SUB	#'0,R1		; SUBTRACT CHARACTER BIAS
	ADD	(SP)+,R1	; GET FINAL UNIT NUMBER
	RETURN			; AND RETURN TO CALLER
	.PAGE
	.SBTTL	ASCII TO BINARY UIC CONVERSION ROUTINE

;+
; *** CVTUIC
;
;	THIS ROUTINE TAKES AN ASCII UIC IN THE FORM GGGMMM AND CONVERTS
;	IT TO BINARY. THE RESULT IS STORED IN THE RECORD BUFFER.
;
;	INPUTS:
;		R0	ADDRESS OF LOCATION TO STORE BINARY UIC
;		R5	ADDRESS OF ASCII UIC STRING
;
;	OUTPUTS:
;		R0	(INPUT R0)+2
;		R1	USED
;		R5	(INPUT R5)+6
;
;-

CVTUIC:	CALL	10$		; CONVERT GROUP CODE TO BINARY
	MOVB	R1,(R0)+	; INSERT IN BUFFER
	CALL	10$		; CONVERT MEMBER CODE TO BINARY
	MOVB	R1,(R0)+	; INSERT IN BUFFER
	SWAB	-2(R0)		; POSITION GRP/MEM IN RIGHT PLACES
	RETURN			; AND RETURN TO CALLER
10$:	MOVB	(R5)+,R1	; GET FIRST CHARACTER
	SUB	#'0,R1		; SUBTRACT CHARACTER BIAS
	ASL	R1		; MULTIPLY BY EIGHT
	ASL	R1		;
	ASL	R1		;
	MOVB	(R5)+,R2	; GET SECOND CHARACTER
	SUB	#'0,R2		; SUBTRACT CHARACTER BIAS
	ADD	R2,R1		; ADD TO RUNNING TOTAL
	ASL	R1		; MULTIPLY BY EIGHT
	ASL	R1		;
	ASL	R1		;
	MOVB	(R5)+,R2	; GET THIRD AND LAST CHARACTER
	SUB	#'0,R2		; SUBTRACT CHARACTER BIAS
	ADD	R2,R1		; ADD TO FORM COMPLETE RESULT
	RETURN			; RETURN TO CALLER
	.PAGE
	.SBTTL	ROUTINE TO GET NEXT DEVICE FOR ACCOUNTING

;+
; *** NXTDEV
;
;	THIS ROUTINE SCANS THE INTERNAL BUFFER AND OBTAINS THE NEXT
;	DEVICE TO BE ACCOUNTED. THIS IS OBTAINED FROM THE D.DEVN AND
;	D.DEVU FIELDS OF THE FIRST CONTROL BLOCK FOUND THAT HAS
;	D.FLAG EQUAL TO ZERO.
;
;	OUTPUT:
;		CARRY SET -- ALL DEVICES HAVE BEEN ACCOUNTED
;		CARRY CLEAR  DEVN AND DEVU HAVE BEEN SET UP WITH THE NAME
;			     AND NUMBER OF THE NEXT DEVICE TO ACCOUNT.
;-

NXTDEV:	CLOSE$	#IDXFDB		; MAKE SURE INDEX FILE IS CLOSED AFTER
				; PREVIOUS OPERATION
	MOV	BUFADR,R5	; GET INTERNAL BUFFER ADDRESS
	MOV	BUFNUM,R4	; AND SIZE OF IT (# CONTROL BLOCKS)
10$:	TST	D.UIC(R5)	; THIS ENTRY IN USE?
	BEQ	20$		; IF EQ NO, SKIP IT
	TST	D.FLAG(R5)	; ALREADY ACCOUNTED?
	BNE	20$		; IF NE YES, SKIP IT
	MOV	D.DEVN(R5),DEVN	; SAVE DEVICE NAME
	MOV	D.DEVU(R5),DEVU	; AND ITS UNIT NUMBER
	BR	30$		; RETURN WITH SUCCESS
20$:	ADD	#D.LGTH,R5	; POINT TO NEXT CONTROL BLOCK
	DEC	R4		; ARE THERE ANY MORE?
	BNE	10$		; IF NE YES, TRY THEM
	SEC			; NO, SET NO MORE DEVICES TO ACCOUNT
	BR	40$		; AND RETURN
30$:	CLC			; SET SUCCESS
40$:	RETURN			; AND RETURN TO CALLER
	.PAGE
	.SBTTL	INDEX FILE OPEN ROUTINE

;+
; *** INDEXV
;
;
;	THIS ROUTINE OPENS THE INDEX FILE ON THE VOLUME SEPCIFIED BY
;	"DEVN" AND "DEVU". THE INDEX FILE IS SIZED TO PERMIT FCS I/O.
;	AN ERROR MESSAGE IS DISPLAYED IF THERE IS AN OPEN ERROR - THE
;	VOLUME WILL NOT BE ACCOUNTED. ALL USERS ON THIS VOLUME MUST BE
;	SCANNED (TO PREVENT A LOOP LOOKING FOR THE NEXT DEVICE TO
;	ACCOUNT) AND MARKED WITH AN ERROR FLAG.
;
;-

INDEXV:	MOV	#IDXDEV,R0	; GET ADDRESS OF DEVICE STRING FOR OPEN
	MOV	DEVN,(R0)+	; INSERT THE DEVICE NAME
	MOV	DEVU,R1		; GET DEVICE PHYSICAL UNIT NUMBER
	MOV	PC,R2		; FIELD WIDTH OF 3 CHARACTERS
	CALL	$CBTMG		; CONVERT TO OCTAL
	MOV	#IDXFDB,FDBADR	; SET FDB ADDRESS FOR ERROR PROCESSOR
	OPNS$R	#IDXFDB		; OPEN THE INDEX FILE
	BCC	20$		; GOOD, WE DID IT
	MOV	#ERR7A,R0	; GET PLACE FOR DEVICE NAME MESSAGE
	MOV	#ERR7,R3	; SET ERROR MESSAGE ADDRESS
10$:	CALL	FMTDEV		; FORMAT DEVICE NAME
	CALL	FCSERR		; INSERT FCS ERROR INFORMATION
	SUB	R3,R0		; CALCULATE ERROR MESSAGE SIZE
	PRINT	R3,R0		; SEND IT OUT
	CALL	IDXERR		; SET ERROR MARKERS FOR THIS VOLUME
	SEC			; SET CARRY TO INDICATE FAILURE
	JMP	40$		; AND RETURN TO CALLER
20$:	MOV	#3,IDXFDB+F.EFBK+2 ; SET EOF BLOCK TO READ HOME BLOCK
	MOV	#2,IDXFDB+F.BKVB+2 ; SET VIRTUAL BLOCK NUMBER TO 2
	READ$	#IDXFDB		; READ HOME BLOCK
	BCC	30$		; GOOD
	CLOSE$	#IDXFDB		; CLOSE INDEX FILE
	MOV	#ERR9A,R0	; BUFFER ADDRESS FOR DEVICE STRING
	MOV	#ERR9,R3	; ERROR TEXT ADDRESS
	BR	10$		; SEND OUT ERROR
30$:	WAIT$	#IDXFDB		; WAIT FOR HOME BLOCK I/O TO COMPLETE
	MOV	IDXBUF,R0	; GET BUFFER ADDRESS
	MOV	H.IBSZ(R0),R0	; GET INDEX BIT MAP SIZE
	MOV	R0,IDXMAP	; SAVE IT
	ADD	#3,R0		; FIND VIRTUAL BLOCK FOR INDEX FILE HEADER
	MOV	R0,IDXFHD	; AND SAVE IT FOR DIRECTORY SCAN
	MOV	R0,IDXFDB+F.BKVB+2 ; SET UP TO READ INDEX FILE HEADER
	INC	R0		; GET EOF BLOCK
	MOV	R0,IDXFDB+F.EFBK+2 ; SET IT UP IN THE FDB
	CLR	UFDADR		; DISABLE ID/SEQUENCE NUMBER CHECK
	CALL	FILSIZ		; FIND SIZE OF INDEX FILE
	ADD	#1,FSIZE+2	; POINT PAST EOF
	ADC	FSIZE		;
	MOV	FSIZE,IDXFDB+F.EFBK ; SET THIS UP IN THE FDB
	MOV	FSIZE+2,IDXFDB+F.EFBK+2 ;
	MOV	#ISIZEA,R0	; GET BUFFER ADDRESS FOR TEXT
	CALL	FMTDEV		; FORMAT DEVICE SPECIFICATION
	MOVB	#SPA,(R0)+	; INSERT " = "
	MOVB	#'=,(R0)+	;
	MOVB	#SPA,(R0)+	;
	MOV	#FSIZE+2,R1	; GET ADDRESS + 2 OF INDEX FILE SIZE
	SUB	#1,(R1)		; SUBTRACT EOF BIAS
	SBC	-(R1)		;
	CALL	FM.QIO		; CONVERT TO DECIMAL
	MOVSTR	#BLK		; INSERT TRAILING STRING
	SUB	#ISIZE,R0	; CALCULATE MESSAGE SIZE
	PRINT	#ISIZE,R0	; PRINT IT OUT
	CALL	BITMAP		; READ INDEX FILE BITMAP
40$:	RETURN			; RETURN TO CALLER
	.PAGE
	.SBTTL	ERROR MARKER ROUTINE

;+
; *** IDXERR
;
;	THIS ROUTINE IS CALLED WHEN THERE HAS BEEN AN INDEX FILE OPEN
;	ERROR (EG VOLUME NOT MOUNTED). ALL USERS ON THIS VOLUME HAVE
;	THEIR ERROR FLAGS SET TO AVOID A LOOP IN THE NEXT VOLUME
;	ROUTINE.
;
;-

IDXERR:	CLOSE$	#IDXFDB		; MAKE SURE FILE IS CLOSED
	MOV	BUFADR,R5	; GET ADDRESS OF USER DATA REGION
	MOV	BUFNUM,R4	; AND NUMBER OF CONTROL BLOCKS
10$:	TST	D.UIC(R5)	; THIS ENTRY IN USE?
	BEQ	20$		; IF EQ, NO
	CMP	D.DEVN(R5),DEVN	; YES, ON THE RIGHT VOLUME?
	BNE	20$		; IF NE NO
	CMP	D.DEVU(R5),DEVU	; MAYBE
	BNE	20$		; IF NE NO
	BIS	#DD.ERR,D.FLAG(R5) ; OK, SET ERROR FLAG
20$:	ADD	#D.LGTH,R5	; POINT TO NEXT CONTROL BLOCK
	DEC	R4		; AND MORE LEFT?
	BNE	10$		; IF NE YES, SO LOOP
	RETURN			; ELSE RETURN TO CALLER
	.PAGE
	.SBTTL	INDEX FILE BIT MAP READ ROUTINE

;+
; *** BITMAP
;
;	THIS ROUTINE IS CALLED DURING THE INDEX FILE OPEN PHASE. IT
;	BUFFERS THE INDEX FILE BIT MAP IN THE ACCOUNT FILE BUFFER.
;	THIS MAP IS USED SUBSEQUENTLY TO DETERMINE IF WE HAVE ALREADY
;	LOOKED AT A PARTICULAR FILE HEADER (IE FOR PROPER SYNONYM
;	EXCLUSION). IF THE BITMAP IS TOO LARGE (>BUFFER SIZE), WE READ
;	WHAT WE CAN AND FUDGE THE REST. IF WE CAN'T READ THE BITMAP
;	FOR ANY REASON, WE SKIP IT AND HOPE THAT EVERYONE IS NOT
;	MADLY RENAMING THEIR FILES. IF THERE IS NO BITMAP BUFFER
;	ALLOCATION, WE FUDGE EVRYTHING.
;
;-

BITMAP:	TST	$BMAP1		; ANY BITMAP BUFFER ALLOCATION?
	BNE	10$		; IF NE YES
	CLR	IDXMAP		; NO, CLEAR SIZE WORD
	BR	50$		; AND RETURN
10$:	CMP	IDXMAP,$BMAP1	; BIT MAP TOO LARGE?
	BLE	20$		; IF LE NO
	MOV	$BMAP1,IDXMAP	; YES, USE ONLY THE FIRST BLOCKS
	MOV	#ERR17A,R0	; GET ERROR MESSAGE ADDRESS FOR DEVICE
	CALL	FMTDEV		; FORMAT DEVICE NAME
	SUB	#ERR17,R0	; CALCULATE MESSAGE LENGTH
	PRINT	#ERR17,R0	; AND PRINT IT, THEN CONTINUE
20$:	MOV	#$BMAP0,IDXFDB+F.BKDS+2 ; SET NEW BUFFER ADDRESS
	MOV	IDXMAP,R0	; GET REQUIRED SIZE IN BLOCKS
	SWAB	R0		; MULTIPLY BY 512. TO GET SIZE...
	ASL	R0		; ...IN BYTES
	MOV	R0,IDXFDB+F.BKDS ; AND PUT IT IN THE FDB
	MOV	#3,IDXFDB+F.BKVB+2 ; SET UP TO READ 1ST BLOCK OF BITMAP
	READ$	#IDXFDB		; READ INDEX FILE BITMAP
	BCC	30$		; IF CC GOOD
	CLR	IDXMAP		; SHOW NO BITMAP AVAILABLE
	MOV	#ERR18A,R0	; GET ERROR MESSAGE ADDRESS FOR DEVICE
	CALL	FMTDEV		; FORMAT DEVICE NAME
	CALL	FCSERR		; INSERT FCS ERROR INFORMATION
	SUB	#ERR18,R0	; CALCULATE MESSAGE LENGTH
	PRINT	#ERR18,R0	; AND PRINT IT
	BR	40$		; RESET BUFFER PARAMETERS AND RETURN
30$:	WAIT$	#IDXFDB		; WAIT FOR BITMAP I/O
	MOV	IFSTAT+2,R0	; GET COUNT OF BYTES READ
	ASL	R0		; COMPUTE HIGHEST FILE I.D. AVAILABLE
	ASL	R0		;
	ASL	R0		;
	MOV	R0,$BMAP2	; SAVE FOR CHKBIT ROUTINE
40$:	MOV	#512.,IDXFDB+F.BKDS    ; RESET BUFFER SIZE
	MOV	IDXBUF,IDXFDB+F.BKDS+2 ; RESET BUFFER ADDRESS
50$:	RETURN			; AND RETURN TO INDEX FILE ROUTINE	
	.PAGE
	.SBTTL	ROUTINE TO FIND NEXT USER FOR ACCOUNTING

;+
; *** NXTUSR
;
;	THIS ROUTINE SCANS THE USER BUFFER TO FIND THE NEXT USER TO BE
;	ACCOUNTED ON THE CURRENT VOLUME. THIS IS THE USER WITH D.FLAG=0
;	AND WITH A TRUE SYSTEM DEVICE THAT MATCHES THAT OF THE CURRENT
;	VOLUME, AS IN DEVN AND DEVU.
;
;	OUTPUT:
;		R5	USER'S CONTROL BLOCK ADDRESS
;
;-

NXTUSR:	MOV	BUFADR,R5	; GET BUFFER ADDRESS
	MOV	BUFNUM,R4	; AND NUMBER OF USERS
10$:	TST	D.UIC(R5)	; THIS ENTRY IN USE?
	BEQ	20$		; IF EQ NO
	TST	D.FLAG(R5)	; THIS ENTRY BEEN DONE YET?
	BNE	20$		; IF NE YES, SKIP IT
	CMP	D.DEVN(R5),DEVN	; DO DEVICE NAMES MATCH?
	BNE	20$		; IF NE NO, SKIP THIS USER
	CMP	D.DEVU(R5),DEVU	; YES, DO UNIT NUMBERS MATCH?
	BEQ	30$		; IF EQ YES, THIS IS THE ONE WE WANT
20$:	ADD	#D.LGTH,R5	; POINT TO NEXT CONTROL BLOCK
	DEC	R4		; ARE THERE ANY LEFT?
	BNE	10$		; IF NE YES, LOOP
	SEC			; NO, SET CARRY TO INDICATE WE'RE OUT OF USERS
	BR	40$		; AND RETURN
30$:	CLC			; CLEAR CARRY TO INDICATE SUCCESS
40$:	RETURN			; RETURN TO CALLER
	.PAGE
	.SBTTL	USER FILE DIRECTORY SCANNING ROUTINE

;+
; *** UFDSIZ
;
;	THIS ROUTINE SCANS A USER FILE DIRECTORY ON THE CURRENT VOLUME
;	AND ADDS UP THE TOTAL NUMBER OF FILES AND BLOCKS ALLOCATED TO
;	THE USER. THE VOLUME SPECIFICATION IS ALREADY SET UP IN THE
;	DATASET DESCRIPTOR, BUT THE UFD NAME NEEDS TO BE INITIALISED.
;	THE DIRECTORY FILE IS READ IN 3 BLOCKS AT A TIME.
;
;	INPUT:
;		R5	USER CONTROL BLOCK ADDRESS
;
;	OUTPUT:
;		THE RELEVANT AREAS IN THE CONTROL BLOCK ARE
;		INCREMENTED.
;
;-

UFDSIZ:	MOV	#DIRECF,R0	; GET ADDRESS OF DIRECTORY FILE NAME STRING
	MOV	D.UIC(R5),(R0)+	; SET UP UFD NAME IN DATASET DESCRIPTOR
	MOV	D.UIC+2(R5),(R0)+ ;
	MOV	D.UIC+4(R5),(R0)+ ;
	BIS	#DD.ACN,D.FLAG(R5) ; SHOW THAT THIS ONE WAS ACCOUNTED
	MOV	#DIRFDB,FDBADR	; SET FDB ADDRESS FOR ERROR PROCESSOR
	OPNS$R	#DIRFDB		; OPEN THE DIRECTORY FILE
	BCC	20$		; OK
	BIS	#DD.ERR,D.FLAG(R5) ; SHOW AN ERROR IN THE CONTROL BLOCK
	MOV	#ERR8A,R0	; GET UFD FIELD ADDRESS IN ERROR MESSAGE
	MOV	#ERR8,R3	; AND ERROR TEXT ADDRESS
10$:	CALL	FMTDEV		; INSERT DEVICE SPECIFICATION
	CALL	FMTUIC		; AND THE UFD IN [GGG,MMM] FORM
	CALL	FCSERR		; INSERT FCS ERROR INFORMATION
	SUB	R3,R0		; CALCULATE MESSAGE LENGTH
	PRINT	R3,R0		; TYPE IT OUT
	BR	60$		; AND RETURN
20$:	MOV	#DIRFDB,FDBADR	; SET FDB ADDRESS FOR ERROR PROCESSOR
	READ$	#DIRFDB		; READ A BLOCK OF THE DIRECTORY FILE
	BCC	30$		; GOOD
	CMPB	#IE.EOF,DIRFDB+F.ERR ; END OF FILE?
	BEQ	60$		; IF EQ YES, THAT'S IT
22$:	MOV	#ERR11A,R0	; SET UP ERROR MESSAGE PARAMETERS
	MOV	#ERR11,R3	;
	BR	10$		; SEND IT
30$:	WAIT$	#DIRFDB		; WAIT FOR I/O
	MOV	DFSTAT+2,R3	; GET COUNT OF BYTES READ
	ASR	R3		; DIVIDE BY SIXTEEN...
	ASR	R3		; ...TO GET NUMBER OF...
	ASR	R3		; ...DIRECTORY ENTRIES...
	ASR	R3		; ...(EACH IS 16. BYTES LONG)
	BEQ	22$		; IF EQ, SOMETHING IS UP
	MOV	DIRBUF,R0	; GET BUFFER ADDRESS (FIRST ENTRY ADDRESS)
40$:	MOV	R0,UFDADR	; NOTE CURRENT POSITION IN UFD
	MOV	(R0),R1		; GET FILE ID
	BEQ	50$		; IF EQ NO FILE IS IN THIS SLOT
	ADD	IDXFHD,R1	; CALCULATE VBN FOR FILE HEADER IN INDEX FILE
	DEC	R1		;
	MOV	R1,IDXFDB+F.BKVB+2 ; SET UP VBN FOR FILSIZ ROUTINE
	CALL	FILSIZ		; FIND THE SIZE OF THIS FILE
	ADD	FSIZE+2,D.BLOK+2(R5) ; ADD FILE SIZE TO UFD SIZE
	ADC	D.BLOK(R5)	;
	ADD	FSIZE,D.BLOK(R5) ;
	INC	D.NFIL(R5)	; AND NUMBER OF FILES
	MOV	UFDADR,R0	; RESTORE CURRENT UFD POSITION
50$:	ADD	#<8.*2>,R0	; POINT TO NEXT ENTRY
	DEC	R3		; ARE THERE ANY MORE?
	BNE	40$		; IF NE YES, DO IT
	BR	20$		; TRY NEXT BLOCK OF DIRECTORY FILE
60$:				; REF. LABEL

	.IF DF	AA$UFD

	MOV	DIRFDB+F.FNB+N.FID,R1 ; SAVE DIRECTORY FILE ID

	.IFTF

	CLOSE$	#DIRFDB		; CLOSE THE DIRECTORY FILE

	.IFT

	BCS	70$		; IF CS SKIP SIZING IT
	ADD	IDXFHD,R1	; CALCULATE VBN FOR DIRECTORY FILE HEADER..
	DEC	R1		;  ..IN THE INDEX FILE
	MOV	R1,IDXFDB+F.BKVB+2 ; SET UP VBN FOR FILSIZ ROUTINE
	CLR	UFDADR		; DISABLE ID/SEQUENCE NUMBER CHECK
	CALL	FILSIZ		; FIND SIZE OF DIRECTORY FILE
	ADD	FSIZE+2,D.BLOK+2(R5) ; ADD SIZE OF UFD FILE TO TOTAL SIZE
	ADC	D.BLOK(R5)	 ;
	ADD	FSIZE,D.BLOK(R5) ;
	INC	D.NFIL(R5)	 ; SHOW ONE MORE FILE

	.ENDC	; DF AA$UFD

70$:	RETURN			; AND RETURN TO CALLER
	.PAGE
	.SBTTL	ROUTINE TO FIND THE SIZE OF A FILE

;+
; *** FILSIZ
;
;	THIS ROUTINE FINDS THE SIZE OF A FILE.
;	ON ENTRY INTO THIS ROUTINE, THE FILE DESCRIPTOR BLOCK FOR
;	THE INDEX FILE (IDXFDB) MUST BE SET UP WITH THE VIRTUAL BLOCK
;	NUMBER OF THE FILE HEADER WITHIN THE INDEX FILE.
;	A FILE ID/SEQUENCE NUMBER CHECK IS PERFORMED IF "UFDADR" IS
;	NON-ZERO AND CONTAINS THE ADDRESS OF THE BUFFERED DIRECTORY
;	ENTRY. WE CHECK TO SEE IF WE HAVE ALREADY EXAMINED THIS FILE
;	BY CHECKING THE STATE OF THE RELEVANT BIT IN THE BUFFERED
;	INDEX FILE BITMAP. IF NO BITMAP IS AVAILABLE, WE REQUIRE THE
;	FILESPEC IN THE DIRECTORY ENTRY TO MATCH THAT IN THE FILE
;	HEADER (NOT VALID IF FILES ARE RENAMED).
;
;	OUTPUT:
;		FSIZE	SIZE OF FILE IN BLOCKS (2 WORDS)
;		R0-R2	USED
;		R3-R5	PRESERVED
;-

FILSIZ:	JSR	R5,$SAVRG	; SAVE R3-R5
	CLR	FSIZE		; SET ZERO SIZE INITIALLY
	CLR	FSIZE+2		;
	MOV	UFDADR,UFDAD2	; MAKE COPY OF DIRECTORY POSITION
	MOV	#IDXFDB,FDBADR	; SET FDB ADDRESS FOR ERROR PROCESSOR

10$:	READ$	#IDXFDB		; READ FILE HEADER
	BCC	15$		; IT WORKED
	MOV	#ERR10A,R0	; GET ADDRESS FOR DEVICE SPEC
	CALL	FMTDEV		; STICK IN DEVICE NAME AND NUMBER
	CALL	FCSERR		; INSERT FCS ERROR INFORMATION
	SUB	#ERR10,R0	; CALCULATE MESSAGE SIZE
	PRINT	#ERR10,R0	; AND PRINT IT
	BR	25$		; AND FORGET ANY MORE EXTENSIONS

15$:	WAIT$	#IDXFDB		; WAIT FOR I/O TO COMPLETE
	MOV	IDXBUF,R0	; GET INDEX FILE I/O BUFFER ADDRESS
	MOV	UFDAD2,R2	; GET ADDRESS OF DIRECTORY ENTRY BUFFER
	BEQ	19$		; IF EQ, ID/SEQ CHECK DISABLED
	CMP	H.FNUM(R0),(R2)+ ; FILE ID MATCH?
	BNE	16$		; IF NE NO, SOMETHING IS UP
	CMP	H.FSEQ(R0),(R2)+ ; YES, SEQUENCE NUMBER MATCH?
	BEQ	17$		; IF EQ YES, OK
16$:	MOV	#ERR15A,R0	; SET ADDRESS FOR ERROR MESSAGE CONSTRUCTION
	MOV	#ERR15,R4	; AND START OF ERROR MESSAGE
161$:	CALL	FMTDEV		; FORMAT DEVICE NAME
	MOV	#DIRECF,R5	; SET DIRECTORY NAME
	CALL	FMTUIC		; FORMAT DIRECORY NAME
	MOV	UFDAD2,R5	; POINT R5 TO FILESPEC
	ADD	#6,R5		;
	CALL	R50.TA		; CONVERT FILENAME TO ASCII
	CALL	R50.TA		;
	CALL	R50.TA		;
	MOVB	#DPT,(R0)+	; INSERT NAME/TYPE SEPARATOR
	CALL	R50.TA		; CONVERT FILETYPE TO ASCII
	MOVB	#';,(R0)+	; INSERT TYPE/VERSION SEPARATOR
	MOV	(R5),R1		; GET BINARY VERSION NUMBER
	CALL	OC.TAL		; AND CONVERT TO ASCII
	SUB	R4,R0		; CALCULATE MESSAGE LENGTH
	PRINT	R4,R0		; PRINT IT
	BR	25$		; AND RETURN TO CALLER

17$:	TST	IDXMAP		; BITMAP AVAILABLE?
	BEQ	172$		; IF EQ NO
	CMP	H.FNUM(R0),$BMAP2 ; FILE ID BEYOND BUFFERED BITMAP?
	BGT	172$		; IF GT YES, SKIP IT
	CALL	CHKBIT		; YES, PERFORM CHECK
	BCS	18$		; IF CS, WE ALREADY LOOKED AT THIS HEADER
	BR	19$		; HEADER CHECKS OUT

172$:	TST	(R2)+		; POSITION DIRECTORY ENTRY TO FILENAME
	MOVB	(R0),R1		; GET IDENTIFICATION AREA OFFSET
	ASL	R1		; CONVERT TO BYTE OFFSET
	ADD	R0,R1		; GET ADDRESS OF IDENTIFICATION AREA
	CMP	(R2)+,(R1)+	; COMPARE FILENAMES
	BNE	18$		; IF NE, THEY DON'T MATCH
	CMP	(R2)+,(R1)+	;
	BNE	18$		;
	CMP	(R2)+,(R1)+	;
	BNE	18$		;
	CMP	(R2)+,(R1)+	; COMPARE FILETYPES
	BNE	18$		;
	CMP	(R2)+,(R1)+	; COMPARE VERSION NUMBERS
	BEQ	19$		; IF EQ, FILESPEC MATCHES DIRECTORY ENTRY
18$:	TST	SYNFLG		; NEED TO PRINT SYNONYM CHECK MESSAGE?
	BEQ	19$		; IF EQ NO
	MOV	#ERR16A,R0	; SET UP MESSAGE POINTERS
	MOV	#ERR16,R4	;
	BR	161$		; ISSUE MESSAGE AND RETURN

19$:	MOVB	1(R0),R1	; GET OFFSET TO MAP AREA
	ASL	R1		; CONVERT TO BYTE OFFSET
	ADD	R1,R0		; R0 NOW POINTS TO MAP AREA
	MOV	M.EFNU(R0),R4	; GET EXTENSION FILE NUMBER FOR LATER IN CASE
				; THERE ARE ANY EXTENSIONS
	CLR	R1		; ZERO R1 TO GET NUMBER OF WORDS OF
				; RETRIEVAL POINTERS
	BISB	M.USE(R0),R1	; GET IT
	ASR	R1		; EACH POINTER IS TWO WORDS LONG, SO DIVIDE
				; BY TWO TO GET NUMBER OF POINTERS
	BLE	25$		; IF LE THEN ZERO BLOCKS ALLOCATED
	ADD	#M.RTRV,R0	; POINT TO START OF RETRIEVAL POINTERS
20$:	CLR	R3		; ZERO R3 READY TO GET BLOCK COUNT
	BISB	1(R0),R3	; GET BLOCK COUNT
	INC	R3		; COUNT WAS #BLOCKS-1
	ADD	R3,FSIZE+2	; ADD TO RUNNING TOTAL
	ADC	FSIZE		; DON'T FORGET THE CARRY
	ADD	#<2*2>,R0	; UPDATE R0 TO NEXT POINTER
	DEC	R1		; ARE THERE ANY MORE?
	BNE	20$		; IF NE YES, DO IT
	TST	R4		; ANY EXTENSIONS?
	BEQ	25$		; IF EQ NO, RETURN WITH SIZE OF FILE
	DEC	R4		; ADJUST POINTER
	ADD	IDXFHD,R4	; POINT TO VBN OF EXTENSION HEADER
	MOV	R4,IDXFDB+F.BKVB+2 ; SET UP IN FDB
	CLR	UFDAD2		; DISABLE CONSISTENCY CHECKING
	JMP	10$		; AND DO SOME MORE WORK
25$:	RETURN			; RETURN TO CALLER
	.PAGE
	.SBTTL	BITMAP CHECK ROUTINE

;+
; *** CHKBIT
;
;	THIS ROUTINE IS CALLED DURING FILE SIZING TO CHECK IF WE HAVE
;	ALREADY LOOKED AT THE FILE HEADER THAT IS CURRENTLY BEING
;	EXAMINED, AS A CHECK ON SKIPPING FILE SYNONYMS. WE LOOK IN THE
;	BUFFERED COPY OF THE INDEX FILE BIT MAP. IF THE BIT CORRESPONDING
;	TO THE FILE ID UNDER EXAMINATION IS CLEAR, WE HAVE ALREADY
;	LOOKED AT THIS HEADER. IF IT IS SET, WE HAVE NOT. THE BIT IS
;	ALWAYS CLEARED BY THIS ROUTINE, PROVIDING THAT IT IS WITHIN
;	THE COPY OF THE BITMAP WE ARE USING.
;
;	INPUTS:
;		R0	ADDRESS OF BUFFERD FILE HEADER
;
;	OUTPUTS:
;		CC	OK, BIT IN BITMAP WAS SET
;		CS	HEADER ALREADY CHECKED, BIT WAS CLEAR
;
;-

CHKBIT:	JSR	R2,$SAVVR	; SAVE R0-R2
	MOV	H.FNUM(R0),R0	; GET FILE ID
	DEC	R0		; COMPUTE WORD AND BIT OFFSET
	MOV	#16.,R1		;
	CALL	$DIV		;
	ASL	R0		; CONVERT WORD OFFSET TO BYTE OFFSET
	ASL	R1		; GET INDEX INTO BIT DEFS. TABLE
	BIT	BITMSK(R1),$BMAP0(R0)	; WAS THE BIT CLEAR?
	BEQ	20$		; IF EQ YES, BAD NEWS
	BIC	BITMSK(R1),$BMAP0(R0)	; NO, CLEAR THE BIT
10$:	CLC			; THIS HEADER IS OK
	BR	30$		;
20$:	SEC			; THIS HEADER ALREADY SEEN
30$:	RETURN			;
	.PAGE
	.SBTTL	CHAINED A/C ACCUMULATION ROUTINE

;+
; *** CHAIN
;
;	THIS ROUTINE SEARCHES THE CONTROL BLOCK LIST IN PAIRS TO CHECK
;	IF THERE ARE ANY CHAIN LINKS TO BE RESOLVED. IF ANY ARE FOUND,
;	THE RELEVANT DATA IS ADDED TOGETHER SO THAT THE MASTER
;	ACCOUNTS WILL PAY FOR ALL CHARGES, AND THE CHAINED ACCOUNTS
;	WILL PAY NOTHING.
;	FOR EACH ACCOUNT (AC1)IN THE CONTROL BLOCK LIST, A SCAN IS MADE
;	OVER FOLLOWING ACCOUNTS (AC2) IF AC1 IS A MASTER OR A MEMBER. IF
;	AC1 IS A MASTER AND ANY OF THE AC2 ARE CHAINED, CHARGES ARE
;	ADDED IF THE LINKAGES MATCH. SIMILARLY, CHARGES ARE ADDED TOGETHER
;	IF AC1 IS CHAINED AND THE MASTER IS LOCATED IN THE AC2 SCAN.
;
;-

CHAIN:	MOV	BUFADR,R5	; GET ADDRESS OF CONTROL BLOCK LIST
	MOV	BUFNUM,R4	; AND MAX. NUMBER OF THEM

10$:	TST	D.UIC(R5)	; THIS ENTRY ACTIVE?
	BEQ	40$		; IF EQ NO
	BIT	#<DD.ERR!DD.CHW>,D.FLAG(R5) ; DO WE NEED THIS ONE?
	BNE	40$		; IF NE NO, SKIP IT
	BIT	#100000,D.ACNO(R5) ; IS THIS A MASTER ACCOUNT?
	BNE	15$		; IF NE YES, LOOK FOR MEMBERS
	TST	D.CHWD(R5)	; NO, IS IT A MEMBER ACCOUNT?
	BEQ	40$		; IF EQ NO, SKIP THIS ENTRY

15$:	BIS	#DD.CHW,D.FLAG(R5) ; SHOW THAT WE LOOKED AT THIS ONE
	MOV	R5,R3		; COPY LIST POINTER
	ADD	#D.LGTH,R3	; POINT TO NEXT ENTRY
	MOV	R4,R2		; COPY ENTRY ACCOUNT
	DEC	R2		; WE ARE AT THE NEXT ENTRY
	BLE	40$		; IF LE THERE WEREN'T ANY MORE
	MOV	D.ACNO(R5),R1	; GET ACCOUNT NUMBER
	BIC	#100000,R1	; CLEAR MASTER A/C FLAG BIT

20$:	TST	D.UIC(R3)	; ACTIVE ENTRY?
	BEQ	30$		; IF EQ NO
	BIT	#<DD.ERR!DD.CHW>,D.FLAG(R3) ; DO WE NEED THIS ONE?
	BNE	30$		; IF NE NO
	BIT	#100000,D.ACNO(R5) ; MASTER ACCOUNT LOOKING FOR A MEMBER?
	BNE	25$		; IF NE YES
	BIT	#100000,D.ACNO(R3) ; NO, IT MUST BE A MEMBER LOOKING FOR A
				; MASTER, SO IS THIS A MASTER?
	BEQ	30$		; IF EQ NO, LOOK FOR NEXT ONE
	MOV	D.ACNO(R3),R1	; GET ACCOUNT NUMBER
	BIC	#100000,R1	; CLEAR THE MASTER FLAG
	CMP	D.CHWD(R5),R1	; ACCOUNTS CHAINED TOGETHER?
	BNE	30$		; IF NE NO, LOOK AT NEXT ENTRY
				; THE ENTRY AT R3 IS NOT MARKED AS DONE
				; (DD.CHW) BECAUSE IT IS A MASTER AND MAY
				; HAVE MORE THAN ONE MEMBER ACCOUNT.

	.IF DF	AA$CFL

	ADD	D.NFIL(R5),D.NFLC+2(R3) ; ADD NUMBER OF FILES
	ADC	D.NFLC(R3)		;

	.ENDC	; DF AA$CFL

	ADD	D.BLOK+2(R5),D.NBLK+2(R3) ; ADD NUMBER OF BLOCKS
	ADC	D.NBLK(R3)	      ;
	ADD	D.BLOK(R5),D.NBLK(R3) ;
	MOV	D.ACNO(R3),D.MSTR(R5) ; SHOW WHO THE MASTER IS
	BIC	#100000,D.MSTR(R5)    ;
	BR	40$		; SINCE A MEMBER ACCOUNT CAN HAVE ONLY ONE
				; MASTER, WE CAN SKIP THE REST OF THE
				; INNER LOOP AND GO STRAIGHT TO THE NEXT
				; ENTRY AT R5

25$:	CMP	D.CHWD(R3),R1	; ACCOUNTS CHAINED TOGETHER?
	BNE	30$		; IF NE NO, GO TO NEXT ONE
	BIS	#DD.CHW,D.FLAG(R3)	; THIS ENTRY IS DONE

	.IF DF	AA$CFL

	ADD	D.NFIL(R3),D.NFLC+2(R5)	; ADD NUMBER OF FILES
	ADC	D.NFLC(R5)		;

	.ENDC	; DF AA$CFL

	ADD	D.BLOK+2(R3),D.NBLK+2(R5) ; ADD NUMBER OF BLOCKS...
	ADC	D.NBLK(R5)	; ...FOR CHARGING PURPOSES
	ADD	D.BLOK(R3),D.NBLK(R5) ;
	MOV	D.ACNO(R5),D.MSTR(R3) ; SHOW WHO OUR MASTER IS
	BIC	#100000,D.MSTR(R3) ; ZAP THE MASTER FLAG
30$:	ADD	#D.LGTH,R3	; POINT SECONDARY MARKER TO NEXT ACCOUNT
	DEC	R2		; ARE THERE ANY MORE?
	BNE	20$		; IF NE YES, SCAN THEM
40$:	ADD	#D.LGTH,R5	; POINT PRIMARY MARKER TO NEXT ACCOUNT
	DEC	R4		; ANY MORE?
	BNE	10$		; IF NE YES, SCAN THEM
	RETURN			; THAT'S IT, RETURN TO CALLER
	.PAGE
	.SBTTL	ROUTINE TO SEARCH FOR ACCOUNT DUPLICATIONS

;+
; *** GETDUP
;
;	THIS ROUTINE SEARCHES THE CONTROL BLOCK LIST IN PAIRS TO CHECK
;	IF ANY UFD IS ENTERED IN MORE THAN ONE ACCOUNT. IF ACCOUNTS ARE
;	FOUND TO MATCH ON THE SAME VOLUME (ACNT ALLOWS THIS,SO DOES MACNT)
;	THEY ARE MARKED AS DUPLICATED ACCOUNTS, SO THAT  THE SAME FILES
;	WILL NOT BE CHARGED FOR TWICE.
;
;-

GETDUP:	MOV	BUFADR,R5	; GET ADDRESS OF CONTROL BLOCK LIST
	MOV	BUFNUM,R4	; AND MAX. NUMBER OF THEM
10$:	TST	D.UIC(R5)	; THIS ENTRY ACTIVE?
	BEQ	40$		; IF EQ NO
	BIT	#<DD.ERR!DD.EDP!DD.DUP>,D.FLAG(R5) ; DO WE NEED THIS ONE?
	BNE	40$		; IF NE NO, SKIP IT
	TST	D.CHWD(R5)	; A/C CHAINED?
	BNE	40$		; YES, GO ELSEWHERE
	BIS	#DD.EDP,D.FLAG(R5) ; SHOW THAT WE LOOKED AT THIS ONE
	MOV	R5,R3		; COPY LIST POINTER
	ADD	#D.LGTH,R3	; POINT TO NEXT ENTRY
	MOV	R4,R2		; COPY ENTRY ACCOUNT
	DEC	R2		; WE ARE AT THE NEXT ENTRY
	BLE	40$		; IF LE THERE WEREN'T ANY MORE
20$:	TST	D.UIC(R3)	; ACTIVE ENTRY?
	BEQ	30$		; IF EQ NO
	BIT	#<DD.ERR!DD.EDP!DD.DUP>,D.FLAG(R3) ; DO WE NEED THIS ONE?
	BNE	30$		; IF NE NO
	TST	D.CHWD(R3)	; A/C CHAINED?
	BNE	30$		; IF NE YES, SKIP IT
	CMP	D.UIC(R5),D.UIC(R3) ; UICS MATCH?
	BNE	30$		; IF NE NO
	CMP	D.UIC+2(R5),D.UIC+2(R3) ; MAYBE
	BNE	30$		; IF NE NO
	CMP	D.UIC+4(R5),D.UIC+4(R3) ; MAYBE
	BNE	30$		; IF NE NO
	CMP	D.DEVN(R5),D.DEVN(R3) ; YES, ARE THEY THE SAME VOLUME?
	BNE	30$		; IF NE NO
	CMP	D.DEVU(R5),D.DEVU(R3) ; MAYBE
	BNE	30$		; IF NE NO
	BIS	#DD.DUP,D.FLAG(R5) ; YES, MARK BOTH ACCOUNTS AS DUPLICATIONS
	BIS	#<DD.DUP!DD.EDP>,D.FLAG(R3) ;
30$:	ADD	#D.LGTH,R3	; POINT SECONDARY MARKER TO NEXT ACCOUNT
	DEC	R2		; ARE THERE ANY MORE?
	BNE	20$		; IF NE YES, SCAN THEM
40$:	ADD	#D.LGTH,R5	; POINT PRIMARY MARKER TO NEXT ACCOUNT
	DEC	R4		; ANY MORE?
	BNE	10$		; IF NE YES, SCAN THEM
	RETURN			; THAT'S IT, RETURN TO CALLER
	.PAGE
	.SBTTL	CHARGE CALCULATION ROUTINE

;+
; *** GETDLR
;
;	THIS ROUTINE SCANS THE CONTROL BLOCK LIST AND CALCULATES THE
;	DISK CHARGES.
;	THE NUMBER OF DISK ACCOUNTINGS AND AVERAGE BLOCK USE IS UPDATED
;	READY TO BE WRITTEN BACK TO THE ACCOUNT FILE.
;	ZERO DISK CHARGES ARE INDICATED FOR MEMBER ACCOUNTS IN THE DATA
;	FILE AS ALL CHARGES ARE ACCUMULATED AGAINST THE MASTER ACCOUNT.
;
;	THE CHARGE IS CALCULATED IN TERMS OF THE CONSTANTS $DSK1 AND $DSK2,
;	WHICH ARE DETERMINED BY ACCGEN. THE CHARGE IN UNITS IS GIVEN BY:
;
;	CHARGE = TIME(MINUTES) * (BLOCKS) * $DSK1 / $DSK2
;
;	IF THE NUMBER OF BLOCKS IN USE IS LESS THAN $BLKMN (DEFINED IN
;	DISKBLD.CMD), THE NUMBER OF BLOCKS IN USE IS REPLACED BY THIS
;	VALUE FOR THE PURPOSES OF CALCULATING A CHARGE, TO EFFECT A
;	MINIMUM CHARGE FOR DISK USE.
;
;-

GETDLR:	MOV	BUFADR,R5	; YAWN
	MOV	BUFNUM,R4	;  ... ZZZZZZZZZ
	CLR	MONEY		; ZERO THE TOTAL DISK CHARGES
	CLR	MONEY+2		;
	CLR	NUSER		; RE-INITIALISE NUMBER OF USERS
	TST	DSKBLK		; WILL THERE BE ANY CHARGE FOR DISK USE?
	BEQ	60$		; IF EQ NO, LEAVE ROUTINE AT ONCE
10$:	TST	D.UIC(R5)	; ACTIVE ENTRY?
	BEQ	50$		; IF EQ NO
	TST	D.CHWD(R5)	; ACCOUNT CHAINED?
	BNE	50$		; IF NE YES, SKIP IT
20$:	ADD	D.BLOK+2(R5),D.NBLK+2(R5) ; ADD OUR BLOCKS WITH CHAINED BLOCKS
	ADC	D.NBLK(R5)	;
	ADD	D.BLOK(R5),D.NBLK(R5) ;
	MOV	D.PREV(R5),R2	; GET PREVIOUS BLOCKS
	MOV	D.PREV+2(R5),R3	;
	ADD	D.NBLK+2(R5),R3	; ADD CURRENT BLOCKS
	ADC	R2		;
	ADD	D.NBLK(R5),R2	;
	ASR	R2		; FIND THE AVERAGE
	ROR	R3		;  (DIVIDE BY TWO)

	.IF DF	AA$BLK

	MOV	R2,R0		; COPY AVERAGE BLOCK USE
	MOV	R3,R1		;
	SUB	D.BALL+2(R5),R1	; SUBTRACT DISK BLOCK ALLOCATION
	SBC	R0		;
	SUB	D.BALL(R5),R0	;
	BLT	30$		; IF LT, USE IS BELOW ALLOCATION
	ADD	R1,R3		; ADD EXCESS TO USE (THIS DOUBLES
	ADC	R2		; THE BLOCKS IN EXCESS)
	ADD	R0,R2		;
30$:				; REF. LABEL

	.ENDC	; DF AA$BLK

	.IF DF	AA$CFL

	ADD	D.NFIL(R5),R3	; COUNT NUMBER OF FILES IF REQUIRED
	ADC	R2		;
	ADD	D.NFLC+2(R5),R3	; AND THE NUMBER OF FILES IN ACCOUNTS...
	ADC	R2		;   ...CHAINED TO US
	ADD	D.NFLC(R5),R2	;

	.ENDC	; DF AA$CFL

	MOV	R2,R0		; COPY HIGH ORDER BLOCK USAGE AGAIN
	BNE	32$		; IF NE, NO MINIMUM CHARGE APPLIES
	MOV	R3,R1		; COPY LOW ORDER BLOCK USAGE
	SUB	#$BLKMN,R1	; SUBTRACT MINIMUM USAGE
	SBC	R0		;
	BGE	32$		; IF GE, NO MINIMUM USE
	MOV	#$BLKMN,R3	; RESET MINIMUM BLOCK USAGE
32$:	MOV	ELAPS,R0	; GET ELAPSED TIME IN MINUTES
	CALL	$DMUL		; CALCULATE TIME(MINS)*(BLOCKS)
	MOV	R4,-(SP)	; SAVE CONTROL BLOCK COUNTER
	MOV	R5,-(SP)	; SAVE CONTROL BLOCK ADDRESS
	MOV	#CHGBLK+2,R5	; GET ADDRESS OF TEMPORARY BUFFER FOR ML.DV
	MOV	R1,(R5)		; SAVE RESULT OF MULTIPLICATION
	MOV	R0,-(R5)	;
	MOV	#DSKBLK,R4	; GET ARGUMENT BLOCK ADDRESS
	CALL	ML.DV		; DO THE SECOND PART OF THE CALCULATION
	MOV	(SP)+,R5	; RESTORE CONTROL BLOCK ADDRESS
	MOV	(SP)+,R4	; RESTORE CONTROL BLOCK COUNTER
	BIT	#DD.DUP,D.FLAG(R5) ; DUPLICATED ACCOUNT?
	BEQ	40$		; IF EQ NO
	ASR	R1		; YES, CHARGES ARE HALF FOR THIS UIC (NOT UFD)
	ROR	R2		;
40$:	MOV	R1,D.DCHG(R5)	; STORE AWAY THE CHARGES
	MOV	R2,D.DCHG+2(R5)	;
	ADD	R2,MONEY+2	; ADD CHARGE TO TOTAL CHARGES
	ADC	MONEY		;
	ADD	R1,MONEY	;
	MOV	D.NDA(R5),R0	; GET PREVIOUS # OF DISK ACCOUNTINGS
	INC	D.NDA(R5)	; INCLUDE THIS ONE (CONTROL BLOCK COPY)
	MOV	D.ABLK(R5),R2	; GET PREVIOUS AVERAGE BLOCKS (HIGH ORDER)
	MOV	D.ABLK+2(R5),R3	; GET PREVIOUS AVERAGE BLOCKS (LOW ORDER)
	CALL	$DMUL		; MULTIPLY NDA*BLOCKS
	ADD	D.NBLK+2(R5),R1	; ADD CURRENT BLOCKS
	ADC	R0		;
	ADD	D.NBLK(R5),R0	;
	MOV	R1,R2		; REARRANGE RESULT FOR $DDIV
	MOV	R0,R1		;
	MOV	D.NDA(R5),R0	; GET NEW NUMBER OF DISK ACCOUNTINGS
	CALL	$DDIV		; CALCULATE NEW BLOCK AVERAGE
	MOV	R2,D.ABLK+2(R5)	; AND STORE THE RESULT
	MOV	R1,D.ABLK(R5)	;
	INC	NUSER		; SHOW ONE MORE ACCOUNT TO ADJUST IN THE ACCOUNT FILE
50$:	ADD	#D.LGTH,R5	; POINT TO NEXT ENTRY
	DEC	R4		; ARE THERE ANY MORE?
	BNE	10$		; IF NE YES
60$:	RETURN			; NO, RETURN TO CALLER
	.PAGE
	.SBTTL	ACCOUNT BUFFER/CONTROL BLOCK MATCH ROUTINE

;+
; *** MATCH
;
;	THIS ROUTINE SEARCHES THE CONTROL BLOCK LIST TO FIND AN ENTRY
;	THAT MATCHES THE CURRENT ENTRY IN THE ACCOUNT FILE BUFFER.
;
;	INPUTS:
;		R0	ACCOUNT ENTRY ADDRESS IN ACCOUNT BUFFER
;
;	OUTPUTS:
;		CC	MATCH FOUND, ADDRESS IN R3
;		CS	NO MATCH WAS FOUND
;
;-

MATCH:	MOV	BUFADR,R3	; GET ADDRESS OF FIRST CONTROL BLOCK
	MOV	BUFNUM,R1	; AND NUMBER OF CONTROL BLOCKS
5$:	TST	D.UIC(R3)	; THIS ENTRY ACTIVE?
	BEQ	10$		; IF EQ NO
	TST	D.CHWD(R3)	; ACCOUNT CHAINED?
	BNE	10$		; IF NE YES, SKIP IT
	BIT	#<DD.ERR!DD.WRT>,D.FLAG(R3) ; DO WE NEED TO THINK ABOUT THIS ONE?
	BNE	10$		; IF NE NO
	CMP	D.ACNO(R3),A.ACNO(R0) ; ACCOUNT NUMBERS MATCH?
	BEQ	20$		; IF EQ YES
10$:	ADD	#D.LGTH,R3	; POINT TO NEXT ENTRY
	DEC	R1		; ANY MORE CONTROL BLOCKS?
	BNE	5$		; IF NE YES, KEEP SCAN GOING
	SEC			; SET FAILURE
20$:	RETURN			; RETURN TO CALLER
	.PAGE
	.SBTTL	BUFFER LISTING ROUTINE

;+
; *** LIST
;
;	THIS ROUTINE TYPES OUT ON THE TERMINAL THE NUMBER OF FILES AND
;	BLOCKS ALLOCATED TO EACH USER.
;
;-

LIST:	MOV	BUFADR,R5	; GET CONTROL BLOCK DATA AREA ADDRESS
	MOV	BUFNUM,R4	; AND NUMBER OF USERS
	DIR$	#TIATT		; ATTACH TO TI:
	PRINT	#HEAD,#HEADSZ	; TYPE OUT TABLE HEADING
10$:	TST	D.UIC(R5)	; THIS ENTRY IN USE?
	BEQ	70$		; IF EQ NO, SKIP IT
	MOV	#<132./2>,R1	; GET SIZE OF OUTPUT BUFFER (WORDS)
	MOV	#OUTBUF,R0	; AND ITS ADDRESS
20$:	MOV	#20040,(R0)+	; BLANK OUT TWO BYTES
	DEC	R1		; DONE?
	BNE	20$		; IF NE NO, LOOP
	MOV	#OUTBUF,R0	; RESET BUFFER ADDRESS
	MOV	D.DEVN(R5),(R0)+ ; STICK IN THE DEVICE NAME
	MOV	D.DEVU(R5),R1	; GET DEVICE NUMBER
	CALL	OC.TAL		; CONVERT TO OCTAL
	MOVB	#COLON,(R0)+	; INSERT A COLON
	MOV	#OUTBUF+OUFD,R0 ; SET POINTER TO UFD FIELD
	BIT	#DD.DUP,D.FLAG(R5) ; DUPLICATED ACCOUNT?
	BEQ	30$		; IF EQ NO
	MOVB	#'*,-1(R0)	; YES, PRECEED UFD WITH A *
30$:	CALL	FMTUIC		; PUT IN UFD NAME [GGG,MMM]
	MOV	#OUTBUF+OACN,R0 ; GET POSITION FOR A/C NUMBER
	MOV	D.ACNO(R5),R1	; GET ACCOUNT NUMBER
	BIT	#100000,R1	; MASTER ACCOUNT?
	BEQ	31$		; IF EQ NO
	BIC	#100000,R1	; YES, CLEAR THE MASTER FLAG
	MOVB	#'M,-2(R0)	; START WITH AN "M" FLAG
31$:	CALL	OC.TAL		; FORMAT A/C NUMBER AS ASCII OCTAL
	MOV	#OUTBUF+OFIL,R0 ; SET BUFFER POSITION FOR # FILES
	BIT	#DD.ERR,D.FLAG(R5) ; ERROR DETECTED FOR THIS ACCOUNT?
	BEQ	40$		; IF EQ NO
	MOVSTR	#ERR0		; YES, MOVE IN MESSAGE TEXT
	BR	60$		; AND PRINT IT OUT
40$:	MOV	D.NFIL(R5),R1	; GET NUMBER OF FILES
	CALL	DE.CML		; CONVERT TO DECIMAL
	MOV	#OUTBUF+OBLK,R0 ; SET BUFFER FOR # BLOCKS
	MOV	R5,R1		; POINT R5 TO NUMBER OF BLOCKS
	ADD	#D.BLOK,R1	;
	CALL	FM.QIO		; FORMAT AS D.P. DECIMAL
	MOV	#OUTBUF+OTST,R0 ; SET UP FOR CHARGE STRING
	MOV	D.CHWD(R5),R2	; GET CHAIN WORD CONTENTS
	BEQ	50$		; IF EQ A/C IS NOT CHAINED
	MOVSTR	#CHTXT		; INSERT "A/C IS CHAINED" TEXT
	MOV	R2,R1		; COPY CHAIN WORD TO R1
	CALL	OC.TAL		; FORMAT AS OCTAL
	BR	60$		; PRINT OUT THIS LINE
50$:	MOV	R5,R1		; POINT R1 TO DISK CHARGES
	ADD	#D.DCHG,R1	;
	CALL	FM.CHG		; FORMAT THE CHARGE
60$:	SUB	#OUTBUF,R0 	; CALCULATE STRING LENGTH
	PRINT	#OUTBUF,R0 	; TYPE IT OUT
70$:	ADD	#D.LGTH,R5	; POINT TO NEXT ENTRY
	DEC	R4		; ANY LEFT?
	BNE	10$		; IF NE YES, DO THEM
80$:	DIR$	#TIDET		; DETACH TI:
	RETURN			; RETURN TO CALLER
	.PAGE
	.SBTTL	FCS ERROR PROCESSOR

;+
; *** FCSERR
;
;	THIS ROUTINE IS CALLED TO FORMAT AN FCS OR DIRECTIVE ERROR CODE.
;
;	INPUTS:
;		R0	MESSAGE BUFFER ADDRESS
;		FDBADR	FILE FDB ADDRESS
;
;	OUTPUTS:
;		R0	UPDATED
;		R1,R2	USED
;
;-

FCSERR:	MOV	FDBADR,R2	; GET FDB ADDRESS
	MOV	#FCS,R1		; ASSUME AN FCS ERROR
	TSTB	F.ERR+1(R2)	; FCS ERROR?
	BEQ	10$		; IF EQ YES
	MOV	#DIR,R1		; NO, DIRECTIVE ERROR
10$:	CALL	MV.STR		; INSERT "FCS" OR "DIR" TEXT
	MOVB	F.ERR(R2),R1	; GET FCS ERROR CODE
	JMP	DC.SGN		; CONVERT TO SIGNED DECIMAL AND RETURN
	.PAGE
	.SBTTL	DEVICE SPECIFICATION FORMATTER

;+
; *** FMTDEV
;
;	THIS ROUTINE FILLS IN THE DEVICE SPECIFICATION (DDNN:) IN THE
;	OUTPUT BUFFER FOR THE CURRENT VOLUME.
;
;	INPUTS:
;		R0	BUFFER POINTER
;
;	OUTPUTS:
;		R0	UPDATED
;		R1,R2	USED
;
;-

FMTDEV:	MOVB	DEVN,(R0)+	; PUT IN DEVICE NAME
	MOVB	DEVN+1,(R0)+	;
	MOV	DEVU,R1		; GET UNIT NUMBER
	CALL	OC.TAL		; CONVERT TO OCTAL
	MOVB	#COLON,(R0)+	; FINISH WITH A COLON
	RETURN			; AND RETURN
	.PAGE
	.SBTTL	UFD FORMATTER ROUTINE

;+
; *** FMTUIC
;
;	THIS ROUTINE STICKS THE UFD NAME IN THE FORM [GGG,MMM] INTO
;	THE OUTPUT BUFFER.
;
;	INPUT:
;		R0	BUFFER POINTER
;		R5	CONTROL BLOCK ADDRESS
;
;	OUTPUT:
;		R0	UPDATED
;		ALL OTHER REGISTERS PRESERVED
;
;-

FMTUIC:	MOVB	#'[,(R0)+	; INSERT LEADING SEPARATOR
	MOVB	(R5)+,(R0)+	; INSERT GROUP CODE
	MOVB	(R5)+,(R0)+	;
	MOVB	(R5)+,(R0)+	;
	MOVB	#',,(R0)+	; INSERT A COMMA
	MOVB	(R5)+,(R0)+	; INSERT MEMBER CODE
	MOVB	(R5)+,(R0)+	;
	MOVB	(R5)+,(R0)+	;
	MOVB	#'],(R0)+	; INSERT FINAL SEPARATOR
	SUB	#6,R5		; ADJUST R5 BACK TO ENTRY VALUE
	RETURN			; AND RETURN


	.END	$DSKEP