if1 %%scan==0
if2 %%scan==1

;scinit (input-name,type,init-arg,routine-if-given)

;scan (input-name,input-count,brktbl-loc,output-loc,brkchar,dispatch)

define ctlchs

	
î!termin

define brktbl sets
%.bloc==.
	0
sets
%.bsav==.
loc %.bloc
	-<%.bsav-%.bloc-1>,,.+1
loc %.bsav
termin

define brkset set,flag
irpc char,,[set]
	flag,,"char
termin
termin

define ifbrk chrval,code,\gsym
	caie a,chrval
	jrst gsym
	pop p,a
	code
	scexit
gsym:
termin
define ifeof code,\gsym
	came a,[-1,,3]
	jrst gsym
	pop p,a
	code
	scexit
gsym:
termin
define ifcnt code,\gsym
	came a,[-1,,1]
	jrst gysm
	pop p,a
	code
	scexit
gsym:
termin

define scan ?input,count,brktbl,output,brkchr,dsptch,\gsym,gsym2
define scexit
	jrst gsym2
termin
define sccont
	jrst gsym
termin
gsym:
	push p,[brkchr]
ifsn [output][]	push p,[output]
.else	push p,[0]
ifsn [brktbl][]	push p,brktbl
.else	push p,[0]
ifsn [count][]	push p,count
.else	push p,[-1]
	push p,[input]
	pushj p,scanrt
ifse [dsptch][]	.go skip
	push p,a
	move a,brkchr
brkoff dsptch
	pop p,a
gsym2:
.tag skip
termin

define brkoff arg
arg!termin

define scinit ?input,type,arg,routin,\gsym
	jrst gsym
ifndef input,input:
	block 3
gsym:	push p,a
	setom input+2
	move a,arg
	movem a,input
ifsn [routin][]	move a,routin
.else [	ifse [type][asciz]	move a,[pushj p,scascz]
	ifse [type][strcnt]
	ifse [type][uai]
]
	movem a,input+1
	pop p,a
termin

scascz:	ildb a,b
	caie a,0
	aos (p)
	popj p,

define pushae ac,list
irp item,,[list]
	push ac,item
termin
termin
define popae ac,list
irp item,,[list]
	pop ac,item
termin
termin

%brko==1000
%brkad==2000
%brksk==4000
%brksv==10000


scanrt:
.begin scnblk
define arg1
-<0+7>(p) termin
define arg2
-<1+7>(p) termin
define arg3
-<2+7>(p) termin
define arg4
-<3+7>(p) termin
define arg5
-<4+7>(p) termin

a=1
b=2
c=3
d=4
e=5
g=6
h=7
	pop p,scnret'
	pushae p,[a,b,c,d,e,g,h]
	move e,arg1	;get ptr to input block
	move d,arg2	;get count
	move b,(e)	;get argument to input routine
	setz c,		;clear output cnt
	move a,outini	;init output ptr
	movem a,outarg
	move a,2(e)	;get first char if left behind by last call
	setom 2(e)	;clear for duration of call
	jumpge a,scnr15	;jump if something indeed was left

scnr10:	cail d,0
	sojl d,[move a,[-1,,1] ? jrst scnr50]	;exit if input counted out
	xct 1(e)	;get char into A (reg 1)
	jrst [move a,[-1,,3] ? jrst scnr50]	;EOF reached

	;have char in a, process
scnr15:	move h,arg3	;get breaktable AOBJN ptr
	jumpe h,scnr40	;nothing, no breaking.
scnr20:	move g,(h)	;get table entry
	caie a,(g)	;compare RH's
scnr22:	aobjn h,scnr20	;loop thru table
	jumpge h,scnr40	;jump if no break found

	;break char. check flags
	tlne g,%brko	;omit this one?
	jrst scnr10	;yes, ignore and get another.
	tlne g,%brkad	;append?
	jrst [xct out ? aoja c,scnr50]	;yes, output and exit
	tlne g,%brksk	;skip?
	jrst scnr50	;ignore char, exit
	tlne g,%brksv	;save for next call?
	jrst [movem a,2(e)	;save it in input block
		jrst scnr50]	;exit
	jrst scnr22	;if no flags seen,continue thru table

	;not found in break table, output and continue scan
scnr40:	xct out
	aoja c,scnr10	;increment outputted count and get another.

	;break character in A, begin return
scnr50:	movem b,(e)	;store updated arg back in input block
	move h,arg5	;get brkchr addr
	movem a,(h)	;store brkchar
	;store output ptr and cnt
	move b,outini	;initial output ptr
	hrl b,c		;put count in LH
	move c,arg4	;get ptr to output
	movem b,(c)	;store string-ptr arg.

;	;do dispatch routines if any
;	skipn h,arg6	;get aobjn ptr
;	jrst scnr90	;nothing to do, exit!
;	move d,-1(h)	;get addr to routine table
;scnr53:	move g,(h)	;get entry in char table
;	caie a,(g)	;compare RH's
;	aobjn h,scnr53
;	jumpge h,scnr90	;nothing matched, exit.
;	ldb g,[221100,,g]	;pull out routine #
;	jumpe g,scnr90		;nothing
;	addi g,(d)		;add into table loc to get entry addr
;	move g,(g)		;get entry = addr of routine
;	pushj p,(g)		;do it.

scnr90:	popae p,[h,g,e,d,c,b,a]
	sub p,[-5,,5]	;bump down ptr
	jrst @scnret


out:	idpb a,outarg	;place to store XCT'd instr
outarg:	0		;arg for output
outini:	440700,,outblk	;initial arg
outblk:	block 100	;output string storage

.end scnblk