.title	ISASCII - Wildcard file test for ASCII files
	.ident		/ISASCII V1.0/
;	.library	/mar:always/
	.library	/sys$library:lib/

	$ssdef
	$rmsdef
	$fibdef
	$iodef
	$atrdef
	$fatdef
CLI$_SYNTAX = ^x310fc		; I couldn't find this anywhere!

	.psect	isascii$$data

proto:	$fab			;alloc space
	$nam			;for proto storage
eproto:

prorab:	$rab

sfab:	$fab	dnm = <*.*;*>,-
		nam = snam
snam:	$nam	rss = 255,-
		rsa = resul,-
		ess = 255,-
		esa = expan
resul:	.blkb	256
expan:	.blkb	256
msgvec:	.blkl	16

thefab:	$fab	fac = <get>,-
		shr = <get>
therab:	$rab	fab=thefab

dfilnm:	.ascid	/FILENAME/	;label for P1
filbuf:	.udesc			;place for item value

buffer:	.long	0

	.psect		isascii$$code
suc:	.word		^m<r2>
	movl		4(ap),r2
	movl		fab$l_nam(r2),r0
	movl		nam$l_rsa(r0),r1
	movzbl		nam$b_rsl(r0),r0
	bisl		#^x010e0000,r0

	movq		r0,-(sp)
	pushaq		(sp)
	calls		#1,@fab$l_ctx(r2)
	ret

err:	.word		^m<r2>
	movl		4(ap),r2
	movl		fab$l_nam(r2),r0
	movl		nam$l_rsa(r0),r1
	movzbl		nam$b_rsl(r0),r0
	bisl		#^x010e0000,r0
	movq		r0,-(sp)

	moval		msgvec,r1
	movl		#5,(r1)+
	movl		#isa_erraccfil,(r1)+
	movl		#1,(r1)+
	movaq		(sp),(r1)+
	movl		fab$l_sts(r2),(r1)+	
	movl		fab$l_stv(r2),(r1)+	
	$putmsg_s	-
		msgvec	=	msgvec
	ret

filact:	.word		^m<r2,r3,r4,r5>
	movc3		#eproto-proto,sfab,proto
	clrl		-(SP)			;set up context
	movq		@4(AP),r0		;get descriptor to rq0
	movb		r0,sfab+fab$b_fns
	movab		(r1),sfab+fab$l_fna
	movl		8(AP),sfab+fab$l_ctx	;user routine

10$:	pushal		(SP)			;context!
	pushaw		err
	pushaw		suc
	pushab		sfab
	calls		#4,G^LIB$FILE_SCAN
	bbc		#NAM$V_WILDCARD,snam+nam$l_fnb,20$	;no wildcard
	cmpl		r0,#RMS$_FNF
	beql		20$
	cmpl		r0,#RMS$_NMF
	beql		20$
	blbs		r0,10$
	brb		barf
20$:	pushal		(SP)
	pushab		sfab
	calls		#2,G^LIB$FILE_SCAN_END
	movc3		#eproto-proto,proto,sfab		;restore proto
	movl		#SS$_NORMAL,r0
barf:	ret

errex:	$exit_s		-
		code	=	r0

clitrp:	.word	^m<>
	ret				;ignore error

getitm:	.word	^m<>
	movaw		clitrp,(FP)	;set up exception handler for CLI
	pushaq		@4(AP)
	calls		#1,G^CLI$PRESENT
	cmpl		#CLI$_PRESENT,r0
	beql		10$
	cmpl		#CLI$_NEGATED,r0
	beql		20$
	cmpl		#CLI$_ABSENT,r0
	beql		30$
	cmpl		#CLI$_SYNTAX,r0
	beql		30$
	blbcw		r0,errex
	bicl		#1,r0
	brw		errex
10$:	cmpl		0(AP),#3	;was output asked for?
	blssu		15$		;nope
	pushaw		@8(AP)
	pushaq		@8(AP)
	pushaq		@4(AP)
	calls		#3,G^CLI$GET_VALUE
	blbcw		r0,errex
	$bintim_s	-
		timbuf	=	@8(AP),-
		timadr	=	@12(AP)
	blbcw		r0,errex
15$:	movw		#1,@8(AP)	;put presence flag
	brw		99$
20$:	clrl		@12(AP)		;put a zero at output
	movw		#1,@8(AP)	;put presence flag
	brw		99$
30$:	clrw		@8(AP)		;zap text area length
	brw		99$
99$:	ret

.entry	determine,	^xffc
	clrl	r9			;examined length accumulator
	movq	@4(AP),r6		;r6'r7 is filename
	movzwl	r6,r6			;blast descrip stuff
	movc3	#FAB$C_BLN,proto,thefab
	movl	r7,thefab+fab$l_fna
	movb	r6,thefab+fab$b_fns
	clrl	thefab+fab$l_nam
	bisb	#FAB$M_SHRGET,thefab+fab$b_shr
	movb	#FAB$M_GET,thefab+fab$b_fac
	$open	fab = thefab
	blbs	r0,20$
10$:	movl	r0,r2
	PRINTF	<!AS!_[access denied is %!XL]>,4(AP),r2
	movl	#1,r0
	ret
20$:	movc3	#RAB$C_BLN,prorab,therab
	movab	thefab,therab+rab$l_fab
	$connect	-
		rab = therab
	blbs	r0,40$
30$:	pushl	r0
	$close	fab = thefab
	popl	r0
	brw	10$
40$:	movw	#32767,therab+rab$w_usz
	movab	@buffer,therab+rab$l_ubf
	$get	rab = therab
	cmpl	#RMS$_EOF,r0
	bneq	60$
	tstl	r9			;have we processed any chars yet?
	beql	50$			;no - ignore file
	brw	110$			;accept file as ASCII
50$:	$close	fab = thefab
	movl	#1,r0
	ret				;simply ignore z-len files
60$:	blbc	r0,30$
	movzwl	therab+rab$w_rsz,r5
	beql	40$			;null record
	addl	r5,r9			;add in byte count of current record
	clrl	r4
	clrl	r3
70$:	movzbl	@buffer[r4],r0		;get a byte
	bneq	80$
	brw	100$
80$:	bbs	#7,r0,100$
	aoblss	r5,r4,70$
	cmpl	r9,#32			;have we looked at at least 32 chars?
	bgeq	90$
	brw	40$			;go get more data
90$:	brw	110$
100$:	$close	fab = thefab
	PRINTF	<!AS!_No>,4(AP)
	movl	#1,r0
	ret
110$:	$close	fab = thefab
	PRINTF	<!AS!_Yes>,4(AP)
	movl	#1,r0
	ret

.entry	startg,	^xffc

	clrq	-(SP)
	movaq	(SP),r8		;a RETADR
	$EXPREG_S	-
		retadr	=	(r8),-
		pagcnt	=	#64
	blbs	r0,10$
	ret

10$:	subl3		(r8),4(r8),r0
	incl		r0
	ashl		#-9,r0,r0
	cmpl		r0,#64
	beql		20$
	movl		#SS$_INSFMEM,r0
	ret
20$:	movl		(r8),buffer
	movaw		clitrp,(FP)		;set up CLI exception handler

30$:	movw		filbuf,r2
	pushaw		filbuf
	pushaq		filbuf
	pushaq		dfilnm
	calls		#3,G^CLI$GET_VALUE
	blbcw		r0,errex
	movl		r0,r3

	pushaw		determine
	pushaq		filbuf
	calls		#2,G^filact
	movw		r2,filbuf		;restore buffer length

	cmpl		r3,#CLI$_COMMA		;test for list processing
	beql		30$
	cmpl		r3,#CLI$_CONCAT
	beql		30$

40$:	ret

	.end	startg