dmacro

.PAGE 'DMACRO'

; MACRO DEFINITION HANDLING.
; WRITTEN BY HAROLD S. STONE, THE INTERFACTOR, INC.

PUTMAC	STX XTEMP
	LDX MCTBPT
	STX T0
PUTM1	LDX MCTBPT+1
	STX T0+1
	LDX #0
	STA (T0,X)
	LDX XTEMP
	RTS

PUTBMP	PHA             ;SAVE THE OUTPUT CHAR
	LDA PASS
	BEQ PUT1
	PLA
	RTS

PUT1	PLA
	JSR PUTMAC
BMMCTB	INC MCTBPT      ;BUMP MACRO TABLE POINTER
	BNE BMM1
	INC MCTBPT+1
BMM1	SEC
	LDA MCTBPT      ;HAS POINTER OVERRUN?
	SBC #<MCTBND
	LDA MCTBPT+1
	SBC #>MCTBND
	BCS BMM2        ;YES
	RTS             ;NO

BMM2	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 #$00        ;INDEX FOR INDIRECT STORE
	STA (T0,X)      ;STORE INTO STACK
	LDX XTEMP
BMSTPT	INC MCSTPT      ;BUMP MACRO STACK POINTER
	LDA MCSTPT      ;HAS POINTER OVERRUN?
	SBC #<MCSTND
	LDA MCSTPT+1
	SBC #>MCSTND
	BCS BMS2        ;YES
	RTS             ;NO

BMS2	LDA #$23        ;ERROR CODE FOR STACK OVERFLOW
	JMP FIXSTK

HMAC	LDA JLABL
	BEQ HMAC0       ;WAS THERE A LABEL SEEN?
	LDA #$25        ;MUST NOT HAVE A LABEL
	JMP FIXERR      ;EXIT TO ERROR PROCESSOR

HMAC0	LDA ICSE
	STA ICOLP       ;ADVANCE SCAN POINTERS OVER .MAC
	INC ICOLP
	JSR GETSYM      ;LOOK FOR THE MACRO NAME
	BCC HMAC0B      ;FOUND AN ALPHANUMERIC STRING
HMAC0A	LDA #$18        ;ILLEGAL OPERAND
	JMP FIXERR      ;EXIT TO ERROR PROCESS
HMAC0B	LDX ICOLP
	JSR NALPH       ;LABEL MUST BEGIN WITH A LETTER
	BCC HMAC0A      ;NOT ALPHA SO EXIT
	LDA ICSL
	CMP #$03        ;MIGHT BE AN OP CODE
	BNE HMAC1
	JSR NOPFND      ;IS IT AN OPCODE
	BCC HMAC1       ;NOT AN OPCODE
	LDA #$03        ;IMPROPER OPCODE
	JMP FIXERR

HMAC1	JSR LABPRC      ;MAKE MORE CHECKS
	JSR NFIND       ;LOOK IT UP
	BCC HMAC2       ;NOT DEFINED BEFORE
	LDA PASS        ;PRIOR DEFINE. IS THIS PASS 1?
	BNE HMAC5A      ;NO SO ALL IS OK
	LDA #$02        ;DEFINED EARLIER
	JMP FIXERR

HMAC2	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
HMAC3	LDA (TOPS),Y
	JSR PUTBMP      ;CHARACTER TO MACRO TABLE
	INY
	CPY #$06
	BNE HMAC3       ;DO IT 6 TIMES
	LDY #20         ; 2 FOR PTR, 18 FOR 9 PARAMS
HMAC4	LDA #0
	JSR PUTBMP      ;CHARACTER TO TABLE
	DEY
	BNE HMAC4
	BEQ HMAC5A
HMAC5	LDA #$0D        ;PASS A CARRIAGE RETURN
	JSR PUTBMP
HMAC5A	JSR PAS2PR
	JSR CARDIN
	BCC HMAC6
	JMP H10

HMAC6	LDX #$FF
	STX ICOLP
HMAC7	JSR NEXTCH      ;LOOK FOR .MND AND .MAC
	BCC HMAC5       ;END OF CARD
	CMP #'.'        ;DECIMAL POINT
	BEQ HMAC9
HMAC8	JSR PUTBMP
	JMP HMAC7

HMAC9	LDA MCTBPT
	STA MAYBE
	LDA MCTBPT+1
	STA MAYBE+1     ;SAVE WHERE .MND MIGHT START
	JSR PUTBMP
	LDY #0          ;GET NEXT THREE CHARACTERS
HMAC10	JSR NEXTCH
	BCC HMAC5
	STA HOLDA
	JSR PUTBMP
	LDA HOLDA
	CMP MND,Y       ;COMPARE TO "MND"
	BEQ HMAC14

;.....HERE IF WE SAW A ".".......

	CPY #1          ;SAW ".M"
	BNE HMAC5
	CMP #'A'
	BNE HMAC7
	JSR NEXTCH      ;LOOK FOR FINAL "C"
	BCC HMAC5
	CMP #'C'
	BNE HMAC8
	LDA NEWMAC      ;ERROR--RESTORE MACRO POINTER
	STA MCTBPT
	LDA NEWMAC+1
	STA MCTBPT+1
	LDA #$26        ;.MAC WITHIN .MAC
	JMP FIXERR

HMAC14	INY
	CPY #$03
	BNE HMAC10

;.....WHEN YOU GET HERE YOU FOUND .MND.......

	LDA PASS
	BNE HMAC15      ;NO POINTER UPDATE ON PASS 2
	LDA MAYBE
	STA MCTBPT      ;RESTORE POINTER
	LDA MAYBE+1
	STA MCTBPT+1
	LDA #$0D        ;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
HMAC15	JSR PAS2PR
	JMP ENDLN       ;NORMAL EXIT

HMND	LDA #$27        ;.MND UNMATCHED
	JMP FIXERR

NEXTCH	LDX ICOLP
	INX
	STX ICOLP
	LDA IMAXCL
	CMP ICOLP
	BCS MNEXT1
	CLC
	RTS

MNEXT1	LDA ICRD,X
	SEC
	RTS

ISMAC	LDA #<MACTAB
	STA T0
	LDA #>MACTAB
	STA T0+1        ;POINT TO MACRO TABLE
ISM1	SEC             ;WHILE T0 < MACTBND DO
	LDA T0
	SBC MCTBPT
	LDA T0+1
	SBC MCTBPT+1
	BCC ISM2
	CLC             ;REPORT NOT IN TABLE
	RTS

ISM2	LDY #5          ;BEGIN  
ISM3	LDA (T0),Y      ;       IF NAME(ISYM) = NAME(T0) THEN
	CMP ISYM,Y
	BNE ISM4
	DEY
	BPL ISM3
	SEC             ;       RETURN WITH CARRY SET
	RTS

ISM4	LDY #6          ;       ELSE T0 := NEXT(T0)
	LDA (T0),Y      ;END
	TAX
	INY
	LDA (T0),Y
	STA T0+1
	STX T0
	JMP ISM1

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 NONBLAN
	BCS GETS2       ;FOUND SOMETHING
GETS1	SEC
	RTS             ;NORMAL EXIT - EMPTY CARD

GETS2	LDX ICOLP       ;POINT TO IT
	LDY #$00        ;SYMBOL LENGTH COUNT
	LDA ICRD,X      ;GET FIRST CHARACTER
	CMP #';'    ;IS IT A COMMENT?
	BEQ GETS1       ;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

GETS4	JSR NALPH       ;IS IT ALPHA?
	BCS GETS3       ;YES
	JSR NUMRC       ;IS IT A NUMBER?
	BCC GETS3A      ;NO
GETS3	STA ISYM,Y      ;BUILD THE SYMBOL
	INX
	INY
	LDA ICRD,X
	CPX IMAXCL
	BEQ GETS4
	BCC GETS4
GETS3A	CPY #00         ;SYMBOL FOUND?
	BEQ GETS1       ;REPORT NO SYMBOL
	CPY #$07        ;IS SYMBOL TOO LONG?
	BCC GETS4A      ;NO
	LDA #$9         ;SYMBOL TOO LONG
	JMP FIXERR

GETS4A	LDA #' '        ; FILL REMAINDER WITH BLANKS
	STY ICSL        ;SET THE SYMBOL LENGTH
GETS5	CPY #$06
	BCS GETS6
	STA ISYM,Y
	INY
	BNE GETS5       ;BRANCH ALWAYS

GETS6	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
MACP0	STA (T0),Y
	DEY
	BPL MACP0
	STA PRMCNT
MACP1	JSR NFNDNB      ;FIND NEXT NONBLANK
	BCC MACP9       ;NO MORE SO EXIT
	LDA MCSTPT
	STA TMPMAC
	LDA MCSTPT+1
	STA TMPMAC+1
MACP2	JSR ISMORE      ;ANY MORE?
	BCC MACP9       ;NO MORE SO EXIT
	CMP #','        ;IS IT A COMMA?
	BEQ MACP3
	JSR PUSH
	JMP MACP2

MACP3	JSR MOVPRM
	JMP MACP2
MACP9	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 #$00        ;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
	CPX IMAXCL      ;OFF END OF CARD?
	BEQ ISC1        ;NO
	BCS ISC3        ;YES
ISC1	LDA ICRD,X      ;GET THE CHARACTER
	CMP #' '        ;IS IT A BLANK?
	BEQ ISC3        ;YES
	CMP #';'    ;A COMMENT BEGINNING?
	BEQ ISC3        ;YES
	INC ICOLP       ;ADVANCE POINTER OVER COMMA
	SEC
	RTS

ISC3	CLC             ;REPORT NOTHING FOUND
	RTS

PAS2PR	PHA
	TXA
	PHA
	TYA
	PHA
	LDA PASS
	BEQ PAS2P1
	LDA #00
	TAX
	TAY
	JSR LTINS
	LDA #$00
	STA LCDPT       ;ENABLE MULTIPLE LINE PRINT
PAS2P1	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 MOVPR0      ;YES
	LDA MCSTPT+1
	CMP TMPMAC+1
	BEQ MOVPRX      ;EQUAL SO EXIT
MOVPR0	LDA #$00
	JSR PUSH        ;TRAILING 0 FOR PARAM
	LDA PRMCNT
	CMP #9
	BCC MOVPR1      ;OK IF FEWER THAN 9 SO FAR
	LDA #$29        ;TOO MANY PARAMS
	JMP FIXSTK
MOVPR1	LDA PRMCNT
	CLC
	ADC #$01        ;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
MOVPRX	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 PRM2        ;CANNOT BE NEGATIVE
PRM1	LDA #$13        ;CAN'T EVALUATE EXPRESSION
	JMP FIXSTK

PRM2	CMP #9          ;CHECK UPPER BOUND
	BCS PRM1
	ASL A           ;DOUBLE IT
	CLC
	ADC #$08        ;OFFSET
	CLC
	ADC MACENT
	STA T0
	LDA MACENT+1
	ADC #$00
	STA T0+1
	RTS

.END