.TITLE	FRG	DISK FRAGMENTATION
	.IDENT	/M1/
	.SBTTL	DATA AREA
;
; DATE:		7/12/77
; BY:		D. MICHAUD
;		BORG INSTRUMENTS
;		DELAVAN WISCONSIN
;
;  THIS MCR TASK WILL PRODUCE FRAGMENTATION STATISTICS FOR THE SPECIFIED
; FILES-11 DEVICE.  THE OUTPUT IS A FREQUENCY COUNT OF CONTIGUOUS FREE
; BLOCKS (HOLES) FALLING WITHIN EACH OF SEVERAL RANGES, THE TOTAL NUMBER
; OF BLOCKS FOR EACH RANGE, AND THE TOTAL NUMBER OF FREE BLOCKS FOR THE
; DEVICE.
;
; OUTPUT IS DIRECTED TO LUN 2, WHICH MAY BE ASSIGNED TO ANY TERMINAL.
; ERROR MESSAGES ARE DIRECTED TO LUN 5.
;
; +001   15 DEC 77   RAY FRENCH   MODIFIED FOR RSX-11D V6.2
; +002   16 DEC 77   RAY FRENCH   ADDED 2-WORD COUNT FOR LARGE DISKS
;
	.NLIST	BEX
	.MCALL	GTIM$,QIOW$,CALL,EXIT$S,DIR$
;+001	.MCALL	FCSMC$,TCBDF$,UCBDF$,ALUN$,GMCR$
	.MCALL	FCSMC$,ALUN$,GMCR$
	FCSMC$		; DEFIN FCS MACROS
;+001	TCBDF$		; DEFINE TCB OFFSETS
;+001	UCBDF$		; DEFINE UCB OFFSETS
	FSRSZ$	0	; NO FSR FOR BLOCK OPERATIONS
FDB:
	FDBDF$
	FDRC$A	FD.RWM
	FDBK$A	INBUF,512.,,10
	FDOP$A	1,DSET
DSET:
	.WORD	0,0
	.WORD	UICSIZ,UIC
	.WORD	NAMSIZ,NAME
UIC:	.ASCII	/[0,0]/
UICSIZ=.-UIC
	.EVEN
NAME:	.ASCII	/BITMAP.SYS/
NAMSIZ=.-NAME
	.EVEN
INBUF:	.BLKB	512.
ALUN:	ALUN$	1,DK,0		; DUMMY ASSIGN LUN
GMCR:	GMCR$			;
BUF=GMCR+2			; BUF OVERLAYS COMMAND LINE BUFFER
TIME:	GTIM$	BUF
;READ:	QIOW$	IO.RLB,1,10,,IOST,,<INBUF,512.,,,1>
DPB:	QIOW$	IO.WVB,5,1,,,,<INBUF,200.,40>
;+001BLOCK:	.WORD	1		; BLOCK COUNTER FOR QIO
				; BLOCK 1 IS NOT PART OF BIT MAP,
				; SO WILL START READING AT BLOCK 2
TOTAL:	.WORD	0
	.WORD	0		;+002
DSKTOT:	.WORD	0,0		;+002 - TOTAL BLOCK COUNT
STBLK:	.BLKW	5		;+001 - STATISTICS BLOCK
COUNTB:	.WORD	0
	.WORD	0		;+002
IOST:	.BLKW	2
BINS:	.WORD	25.,50.,75.,100.,250.,500.,750.,1000.
BSIZ=8.			; NUMBER OF BINS - THE BIGGEST (< 1000. )
;+002 BIN AND BINSUM CHANGED FROM 9. TO 18. WORDS
BIN:	.BLKW	18.	;HOLDS FREQUENCY COUNT FOR EACH BIN
BINSUM:	.BLKW	18.	; HOLDS #BLOCKS FOR EACH BIN
;+001ISTRNG:	.ASCII	<11><11>/DISK FRAGMENTATION STATISTICS FOR /
ASCDEV:	.ASCII	/DK0:/
;+001	.ASCII	/%2N/<11><11><11>/%Y/<11>/%3Z/
;+001	.ASCII	 /%2N/<11><11>/CONTIGUOUS FREE BLOCKS (HOLES)/
;+001	.ASCII	/%2NHOLE RANGE/<11>/ FREQUENCY/<11>/NUMBER OF BLOCKS/
;+001	.ASCII	 /%N  0 -   25/<11>/%U/<11><11>/%U/
;+001	.ASCII	 /%N 26 -   50/<11>/%U/<11><11>/%U/
;+001	.ASCII	 /%N 51 -   75/<11>/%U/<11><11>/%U/
;+001	.ASCII	 /%N 76 -  100/<11>/%U/<11><11>/%U/
;+001	.ASCII	 /%N101 -  250/<11>/%U/<11><11>/%U/
;+001	.ASCII	 /%N251 -  500/<11>/%U/<11><11>/%U/
;+001	.ASCII	 /%N501 -  750/<11>/%U/<11><11>/%U/
;+001	.ASCII	 /%N751 - 1000/<11>/%U/<11><11>/%U/
;+001	.ASCII	 /%N    > 1000/<11>/%U/<11><11>/%U/
;+001	.ASCIZ	/%2N/<11>/TOTAL FREE BLOCKS /<11>/%U/
	.EVEN
;+001ER1:	.ASCII	/...FRG - PRIVILEGED COMMAND/
;+001ER1SIZ=.-ER1
;+001	.EVEN
ER2:	.ASCII	/...FRG - FAILURE ON INPUT/
ER2SIZ=.-ER2
	.EVEN
ER3:	.ASCII	/...FRG  - COMMAND LINE FAILURE/
ER3SIZ=.-ER3
	.EVEN
ER4:	.ASCII	/...FRG - ILLEGAL DEVICE/
ER4SIZ=.-ER4
	.EVEN
	.PAGE
	.SBTTL	CODE AREA
;+
;	**  FRAG - DISPLAY FRAGMENTATION DATA FOR FILES-11 DEVICES
;
; SYNTAX:
;		FRG DDN:
;
; WHERE:
;		DD - A LEGAL FILES-11 DEVICE NAME
;		N  - A LEGAL UNIT NUMBER < 8
;-
FRAG:
	JSR	PC,OTI$		;+001 - SET UP FORTRAN I/O
	DIR$	#GMCR		; GET COMMAND LINE
;+001	BCS	ERROR3		; STRICT SYNTAX-MUST HAVE COMMAND LINE
	BCC	10$		;+001
	JMP	ERROR3		;+001
10$:				;+001
;
;+001	MOV	$TKTCB,R0	; GET CURRENT TCB POINTER
;+001	MOV	T.UCB(R0),R0	; GET OUR TCB ADDRESS
;+001	BIT	#U2.PRV,U.CW2(R0)	; ARE WE PRIVILEGED?
;+001	BEQ	ERROR1		; EQ=NOPE - FATAL
;
	MOV	#BUF+3,R0	; COMMAND LINE
	CMPB	#' ,(R0)+	; STRICT SYNTAX-MUST BE SPACE
;+001	BNE	ERROR3		;
	BEQ	20$		;+001
	JMP	ERROR3		;+001
20$:				;+001
	MOV	(R0),ALUN+A.LUNA
	MOVB	(R0)+,ASCDEV	;
	MOVB	(R0)+,ASCDEV+1	; GET DEVICE NAME FOR OUTPUT
	MOVB	(R0),ASCDEV+2	; AND DEV NUMBER
	BIC	#177770,(R0)	; STRIP ASCII
	MOV	(R0),ALUN+A.LUNU	; DEV NUM FOR ALUN$
	DIR$	#ALUN		; ASSIGN INPUT DEVICE
;+001	BCS	ERROR4		; CS= ILLEGAL DEVICE
	BCC	30$		;+001
	JMP	ERROR4		;+001
30$:				;+001
;
	MOV	#STBLK,FDB+F.STBK ;+001 PUT STATISTICS BLOCK ADR IN FDB
;+001	OPEN$R	#FDB,,,,,,ERROR2
	OPNS$R	#FDB,,,,,,ERROR2
;+001 EOF POINTERS ARE NOT ALWAYS SET IN THE BITMAP - THE NEXT 4 LINES
;+001 OF CODE MAKE SURE THEY ARE SET IN  THE FDB
	MOV	STBLK+6,FDB+F.HIBK+2 ;+001 SET HIGHEST BLOCK ALLOCATED
	MOV	STBLK+6,FDB+F.EFBK+2 ;+001 SET EOF BLOCK
;***	INC	FDB+F.EFBK+2	;+001 AND INCREMENT IT
;***	CLR	FDB+F.FFBY	;+001 FINISH SETTING EOF POINTERS
	MOV	#1000,FDB+F.FFBY ;+001 SET EOF BYTE
	READ$	#FDB
	WAIT$	#FDB
	MOV	INBUF+254,DSKTOT+2 ;+001 - SAVE TOTAL BLOCK COUNT
	MOV	INBUF+256,DSKTOT ;+001
	MOV	#1,R5		;+001 - USE R5 FOR BLOCK COUNTER
RECORD:
	INC	R5		;+001 INCREMENT BLOCK COUNTER
	CMP	R5,STBLK+6	;+001 END OF BITMAP?
	BGT	FINISH		;+001 BRANCH IF SO
;+001	MOV	BLOCK,READ+Q.IOPL+10	; SET FOR NEXT BLOCK
;+001	DIR$	#READ		; READ A BLOCK
;+001	TSTB	IOST		; DONE?
;+001	BLT	ERR		; LT=MAYBE
	READ$	#FDB
	WAIT$	#FDB
	MOV	#INBUF,R0	; GET RECORD BUFFER
BLOCKS:
	MOV	(R0)+,R1	; GET 1ST 16 BLOCKS
	BEQ	FULL		; EQ= ALL USED
	CMP	R1,#-1		; ALL FREE?
	BNE	COUNT		; NE=NOT ALL FREE
	ADD	#16.,COUNTB	; COUNT 16 FREE BLOCKS
	ADC	COUNTB+2	;+002 - ADD CARRY
	BR	END		; SEE IF DONE
;
COUNT:
	MOV	#16.,R2		; BIT SHIFT COUNTER
SHIFT:	ASR	R1		; CHECK A BLOCK
	BCC	FULL		; CC= A USED BLOCK
;+002	INC	COUNTB		; COUNT A BLOCK FREE
	ADD	#1,COUNTB	;+002 - COUNT A BLOCK
	ADC	COUNTB+2	;+002 - ADD CARRY BIT
	BR	ENDLP		; SEE IF DONE
;
FULL:
	TST	COUNTB+2	;+002 - CHECK HIGH ORDER OF COUNT
	BEQ	2$		;+002 - BRANCH IF ZERO
1$:	MOV	#BSIZ,R3	;+002 - COUNT THIS LARGE MUST BE LAST BIN
	ASL	R3		;+002 - CONVERT TO BYTES
	BR	10$		;+002 - SO SKIP THE TEST
2$:	TST	COUNTB		; ANY FREE BLOCKS?
	BEQ	ENDLP		; EQ=NOPE
	BLT	1$		;+002 - SIGN BIT SET MEANS > 16K
	MOV	#BSIZ,R4	; NUMBER OF BINS
	CLR	R3		; CLEAR BIN POINTER
5$:
	CMP	COUNTB,BINS(R3)	; MORE THAN THIS BIN?
	BLE	10$		; LE=NOPE
	ADD	#2,R3		; POINT TO NEXT BIN
	SOB	R4,5$		; CHECK NEXT BIN
;
10$:	ASL	R3		;+002 - CONVERT TO DOUBLE WORD SIZE
	ADD	COUNTB,TOTAL	; ACCUMULATE TOTAL
	ADC	TOTAL+2		;+002 - ADD CARRY BIT
	ADD	COUNTB+2,TOTAL+2 ;+002 - ADD HIGH ORDER
	ADD	COUNTB,BINSUM(R3)	; ACC TOTAL FOR EACH BIN
	ADC	BINSUM+2(R3)	;+002 - ADD CARRY BIT
	ADD	COUNTB+2,BINSUM+2(R3) ;+002 - ADD HIGH ORDER
;+002	INC	BIN(R3)		; INCREMENT BIN
	ADD	#1,BIN(R3)	;+002 - INCREMENT BIN
	ADC	BIN+2(R3)	;+002 - ADD CARRY BIT
	CLR	COUNTB		; CLEAR COUNTER
	CLR	COUNTB+2	;+002
ENDLP:
	TST	R1		; ANY FREE BLOCKS STILL?
	BEQ	END
	SOB	R2,SHIFT	; CHECK ANOTHER BLOCK
;
END:
	CMP	R0,#ALUN	; READ ANOTHER DISK BLOCK?
	BHIS	RECORD		; HIS=YES
	BR	BLOCKS		; NO,LOOK AT ANOTHER 16 BITS
;
;+001ERR:
;+001	CMPB	#IE.EOF,IOST		; END OF FILE?
;+001	BNE	ERROR2			; NE=OOPS!
;+001	BR	FINISH			; WRITE STATISTICS
;
;+001ERROR1:
;+001	MOV	#ER1,DPB+Q.IOPL		; GET ERROR STRING
;+001	MOV	#ER1SIZ,DPB+Q.IOPL+2	; GET SIZE
;+001	BR	OUT
;
ERROR2:	MOV	#ER2,DPB+Q.IOPL		; GET ERROR STRING
	MOV	#ER2SIZ,DPB+Q.IOPL+2	; GET SIZE
	BR	OUT
ERROR3:	MOV	#ER3,DPB+Q.IOPL		; GET ERROR STRING
	MOV	#ER3SIZ,DPB+Q.IOPL+2	; GET SIZE
	BR	OUT
ERROR4:	MOV	#ER4,DPB+Q.IOPL		; GET ERROR STRING
	MOV	#ER4SIZ,DPB+Q.IOPL+2	; GET SIZE
	BR	OUT
;
FINISH:
	DIR$	#TIME		; GET TIME/DATE
	MOV	#BSIZ+1,R0	; # OF BINS
	MOV	#BUF+14,R2	; START OF NUMBERS
	MOV	#BIN,R5		; GET FREQUENCY BUFFER
	MOV	#BINSUM,R4	; GET SUBTOTALS BUFFER
10$:
	MOV	(R5)+,(R2)+	; TRANSFER A FREQUENCY
	MOV	(R5)+,(R2)+	;+002 
	MOV	(R4)+,(R2)+	; TRANSFER A SUBTOTAL
	MOV	(R4)+,(R2)+	;+002
	SOB	R0,10$		; GET ANOTHER
	MOV	TOTAL,(R2)+	; TOTAL FREE BLOCKS
	MOV	TOTAL+2,(R2)+	;+002
	MOV	DSKTOT,(R2)+	;+002
	MOV	DSKTOT+2,(R2)	;+002
;+001	MOV	#BUF,R2		; GET ARGUEMENTS
;+001	MOV	#INBUF,R0	; GET NEW OUTPUT STRING BUFFER
;+001	MOV	#ISTRNG,R1	; GET ASCIZ STRING
;+001	CALL	$EDMSG		; EDIT STRING
;+001	SUB	#INBUF,R0	; GET SIZE
;+001	MOV	#INBUF,DPB+Q.IOPL	; GET STRING INTO DPB
;+001	MOV	R0,DPB+Q.IOPL+2		; GET SIZE INTO DPB
;+001	MOV	#2,DPB+Q.IOLU		; USE LUN 2
	MOV	#ARG,R5		;+001 - STEP UP FORTRAN CALL
	JSR	PC,PRINT	;+001 - CALL FORTAN I/O ROUTINE
OUT:
	CLOSE$	#FDB		; CLOSE THE FILE
;+001	DIR$	#DPB
	JSR	PC,EXIT$	;+001 - FORTRAN EXIT
;+001 - FOLLOWING ARE GLOBALS FOR FORTRAN
	.GLOBL	$OTSVA		
	.GLOBL	RCI$
	.GLOBL	LCI$
	.GLOBL	ICI$
ARG:	.WORD	3		;+001 - FORTRAN ARGUMENT LIST
	.WORD	ASCDEV		;+001
	.WORD	BUF		;+001
	.WORD	BUF+14
	.END	FRAG