.TITLE	SDF
	.IDENT	/V01/

;
; A BIT ADDRESS IS DEFINED AS FOLLOWS:
;
;	BITS  0- 2 = BIT NUMBER
;	BITS  3-11 = BYTE NUMBER
;	BITS 12-19 = BLOCK NUMBER-1
;
;	19 18 17 16 15 14 13 12 11 10  9  8  7  6  5  4  3  2  1  0
;      |        BLOCK-1        |           BYTE           |   BIT  |
;

;
; VERSION 01
;
; AUTHOR:	A.E. LEVAN	13-OCT-89
;		SYSTEMS RESEARCH LABORATORIES
;		2800 INDIAN RIPPLE ROAD
;		DAYTON, OHIO  45440
;		513-426-6000
;
;	THIS SOFTWARE WAS WRITTEN UNDER CONTRACT WITH THE
;	UNITED STATES AIR FORCE.
;
; GIVE THE OPERATOR A LIST OF THE FREE AND ALLOCATED BLOCKS
;   ON A FILES-11 DISK AS DEFINED BY THE BITMAP FILE.
;

;+
; SYSTEM MACRO LIBRARY CALLS
;-

;
;	COMMAND LINE MACROS
;

	.MCALL	CSI$		; DEFINE CSI CONTROL BLOCK OFFSETS AND BITS
	.MCALL	CSI$1		; COMMAND SYNTAX ANALYZER
	.MCALL	CSI$2		; COMMAND SEMANTIC PARSER
	.MCALL	CSI$SW		; CREATE SWITCH DESCRIPTOR TABLE
	.MCALL	CSI$SV		; CREATE SWITCH VALUE DESCRIPTOR TABLE
	.MCALL	CSI$ND		; DEFINE END OF DESCRIPTOR TABLE
	.MCALL	GCMLB$		; ALLOCATE AND INITIALIZE GCML CONTROL BLOCK
	.MCALL	GCMLD$		; DEFINE GML CONTROL BLOCK OFFSETS AND BITS
	.MCALL	GCML$		; GET COMMAND LINE

;
;	DIRECTIVE MACROS
;

	.MCALL	CLEF$C		; CLEAR EVENT FLAG
	.MCALL	DIR$		; ISSUE DIRECTIVE
	.MCALL	EXIT$S		; EXIT PROGRAM
	.MCALL	GLUN$C		; GET LUN PARAMETERS
	.MCALL	QIOW$		; I/O DIRECTIVE
	.MCALL	SETF$C		; SET EVENT FLAG
	.MCALL	WTSE$S		; WAIT FOR EVENT FLAG

;
;	FCS MACROS
;

	.MCALL	CLOSE$		; CLOSE FILE
	.MCALL	FDAT$A		; DEFINE FILE ATTRIBUTES
	.MCALL	FDBDF$		; DEFINE FDB
	.MCALL	FDBK$A		; DEFINE BLOCK ACCESS
	.MCALL	FDOP$A		; DEFINE OPEN CHARACTERISTICS
	.MCALL	FDRC$A		; DEFINE RECORD ACCESS
	.MCALL	FINIT$		; INITIALIZE FSR REGION
	.MCALL	FSRSZ$		; DEFINE FSR REGION
	.MCALL	NMBLK$		; DEFINE DEFAULT FILENAME BLOCK
	.MCALL	OPEN$R		; OPEN FILE FOR READ
	.MCALL	OPEN$W		; OPEN FILE FOR WRITE
	.MCALL	PUT$		; WRITE LOGICAL RECORD
	.MCALL	READ$		; DEFINE READ FUNCTION
	.MCALL	WAIT$		; DEFINE WAIT FUNCTION

;+
; LOCAL MACRO DEFINITIONS
;-

;
;	MACRO TO HANDLE FATAL ERRORS
;

	.MACRO	FATAL EMN
	MOV	#EM'EMN',R1
	MOV	#EM'EMN'L,R0
	JMP	ERSRV
	.ENDM

;+
; EQUATED SYMBOLS AND SYMBOL DEFINITIONS
;-

	CSI$			; DEFINE CSI CONTROL BLOCK OFFSETS AND BITS
	GCMLD$			; DEFINE GML CONTROL BLOCK OFFSETS AND BITS

	INLUN	=	1	; INPUT LUN
	OTLUN	=	2	; OUTPUT LUN
	TILUN	=	5	; TERMINAL LUN

;+
; STORAGE DEFINITIONS
;-

	.SBTTL	DATA
	.PSECT	DATA,RW,D,LCL

;
;	INITIALIZE THE FILE STORAGE REGION
;
; 	SIZE = 1 - 1 FILE USING RECORD ACCESS
;

	FSRSZ$	1,,DATA

;
;	ALLOCATE FDB1 FOR THE BITMAP FILE
;

FDB1:	FDBDF$			; ALLOCATE FDB FOR BITMAP FILE
	FDRC$A	FD.RWM		; READ/WRITE MODE (BLOCK I/O)
	FDBK$A	BUF1,512.,,1,IOSB1 ; BUFFER ADD,BUFFER SIZE,EFN,STATUS BLK ADD
	FDOP$A	INLUN,DSPT1,,FO.RD!FA.SHR ; LUN,DATASET DESC ADD,READONLY&SHARE

;
;	DATA SET DESCRIPTOR FOR FDB1 (BITMAP FILE)
;

DSPT1:	.WORD	DNML1,DNM1
	.WORD	DIRL1,DIR1
	.WORD	FNML1,FNM1

DNM1:	.ASCII	/SY0:/
DNML1=	.-DNM1
DIR1:	.ASCII	/[0,0]/
DIRL1=	.-DIR1
FNM1:	.ASCII	/BITMAP.SYS/
FNML1=	.-FNM1
	.EVEN
;
;	ALLOCATE FDB2 FOR THE OUTPUT FILE
;

FDB2:	FDBDF$			; ALLOCATE FDB FOR BITMAP FILE
	FDAT$A	R.VAR,FD.CR	; VBL LENGTH REC,LIST CONTROL
	FDRC$A	,OUTB,80.	; RECORD I/O,OUTPUT BUF ADD&LENGTH
	FDOP$A	OTLUN,DSPT2,DFNB2,FO.WRT ; LUN,DATASET DESC ADD,DEFAULT FILENAME
				; BLOCK ADD,WRITE

;
;	DATA SET DESCRIPTOR FOR FDB2 (OUTPUT FILE)
;

DSPT2:	.BLKW	6

;
;	DEFAULT FILENAME BLOCK FOR FDB2 (OUTPUT FILE)
;

DFNB2:	NMBLK$	DSKFRG,LST,,TI	; DEF=TI:DSKFRG.LST

;
;	LOCAL SYMBOL DEFINITIONS
;

BITS:	.BYTE	1,2,4,10,20,40,100,200 ; BIT VALUES IN A BYTE
BITMSK:	.WORD	^C7		; BIT MASK
BLCTT:	.WORD	0		; TOTAL BLOCKS COUNTED - HIGH PART
	.WORD	0		; TOTAL BLOCKS COUNTED - LOW PART
BUF1:	.BLKB	512.		; INPUT BUFFER
BYTMSK:	.WORD	^C7770		; BYTE MASK
CSIBLK:	.BLKB	C.SIZE		; SIZE OF CSI BLOCK
FRAGST:	.WORD	0		; FRAGMENT STATUS FLAG (0=USED)
FRAGSZ:	.WORD	0		; FRAGMENT SIZE - HIGH PART
	.WORD	0		; FRAGMENT SIZE - LOW PART
FRAGT:	.WORD	0		; TOTAL FRAGMENTS - HIGH PART
	.WORD	0		; TOTAL FRAGMENTS - LOW PART
FREET:	.WORD	0		; TOTAL FREE BLOCKS - HIGH PART
	.WORD	0		; TOTAL FREE BLOCKS - LOW PART
GCLBLK:	GCMLB$	,SDF,,TILUN	; CMD LINE DATA BLOCK
HIADD:	.WORD	0		; HIGH ADDRESS - HIGH PART
	.WORD	0		; HIGH ADDRESS - LOW PART
IOSB1:	.BLKW	2		; I/O STATUS BLOCK LUN1
IOSB2:	.BLKW	2		; I/O STATUS BLOCK LUN2
KOUNT:	.WORD	0		; TOTAL COUNTS - HIGH PART
	.WORD	0		; TOTAL COUNTS - LOW PART
LOADD:	.WORD	0		; LOW ADDRESS - HIGH PART
	.WORD	0		; LOW ADDRESS - LOW PART
NBLKS:	.WORD	0		; TOTAL BLOCKS - HIGH PART
	.WORD	0		; TOTAL BLOCKS - LOW PART
OUTB:	.BLKB	80.		; OUTPUT BUFFER
OUTBL:	.BLKW	1		; LENGTH OF CURRENT OUTPUT STRING
STBLK:	.BLKW	5		; STATISTICS BLOCK
USEDT:	.WORD	0		; TOTAL USED BLOCKS - HIGH PART
	.WORD	0		; TOTAL USED BLOCKS - LOW PART

WRKB:	.BLKB	80.		; WORK BUFFER
EDTSTR:	.ASCIZ	/ %B,%P (%7S.)   %B,%P (%7S.)   %7S.   %4A   %7S./
FRSTR:	.ASCII	/FREE/
USSTR:	.ASCII	/USED/
	.EVEN
ARGBLK:	.WORD	LOADD		; ADDRESS OF LOADD HIGH PART
	.WORD	0		; VALUE OF LOADD LOW PART
	.WORD	HIADD		; ADDRESS OF HIADD HIGH PART
	.WORD	0		; VALUE OF HIADD LOW PART
	.WORD	0		; ADDRESS OF "FREE" OR "USED"

;
;	ASCII MESSAGE DEFINITIONS
;

	.NLIST	BEX

MSG1:	.ASCII	/    NUMBER OF BLOCKS IN BITMAP FILE = /
MSG1N:	.BLKB	8.
MSG1L	=	.-MSG1

MSG2:	.ASCII	/NUMBER OF MAP BLOCKS IN BITMAP FILE = /
MSG2N:	.BLKB	8.
MSG2L	=	.-MSG2

MSG3:	.ASCII	/           NUMBER OF BLOCKS ON DISK = /
MSG3N:	.BLKB	8.
MSG3L	=	.-MSG3

MSG4:	.ASCII	<15><12>
	.ASCII	/         LO LBN                  HI LBN             FRAG    FRAG     SUB  /
MSG4L	=	.-MSG4
MSG4A:	.ASCII	/   OCTAL       DEC         OCTAL       DEC          SIZE   STATUS   TOTAL /
MSG4AL	=	.-MSG4A
MSG4B:	.ASCII	/   -----       ---         -----       ---          ----   ------  -------/
MSG4BL	=	.-MSG4B

MSG5:	.ASCII	<15><12>/      NUMBER OF USED BLOCKS ON DISK = /
MSG5N:	.BLKB	8.
MSG5L	=	.-MSG5

MSG6:	.ASCII	/      NUMBER OF FREE BLOCKS ON DISK = /
MSG6N:	.BLKB	8.
MSG6L	=	.-MSG6

MSG7:	.ASCII	/   NUMBER OF BLOCKS COUNTED ON DISK = /
MSG7N:	.BLKB	8.
MSG7L	=	.-MSG7

MSG8:	.ASCII	/        NUMBER OF FRAGMENTS ON DISK = /
MSG8N:	.BLKB	8.
MSG8L	=	.-MSG8

MSG9:	.ASCII	<14>/                             DEVICE = /
MSG9N:	.BLKB	8.
MSG9L	=	.-MSG9

EM1:	.ASCII	/ INVALID COMMAND LINE/
EM1L	=	.-EM1

EM2:	.ASCII	/ ERROR ON OUTPUT FILE OPEN/
EM2L	=	.-EM2

EM3:	.ASCII	/ ERROR ON BITMAP FILE OPEN/
EM3L	=	.-EM3

EM4:	.ASCII	/ ERROR ON FILE READ/
EM4L	=	.-EM4

EM5:	.ASCII	/ WARNING - LBN 0 NOT ALLOCATED/
EM5L	=	.-EM5

	.EVEN
	.LIST	BEX

;
;	DIRECTIVE PARAMETER BLOCKS
;

MSGDPB:	QIOW$	IO.WVB,TILUN,5,,IOSB2,,<0,0,40> ; MESSAGE DPB

	.SBTTL	CODE
	.PSECT	CODE,RW,D,LCL

START::				; ENTRY POINT
	FINIT$			; INITIALIZE THE FSR

;
; GET COMMAND LINE
;  IF NONE - USE DEFAULTS
;

10$:	GCML$	#GCLBLK		; GET COMMAND LINE
	BCC	15$		; SKIP IF CMD LINE OK
	FATAL	<1>		; ELSE,ERROR
15$:	TST	GCLBLK+G.CMLD	; NULL COMMAND LINE?
	BEQ	16$		; IF SO, USE DEFAULTS
	CALL	PARCL		; ELSE,PARSE COMMAND LINE
16$:

;
; OPEN THE OUTPUT FILE
;

	OPEN$W	#FDB2		;OPEN OUTPUT FILE
	BCC	17$		; BRANCH IF OK
	FATAL	<2>		; ELSE,ERROR
17$:

;
; OPEN THE BITMAP FILE
;

	MOV	#STBLK,FDB1+F.STBK ; SET STATUS BLOCK ADDRESS
	OPEN$R	#FDB1		; OPEN THE DATA FILE FOR READ
	BCC	20$		; BRANCH IF OPEN OK
	FATAL	<3>		; ELSE,ERROR
20$:	MOVB	F.FNB+N.DVNM(R0),MSG9N ; GET TRUE DEVICE NAME
	MOVB	F.FNB+N.DVNM+1(R0),MSG9N+1
	MOV	F.FNB+N.UNIT(R0),R1 ; GET UNIT NUMBER
	MOV	#MSG9N+2,R0	; ADDRESS OF OUTPUT STRING
	CLR	R2		; SUPPRESS LEADING 0'S
	CALL	$CBOMG		; CONVERT TO ASCII
	MOVB	#':,(R0)+	; ADD A COLON
	MOV	#MSG9,R1	; ADDRESS OF OUTPUT STRING
	SUB	R1,R0		; GET MESSAGE LENGTH
	CALL	OUTMSG		; OUTPUT MESSAGE
	MOV	#FDB1,R0	; RESTORE FDB ADDRESS

;
; PUT TRUE FILE SIZE INTO FDB
;

	MOV	STBLK+6,F.HIBK+2(R0) ; LIE
	MOV	STBLK+6,F.EFBK+2(R0) ; LIE
	INC	F.EFBK+2(R0)

;
; TELL OPERATOR BITMAP FILE SIZE
;

	MOV	#MSG1N,R0	; ADDRESS OF NUMBER STRING
	MOV	STBLK+6,R1	; R1=# OF BLOCKS IN BITMAP
	CLR	R2		; SUPPRESS LEADING ZEROS
	CALL	$CBDMG		; CONVERT
	MOVB	#'.,(R0)+	; ADD TRAILING DECIMAL POINT
	MOV	#MSG1,R1	; ADDRESS OF OUTPUT STRING
	SUB	R1,R0		; GET MESSAGE LENGTH
	CALL	OUTMSG		; OUTPUT MESSAGE

;
; READ STORAGE CONTROL BLOCK (VIRTUAL BLOCK 1)
;

	MOV	#FDB1,R0	; GET FDB ADDRESS
	MOV	#1,R2		; SET VBN=1
	MOV	#BUF1,R1	; SET BUFFER ADDRESS
	CALL	DOREAD		; DO THE READ

;
; TELL OPERATOR NUMBER OF STORAGE BITMAP BLOCKS
;

	MOV	#MSG2N,R0	; ADDRESS OF NUMBER STRING
	MOVB	BUF1+3,R1	; R1=# OF MAP BLOCKS
	BIC	#^C377,R1	; CLEAR HIGH BYTE
	MOV	R1,R3		; SAVE IT FOR LATER
	CLR	R2		; SUPPRESS LEADING ZEROS
	CALL	$CBDMG		; CONVERT
	MOVB	#'.,(R0)+	; ADD TRAILING DECIMAL POINT
	MOV	#MSG2,R1	; ADDRESS OF OUTPUT STRING
	SUB	R1,R0		; GET MESSAGE LENGTH
	CALL	OUTMSG		; OUTPUT MESSAGE

;
; TELL OPERATOR NUMBER OF BLOCKS ON DISK
;
;  (NUMBER OF BLOCKS MAPPED BY BITMAP FILE)
;

	MOV	#MSG3N,R0	; ADDRESS OF NUMBER STRING
	MOV	#BUF1+4,R1	; ASSUME LARGE DISK
	CMP	R3,#126.	; GOOD ASSUMPTION?
	BGT	30$		; BRANCH IF YES
	MOV	R3,R1		; R1=# OF BLOCKS
	ASL	R1		; MULT BY 4
	ASL	R1
	ADD	#4,R1		; +4
	ADD	#BUF1,R1	; R1=ADDRESS OF DOUBLEWORD
30$:	MOV	(R1),NBLKS	; STORE TOTAL # OF BLOCKS
	MOV	2(R1),NBLKS+2
	CLR	R2		; SUPPRESS LEADING ZEROS
	CALL	$CDDMG		; CONVERT
	MOVB	#'.,(R0)+	; ADD TRAILING DECIMAL POINT
	MOV	#MSG3,R1	; ADDRESS OF OUTPUT STRING
	SUB	R1,R0		; GET MESSAGE LENGTH
	CALL	OUTMSG		; OUTPUT MESSAGE

;
; CALCULATE LOOP COUNTER
;

	MOV	NBLKS,KOUNT	; COPY NBLKS HIGH
	MOV	NBLKS+2,KOUNT+2 ; COPY NBLKS LOW
	SUB	#1,KOUNT+2	; KOUNT=NBLKS-1
	SBC	KOUNT

;
; PRINT HEADER
;

	MOV	#MSG4L,R0	; GET MESSAGE SIZE
	MOV	#MSG4,R1	; AND MESSAGE ADDRESS
	CALL	OUTMSG		; AND PRINT HEADER
	MOV	#MSG4AL,R0	; GET MESSAGE SIZE
	MOV	#MSG4A,R1	; AND MESSAGE ADDRESS
	CALL	OUTMSG		; AND PRINT HEADER
	MOV	#MSG4BL,R0	; GET MESSAGE SIZE
	MOV	#MSG4B,R1	; AND MESSAGE ADDRESS
	CALL	OUTMSG		; AND PRINT HEADER

;
; CHECK LBN 0
;
; IF IT IS NOT ALLOCATED, DISK IS PROBABLY CORRUPT
;

40$:	CALL	DOR1		; READ FIRST MAP BLOCK
	BITB	#1,BUF1		; IS LBN 0 ALLOCATED?
	BEQ	45$		; IF YES, OK - CONTINUE
	FATAL	<5>		; ELSE,ERROR
45$:	MOV	#-1,FRAGST	; INIT FRAGMENT STATUS FLAG

;
; GET NEXT FRAGMENT SIZE
;
; CALL APPROPRIATE ROUTINE DEPENDING ON FRAGST FLAG
;

50$:
	CLR	FRAGSZ		; SET FRAGMENT SIZE=0
	CLR	FRAGSZ+2

	COM	FRAGST		; COMPLEMENT STATUS
	BEQ	51$		; IF STATUS=0,COUNT USED BLOCKS
	CALL	FREE		; ELSE,COUNT FREE BLOCKS
	BR	52$
51$:	CALL	USED		; GET COUNT OF USED BLOCKS

;
; CALCULATE HIGHEST ADDRESS IN FRAGMENT
;

52$:	MOV	LOADD+2,HIADD+2	; HIADD = (LOADD+FRAGSZ)-1
	MOV	LOADD,HIADD
	ADD	FRAGSZ+2,HIADD+2
	ADC	HIADD
	ADD	FRAGSZ,HIADD
	SUB	#1,HIADD+2
	SBC	HIADD

;
; UPDATE COUNTERS
;

	ADD	#1,FRAGT+2	; INCREMENT TOTAL FRAGMENTS
	ADC	FRAGT

	ADD	FRAGSZ+2,BLCTT+2 ; ADD CURRENT FRAGMENT SIZE
	ADC	BLCTT		; TO TOTAL BLOCKS COUNTED
	ADD	FRAGSZ,BLCTT

	TST	FRAGST		; CURRENT FRAGMENT FREE OR USED?
	BEQ	54$		; IF STATUS=0,USED ELSE,FREE

	ADD	FRAGSZ+2,FREET+2 ; ADD CURRENT FRAGMENT SIZE
	ADC	FREET		; TO TOTAL FREE BLOCKS
	ADD	FRAGSZ,FREET
	BR	55$

54$:	ADD	FRAGSZ+2,USEDT+2 ; ADD CURRENT FRAGMENT SIZE
	ADC	USEDT		; TO TOTAL USED BLOCKS
	ADD	FRAGSZ,USEDT

;
; FORMAT OUTPUT BUFFER AND PRINT RESULTS
;

55$:	CALL	FORMOB		; FORMAT AND PRINT OUTPUT BUFFER

	TST	KOUNT		; NEG?
	BLT	60$		; IF YES,DONE

;
; SET NEW LOW ADDRESS OF NEXT FRAGMENT = HIGHEST ADDRESS OF
;  CURRENT FRAGMENT + 1
;

	MOV	HIADD+2,LOADD+2	; LOADD = HIADD+1
	MOV	HIADD,LOADD
	ADD	#1,LOADD+2
	ADC	LOADD

	BR	50$

;
; TELL OPERATOR TOTAL NUMBER OF USED,FREE, AND COUNTED BLOCKS
;  AND TOTAL NUMBER OF FRAGMENTS
;

60$:	MOV	#MSG5N,R0	; ADDRESS OF NUMBER STRING
	MOV	#USEDT,R1	; R1=ADDRESS OF DOUBLEWORD
	CLR	R2		; SUPPRESS LEADING ZEROS
	CALL	$CDDMG		; CONVERT
	MOVB	#'.,(R0)+	; ADD TRAILING DECIMAL POINT
	MOV	#MSG5,R1	; ADDRESS OF OUTPUT STRING
	SUB	R1,R0		; GET MESSAGE LENGTH
	CALL	OUTMSG		; OUTPUT MESSAGE

	MOV	#MSG6N,R0	; ADDRESS OF NUMBER STRING
	MOV	#FREET,R1	; R1=ADDRESS OF DOUBLEWORD
	CLR	R2		; SUPPRESS LEADING ZEROS
	CALL	$CDDMG		; CONVERT
	MOVB	#'.,(R0)+	; ADD TRAILING DECIMAL POINT
	MOV	#MSG6,R1	; ADDRESS OF OUTPUT STRING
	SUB	R1,R0		; GET MESSAGE LENGTH
	CALL	OUTMSG		; OUTPUT MESSAGE

	MOV	#MSG7N,R0	; ADDRESS OF NUMBER STRING
	MOV	#BLCTT,R1	; R1=ADDRESS OF DOUBLEWORD
	CLR	R2		; SUPPRESS LEADING ZEROS
	CALL	$CDDMG		; CONVERT
	MOVB	#'.,(R0)+	; ADD TRAILING DECIMAL POINT
	MOV	#MSG7,R1	; ADDRESS OF OUTPUT STRING
	SUB	R1,R0		; GET MESSAGE LENGTH
	CALL	OUTMSG		; OUTPUT MESSAGE

	MOV	#MSG8N,R0	; ADDRESS OF NUMBER STRING
	MOV	#FRAGT,R1	; R1=ADDRESS OF DOUBLEWORD
	CLR	R2		; SUPPRESS LEADING ZEROS
	CALL	$CDDMG		; CONVERT
	MOVB	#'.,(R0)+	; ADD TRAILING DECIMAL POINT
	MOV	#MSG8,R1	; ADDRESS OF OUTPUT STRING
	SUB	R1,R0		; GET MESSAGE LENGTH
	CALL	OUTMSG		; OUTPUT MESSAGE

100$:
FINI:	CLOSE$	#FDB1		; CLOSE FILE IF OPEN
	CLOSE$	#FDB2		; CLOSE FILE IF OPEN

EXIT:	EXIT$S			; EXIT THIS PROGRAM

;
; SUBROUTINE TO DO READ
;
; INPUTS:
;	IF ENTRY AT DOREAD
;	   R1 = BUFFER ADDRESS
;	   R2 = VBN TO READ
;	IF ENTRY AT DOR1 - READ NEXT BLOCK
;
; OUTPUTS:
;	ALL REGISTERS PRESERVED
;	IF ERROR - POP STACK AND GO TO ERROR CODE
;	
;

DOREAD:				; SUBROUTINE ENTRY POINT
	MOV	R1,FDB1+F.BKDS+2 ; SET BUFFER ADDRESS
	MOV	R2,FDB1+F.BKVB+2 ; SET BLOCK # TO READ
DOR1:	MOV	R0,-(SP)	; SAVE R0 CONTENTS
	READ$	#FDB1		; DO READ
	BCS	99$		; BRANCH IF ERROR
	WAIT$	R0		; WAIT FOR READ TO COMPLETE
	MOV	(SP)+,R0	; RESTORE R0 CONTENTS

	RETURN

99$:	CMP	(SP)+,(SP)+	; CLEAN STACK
	FATAL	<4>		; GO TO ERROR CODE

;
; SUBROUTINE TO HANDLE FATAL ERRORS
;
; INPUTS:
;	R0 = ERROR MESSAGE LENGTH
;	R1 = ERROR MESSAGE ADDRESS
;
; OUTPUTS:
;	ERROR MESSAGE IS WRITTEN TO TERMINAL
;	R0 IS DESTROYED
;	ALL OTHER REGISTERS PRESERVED
;	JUMP TO EXIT PROCESSING
;

ERSRV:				; SUBROUTINE ENTRY POINT
	MOV	R1,MSGDPB+Q.IOPL ; PUT BUFFER ADDRESS IN QIO
	MOV	R0,MSGDPB+Q.IOPL+2 ; SET BYTE COUNT
	DIR$	#MSGDPB		; WRITE MESSAGE
	BCC	10$		; BRANCH IF DIRECTIVE OK
	HALT			; ELSE,QUIT
10$:	CMPB	#IS.SUC,IOSB2	; WRITE OK?
	BEQ	20$		; BRANCH IF YES
	HALT			; ELSE,QUIT
20$:	JMP	FINI

;
; SUBROUTINE TO FORMAT THE OUTPUT BUFFER
;
; INPUTS:
;	LOADD = LOWEST ADDRESS IN FRAGMENT
;	HIADD = HIGHEST ADDRESS IN FRAGMENT
;	FRAGSZ = FRAGMENT SIZE IN BLOCKS
;	FRAGST = FRAGMENT STATUS (0=USED,NON 0=FREE)
;
; OUTPUT:
;	THE OUTPUT BUFFER IS FORMATTED AND PRINTED
;	R0,R1,R2 DESTROYED
;	ALL OTHER REGISTERS PRESERVED
;

FORMOB:				; SUBROUTINE ENTRY POINT
	MOV	#OUTB,R0	; ADDRESS OF OUTPUT BUFFER
	MOV	#EDTSTR,R1	; ADDRESS OF EDIT STRING
	MOV	LOADD+2,ARGBLK+2 ; GET VALUE OF LOW LOADD
	MOV	HIADD+2,ARGBLK+6 ; GET VALUE OF LOW HIADD
	MOV	#USSTR,ARGBLK+8. ; ASSUME USED
	TST	FRAGST		; GOOD ASSUMPTION?
	BEQ	10$		; BRANCH IF YES
	MOV	#FRSTR,ARGBLK+8. ; ADDRESS OF "FREE"
10$:	MOV	#ARGBLK,R2	; ADDRESS OF ARGUMENT BLOCK
	CALL	$EDMSG		; FORMAT BUFFER
	MOV	R1,R3		; SAVE STRING LENGTH

	MOV	#WRKB,R0	; GET ADDRESS OF WORK BUFFER
	MOV	#LOADD,R1	; GET ADDRESS OF VALUE TO CONVERT
	CLR	R2		; SUPPRESS LEADING ZEROS
	CALL	$CDDMG		; CONVERT DOUBLEWORD TO DECIMAL ASCII
	SUB	#WRKB,R0	; GET NUMBER OF CHARACTERS
	MOV	R0,R1
	MOV	#OUTB+20.,R0	; GET ADDRESS IN OUTPUT BUFFER
	SUB	R1,R0		; ADJUST FOR NUM OF CHARACTERS
	MOV	#LOADD,R1	; GET ADDRESS OF VALUE TO CONVERT
	CLR	R2		; SUPPRESS LEADING ZEROS
	CALL	$CDDMG		; CONVERT DOUBLEWORD TO DECIMAL ASCII

	MOV	#WRKB,R0	; GET ADDRESS OF WORK BUFFER
	MOV	#HIADD,R1	; GET ADDRESS OF VALUE TO CONVERT
	CLR	R2		; SUPPRESS LEADING ZEROS
	CALL	$CDDMG		; CONVERT DOUBLEWORD TO DECIMAL ASCII
	SUB	#WRKB,R0	; GET NUMBER OF CHARACTERS
	MOV	R0,R1
	MOV	#OUTB+44.,R0	; GET ADDRESS IN OUTPUT BUFFER
	SUB	R1,R0		; ADJUST FOR NUM OF CHARACTERS
	MOV	#HIADD,R1	; GET ADDRESS OF VALUE TO CONVERT
	CLR	R2		; SUPPRESS LEADING ZEROS
	CALL	$CDDMG		; CONVERT DOUBLEWORD TO DECIMAL ASCII

	MOV	#WRKB,R0	; GET ADDRESS OF WORK BUFFER
	MOV	#FRAGSZ,R1	; GET ADDRESS OF VALUE TO CONVERT
	CLR	R2		; SUPPRESS LEADING ZEROS
	CALL	$CDDMG		; CONVERT DOUBLEWORD TO DECIMAL ASCII
	SUB	#WRKB,R0	; GET NUMBER OF CHARACTERS
	MOV	R0,R1
	MOV	#OUTB+56.,R0	; GET ADDRESS IN OUTPUT BUFFER
	SUB	R1,R0		; ADJUST FOR NUM OF CHARACTERS
	MOV	#FRAGSZ,R1	; GET ADDRESS OF VALUE TO CONVERT
	CLR	R2		; SUPPRESS LEADING ZEROS
	CALL	$CDDMG		; CONVERT DOUBLEWORD TO DECIMAL ASCII

30$:	TST	FRAGST		; CURRENT FRAGMENT FREE OR USED?
	BEQ	32$		; 0=USED
	MOV	#FREET,R1	; GET ADDRESS OF VALUE TO CONVERT
	BR	34$
32$:	MOV	#USEDT,R1	; GET ADDRESS OF VALUE TO CONVERT

34$:	MOV	R1,-(SP)
	MOV	#WRKB,R0	; GET ADDRESS OF WORK BUFFER
	CLR	R2		; SUPPRESS LEADING ZEROS
	CALL	$CDDMG		; CONVERT DOUBLEWORD TO DECIMAL ASCII
	SUB	#WRKB,R0	; GET NUMBER OF CHARACTERS
	MOV	R0,R1
	MOV	#OUTB+74.,R0	; GET ADDRESS IN OUTPUT BUFFER
	SUB	R1,R0		; ADJUST FOR NUM OF CHARACTERS
	MOV	(SP)+,R1	; GET ADDRESS OF VALUE TO CONVERT
	CLR	R2		; SUPPRESS LEADING ZEROS
	CALL	$CDDMG		; CONVERT DOUBLEWORD TO DECIMAL ASCII

	MOV	R3,R0		; R0=STRING LENGTH
	MOV	#OUTB,R1	; R1=OUTPUT BUFFER ADDRESS
	CALL	OUTMSG

	RETURN

;
; SUBROUTINE TO COUNT FREE BLOCKS
;
; INPUTS:
;	LOADD = STARTING ADDRESS
;	FRAGSZ = 0
;	FRAGST <> 0
;
; OUTPUT:
;	FRAGSZ = COUNT OF FREE BLOCKS IN FRAGMENT
;	R4,R5 ARE DESTROYED
;	ALL OTHER REGISTERS PRESERVED
;

FREE:				; SUBROUTINE ENTRY POINT
	MOV	LOADD+2,R4	; GET LOW PART OF ADDRESS
	MOV	R4,R5		; IN R5 ALSO
	BIC	BYTMSK,R4	; R4 = BYTE ADDRESS*10
	ASR	R4		; GET BYTE ADDRESS
	ASR	R4
	ASR	R4
	BIC	BITMSK,R5	; R5 = BIT ADDRESS

;
; STEP 1 - IF BIT ADDRESS <> 0 THEN WE MUST COUNT THE REMAINING BITS IN THE BYTE
;

	BEQ	20$		; BRANCH IF ON A BYTE BOUNDRY
10$:	BITB	BITS(R5),BUF1(R4) ; TEST BIT - BIT SET=FREE
	BEQ	40$		; BIT CLEAR=USED=END OF COUNT
	INC	FRAGSZ+2	; ADD 1 TO COUNT
	SUB	#1,KOUNT+2	; DECREMENT LOOP COUNT
	SBC	KOUNT
	BLT	40$		; IF NEG,DONE
	INC	R5		; BIT ADDRESS=BIT ADDRESS+1
	BIT	#7,R5		; ARE WE DONE?
	BNE	10$		; GO AGAIN IF NO
	CLR	R5		; ZERO BIT ADDRESS
	INC	R4		; INCREMENT BYTE ADDRESS

;
; STEP 2 - CHECK FOR FREE BLOCKS A BYTE AT A TIME
;
; IF THE BYTE=-1, THEN ALL 8. BLOCKS ARE FREE
;  ELSE, GO ON TO STEP 3
;

20$:	CMP	R4,#1000	; OUT OF DATA?
	BLT	21$
	CALL	DOR1		; READ MORE
	CLR	R4		; BYTE ADDRESS=0
21$:	CMPB	BUF1(R4),#377	; ALL 8 BLOCKS FREE?
	BNE	30$		; BRANCH IF NO
	SUB	#8.,KOUNT+2	; KOUNT=KOUNT-8
	SBC	KOUNT
	BLT	25$		; IF <= OVERFLOW
	ADD	#8.,FRAGSZ+2	; ADD 8 TO FRAGMENT SIZE
	ADC	FRAGSZ
	INC	R4		; POINT AT NEXT BYTE
	BR	20$		; LOOP
25$:	ADD	#8.,KOUNT+2	; RESTORE COUNTER
	ADC	KOUNT

;
; STEP 3 - COUNT THE REST OF THE FREE BLOCKS IN THE BYTE
;	   UNTILL WE HIT A USED ONE
;

30$:	BITB	BITS(R5),BUF1(R4) ; TEST BIT - BIT SET=FREE
	BEQ	40$		; BIT CLEAR=USED=END OF COUNT
	ADD	#1,FRAGSZ+2	; ADD 1 TO COUNT
	ADC	FRAGSZ
	SUB	#1,KOUNT+2	; DECREMENT LOOP COUNT
	SBC	KOUNT
	BLT	40$		; IF NEG,DONE
	INC	R5		; BIT ADDRESS=BIT ADDRESS+1
	BR	30$		; GO AGAIN IF NO

40$:	RETURN

;
; SUBROUTINE TO OUTPUT A MESSAGE TO THE OUTPUT FILE
;
; INPUTS:
;	R0 = MESSAGE LENGTH
;	R1 = MESSAGE ADDRESS
;
; OUTPUTS:
;	BUFFER IS WRITTEN TO TERMINAL
;	R0,R1 DESTROYED
;	ALL OTHER REGISTERS PRESERVED
;

OUTMSG:				; SUBROUTINE ENTRY POINT
	MOV	R0,OUTBL	; R0=LENGTH
	PUT$	#FDB2,R1,OUTBL	; WRITE STRING
	BCC	20$		; BRANCH IF ALL OK
	HALT

20$:	RETURN

;
; SUBROUTINE TO CHECK AND PARSE COMMAND
;
; INPUTS:
;	COMMAND LINE AND LENGTH
;
; OUTPUTS:
;	COMMAND LINE IS PARSED AND DEVICE ADDRESS AND SIZE INSERTED
;		INTO DATASET DESCRIPTOR
;	ELSE, ERROR - POP STACK AND GO TO ERROR CODE
;	R0,R1,R2 DESTROYED
;
; COMMAND LINE MUST HAVE THE FOLLOWING FORM:
;	CMD DEVICE
;
; WHERE:
;	CMD = TASK NAME (IGNORED)
;	DEVICE = DEVICE NAME (EX: DR0:)
;

PARCL:				; SUBROUTINE ENTRY POINT
	CSI$1	#CSIBLK,GCLBLK+G.CMLD+2,GCLBLK+G.CMLD ; ANALYZE CMD LINE
	BCS	99$		; WAS CSI$1 SUCCESSFUL?

; PARSE OUTPUT FILE SPEC

	CSI$2	#CSIBLK,OUTPUT	; PARSE OUTPUT FILE SPEC
	BCS	99$		; BRANCH IF ERROR
	BITB	#<CS.WLD!CS.MOR>,CSIBLK+C.STAT ; WILD OR MORE?
	BNE	99$		; ERROR IF YES
	MOV	#CSIBLK+C.DSDS,R0 ; GET CURRENT DATA-SET DESCRIPTOR POINTER
	MOV	#DSPT2,R1	; GET OUTPUT DATA-SET DESCRIPTOR POINTER
	MOV	#6,R2		; SET MOVE WHOLE DESCRIPTOR
10$:	MOV	(R0)+,(R1)+	;   A WORD AT A TIME
	SOB	R2,10$

; PARSE INPUT FILE SPEC
;
;	ONLY DEVICE IS ALLOWED

	BITB	#CS.EQU,CSIBLK+C.STAT ; EQUAL SIGN SEEN?
	BEQ	20$		; IF NO,INPUT ONLY

	CSI$2	#CSIBLK,INPUT	; PARSE OUTPUT FILE SPEC
	BCS	99$		; BRANCH IF ERROR
	BITB	#<CS.NMF!CS.DIF!CS.WLD!CS.MOR>,CSIBLK+C.STAT
				; NAME OR DIRECTORY OR WILD OR MORE?
	BNE	99$		; ERROR IF YES
	MOV	#CSIBLK+C.DSDS,R0 ; GET CURRENT DATA-SET DESCRIPTOR POINTER
	MOV	#DSPT1,R1	; GET OUTPUT DATA-SET DESCRIPTOR POINTER
	MOV	(R0)+,(R1)+	; MOVE ONLY DEVICE NAME DESCRIPTOR
	MOV	(R0)+,(R1)+

20$:	RETURN

99$:	TST	(SP)+		; POP RETURN ADDRESS (CRUDE BUT EFFECTIVE)
	FATAL	<1>		; GO TO ERROR CODE

;
; SUBROUTINE TO COUNT USED BLOCKS
;
; INPUTS:
;	LOADD = STARTING ADDRESS
;	FRAGSZ = 0
;	FRAGST = 0
;
; OUTPUT:
;	FRAGSZ = COUNT OF USED BLOCKS IN FRAGMENT
;	R4,R5 ARE DESTROYED
;	ALL OTHER REGISTERS PRESERVED
;

USED:				; SUBROUTINE ENTRY POINT
	MOV	LOADD+2,R4	; GET LOW PART OF ADDRESS
	MOV	R4,R5		; IN R5 ALSO
	BIC	BYTMSK,R4	; R4 = BYTE ADDRESS
	ASR	R4		; GET BYTE ADDRESS
	ASR	R4
	ASR	R4
	BIC	BITMSK,R5	; R5 = BIT ADDRESS

;
; STEP 1 - IF BIT ADDRESS <> 0 THEN WE MUST COUNT THE REMAINING BITS IN THE BYTE
;

	BEQ	20$		; BRANCH IF ON A BYTE BOUNDRY
10$:	BITB	BITS(R5),BUF1(R4) ; TEST BIT - BIT SET=USED
	BNE	40$		; BIT SET=FREE=END OF COUNT
	INC	FRAGSZ+2	; ADD 1 TO COUNT
	SUB	#1,KOUNT+2	; DECREMENT LOOP COUNT
	SBC	KOUNT
	BLT	40$		; IF NEG,DONE
	INC	R5		; BIT ADDRESS=BIT ADDRESS+1
	BIT	#7,R5		; ARE WE DONE?
	BNE	10$		; GO AGAIN IF NO
	CLR	R5		; ZERO BIT ADDRESS
	INC	R4		; INCREMENT BYTE ADDRESS

;
; STEP 2 - CHECK FOR USED BLOCKS A BYTE AT A TIME
;
; IF THE BYTE=0, THEN ALL 8. BLOCKS ARE USED
;  ELSE, GO ON TO STEP 3
;

20$:	CMP	R4,#1000	; OUT OF DATA?
	BLT	21$
	CALL	DOR1		; READ MORE
	CLR	R4		; BYTE ADDRESS=0
21$:	TSTB	BUF1(R4)	; ALL 8 BLOCKS USED?
	BNE	30$		; BRANCH IF NO
	SUB	#8.,KOUNT+2	; KOUNT=KOUNT-8
	SBC	KOUNT
	BLT	25$		; IF <= OVERFLOW
	ADD	#8.,FRAGSZ+2	; ADD 8 TO FRAGMENT SIZE
	ADC	FRAGSZ
	INC	R4		; POINT AT NEXT BYTE
	BR	20$		; LOOP
25$:	ADD	#8.,KOUNT+2	; RESTORE COUNTER
	ADC	KOUNT

;
; STEP 3 - COUNT THE REST OF THE USED BLOCKS IN THE BYTE
;	   UNTILL WE HIT A FREE ONE
;

30$:	BITB	BITS(R5),BUF1(R4) ; TEST BIT - BIT CLEAR=USED
	BNE	40$		; BIT SET=FREE=END OF COUNT
	ADD	#1,FRAGSZ+2	; ADD 1 TO COUNT
	ADC	FRAGSZ
	SUB	#1,KOUNT+2	; DECREMENT LOOP COUNT
	SBC	KOUNT
	BLT	40$		; IF NEG,DONE
	INC	R5		; BIT ADDRESS=BIT ADDRESS+1
	BR	30$		; GO AGAIN IF NO

40$:	RETURN

	.END	START
%%%%%%
.;	DIR.CMD
.;
.; 	PRINT A LIST OF THE ENTRIES IN A DIRECTORY FILE
.;	   ON THE USERS TERMINAL
.;
.;
.;	DEFINE THE RAD-50 CHARACTER SET
.;		*** NOTE ***
.;	SET THE UNDEFINED CHARACTER (35) TO "?"
.;
	.SETS R50CS " ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789"
.;
.;	DEFINE THE DEFAULT VALUES FOR THE SWITCHES
.;		/AL = FALSE - PRINT ALL ENTRIES
.;		/CN = FALSE - COMPRESS FILENAMES
.;		/CE = TRUE  - PRINT CURRENT ENTRIES
.;		/DE = FALSE - PRINT DELETED ENTRIES
.;		/EN = FALSE - PRINT ENTRY NUMBER
.;		/FI = FALSE - PRINT FILE ID'S
.;		/ST = TRUE  - PRINT STATISTICS
.;		/UE = FALSE - PRINT UNUSED ENTRIES
.;
.;		*** NOTE ***
.;	THE USE OF THE /AL SWITCH WITH ANY OF THE OTHER ENTRY
.;	SELECTION SWITCHES (/CE /DE /UE) IS NOT RECOMMENDED
.;	AS THESE SWITCHES WILL BE IGNORED
.;
	.SETF SWAL
	.SETF SWCN
	.SETT SWCE
	.SETF SWEN
	.SETF SWDE
	.SETF SWFI
	.SETT SWST
	.SETF SWUE
.;
.;	INITIALIZE STATISTICS COUNTERS
.;
	.SETN NCE 0
	.SETN NDE 0
	.SETN NUE 0
.;
.;	DEFINE DEFAULT DEVICE
.;
	.SETS DEV "SY:"
.;
.;	DEFINE DEFAULT GROUP AND MEMBER (UIC)
.;
	.PARSE <UIC> "[,]" JUNK1 GRP MEM JUNK2
.;
	.ENABLE	SUBSTITUTION
.;
.;	A COMMAND LINE HAS THE FOLLOWING FORMAT:
.;
.;	DIR DDNN:[GGG,MMM]/SW1/SW2/SW3...
.;
.;	WHERE:
.;	   DDNN = DEVICE
.;	   [GGG,MMM] = UIC
.;	   /SW... = SWITCHES
.;
.;	GET THE COMMAND LINE
.; 	IF NO COMMAND LINE, USE CURRENT DEVICE AND UIC
.;	P0 = COMMAND (THIS FILENAME)
.; 	P1-P9 = OPERANDS
.;
	.IF P1 EQ "" .GOTO 20
.;
.;	A COMMAND LINE WAS FOUND
.;	SEE IF IT WAS A CALL FOR HELP
.;
	.IF P1 NE "?" .GOTO 10
.;
.;	IT WAS - GIVE USER A LIST OF THE OPTIONS
.;
;	A COMMAND LINE HAS THE FOLLOWING FORMAT:
;
;	DDNN:[GGG,MMM]/SW1/SW2/SW3...
;
;	WHERE:
;	   DDNN = DEVICE (EX: DL10:)
;	   [GGG,MMM] = UIC (EX: [127,131])
;	   /SW... = SWITCHES (EX: /-CE/DF)
;
;	THE DEFAULT VALUES FOR THE SWITCHES ARE:
;		/AL = FALSE - PRINT ALL ENTRIES
;		/CN = FALSE - COMPRESS FILENAMES
;		/CE = TRUE  - PRINT CURRENT ENTRIES
;		/DE = FALSE - PRINT DELETED ENTRIES
;		/EN = FALSE - PRINT ENTRY NUMBER
;		/FI = FALSE - PRINT FILE ID'S
;		/ST = TRUE  - PRINT STATISTICS
;		/UE = FALSE - PRINT UNUSED ENTRIES
;		*** NOTE ***
;	THE USE OF THE /AL SWITCH WITH ANY OF THE OTHER ENTRY
;	SELECTION SWITCHES (/CE /DE /UE) IS NOT RECOMMENDED
;	AS THESE SWITCHES WILL BE IGNORED
;
	.ASKS P1 COMMAND LINE
.;
.;	SEARCH THE COMMAND LINE FOR A DEVICE AND UIC
.;
.10:
	.TEST P1 ":"
	.IF <STRLEN> EQ 0 .GOTO 15
	.PARSE P1 ":" DEV JUNK1
	.SETS DEV DEV+":"
.15:	.TEST P1 "["
	.IF <STRLEN> EQ 0 .GOTO 20
	.PARSE P1 "[,]" JUNK1 GRP MEM JUNK2
.;
.;	CONSTRUCT DIRECTORY FILENAME
.;
.20:	.SETN NGRP 'GRP'
	.SETN NMEM 'MEM'
	.SETS DFIL DEV+"[0,0]"+"'NGRP%ZOR3'"+"'NMEM%ZOR3'"+".DIR"
	; DIRECTORY FILE = 'DFIL'
.;
.;	SEARCH THE COMMAND LINE FOR ANY SWITCHES
.;
.30:	.TEST P1 "/"
	.IF <STRLEN> EQ 0 .GOTO 39
.;
.;	PARSE SWITCHES
.;
	.PARSE P1 "/" JUNK1 SW1 SW2 SW3 SW4 SW5 SW6 SW7 SW8 SW9
	.SETN NSW <STRLEN>-1
.;
	.SETN K1 0
.;
.31:
	.SETF NFLG
	.INC K1
	.SETS S SW'K1'
	.SETS CH1 S[1:1]
	.IF CH1 NE "-" .GOTO 32
	.TEST S
	.SETT NFLG
	.SETS S S[2:<STRLEN>]
.32:	.SETS CHS S[1:2]
	.IF CHS NE "NO" .GOTO 33
	.TEST S
	.SETT NFLG
	.SETS S S[3:<STRLEN>]
.33:	.SETS SWITCH "SW"+S
	.IFDF 'SWITCH' .GOTO 34
	; SWITCH -'S'- IS INVALID
	.GOTO 100
.34:	.SETT 'SWITCH'
	.IFT NFLG .SETF 'SWITCH'
	.IF K1 LT NSW .GOTO 31
.;
.;	IF THE /AL WAS SPECIFIED, SET /CE,/DE,/UE SWITCHES TRUE
.;
.35:	.IFF SWAL .GOTO 39
	.SETT SWCE
	.SETT SWDE
	.SETT SWUE
.;
.39:
.;
.;	TEST THE DIRECTORY FILENAME
.;	IF AN ERROR IS FOUND, INFORM USER AND EXIT
.;
	.TESTFILE	'DFIL'
	.IF <FILERR> EQ 1 .GOTO 40
	.SETS REASN "UNKNOWN ERROR"
	.IF <FILERR> EQ 346 .SETS REASN "NO SUCH FILE"
	.IF <FILERR> EQ 177644 .SETS REASN "INVALID DEVICE OR UNIT"
	; TESTFILE ERROR ON DIRECTORY FILE = 'DFIL'
	; FILERR='<FILERR>'	'REASN'
	.GOTO 100
.;
.;	OPEN THE DIRECTORY FILE
.;
.40:	.OPENR	'DFIL'
	.SETN ENTN 0
.;
.;	READ THE NEXT ENTRY IN THE FILE
.;
.;	BRANCH ON EOF
.;	IF ERROR ON READ, TELL USER AND EXIT
.;
.50:
	.READ	RECORD
	.IFT <EOF> .GOTO 90
	.IF <FILERR> EQ 1 .GOTO 60
.;
.;	ERROR - PRINT ERROR # AND EXIT
.;
	; ERROR IN FILE READ
	; FILERR='<FILERR>'
	.GOTO 90
.;
.;	SET UP TO PARSE ENTRY
.;
.60:
	.INC ENTN
	.SETN K1 0
	.SETN K2 0
	.SETT ALLZ
.;
.;	CONVERT THE 16 BYTE ENTRIES TO 8 VALUES
.;	IF ALL BYTES=0 SET ALLZ FLAG (ENTRY UNUSED)
.;
.61:
	.INC K1
	.SETS S RECORD[K1:K1]
	.SETN NL 'S%V'
	.SETN NL NL&377
	.INC K1
	.SETS S RECORD[K1:K1]
	.SETN NH 'S%V'
	.SETN NH NH&377
	.SETN VAL'K2' (400*NH)+NL
	.IF VAL'K2' NE 0 .SETF ALLZ
	.INC K2
	.IF K2 LT 8. .GOTO 61
.;
.;	IF ENTRY IS UNUSED, INCREMENT COUNTER
.;
	.IFT ALLZ .INC NUE
.;
.;	IF ALLZ=TRUE AND SWUE=FALSE - SKIP FILE
.;	ELSE, IF ALLZ=TRUE AND SWUE=TRUE, GO HANDLE IT
.;
	.IFT ALLZ .AND .IFF SWUE .GOTO 50
	.IFT ALLZ .AND .IFT SWUE .GOTO 62
.;
.;	THIS ENTRY EITHER CONTAINS AN ACTIVE FILENAME
.;	OR A DELETED FILENAME - SET COUNTER ACCORDINGLY
.;
	.IF VAL0 EQ 0 .INC NDE
	.IF VAL0 NE 0 .INC NCE
.;
.;	IF VAL0=0 AND SWDE=FALSE - SKIP FILE
.;
	.IF VAL0 EQ 0 .AND .IFF SWDE .GOTO 50
.;
.;	IF VAL0<>0 AND SWCE=FALSE - SKIP FILE
.;
	.IF VAL0 NE 0 .AND .IFF SWCE .GOTO 50
.;
.;	CONVERT OCTAL VALUES TO FILE NAME AND TYPE
.;
.62:	.SETN K1 2
	.SETN K2 0
	.SETS FNAM ""
.65:
	.INC K1
	.SETN C VAL'K1'
	.SETN C1 C/3100
	.SETN C C-(3100*C1)
	.SETN C2 C/50
	.SETN C C-(50*C2)
	.SETN C3 C
	.SETS FNAM FNAM+R50CS[C1+1:C1+1]+R50CS[C2+1:C2+1]+R50CS[C3+1:C3+1]
	.INC K2
	.IF K2 EQ 3 .SETS FNAM FNAM+"."
	.IF K2 LT 4 .GOTO 65
.;
.;	INSERT VERSION NUMBER
.;
	.SETS FNAM FNAM+";"+"'VAL7%R5'"
.;
.;	FORMAT OUTPUT STRING
.;
.;	IF SWEN SWITCH=TRUE INSERT ENTRY #
.;	IF SWFI=TRUE, INSERT FILE ID
.;
.70:	.SETS OUTS ""
	.IFT SWEN .SETS OUTS OUTS+"ENTRY="+"'ENTN%DR5'"
	.IFT SWFI .SETS OUTS OUTS+"	FID=("+"'VAL0%R5'"+","+"'VAL1%R5'"
	.IFT SWFI .SETS OUTS OUTS+","+"'VAL2'"+")"
.;
.;	IF SWCN=TRUE, COMPRESS FILENAME
.;
	.IFF SWCN .GOTO 80
	.SETN K1 0	; INPUT POINTER
	.SETN K2 0	; OUTPUT POINTER
	.SETS JUNK1 FNAM
	.SETS FNAM ""

.71:
	.INC K1
	.SETS CHS JUNK1[K1:K1]
	.IF CHS EQ " " .GOTO 72
	.INC K2
	.SETS FNAM FNAM+CHS
.72:	.IF K1 LT 19. .GOTO 71

.80:	.SETS OUTS OUTS+"	"+FNAM
.;
.;	IF ENTRY IS FOR A DELETED OR UNUSED ENTRY, INSERT NOTE
.;
	.SETS S ""
	.IF VAL0 EQ 0 .SETS S "(DELETED ENTRY)"
	.IFT ALLZ .SETS S "(UNUSED ENTRY)"
.;
	.SETS OUTS OUTS+S
.;
.;	PRINT INFORMATION ON USER TERMINAL
.;
; 'OUTS'
.;
	.GOTO 50
.;
.;	CLOSE DIRECTORY FILE
.;
.90:	.CLOSE
.;
.;	IF SWST=TRUE, PRINT STATISTICS
.;
	.IFF SWST .GOTO 100
.;
;
;	NUMBER OF CURRENT ENTRIES = 'NCE%D'
;	NUMBER OF DELETED ENTRIES = 'NDE%D'
;	NUMBER OF  UNUSED ENTRIES = 'NUE%D'
;	  TOTAL NUMBER OF ENTRIES = 'ENTN%D'
.;
.100:	.EXIT