.title	mac		;macro handlers

	.ident	/03apr4/

	.mcall	(at)always,ch.mne,ct.mne
	.mcall (at)putkb
	.mcall	(at)sdebug ,ndebug
	always
	ch.mne
	ct.mne

	.if ndf	xmacro

	.mcall	(at)append,gencnd,error,scan,search
	.mcall	(at)setnz,xmit,zap

	.globl	mx.flg			; defined in lout.m11

	.globl	smllvl,	msbmrp,	getmch,	mactst

	.globl	absexp,	aexp,	argcnt,	asgmtf,	chrpnt,	cndmex
	.globl	codrol,	cradix
	.globl	dflmac,	dflsmc,	dmarol,	endflg
	.globl	ed.lc,	edmask
	.globl	endlin,	finsml,	getchr,	getlin,	getnb
	.globl	mdepth
	.globl	getr50,	getsym,	gsarg,	gsargf,	inisml
	.globl	insert,	lblend,	lcendl,	lcflag,	lcmask
	.globl	lc.mc,	lc.me,	linbuf,	lsgbas
	.globl	mactop,	macrol,	mode,	pass, symbot,macovf,uplift,upbomb
	.globl	r50unp,	rolupd,	savreg
	.globl	setchr,	setcli,	setnb,	setpf0,	setpf1
	.globl	setsym,	smlnam, smlfil,	tstarg,	value
	.globl	symbol,	lc.md,	xmit0
	.globl	ucflag


	.globl	crfdef,	crfref
	xitsec			;start in default sector

getmch:				;get a macro character
	tst	getmcs		;working on argument?
	bne	18$		;  yes
	call	getmc2		;move a character
	bgt	4$		;all set if .gt. zero
	beq	2$		;end if zero
	cmp	r5,#mt.max	;end of type?
	bhi	10$		;  no
	mov	#vt,r5		;yes, fudge return
	call	savreg
	jmp	endmac		;close out expansion

2$:	mov	r1,msbmrp	;eol, store new pointer
	bis	#lc.me,lcflag	;flag as macro expansion
	mov	#lf,r5		;mark end
4$:	return

10$:	mov	r1,getmcs	;remember read pointer
	mov	msbarg,r1
	tst	(r1)+
	mov	r5,r3		;count
	neg	r3		;assume macro
	cmp	msbtyp,#mt.mac	;true?
	beq	12$		;  yes, use it
	mov	msbcnt,r3	;get arg number
12$:	dec	r3		;move to proper arg
	ble	18$		;found
14$:	call	getmc2		;get next char
	bgt	14$		;loop if pnz
	beq	12$		;new arg if zero
16$:	mov	getmcs,r1	;reset read pointer
	clr	getmcs		;clear (used as flag)
	br	getmch		;null arg

18$:	call	getmc2		;get next character
	ble	16$		;finished if .le. zero
	return

getmc2:	bit	#bpmb-1,r1	;macro, end of block?
	bne	22$		;  no
	mov	-bpmb(r1),r1	;yes, point to next block
	tst	(r1)+		;move past link
22$:	movb	(r1)+,r5	;set in r5
	return

	entsec	impure
getmcs:	.blkw			;macro pntr save while
				;processing args
	xitsec

	.endc
	.if ndf	xmacro

mt.rpt=	177601
mt.irp=	177602
mt.mac=	177603
mt.max=	mt.mac

	.globl	rept,	endr,	endm

rept:				;repeat handler
	call	absexp		;evaluate count
	mov	r0,-(sp)	;save count
	call	setpf1		;mark the listing
	call	getblk		;get a storage block
	clr	(r2)+		;start in third word
	clr	-(sp)		;no arguments
	mov	r0,-(sp)	;  and start of block
	tst	mx.flg		; <<<
	beq	1$		; <<< REEDS june 81
	bis	#lc.mc,lcflag	; <<<
1$:				; <<<
	call	endlin		;polish off line
	zap	dmarol		;no dummy args for repeat
	call	promt		;use macro stuff

	mov	#mt.rpt,r5	;fudge an "end of repeat"
reptf:	call	wcimt
	call	mpush		;push previous macro block
	mov	(sp)+,(r2)+	;store text pointer
	mov	(sp)+,(r2)+	;store arg pointer
	clr	(r2)+		;counter
	mov	(sp)+,(r2)+	;max
	call	setchr		;restore character

endmac:	mov	#msbcnt,r0	;set pointer to count
	inc	(r0)		;bump it
	cmp	(r0)+,(r0)+	;through?
	bgt	1$		;  yes
	mov	msbtxt,(r0)	;no, set read pointer
	add	#4,(r0)		;bypass link
	return

1$:	clr	cndmex		;clear mexit flag
	jmp	mpop

endm:
	error	56,o,<.endm out of context>
	return
endr:
	error	57,o,<.endr out of context>
	return
	.iftf
	.globl	opcerr
opcerr:	error	24,o,<opcode out of context>
	return
opcer1:	error	25,o,<missing macro name>
	return
	.ift
	.globl	macro,	macr

macro:
macr:				;macro definition
	call	gsarg		;get the name
	beq	opcer1		;  error if null
macrof:
	call	tstarg		;bypass possible comma
	mov	symbol,macnam
	mov	symbol+2,macnam+2
	call	msrch		;search the table
	 beq	1$		;branch if null
	call	decmac		;decrement the reference
1$:
	call	getblk		;get a storage block
	mov	r0,-(sp)	;save pointer
	call	msrch		;getblk might have moved things
	mov	(sp)+,(r4)	;set pointer
	call	insert		;insert in table
	call	crfdef
	call	proma		;process dummy args
	clr	(r2)+		;clear level count
	mov	argcnt,(r2)+	;keep number of args
	mov	macgsb,(r2)+	;  and generated symbol bits
	bis	#lc.md,lcflag
	call	endlin		;polish off line
	call	promt		;process the text
	call	getsym
	beq	mac3
	cmp	r0,macnam
	bne	2$
	cmp	symbol+2,macnam+2
	beq	mac3
2$:	error	26,a,<.endm name doesn't match .macro name>
mac3:	mov	#mt.mac,r5
	call	wcimt		;set end marker
	call	setchr
	return
mactst:				;test for macro call
	call	msrch		;search for macro
	beq	9$		;  exit with zero if not found
	call	setpf0		;mark location
	mov	r0,-(sp)	;save text pointer
	call	incmac		;increment reference
	cmp	(r0)+,(r0)+	;move up a couple of slots
	mov	(r0)+,argmax	;set number of args
	mov	(r0)+,macgsb	;  and generated symbol bits
	mov	r0,-(sp)	;save pointer
	call	crfref		;cref it
	call	promc		;process call arguments
	mov	r0,r3		;save block pointer
	mov	#mt.mac,r5
	call	mpush		;push nesting level
	mov	(sp)+,msbmrp
	mov	(sp)+,(r2)+	;set text pointer
	mov	r3,(r2)+	;  and argument pointer
	mov	argcnt,(r2)	;fill in argument count
	mov	(r2)+,(r2)+	;  and replecate
	call	setchr
	setnz	r0		;return non-zero
9$:	return


msrch:	search	macrol		;search macro roll
	mov	value,r0	;doesn't count if no pointer
	return
	.globl	irp,	irpc

irpc:	inc	r3
irp:
	call	gmarg
	beq	1$
	call	proma
	call	rmarg
	call	gmarg
	beq	1$
	mov	#177777,argmax	;any number of arguments
	call	promcf
	mov	r0,r3
	call	rmarg
	call	getblk
	clr	(r2)+
	mov	argcnt,-(sp)
	mov	r3,-(sp)
	mov	r0,-(sp)
	tst	mx.flg		;
	beq	111$;		; <<< REEDS june 81
	bis	#lc.mc,lcflag	;
111$:	call	endlin
	call	promt
	mov	#mt.irp,r5
	jmp	reptf

1$:	error	27,a,<illegal arguments>
	return

proma:				;process macro args
	zap	dmarol		;clear dummy argument roll
	clr	argcnt		;get a fresh start with arguments
	clr	macgsb		;clear generated bit pattern
	mov	#100000,-(sp)	;stack first generated symbol bit
1$:	call	tstarg		;any more args?
	beq	3$		;  no, quit and go home
	cmp	#ch.qm,r5	;yes, generated type?
	bne	2$		;  no
	bis	(sp),macgsb	;yes, set proper bit
	call	getnb		;bypass it
2$:	call	gsargf		;get symbolic argument
	append	dmarol		;append to dma roll
	clc
	ror	(sp)		;shift generated sym bit
	br	1$

3$:	tst	(sp)+		;prune stack
	return


promc:	clr	r3
promcf:
	clr	argcnt
	call	getblk
	mov	r0,-(sp)
	tst	r3
	bne	prmc7
prmc1:	cmp	argmax,argcnt
	blos	prmc10
	call	tstarg		;bypass any comma
	bne	9$		;ok if non-null
	tst	macgsb		;null, any generated stuff left?
	beq	prmc10		;  no, through
9$:	cmp	#ch.bsl,r5	; "\"?
	beq	prmc20		;  yes
	call	gmargf		;get argument
	.if ndf	xedlsb
	tst	r5		;any arguments?
	bne	2$		;  yes
	tst	macgsb		;no, generation requested?
	bmi	prmc30		;  yes
	.endc
2$:	.if ndf	xedlc		;>>>gh 5/15/78 to not automatically upper-case
	bit	#ed.lc,edmask	;lower case enabled?
	bne	3$		;  no, leave as upper case
	tst	ucflag
	bne	3$
	mov	chrpnt,r5	;fake for ovlay pic
	movb	(r5),r5		;fetch original character
	.endc

3$:	call	wcimt
	beq	prmc4
	call	getchr
	br	2$

prmc4:	call	rmarg
prmc5:	asl	macgsb		;move generation bit over one
	br	prmc1

prmc6:	inc	argcnt
	call	getchr
prmc7:	.if ndf	xedlc		;>>>gh 5/15/78 to not automatically upper-case
	bit	#ed.lc,edmask	;lower case enabled?
	bne	8$		;  no, leave as upper case
	tst	ucflag
	bne	8$
	mov	chrpnt,r5	;fake for ovlay pic
	movb	(r5),r5		;fetch original character
	.endc
8$:	call	wcimt
	beq	prmc10
	clr	r5
	call	wcimt
	br	prmc6

prmc10:	com	r5
	call	wcimt
	com	r5
	bit	#lc.mc,lcmask	;macro call suppression?
	beq	12$		;  no
	mov	lblend,r0	;yes, have we a label?
	beq	11$		;  no, suppress entire line
	mov	r0,lcendl	;yes, list only label
	br	12$

11$:	bis	#lc.mc,lcflag
12$:	mov	(sp)+,r0
	return
prmc20:	call	getnb		; "\", bypass
	call	absexp		;evaluate expression, abs
	mov	r5,-(sp)	;stack character
	mov	r3,-(sp)
	mov	cradix,r3	;break out in current radix
	mov	r0,r1		;value to r1
	call	prmc40		;convert to ascii
	clr	r5
	call	wcimt
	mov	(sp)+,r3	;restore regs
	mov	(sp)+,r5
	br	prmc5

	.if ndf	xedlsb
prmc30:	inc	lsgbas		;generated symbol, bump count
	mov	lsgbas,r1	;fetch it
	add	#^d<64-1>,r1	;start at 64.
	bit	#177600,r1	;gen symbols in range 64-127 only
	beq	1$
	error	54,t,<no generated symbols after 127$>
1$:
	mov	r5,-(sp)	;stack current char
	mov	r3,-(sp)	;and r3
	mov	#10.,r3		;make it decimal
	call	prmc40		;convert to ascii
	mov	#ch.dol,r5
	call	wcimt		;write "$"
	clr	r5
	call	wcimt
	mov	(sp)+,r3	;restore regs
	mov	(sp)+,r5
	br	prmc4		;return
	.endc

prmc40:				;macro number converter
	clr	r0
	div	r3,r0
	mov	r1,-(sp)	;stack remainder
	mov	r0,r1		;set new number
	beq	41$		;down to zero?
	call	prmc40		;  no, recurse
41$:	mov	(sp)+,r5		;get number
	add	#dig.0,r5	;convert to ascii
	jmp	wcimt		;write in tree and exit
.globl	lst.kb,linbuf,putil2
promt:
	clr	r3
1$:	call	getlin
	bne	2$
	inc	macdfn
	bis	#lc.md,lcflag
	call	setcli
	bit	#dflmac,r0
	beq	63$
	inc	r3
	cmp	#endm,value	; what a crock: .endm & .endr are synonyms
	beq	10$		; in spite of what the manual says
	cmp	#endr,value
	bne	3$
10$:	dec	r3
	dec	r3
	bpl	3$
2$:
	clr	macdfn
	return
63$:
	.if ndf	xsml
	tst	smllvl		;in system macro?
	beq	3$		;  no
	bit	#dflsmc,r0	;yes, nested?
	beq	3$		;  no
	cmp	r5,#'(		;check for prefix, crudely
	bne	64$
	call	getnb
	call	getsym
	cmp	r5,#')
	bne	64$
	call	getnb
64$:	call	smltst		;yes, test for more
	.endc
3$:	mov	#linbuf,chrpnt
	call	setchr
4$:	call	getsym
	beq	7$
	scan	dmarol
	mov	r0,r4
	beq	5$
	mov	rolupd,r5
	neg	r5
	dec	concnt
	call	wcimt
	dec	concnt
5$:	call	setsym
6$:	tst	r4
	bne	61$
	.if ndf	xedlc		;>>>gh 5/16/78 to not automatically upper-case
	bit	#ed.lc,edmask	;lower case enabled?
	bne	21$		;  no, leave as upper case
	tst	ucflag
	bne	21$
	mov	chrpnt,r5	;fake for ovlay pic
	movb	(r5),r5		;fetch original character
21$:	.endc
	call	wcimt
61$:	call	getr50
	bgt	6$
7$:	cmp	r5,#ch.xcl
	beq	8$
	.if ndf	xedlc		;>>>gh 5/16/78 to not automatically upper-case
	bit	#ed.lc,edmask	;lower case enabled?
	bne	22$		;  no, leave as upper case
	tst	ucflag
	bne	22$
	mov	chrpnt,r5	;fake for ovlay pic
	movb	(r5),r5		;fetch original character
22$:	.endc
	call	wcimt
	bne	9$
	call	endlin
	jmp	1$

8$:	inc	concnt
9$:	call	getchr
	br	4$

	.globl	narg,	nchr,	ntype,	mexit
	.globl	mx.2,mx.sym,mx.num ,dnc

narg:				;number of arguments
	call	gsarg		;get a symbol
	beq	ntyper		;error if missing
	mov	msbcnt+2,r3	;set number
	br	ntypex

nchr:				;number of characters
	call	gsarg
	beq	ntyper		;  error id no symbol
	call	gmarg		;isolate argument
	beq	ntypex		;  zero if null
	tst	r5		;quick test for completion
	beq	2$		;  yes
1$:	inc	r3		;bump count
	call	getchr		;get the next character
	bne	1$		;loop if not end
2$:	call	rmarg		;remove arg delimiters
	br	ntypex

ntype:				;test expression mode
	call	gsarg		;get the symbol
	beq	ntyper		;  error
	call	tstarg		;bypass any commas
	mov	#symbol,r1
	mov	(r1)+,-(sp)	;preserve symbol
	mov	(r1)+,-(sp)
	call	aexp		;evaluate
	mov	r0,r3		;set result
	zap	codrol		;clear any generated code
	mov	(sp)+,-(r1)	;restore symbol
	mov	(sp)+,-(r1)
ntypex:	clr	mode		;clear mode
	mov	r3,value	;  and set value
	tst	mx.flg		; <<< REEDS june 81
	beq	100$		; <<<
	bis	#lc.mc,lcflag	; <<<
	mov	#1,mx.2		; <<<
	.irpc	xx,<012345>	; <<<
	mov	r'xx,-(sp)	; <<<
	.endm			; <<<
	mov	#mx.sym,r2	; <<<
	call	r50unp		; <<<
	mov	#mx.num,r2	; <<<
	mov	value,r1	; <<<
	call	dnc		; <<<
	movb	#0,(r2)		; <<<
	.irpc	xx,<543210>	; <<<
	mov	(sp)+,r'xx	; <<<
	.endm			; <<<
100$:				; <<<
	jmp	asgmtf		;exit through assignment

;
; there are mxpand problems here.
;
;
;
ntyper:	error	28,a,<no symbol to assign to>
	br	ntypex

mexit:				;macro/repeat exit
	mov	maclvl,cndmex	;in macro?
	bne	mex1		;  yes, pop
	error	29,o,<unbalanced .endm>		;  no, error
mex1:	return

	gencnd	b,	tcb
	gencnd	nb,	tcb,	f
	gencnd	idn,	tcid
	gencnd	dif,	tcid,	f


tcb:				; "ifb" conditional
	beq	tcberx		;ok if null
	call	gmargf		;isolate argument
	call	setnb		;bypass any blanks
	beq	tcidt		;true if pointing at delimiter
	br	tcidf		;else false

tcberr:	error	30,a,<missing argument in 'if' construction>
					;naughty
tcberx:	return

tcid:				; "ifidn" conditional
	beq	tcberr		;error if null arg
	call	gmargf		;isolate first arg
	mov	chrpnt,r1	;save character pointer
	tst	-(r0)
	mov	-(r0),r2	;pointer to terminator
	call	rmarg		;return this arg
	call	gmarg		;get the next
	beq	tcberr
1$:	movb	(r1),r0		;set character from first field
	cmp	r1,r2		;is it the last?
	bne	2$		;  no
	clr	r0		;yes, clear it
2$:	.if ndf	xedlc		;>>>gh 5/17/78 to properly compare upper and lower case
	bit	#ed.lc,edmask	;lower case enabled?
	bne	3$		;  no, leave as upper case
	tst	ucflag
	bne	3$
	mov	chrpnt,r5	;fake for ovlay pic
	movb	(r5),r5		;fetch original character
	.endc
3$:	cmp	r0,r5		;match?
	bne	tcidf		;  no
	tst	r5		;yes, finished?
	beq	tcidt		;  yes, good show
	call	getchr		;no, get the next character
	inc	r1		;advance first arg pointer
	br	1$		;try again

tcidf:	com	r3		;false, toggle condition
tcidt:	jmp	rmarg		;ok, restore argument

gmarg:				;get macro argument
	call	tstarg		;test for null
	beq	gmargx		;  yes, just exit
gmargf:	call	savreg		;stash registers
	clr	r1		;clear count
	mov	#chrpnt,r2
	mov	(r2),-(sp)	;save initial character pointer
	mov	#ch.lab,r3	;assume "<>"
	mov	#ch.rab,r4
	cmp	r5,r3		;true?
	beq	11$		;  yes
	cmp	r5,#ch.uar	;up-arrow?
	beq	10$		;  yes
1$:	bitb	#ct.pc-ct.com-ct.smc,cttbl(r5)	;printing character?
	beq	gm21		;  no
	call	getchr		;yes, move on
	br	1$

10$:	call	getnb		; "^", bypass it
	beq	20$		;error if null
	mov	(r2),(sp)	;set new pointer
	com	r3		;no "<" equivalent
	.if ndf	xedlc		;>>>gh 5/17/78 to not automatically upper-case
	bit	#ed.lc,edmask	;lower case enabled?
	bne	3$		;  no, leave as upper case
	tst	ucflag
	bne	3$
	mov	chrpnt,r5	;fake for ovlay pic
	movb	(r5),r5		;fetch original character
3$:	.endc
	mov	r5,r4		;">" equivalent
11$:	call	getchr
	beq	20$		;  error if eol
	.if ndf	xedlc		;>>>gh 5/17/78 to not automatically upper-case
	bit	#ed.lc,edmask	;lower case enabled?
	bne	4$		;  no, leave as upper case
	tst	ucflag
	bne	4$		;  no, leave as upper case
	mov	chrpnt,r5	;fake for ovlay pic
	movb	(r5),r5		;fetch original character
4$:	.endc
	cmp	r5,r3		; "<"?
	beq	12$		;  yes
	cmp	r5,r4		;no, ">"?
	bne	11$		;  no, try again
	dec	r1		;yes, decrement level count
	dec	r1
12$:	inc	r1
	bpl	11$		;loop if not through
	inc	(sp)		;point past "<"
	bis	#100000,r5	;must move past in rmarg
	br	gm21

20$:	error	31,a,<missing argument>
gm21:	mov	gmapnt,r0	;get current arg save pointer
	bne	22$		;branch if initialized
	mov	#gmablk,r0	;do so
22$:	mov	(r2),(r0)+	;save pointer
	mov	r5,(r0)+	;  and character
	clrb	@(r2)		;set null terminator
	mov	(sp)+,(r2)	;point to start of arg
	call	setchr		;set register 5
	mov	r0,gmapnt	;save new buffer pointer
gmargx:	return
rmarg:				;remove macro argument
	mov	gmapnt,r0	;set pointer to saved items
	mov	-(r0),r5	;set character
	tst	-(r0)
	movb	r5,@(r0)	;restore virgin character
	asl	r5
	adc	(r0)
	mov	(r0),chrpnt
	call	setnb
	mov	r0,gmapnt
	return

	entsec	imppas
gmapnt:	.blkw	1		;pointer to following buffer
gmablk:	.blkw	1		;pointer to "borrowed" character
	.blkw	1		;character itself
	.blkw	3*2		;room for more pairs
	xitsec
wcimt:				;write character in macro tree
	dec	concnt		;any concatenation chars pending?
	bmi	1$		;  no
	mov	r5,-(sp)	;yes, stack current character
	mov	#ch.xcl,r5
	call	2$
	mov	(sp)+,r5
	br	wcimt

1$:	clr	concnt
2$:	bit	#bpmb-1,r2	;room in this block?
	bne	3$		;  yes
	sub	#bpmb,r2	;no, point to link
	mov	r2,-(sp)
	call	getblk
	mov	r0,@(sp)+	;set new link
3$:	movb	r5,(r2)+	;write, leaving flags set
	return

getblk:				;get a macro block
	mov	r3,-(sp)
	mov	macnxt,r0	;test for block in garbage
	bne	1$		;  yes, use it
	mov	mactop,r0	;no, get a new one
	add	#bpmb,mactop	;set new pointer
	mov	#macovf,upbomb	; on error, print message & die
	call	uplift		; check if overran dynamic tables
				; if so, buy more core & shuffle
				; (on error, uplift won't return)
	br	2$

1$:	mov	(r0),macnxt	;set new chain
2$:	mov	r0,r2
	clr	(r2)+		;clear link cell, point past it
	mov	(sp)+,r3
	return



incmac:	inc	2(r0)		;increment macro reference
	return

decmac:	dec	2(r0)		;decrement macro storage
	bpl	remmax		;just exit if non-negative

remmac:	mov	r0,-(sp)	;save pointer
1$:	tst	(r0)		;end of chain?
	beq	2$		;  yes
	mov	(r0),r0		;no, link
	br	1$

2$:	mov	macnxt,(r0)
	mov	(sp)+,macnxt
remmax:	return
mpush:				;push macro nesting level
	inc	mdepth
	call	getblk		;get a storage block
	tst	-(r2)		;point to start
	mov	#msbblk,r1	;pointer to start of prototype
	mov	r2,-(sp)	;save destination
	mov	r1,-(sp)	;  and core pointers
1$:	mov	(r1),(r2)+	;xfer an item
	clr	(r1)+		;clear core slot
	cmp	#msbend,r1	;through?
	bne	1$		;  no
	mov	(sp)+,r2	;yes, make core destination
	mov	r5,(r2)+	;save type
	mov	(sp)+,(r2)+	;  and previous block pointer
	inc	maclvl		;bump level count
	return			;return with r2 pointing at msbtxt

mpop:				;pop macro nesting level
	dec	mdepth		;for lout.m11
	mov	#msbarg+2,r2	;point one slot past arg
	mov	-(r2),r0	;get pointer to arg block
	beq	1$		;branch if null
	call	remmac		;remove it
1$:	mov	-(r2),r0	;point to text block
	beq	2$		;branch if null
	call	decmac		;decrement level
2$:	mov	-(r2),r1	;get previous block
	tst	-(r2)		;point to start
	mov	r1,r0		;save block pointer
	call	xmit0-<msbend-msbblk>	;xfer block
	clr	(r0)		;clear link
	call	remmac		;return block for deposit
	dec	maclvl		;decrement level count
	return


	entsec	impure
msbblk:				;pushable block (must be ordered)
msbtyp:	.blkw			;block type
msbpbp:	.blkw			;previous block pointer
msbtxt:	.blkw			;pointer to basic text block
msbarg:	.blkw			;pointer to arg block
msbcnt:	.blkw	2		;repeat count, etc.
msbmrp:	.blkw			;macro read pointer
msbend:				;end of ordered storage

macnxt:	.blkw
maclvl:	.blkw			;macro level count
concnt:	.blkw
argmax:	.blkw
macnam:	.blkw	2
macgsb:	.blkw			;macro generated symbol bits
	xitsec
	.if ndf	xsml

	.globl	mcall		;.mcall

mcall:	bis	#lc.md,lcflag	;for listing control
	mov	#sysmac,-(sp)	;assume system mcall
	cmp	r5,#'(		;named file?
	bne	14$		;  no, use system
	mov	#smlfil,r1	;yes, point to dest. for specified pathname.
	mov	r1,(sp)		;store as adr. of pathname being gathered
11$:	cmp	r1,#smlfil+34	;any more room?
	blo	12$		;yes
	dec	r1		;no, cause truncation.
12$:	call	getnb		;get next char. (ignoring blanks)
	.if ndf xedlc
	movb	@chrpnt,(r1)	;store char.
	bicb	#200,(r1)	;turn off sign bit
	.iff
	movb	r5,(r1)		;store char.
	.endc
	cmpb	(r1)+,#')
	bne	11$		;continue till ")"
	clrb	-(r1)		;end, make null
	call	getnb		;yes, bypass it
14$:	mov	(sp)+,smlnam	;store pointer to asciz name
	call	smltst		;test for undefined arguments
	jeq	5$		;  branch if none
	tst	pass		;found some, pass one?
	bne	41$		;  no, error
1$:	call	inisml		;get another file
	beq	42$		;  error if none
2$:	clr	r3		;set count to zero
3$:	call	getlin		;get a new line
	bne	1$		;try another file if eof
	call	setcli		;test for directive
	bit	#dflmac,r0	;macro/endm?
	beq	3$		;  no
	mov	#value,r4	;set for local and macrof
	dec	r3		;yes, assume .endm
	cmp	#endm,(r4)	;good guess?
	beq	3$		;  yes
	cmp	#endr,(r4)	;a synonym for .endm
	beq	3$		;  yes
	inc	r3		;no, bump count
	inc	r3
	cmp	#1,r3		;outer level?
	bne	3$		;  no
	call	gsarg		;yes, get name
	beq	44$		;  error if null
	search	macrol		;search table
	beq	3$		;  ignore if not found
	tst	(r4)		;has it a value?
	 bne	3$		;  no, not interested
	call	macrof		;good, define it
	dec	smllvl		;decrement count
	bgt	2$		;loop if more to go
	br	5$		;ok, clean up

4$:	error	60,u ,<.mcall error>
	br	5$
41$:	tst	err.xx		; dont want this message to mask the others
	bne	5$
	error	61,u ,<macro not defined by .mcall>
	br	5$
42$:	error	62,u ,<cannot open .mcall file>
	br	5$
44$:	error	63,u ,<illegal .macro statement in .mcall>
5$:	clr	smllvl		;make sure count is zapped
	clr	endflg		;ditto for end flag
	jmp	finsml		;be sure files are closed

	entsec	dpure
sysmac:			;kludged to lower-case
	.enabl lc
	.asciz	+/usr/share/misc/sysmac+

	xitsec
smltst:				;test mcall arguments
1$:	call	gsarg		;fetch next argument
	beq	3$		;  exit if through
	call	msrch		;ok, test for macros
	bne	2$		;  found, not interested
	call	insert		;insert with zero pointer
	inc	smllvl		;bump count
2$:	call	crfdef		;cref it
	br	1$

3$:	mov	smllvl,r0	;finished, count to r0
	return

	entsec	imppas
smllvl:	.blkw			;mcall hit count
	xitsec

	.endc			;xsml

	.endc			;xmacro
;
; mac.er is called on reaching end of prog w/o .end file or when
; running out of core.
;
.globl	lst.kb,putli2, mac.er, macdfn
.text
mac.er:
	call	savreg
	tst	macdfn
	beq	9$
	tst	pass
	beq	9$
	mov	#mac.xx,r2
	mov	#lst.kb,r4
	call	putli2
9$:	return
.data
mac.xx:	.asciz /possibly unterminated .macro, .rept, .irp, or .irpc/
.even
.bss
macdfn:	.blkw
	.end