.TITLE	HOL	DISK FRAGMENTATION
	.IDENT	/1.0/
	.SBTTL	DATA AREA
;
; DATE:		8/14/78
; BY:		M. ARMSTRONG
;		BADGER METER, INC. - ELECTRONICS DIV.
;		RICHMOND, CA
;
;  THIS MCR TASK WILL PRODUCE FRAGMENTATION STATISTICS FOR THE SPECIFIED
; FILES-11 DEVICE.  THE OUTPUT IS A LIST OF CONTIGUOUS FREE BLOCKS (HOLES)
; AND THE TOTAL NUMBER OF FREE BLOCKS FOR THE DEVICE.  THE LIST IS IN THE
; FORM OF LINES OF NUMBER PAIRS.  THE FIRST NUMBER OF EACH PAIR IS THE
; BLOCK ADDRESS, IN OCTAL, OF THE FIRST BLOCK OF THE HOLE.  THE SECOND
; NUMBER IS THE SIZE OF THE HOLE IN DECIMAL BLOCKS.  INPUT IS VIA LUN 1.
;
; OUTPUT IS DIRECTED TO LUN 2, WHICH MAY BE ASSIGNED TO ANY TERMINAL.
;
; THIS PROGRAM FULFILLS THE SAME FUNCTION AS, AND IS DERIVED FROM THE
; DECUS PROGRAM 'FRAG' BY MICHAUD, BUT PROVIDES BETTER DETAIL.
;

;
; EQUATE SECTION, SYMBOLIC DEFINITIONS
;

AFLDSZ= 7		; MAX SIZE OF OCTAL BLK ADDR FIELD
BFLDSZ= 6		; MAX SIZE OF DECIMAL BLK SIZE FIELD
FLDSIZ= AFLDSZ+BFLDSZ+2	; OOOOOOO;DDDDDD.<TAB>
FLDCNT=	LINSIZ/FLDSIZ	; NUMBER OF FIELDS PER OUTPUT LINE
LINSIZ=	80.		; NUMBER OF CHARACTERS PER OUTPUT LINE

; CHARACTER EQUATES

SPACE = 40
TAB   =	11
LF    = 12
CR    = 15

; LUN DEFINITIONS

INDEV	= 1
TERM	= 2
ERRDEV	= 3


	.MCALL	GTIM$,QIOW$,CALL,EXIT$S,DIR$
	.MCALL	FCSMC$,ALUN$,GMCR$,GLUN$,FCSBT$
	FCSMC$		; DEFINE FCS MACROS
	FCSBT$		; DEFINE FCS MACRO OFFSETS
	FSRSZ$	0	; NO FSR FOR BLOCK OPERATIONS
FDB:
	FDBDF$
	FDRC$A	FD.RWM
	FDBK$A	INBUF,512.,,10
	FDOP$A	INDEV,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
OUTBUF:	.BLKB	LINSIZ		; OUTPUT LINE BUFFER
	.EVEN
INBUF:				; INPUT BLOCK BUFFER (OVERLAYS GMCR BFR)
GLUN:	GLUN$	INDEV,GLBUF	; DPB FOR 'GET LUN CHARACTERISTICS' DIRECTIVE
GLBUF:	.BLKW	6		; BUFFER FOR GLUN
GMCR:	GMCR$			; DPB FOR 'GET MCR COMMAND LINE' DIRECTIVE
.=INBUF+512.			; ALLOCATE SPACE FOR INPUT BFR ON TOP OF GMCR
ALUN:	ALUN$	INDEV,SY,0	; DEFAULT ASSIGN LUN
TIME:	GTIM$	TBUF
TBUF:	.BLKW	8.		; BUFFER FOR TIME/DATE INFO
READ:	QIOW$	IO.RVB,INDEV,10,,IOST,,<INBUF,512.,,,1>
DPB:	QIOW$	IO.WVB,TERM,1,,,,<OUTBUF,LINSIZ,40>
IOST:	.BLKW	2
STAT:	0			; STATUS FROM 'GETWRD':
				; 1 => NON-ZERO WORD FROM BFR, NOT ALL ONES
				; 0 => ZERO WORD FROM BFR
				; -1 => ALL-ONES WORD FROM BFR
LOWLIM:	0,0			; DOUBLE PRECISION LOWER HOLESIZE LIMIT
COUNT:	0,0			;   "        "     FREE-BLOCK COUNT (HOLE SIZE)
TOTAL:	0,0			;   "	     "	   TOTAL FREE-BLOCK COUNT
BLKADR:	0,0			; LOGICAL BLOCK ADDRESS OF HOLE
BLOCK:	.WORD	1		; VIRTUAL BLOCK PTR FOR 'BITMAP.SYS'
				; BLOCK 1 IS NOT PART OF BIT MAP,
				; SO WILL START READING AT BLOCK 2
BUFPTR:	INBUF+512.		; PTR INTO INPUT BFR BLOCK (VALUE FORCES READ)
BITCNT:	16.			; BIT POSITION IN CURWRD (VALUE FORCES FETCH)
CURWRD:	0			; MAP WORD CURRENTLY BEING EXAMINED
HDRDON:	0			; FLAG TO INDICATE HEADER HAS BEEN DISPLAYED
.NLIST	BEX
TOTBUF:	.ASCII	<LF><LF><TAB>/TOTAL FREE BLOCKS: /
TOTAMT:	.ASCII	/      ./
TOTSIZ=	.-TOTBUF
ER1:	.ASCII	/HOL -- BAD SWITCH/
ER1SIZ=.-ER1
ER2:	.ASCII	/HOL -- INPUT ERROR/
ER2SIZ=	.-ER2
ER3:	.ASCII	/HOL -- COMMAND ERROR/
ER3SIZ=	.-ER3
ER4:	.ASCII	/HOL -- ILLEGAL DEVICE/
ER4SIZ=	.-ER4
	.EVEN
TSKNAM:	.ASCII	/HOLES/
TKNMSZ=	.-TSKNAM
ISTRNG:	.ASCII	/CONTIGUOUS FREE BLOCKS (HOLES) FOR DEVICE /
ASCDEV:	.ASCII	/SY:  /<TAB>
	.ASCIZ	/%Y  %2Z%2N/
.LIST	BEX
	.EVEN
	.PAGE
	.SBTTL	HOLE -- MAIN ROUTINE
;+
;	**  HOLES - DISPLAY FRAGMENTATION DATA FOR FILES-11 DEVICES
;
; SYNTAX:
;		HOL [DDN:] [/M]
;
; WHERE:
;		DD - A LEGAL FILES-11 DEVICE NAME
;		N  - A LEGAL UNIT NUMBER FOR THE SELECTED DEVICE
;		IF 'DDN:' IS NOT SPECIFIED 'SY0:' IS ASSUMED
;
;		M IS AN OPTIONAL POSITIVE, NONZERO INTEGER OF 9
;		DECIMAL DIGITS OR LESS.  IF PRESENT, IT DEFINES
;		THE MINIMUM SIZE HOLE TO BE REPORTED.
;-

HOLE:
	DIR$	#GMCR,ERROR3	; GET COMMAND LINE
	MOV	$DSW,R1		; GET THE DIRECTIVE STATUS WORD
	CMP	#3,R1		; COMND LN CONSIST ONLY OF 3 CHAR TASK NAME?
	BEQ	22$		; YES IF EQ (NULL DEVICE SPEC & SHORT NAME)

	MOV	#GMCR+2,R0	; LOAD ADDR OF MCR TEXT BFR
	MOV	#TKNMSZ,R2	; GET MAX NUMBER OF CHARS IN TASK NAME
	BR	32$		; GO VALIDATE NAME

31$:	CALL	GETCHR		; GET A CHAR FROM THE MCR BFR
	BEQ	22$		; NULL SPEC IF EQ
	BCS	34$		; SPACE/TAB SEEN - END OF NAME
32$:	CMPB	TSKNAM-GMCR-2(R0),(R0) ; VALID CHAR ?
	BEQ	33$		; YES IF EQ
	JMP	ERROR3		; NO - SYNTAX ERROR
33$:	SOB	R2,31$		; KEEP LOOKING 'TIL SPACE/TAB, EOL, OR ERROR

34$:	CALL	GETCHR		; PASS OVER SPACES TO SOMETHING MEANINGFUL
	BEQ	22$		; NULL SPEC W/TRAILING BLANKS IF EQ
	BCS	34$		; SPACE/TAB IF CS, KEEP LOOKING
	CMPB	#'/,(R0)	; IS SWITCH SPEC FIRST THING AFTER NAME?
	BEQ	24$		; YES IF EQ, NULL DEVICE SPEC (ASSUME SY0:)
	CALL	GETDEV		; NO, MUST BE DEVICE SPEC
	BCS	36$		; DEVICE SPEC SYNTAX BAD IF CS
	TST	R1		; EOL REACHED BEFORE VALID SPEC ASSEMBLED?
	BNE	35$		; NO IF NE
36$:	JMP	ERROR4		; SYNTAX ERROR
35$:	CALL	GETCHR		; IS A SWITCH SPECIFIED?
	BEQ	22$		; NO SWITCH SPEC
	BCS	35$		; IGNORE SPACES
	CMPB	#'/,(R0)	; MAYBE, SEE IF IT'S LEGAL
	BEQ	24$		; WELL, AT LEAST HE'S TRYING TO SPEC A SWITCH
	JMP	ERROR3		; NOTHING LEGAL HERE EXCEPT A SLASH
;
; CHECK FOR SWITCH
;
24$:	CALL	GETSWT
	BCS	ERROR1		; BAD SWITCH IF CS
22$:	DIR$	#ALUN,ERROR4	; ASSIGN INPUT DEVICE (ERR4 = ILL DEV)
	DIR$	#GLUN		; IS IT A DIRECTORY DEVICE?
	BIT	#FD.DIR,GLBUF+G.LUCW
	BEQ	ERROR4		; NO IF EQ
	OPEN$R	#FDB,,,,,,ERROR2
NEWLIN:	MOV	#OUTBUF,R0	; INIT THE OUTPUT LINE BUFFER PTR
	MOV	#FLDCNT,R4	; INIT THE FIELD COUNTER
GTHOLE:	CALL	CONTIG		; FIND A HOLE
	BCS	EOFCHK		; EOF OR INPUT ERROR IF CS
	ADD	COUNT+2,TOTAL+2
	ADC	TOTAL
	ADD	COUNT,TOTAL	; UPDATE THE GRAND TOTAL
	TST	HDRDON		; YES - HAVE WE DONE THE HEADER YET?
	BNE	4$		; YES IF NE
	CALL	HEADER		; NO, DO IT NOW
4$:
	CMP	COUNT,LOWLIM	; IS THE HOLESIZE >= THE SPECIFIED LIMIT?
	BHI	25$		; YES IF HI
	BLO	GTHOLE		; NO IF LO - FIND ANOTHER
	CMP	COUNT+2,LOWLIM+2; CAN'T TELL IF EQ - LOW ORDER PART >= LIMIT?
	BLO	GTHOLE		; NO IF LO
25$:	MOV	#BLKADR,R1	; PACK DISK BLOCK ADDRESS (IN OCTAL)
	MOV	#AFLDSZ,R2	;  RIGHT-JUSTIFIED, 'AFLDSZ' DIGITS
	CALL	CDBOM
	MOVB	#':,(R0)+	; SEPARATE FROM HOLE SIZE WITH ':'
	MOV	#COUNT,R1	; PACK HOLE SIZE (IN DECIMAL)
	CLR	R2		; LEFT-JUSTIFIED (ZERO-SUPPRESSED)
	CALL	$CDDMG
	MOVB	#'.,(R0)+	; PACK A DOT (DECIMAL NUMBER INDICATOR)
	MOVB	#TAB,(R0)+	;  AND SEPARATE FROM NEXT PAIR BY A TAB
	SOB	R4,GTHOLE	; LOOP 'TIL LINE IS FULL
	MOVB	#CR,-1(R0)	; REPLACE LAST TAB WITH EOL
	SUB	#OUTBUF,R0	; CALC ACTUAL LINE SIZE
	MOV	R0,DPB+Q.IOPL+2	;  AND LOAD IT INTO THE DPB
	DIR$	#DPB		; OUTPUT THE LINE
	BR	NEWLIN		;  AND START ANOTHER
EOFCHK:
	CMPB	#IE.EOF,IOST	; END OF FILE?
	BNE	ERROR2		; NE=OOPS!
	MOVB	#CR,-1(R0)	; REPLACE LAST TAB WITH EOL
	SUB	#OUTBUF,R0	; LOAD SIZE OF LAST LINE
	MOV	R0,DPB+Q.IOPL+2	;  INTO DPB
	DIR$	#DPB		;  AND WRITE THE LINE
	MOV	#TOTAL,R1	; CONVERT THE GRAND TOTAL TO ASCII DECIMAL
	CLR	R2		; (ZERO-SUPPRESSED, LEFT JUSTIFIED)
	MOV	#TOTAMT,R0
	CALL	$CDDMG
	MOVB	#'.,(R0)+	; PACK DOT AND EOL AT END OF LINE
	MOVB	#CR,(R0)+
	SUB	#TOTBUF,R0	; PUT CORRECT LINE SIZE INTO DPB
	MOV	R0,DPB+Q.IOPL+2
	MOV	#TOTBUF,DPB+Q.IOPL ;  AND ALSO NEW BFR ADDR
	BR	OUT		; GO OUTPUT THE LINE AND EXIT
;
ERROR1:	MOV	#ER1,DPB+Q.IOPL		; GET ERROR STRING
	MOV	#ER1SIZ,DPB+Q.IOPL+2	; GET SIZE
	BR	ERROUT
ERROR2:	MOV	#ER2,DPB+Q.IOPL		; GET ERROR STRING
	MOV	#ER2SIZ,DPB+Q.IOPL+2	; GET SIZE
	BR	ERROUT
ERROR3:	MOV	#ER3,DPB+Q.IOPL		; GET ERROR STRING
	MOV	#ER3SIZ,DPB+Q.IOPL+2	; GET SIZE
	BR	ERROUT
ERROR4:	MOV	#ER4,DPB+Q.IOPL		; GET ERROR STRING
	MOV	#ER4SIZ,DPB+Q.IOPL+2	; GET SIZE
ERROUT:	MOVB	#ERRDEV,DPB+Q.IOLU	; CHANGE LUN TO ERROR DEVICE (TI:)
OUT:
	CLOSE$	#FDB		; CLOSE THE FILE
	DIR$	#DPB
	EXIT$S
.PAGE
.SBTTL	CONTIG -- CONTIGUOUS BLOCK SEARCH ROUTINE
;
; THIS IS THE ROUTINE THAT SEARCHES THE BIT MAP FILE FOR UNALLOCATED BLOCKS
; AND CALCULATES THE SIZE OF CONTIGUOUS CHUNKS OF THEM.  THE RETURN TO THE
; CALLER IS THE DISK ADDRESS OF THE FIRST BLOCK OF A HOLE IN 'BLKADR' AS A
; DOUBLE PRECISION NUMBER AND THE SIZE OF THE HOLE IN 'COUNT', ALSO A DOUBLE
; PRECISION NUMBER.
;

CONTIG:	CLR	COUNT		; INIT THE HOLE SIZE
	CLR	COUNT+2
	CALL	$SAVAL		; SAVE R0-R5
	MOV	BITCNT,R2	; GET THE BIT COUNT FOR THE CURRENT WORD
	MOV	CURWRD,R1	; IS THE CURRENT WORD NON-ZERO?
	BNE	2$		; YES IF NE
1$:	MOV	#16.,R2		; INIT THE BIT POSITION INDICATOR
	CALL	GETWRD		; GET THE NEXT WORD FROM THE MAP FILE
	BCS	EXIT		; EOF OR ERROR
	TST	STAT
	BEQ	1$		; ZERO WORD IF EQ
	BMI	7$		; ALL ONES WORD IF MI
2$:	ASR	R1		; IS NEXT BIT ZERO?
	BCS	3$		; NO IF CS
	SOB	R2,2$		; LOOP UNTIL A ONE BIT IS FOUND
	BR	1$		; (THIS SHOULDN'T HAPPEN)
4$:	ASR	R1		; GET THE NEXT BIT. IS IT ONE?
	BCS	5$		; YES
	BR	EXIT		; NO, END OF THIS HOLE
3$:	CALL	BLKSAV		; SAVE THE BLOCK ADDRESS AND
5$:	ADD	#1,COUNT+2	;  COUNT ANOTHER BLOCK IN THIS HOLE
	ADC	COUNT
	SOB	R2,4$		; LOOP 'TIL THE WORD IS DONE
6$:	CALL	GETWRD		; GET THE NEXT WORD FROM THE MAP
	BCS	EXIT		; EOF OR ERROR
	TST	STAT
	BEQ	EXIT		; ALL ZEROS, END OF HOLE
	BMI	10$		; ALL ONES, ADD 16. TO HOLE SIZE
	MOV	#16.,R2		; NEITHER, COUNT ONES TO NEXT ZERO
	BR	4$

7$:	CALL	BLKSAV		; SAVE ADDRESS OF HOLE
10$:	ADD	#16.,COUNT+2	; ADD 16. BLOCKS TO SIZE OF HOLE
	ADC	COUNT
	BR	6$		;  AND GO BACK FOR MORE

EXIT:	MOV	R1,CURWRD	; SAVE THE WORKING REGISTERS
	BEQ	11$		; (IF CURWRD.NE.0 BITCNT MUST BE DEC'D
	DEC	R2		;   TO BE READY FOR NEXT PASS THRU HERE)
11$:	MOV	R2,BITCNT
	RETURN
.PAGE
.SBTTL	GETWRD -- GET NEXT MAP WORD
;
; THIS ROUTINE GETS THE NEXT WORD FROM THE MAP FILE INPUT BUFFER.  IF THE
; BUFFER IS EXHAUSTED IT WILL READ ANOTHER BLOCK.  THE NEXT AVAILABLE WORD
; IS RETURNED IN R1.  IF EOF IS REACHED OR A READ ERROR OCCURS THE CARRY
; BIT WILL BE SET ON RETURN AND R1 IS NOT CHANGED.
;

GETWRD:	CLR	STAT		; CLEAR THE STATUS INDICATOR
	CMP	BUFPTR,#INBUF+510. ; IS BUFFER EXHAUSTED?
	BLO	1$		; NO IF LO

	INC	BLOCK		; YES, GET NEXT BLOCK FROM FILE
	MOV	BLOCK,READ+Q.IOPL+10
	DIR$	#READ
	TSTB	IOST		; READ SUCCESSFUL?
	BLT	ERR		; NO, EITHER EOF OR READ ERROR
	MOV	#INBUF-2,BUFPTR	; RE-INIT THE BUFFER PTR

1$:	ADD	#2,BUFPTR	; UPDATE THE PTR
	MOV	@BUFPTR,R1	; GET THE BUFFER WORD
	BEQ	GEXIT		; IF WORD IS ZERO, STATUS IS CORRECT
	INC	STAT		; NON-ZERO CHANGE STATUS
	CMP	#-1,R1		; IS WORD ALL ONES?
	BNE	GEXIT		; NO IF NE
	NEG	STAT		; YES

GEXIT:	CLC
	RETURN

ERR:	SEC
	RETURN

.PAGE
.SBTTL	BLKSAV -- SAVE BLOCK ADDRESS OF CURRENT HOLE
;
; THIS ROUTINE TAKES THE BIT MAP VIRTUAL BLOCK NUMBER, THE WORD NUMBER
; WITHIN THE CURRENT BUFFER, AND THE BIT NUMBER WITHIN THE CURRENT WORD
; AND COMBINES THEM TO PRODUCE A LOGICAL BLOCK ADDRESS FOR THE DEVICE.
;

BLKSAV:	CALL	$SAVAL		; SAVE ALL REGISTERS FIRST
	MOV	#512.,R0	; MULTIPLY THE BLOCK NUMBER RELATIVE TO THE 
	MOV	BLOCK,R3	;  START OF THE MAP BY 512. (BYTES/BLOCK)
	MOV	R2,BITCNT	; SAVE THE BIT POSITION BEFORE DESTROYING IT
	CLR	R2
	SUB	#2,R3		; (MAP STARTS AT REL BLK 2)
	CALL	$DMUL
	MOV	R1,R3		; MOV THE PRODUCT BACK TO THE MULTIPLICAND
	MOV	R0,R2		;  REGISTERS
	MOV	BUFPTR,R4	; CALC. BYTE OFFSET INTO CURRENT BLOCK
	SUB	#INBUF,R4
	ADD	R4,R3		; (AT THIS POINT, THE TOTAL NUMBER OF
	ADC	R2		;   MAP BYTES IS CONTAINED IN R2-3)
	MOV	#8.,R0		; MULTIPLY BY 8. VOL BLKS PER MAP BYTE
	CALL	$DMUL
	MOV	#16.,R4		; LAST, ADD OFFSET INTO CURRENT WORD
	SUB	BITCNT,R4
	ADD	R4,R1		;  INTO THE TOTAL TO OBTAIN
	ADC	R0
	MOV	R1,BLKADR+2	;  THE ACTUAL VOLUME LOGICAL BLOCK ADDRESS
	MOV	R0,BLKADR
	RETURN
.PAGE
.SBTTL	DISPLAY HEADER AND GETCHR ROUTINES
;
; HEADER OUTPUT ROUTINE
;
HEADER:	COM	HDRDON		; SET HEADER DONE FLAG
	DIR$	#TIME		; GET CURRENT DATE AND TIME
	MOV	#OUTBUF,R0	; FORMAT THE LINE INTO THE OUTPUT LINE
	MOV	#ISTRNG,R1	; (ADDR OF EDIT-CONTROL STRING)
	MOV	#TBUF,R2	; (DATE/TIME DATA)
	CALL	$EDMSG
	SUB	#OUTBUF,R0	;  SET UP DPB TO OUTPUT THE HEADER
	MOV	R0,DPB+Q.IOPL+2
	DIR$	#DPB		; OUTPUT IT
	MOV	#OUTBUF,R0	; RE-INIT THE LINE BFR PTR
	MOV	#LINSIZ,DPB+Q.IOPL+2 ; RESTORE THE LINE SIZE
	RETURN

;
; GET A CHARACTER FROM THE MCR INPUT BUFFER
;
;	THE INPUT TO THIS ROUTINE IS A POINTER TO THE CHARACTER BUFFER
;  IN R0, AND THE NUMBER OF CHARACTERS REMAINING IN THE BUFFER IN R1.
;
; ON RETURN TO THE CALLER:
;
;	IF THE END OF LINE IS ENCOUNTERED ( R1=0 ) THE ROUTINE WILL
;  RETURN WITH THE Z-BIT SET IN THE PSW.  IF THERE IS A CHARACTER AT
;  THE NEXT POSITION, BUT IT IS EITHER SPACE OR TAB THE C-BIT WILL BE
;  SET IN THE PSW ON RETURN.  BOTH CONDITIONS MAY NOT OCCUR TOGETHER.
;
;  R0 WILL POINT TO THE NEXT CHARACTER IN THE BUFFER (IF NOT EOL)
;  AND R1 WILL BE REDUCED BY ONE.
;

GETCHR:	INC	R0		; POINT TO THE NEXT BUFFER POSITION
	DEC	R1		; WAS PREVIOUS CHARACTER THE LAST ONE?
	BEQ	3$		; YES IF EQ, EXIT
	CMPB	#SPACE,(R0)	; NO, IS THIS ONE A BLANK?
	BEQ	1$		; YES, SAY SO
	CMPB	#TAB,(R0)	; NO, TAB?
	BNE	2$		; NO IF NE
1$:	SEC			; SET THE 'SPACE/TAB' INDICATOR
	CLZ			; CLEAR THE EOL INDICATOR
	RETURN
2$:	CLC			; CLEAR BOTH INDICATORS
	CLZ
3$:	RETURN
.PAGE
.SBTTL	SYNTAX-CHECKING AND PARSING AIDS
;
; GET A VALID DEVICE SPECIFICATION FROM THE MCR BUFFER
;
;	THIS ROUTINE USES THE SAME INPUTS AND PRODUCES THE SAME OUTPUT
;  STATES FOR R0, R1, AND THE C-BIT AS GETCHR DOES.  SINCE THE
;  Z-BIT IS NOT PRESERVED FOR ROUTINES WHICH USE THE SAVE-REGISTER
;  ROUTINES, IT WILL BE NECESSARY FOR THE CALLING ROUTINE TO TEST R1
;  TO DETERMINE WHETHER THE END-OF-LINE CONDITION EXISTS.  IT ALSO
;  LOADS DEVICE SPEC DATA INTO THE 'ALUN' DPB.  IN THIS CASE, A SYNTAX
;  ERROR IN THE SPEC CAUSES THE C-BIT TO SET.
;

GETDEV:	JSR	R5,$SAVRG	; SAVE R3-5
	MOVB	(R0),ALUN+A.LUNA ; LOAD 2-CHAR DEVICE IDENTIFIER
	MOVB	(R0),ASCDEV	; FOR 'ALUN' DIRECTIVE AND DISPLAY HEADER
	CALL	GETCHR		; GET THE SECOND CHAR
	BLOS	EREXIT		; (BLOS => BEQ.OR.BCS) SYNTAX ERROR IF LOS
	MOVB	(R0),ALUN+A.LUNA+1
	MOVB	(R0),ASCDEV+1
	CLR	R4		; NOW GET THE UNIT NUMBER, IF ANY
1$:	CALL	GETCHR
	BLOS	EREXIT		; AGAIN SYNTAX ERROR IF LOS
	MOVB	(R0),R5		; CHECK WHETHER VALID ASCII OCTAL DIGIT
	CMPB	#':,R5		;  OR NULL UNIT #
	BEQ	2$		; UNIT # COMPLETE, GO CONVERT FOR DISPLAY
	CMPB	#'0,R5		; NOT DONE, VALID OCTAL DIGIT?
	BGT	EREXIT		; NO IF GT, SYNTAX ERROR
	CMPB	#'7,R5
	BLT	EREXIT		; NO IF LT, SYNTAX ERROR
	BICB	#^C<7>,R5	; STRIP THE ASCII FROM THE DIGIT
	ASH	#3,R4		; MULT PREV DIGIT BY 8
	ADD	R5,R4		;  AND ADD IN THE NEW DIGIT
	BR	1$		; GO LOOK FOR ONE MORE

2$:	MOV	R4,ALUN+A.LUNU	; SAVE THE UNIT # IN THE ALUN DPB
	JSR	R2,$SAVVR	; SAVE R0-2
	MOV	#ASCDEV+2,R0	; SET UP DESTINATION ADDR
	MOV	R4,R1		; PUT THE UNIT # IN THE RIGHT REG
	MOV	#20*400+10,R2	; SET UP THE CONVERSION PARAM'S
				; (2-OCTAL DIGITS, ZERO SUPPRESSED)
	CALL	$CBTA
	MOVB	#':,(R0)+	; FOLLOW # WITH COLON
	CLC			; CLEAR ANY STRAY ERROR INDICATION
	RETURN
EREXIT:	SEC			; SET THE SYNTAX ERROR INDICATOR
	RETURN

.PAGE
;
; GET SWITCH VALUE
;
;	FIGURE THIS ONE OUT YOURSELF
;

GETSWT:	MOV	R0,R5		; SET UP SOURCE PTR FOR THE CNV RTN
	INC	R5		; MOVE PTR FROM '/' TO FIRST DIGIT
1$:	CALL	GETDIG		; GET VALID DECIMAL DIGIT
	BHI	1$		; (BHI => BNE.AND.BCC) VALID, GET ANOTHER
	BCS	2$		; NOT A DEC DIGIT IF CS, SYNTAX ERROR
	MOV	#LOWLIM,R3	; SET UP DESTINATION PTR
	MOV	R0,R4		;  AND INPUT DIGIT STRING LENGTH
	SUB	R5,R4
	CALL	.DD2CT		; CONVERT THE STRING TO A DBL PREC #
2$:	RETURN

;
; GET A DECIMAL DIGIT
;
;	THIS ROUTINE GETS A CHAR FROM THE INPUT BUFFER AND VERIFIES
;  THAT IT IS A VALID ASCII DECIMAL DIGIT OR '#'.  END-OF-LINE WILL
;  RETURN THE Z-BIT SET.  SPACE, TAB, OR OTHER CHAR WILL RETURN C-BIT
;  SET.  OTHERWISE, BOTH WILL BE CLEAR.
;

GETDIG:	CALL	GETCHR		; GET THE NEXT CHAR
	BLOS	2$		; (BLOS => BEQ.OR.BCS) EXIT IF LOS
	CMPB	#'#,(R0)	; IS IT THE OCTAL NUMBER INDICATOR?
	BEQ	2$		; YES IF EQ, EXIT
	CMPB	#'0,(R0)	; NO, IS IT A VALID DECIMAL DIGIT?
	BGT	1$		; NO IF GE
	CMPB	#'9,(R0)
	BLT	1$		; NO IF LT
	CLC			; CLEAR STRAY INDICATORS
	CLZ
	RETURN
1$:	SEC			; SET INVALID CHAR INDICATOR
	CLZ			; CLEAR EOL INDICATOR
2$:	RETURN			; EXIT

	.END	HOLE