;	SUBROUTINE TO LIST ALL FORMS TYPE DEVICES WITH NON ZERO FORMS
;
;	ORIGINAL AUTHOR	MIKE DEARING
;			INTERNATIONAL HARVESTER
;
;
	.MCALL	DIR$,QIOW$,EXIT$S
	.enable	lc
;
FRM::	DIR$	#HDRQIO		;DO HEADER LINE
	MOV	.PUDBA,R0	;PUD BASE -> R0
ENDCHK:	CMP	.PUDEA,R0	;THROUGH PUD ?
	BEQ	FRMFIN		;YES
	BR	FRMSPL		;NO CHECK A PUD
NXTPUD:	ADD	#U.SZ,R0	;BUMP TO NEXT PUD
	BR	ENDCHK		;AND CHECK IF STILL IN PUD
FRMSPL:	MOVB	U.FO(R0),R2	;FORMS TYPE -> R2
	BEQ	NXTPUD		;IF ZERO, FORGET IT
	ADD	#60,R2		;CONVERT FORM TYPE TO ASCII
	MOVB	R2,DEVNM+7	;STORE IN MESSAGE LINE
	MOV	U.DN(R0),DEVNM	;STORE DEVICE NAME
	MOV	#40,R1		;ASCII SPACE -> R1
	MOVB	U.UN(R0),R2	;UNIT NUMBER -> R2
	BEQ	UNPAKO		;IF UNIT ZERO, FORGET NEXT
	CMPB	#7,R2		;OVER ONE DIGIT UNIT NUMBER ?
	BGE	UNPAKO		;NO
	MOV	R2,R1		;YES UNIT NUMBER -> R1 ALSO
	ASH	#-3,R2		;CONVERT TO 'EIGHTS' DIGIT
	BIC	#177770,R1	;AND CLEAR UPPER NUMBER OF 'ONES' DIGIT
	ADD	#60,R1		;MAKE 'UNITS' DIGIT ASCII
UNPAKO:	ADD	#60,R2		;MAKE 'EIGHTS' DIGIT ASCII
	MOVB	R2,DEVNM+2	;INSERT ASCII DEVICE UNIT NUMBER
	MOVB	R1,DEVNM+3	;INTO MESSAGE LINE
FORMO:	DIR$	#FRMQIO		;DO MESSAGE
	BR	NXTPUD		;TRY FOR ANOTHER
FRMFIN:	CMPB	#'T,DEVNM+7	;DID WE FIND ANY NON ZERO PUDS ?
	BNE	FRMEX		;YES
	DIR$	#NOQIO		;NO TELL GUY
	RTS	PC		;AND RETURN
FRMEX:	DIR$	#NOQIO1		;DO CRLF QIO
	RTS	PC		;AND RETURN TO MAIN
;
;NOW THE ASCII MESSAGES
;
DEVNM:	.ASCII	/DVNN   T/
	END1=.
HDR:	.BYTE	12,15
	.ASCII	/Dev form type/
	.BYTE	12,15
	.ASCII	/--- ---------/
	.BYTE	12,15
	END2=.
	.EVEN
NONE:	.ASCII	/none/
NONE1:	.BYTE	12,15
	END3=.
IOST:	.WORD	0,0
;
;
;NOW THE QIO DIRECTIVES
;
FRMQIO:	QIOW$	IO.WVB,3,1,,IOST,,<DEVNM,END1-DEVNM,40>
HDRQIO:	QIOW$	IO.WVB,3,1,,IOST,,<HDR,END2-HDR,40>
NOQIO:	QIOW$	IO.WVB,3,1,,IOST,,<NONE,END3-NONE,40>
NOQIO1:	QIOW$	IO.WVB,3,1,,IOST,,<NONE1,END3-NONE1,40>
	.END