dmacro.src

	.page
	.subttl  dmacro

; macro definition handling.

putmac	stx xtemp
	ldx mctbpt
	stx t0
	ldx mctbpt+1
	stx t0+1
	ldx #0
	sta (t0,x)
	ldx xtemp
	rts

putbmp	pha		;save the output char
	lda pass
	beq 10$
	pla
	rts

10$	pla
	jsr putmac
	inc mctbpt	;bump macro table pointer
	bne 20$
	inc mctbpt+1
20$	sec
	lda mctbpt	;has pointer overrun?
	sbc #<mctbnd
	lda mctbpt+1
	sbc #>mctbnd
	bcs 30$		;yes
	rts		;no

30$	lda #$22	;error code for macro overflow
bmm3	jmp fixstk

push	pha		;push acc into macro stack
	lda mcstpt
	sta t0
	lda mcstpt+1
	sta t0+1
	pla		;retrieve the byte
	stx xtemp
	ldx #0		;index for indirect store
	sta (t0,x)	;store into stack
	ldx xtemp

	inc mcstpt	;bump macro stack pointer
	lda mcstpt	;has pointer overrun?
	sbc #<mcstnd
	lda mcstpt+1
	sbc #>mcstnd
	bcs 10$		;yes
	rts		;no

10$	lda #$23	;error code for stack overflow
	jmp fixstk



hmac	lda jlabl
	beq 10$		;was there a label seen?
	lda #$25	;must not have a label
	jmp fixerr	;exit to error processor

10$	lda icse
	sta icolp	;advance scan pointers over .mac
	inc icolp
	jsr getsym	;look for the macro name
	bcc 30$		;found an alphanumeric string
20$	lda #$18	;illegal operand
	jmp fixerr	;exit to error process

30$	ldx icolp
	jsr nalph	;label must begin with a letter
	bcc 20$		;not alpha so exit
	lda icsl
	cmp #$03	;might be an op code
	bne 40$
	jsr nopfnd	;is it an opcode
	bcc 40$		;not an opcode
	lda #$03	;improper opcode
	jmp fixerr

40$	jsr labprc	;make more checks
	bcc 50$
	jmp lts1

50$	jsr nfind	;look it up
	bcc 60$		;not defined before
	lda pass	;prior define. is this pass 1?
	bne 100$	;no so all is ok
	lda #$02	;defined earlier
	jmp fixerr

60$	lda #$ff
	sta knval
	sta knval+1	;define it as macro
	jsr nsert
	lda mctbpt
	sta newmac	;save this place in the table
	lda mctbpt+1
	sta newmac+1

	ldy #$0		;copy symbol name to macro table
70$	lda (tops),y
	jsr putbmp	;character to macro table
	iny
	cpy #$06
	bne 70$		;do it 6 times

	ldy #20		; 2 for ptr, 18 for 9 params
80$	lda #0
	jsr putbmp	;character to table
	dey
	bne 80$
	beq 100$

90$	lda #cr		;pass a carriage return
	jsr putbmp
100$	jsr pas2pr
	jsr cardin
	bcc 110$
	jmp h10

110$	ldx #$ff
	stx icolp
120$	jsr nextch	;look for .mnd and .mac
	bcc 90$		;end of card
	cmp #'.'	;decimal point
	beq 140$
130$	jsr putbmp
	jmp 120$

140$	lda mctbpt
	sta maybe
	lda mctbpt+1
	sta maybe+1	;save where .mnd might start
	lda #'.'	;restore the period
	jsr putbmp
	ldy #0		;get next three characters
150$	jsr nextch
	bcc 90$
	sta holda
	jsr putbmp
	lda holda
	cmp mnd,y	;compare to "mnd"
	beq 160$

;.....here if we saw a ".".......

	cpy #1		;saw ".M"
	bne 120$
	cmp #'A'
	bne 120$
	jsr nextch	;look for final "C"
	bcc 90$
	cmp #'C'
	bne 130$
	lda newmac	;error--restore macro pointer
	sta mctbpt
	lda newmac+1
	sta mctbpt+1
	lda #$26	;.mac within .mac
	jmp fixerr

160$	iny
	cpy #$03
	bne 150$

;.....when you get here you found .MND.......

	lda pass
	bne 170$	;no pointer update on pass 2
	lda maybe
	sta mctbpt	;restore pointer
	lda maybe+1
	sta mctbpt+1
	lda #cr		;last char is cr
	jsr putbmp
	lda #0
	jsr putbmp	;store zero at end for end file
	lda newmac
	sta t0		;prepare to fill in fwd pointer
	lda newmac+1
	sta t0+1
	ldy #6
	lda mctbpt
	sta (t0),y
	lda mctbpt+1
	iny
	sta (t0),y
170$	jsr pas2pr
	jmp endln	;normal exit

hmnd	lda #$27	;.MND unmatched
	jmp fixerr



nextch	ldx icolp
	inx
	stx icolp
	lda icrd,x	;get next character
	beq 10$		;...EOL
	sec		;flag good character
	rts

10$	clc		;flag EOL
	rts



ismac	lda #<mactab
	sta t0
	lda #>mactab
	sta t0+1	;point to macro table
10$	sec		;WHILE t0 < mactbnd DO
	lda t0
	sbc mctbpt
	lda t0+1
	sbc mctbpt+1
	bcc 20$
	clc		;report not in table
	rts

20$	ldy #5		;BEGIN  
30$	lda (t0),y	;  IF name(isym) = name(t0) THEN
	cmp isym,y
	bne 40$
	dey
	bpl 30$
	sec		;  return with carry set
	rts

40$	ldy #6		;  ELSE t0 := next(t0)
	lda (t0),y	;END
	tax
	iny
	lda (t0),y
	sta t0+1
	stx t0
	jmp 10$


calmac	lda t0
	sta tmpmac	;macro table pointer
	lda t0+1
	sta tmpmac+1
	jsr pas2pr	;print the call line
	jsr pshmac	;push down text pointers
	lda tmpmac	;point to new macro
	sta t0
	lda tmpmac+1
	sta t0+1
	jsr setmac	;setup new text pointers
	jsr macprm	;initialize params
	jmp endln	;normal exit

; getsym scans for an identifier.
;	it returns with carry clear if it finds one.
;	it sets length (icsl), first (icolp), & last (icse)

getsym	jsr nfndnb	;look for nonblank
	bcs 20$		;...found something
10$	sec
	rts		;normal exit - empty card

20$	ldx icolp	;point to it
	ldy #0		;symbol length count
	lda icrd,x	;get first character
	cmp #';'	;is it a comment?
	beq 10$		;yes, take normal exit

; return symbol found
;
;	while char = alpha or number do
;	 begin  isym[i] := char;
;	   i := i+1;
;	   if i > maccol then exit loop;
;	 end
;	 if i = 0 then report symbol not found
;	 if i > 6 the report symbol too long
;	 while i < 6 do
;	   begin isym[i] := blank
;	     i := i+1
;	   end

30$	jsr nalph	;is it alpha?
	bcs 40$		;yes
	jsr numrc	;is it a number?
	bcc 50$		;no
40$	sta isym,y	;build the symbol
	inx
	iny
	lda icrd,x
	bne 30$		;...loop while not EOL

50$	cpy #0		;symbol found?
	beq 10$		;report no symbol
	cpy #$07	;is symbol too long?
	bcc 60$		;no
	lda #$9		;symbol too long
	jmp fixerr

60$	lda #space	;fill remainder with blanks
	sty icsl	;set the symbol length
70$	cpy #$06
	bcs 80$
	sta isym,y
	iny
	bne 70$		;branch always

80$	clc		;report symbol found
	stx icse
	rts

; macprm processes the parameters for a macro call.
;
;	clear parameters
;	advance to next nonblank
;	parmct := 0
;	tmpmac := macstpt;  remember stack pointer
;	while ismore do
;	   begin if char <> comma then push(char)
;	      else
;	        begin movprm;
;	        end;
;	      nextchar; point to next char;
;	   end
;	movprm;

macprm	lda #$01	;point to first param
	jsr prmpnt
	ldy #17		;initialize 18 cells to 0
	lda #$0
10$	sta (t0),y
	dey
	bpl 10$

	sta prmcnt
	jsr nfndnb	;find next nonblank
	bcc 40$		;no more so exit
	lda mcstpt
	sta tmpmac
	lda mcstpt+1
	sta tmpmac+1
20$	jsr ismore	;any more?
	bcc 40$		;no more so exit
	cmp #comma	;is it a comma?
	beq 30$
	jsr push
	jmp 20$

30$	jsr movprm
	jmp 20$
40$	jsr movprm
	rts		;exit

fixstk	pha
	lda stkfrm
	sta mcstpt	;reset stack pointer
	lda stkfrm+1
	sta mcstpt+1
	lda #$80	;turn off macro expansion
	sta sfile	;error recovery (hopefully)
	pla

fixerr	ldx icse	;**************** might be incorrect !! (3)
	ldy #0		;bump plc by 3 after error
	jmp lts1	;exit to error handler

; ismore says there is more (carry set) or not (carry clear)

ismore	ldx icolp	;pointer to character
	lda icrd,x	;get the character
	beq 20$		;...EOL
	cmp #space
	beq 20$		;...blank
	cmp #';'
	beq 20$		;...comment
	inc icolp	;advance pointer
	sec		;return true (more)
	rts

20$	clc		;return false (no more)
	rts


pas2pr	pha
	txa
	pha
	tya
	pha
	lda pass
	beq 10$
	lda #0
	tax
	tay
	jsr ltins
	lda #0
	sta lcdpt	;enable multiple line print
10$	pla
	tay
	pla
	tax
	pla
	rts

; movprm moves a param to macro table.
; it inserts a pointer to text in stack in the param cell push(0)
; trailing 0 after parm

movprm	lda mcstpt
	cmp tmpmac	;has anything been pushed?
	bne 10$		;yes
	lda mcstpt+1
	cmp tmpmac+1
	beq 30$		;equal so exit
10$	lda #0
	jsr push	;trailing 0 for param
	lda prmcnt
	cmp #9
	bcc 20$		;ok if fewer than 9 so far
	lda #$29	;too many params
	jmp fixstk
20$	lda prmcnt
	clc
	adc #1		;this is the parameter number
	jsr prmpnt	;set t0 to point to it
	ldy #0
	lda tmpmac	;point param to stack
	sta (t0),y
	iny
	lda tmpmac+1
	sta (t0),y
	lda mcstpt
	sta tmpmac
	lda mcstpt+1
	sta mcstpt+1	;point to next text area
30$	inc prmcnt
	rts

; parameter point translates a parameter number into an address.
;	it requires: parm number in acc & macent pointing to macro entry.
;	it sets t0 in base page.

prmpnt	sec
	sbc #1		;subtract lower bound
	bpl 20$		;cannot be negative
10$	lda #$13	;can't evaluate expression
	jmp fixstk

20$	cmp #9		;check upper bound
	bcs 10$
	asl a		;double it
	clc
	adc #8		;offset
	clc
	adc macent
	sta t0
	lda macent+1
	adc #0
	sta t0+1
	rts

;	.end