Apple-2-SW
/
A2osX
mirror of https://github.com/A2osX/A2osX.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity
A2osX/SCMASM.31/SCMASM.S.MACRO.txt

371 lines
10 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

NEW
AUTO 3,1
*--------------------------------------
* .MA DIRECTIVE
*--------------------------------
PSMA LDA PASS WHICH PASS?
BNE .2 PASS 2, SO SET FLAG AND IGNORE
LDA #'Z+1 RIGHT BRACKET CODE
STA SYMBOL+7
LDA #0 CLEAR VALUE BYTES
LDX #3
.1 STA SYMBOL+2,X
DEX
BPL .1
JSR GNNB GET FIRST CHAR OF MACRO NAME
LDX #1
JSR PACK.NAME
CPX #2 NEED AT LEAST TWO CHARS, COUNTING BRACKET
BCC .3 NO MACRO NAME
STX SYMBOL+6 LENGTH
JSR STSRCH
BCC .4 DOUBLE DEFN
JSR STADD ENTER INTO SYMBOL TABLE
.2 SEC SET "INSIDE MACRO DEFINITION" FLAG
ROR FLAG.MA
RTS RETURN TO MAIN LEVEL OF ASM
.3 LDY #QNONAM NO MACRO NAME
.HS 2C SKIP NEXT TWO BYTES
.4 LDY #QER4 EXTRA DEF'N
JMP FIRM.ERROR
*--------------------------------
* PACK MACRO LINE
*--------------------------------
PACK.MACRO.LINE
JSR SCAN.TO.OPCODE
LDX FLAG.MA IN A MACRO DEF'N?
BPL D.SET ...NO, TRY .SE DIRECTIVE
LDX PASS WHICH PASS?
BNE .10 PASS 2
*---PASS 1-----------------------
BCS .4 ...OPCODE IS NOT A DIRECTIVE
LDX #DIR.QT.MA
JSR DIR.SCAN.OR.FAIL
BCC .2 NOT .MA
.1 LDY #QER2 "BAD OPCODE"
JMP SOFT.ERROR
.2 JSR DIR.SCAN.OR.FAIL
BCC .3 NOT .EM
LDA #0 TERMINATE THE SKELETON
STA CURRENT.MAJOR.LABEL+1 KILL POSSIBILITY OF LOCAL LABELS
* UNTIL ANOTHER MAJOR LABEL
JSR ADD.CHAR.TO.SKELETON
.11 LSR FLAG.MA
.12 SEC
RTS
*--------------------------------
.3 JSR DIR.SCAN.OR.FAIL SEE IF .IN
BCS .1 YES, SO ILLEGAL!
* FALL INTO ACCEPTABLE LINE CODE
*--------------------------------
.4 LDY #0 BACK TO BEGINNING OF LINE
BEQ .5 ...ALWAYS
.55 LDX #$80 COMPRESSED BLANK TOKEN
.6 INX COUNT THE BLANK
CPX #$BF MAX BLANK COUNT?
BCS .7 YES, OUTPUT TOKEN NOW
JSR GNC2 GET NEXT CHARACTER
BCS .7 END OF LINE
BEQ .6 BLANK, SO COMPRESS IT
DEY NON-BLANK, SO BACK UP PNTR
.7 TXA COMPRESSED BLANK TOKEN
.8 JSR ADD.CHAR.TO.SKELETON
.5 JSR GNC2 GET NEXT CHARACTER
BCS .9 END OF LINE
BEQ .55 ...it is a blank
CMP #']' MACRO PARAMETER?
BNE .8 ...NO
TAX save ']' in X
JSR GNC2 GET PARAMETER CODE
BCS .7 ...eol, add ']' and end
CMP #']'
BEQ .8 ...two makes one
CMP #'#'
BEQ .81 ...]# is valid parameter
CMP #'9'+1 HOW ABOUT 1...9
BCS .82 ...not a parameter
CMP #'1'
BCC .82 ...not a parameter
.81 LDX #$7F valid parameter
.82 DEY back up char pntr
JMP .7 go add $7F or ']'
*--------------------------------
.9 LDA #0 TERMINATE THE LINE
JSR ADD.CHAR.TO.SKELETON
SEC
RTS
*---PASS 2-----------------------
* IF NOT ".EM", JUST LIST THE LINE
.10 BCS .12 ...OPCODE IS NOT A DIRECTIVE
LDX #DIR.QT.EM
JSR DIR.SCAN.OR.FAIL
BCC .12 NOT .EM
BCS .11 ...ALWAYS
*--------------------------------
* .SET DIRECTIVE
*--------------------------------
D.SET
BCS .1 NOT A DIRECTIVE
LDX #DIR.QT.SE
JSR DIR.SCAN.OR.FAIL
BCS .2 FOUND .SE
.1 CLC
RTS
.2 JSR EXPR.DEFINED GET VALUE
JSR GNC.UC.START CHECK FOR VALID LABEL
BEQ .6 ...NO LABEL ERROR
JSR CHECK.LETTER MUST BE NORMAL LABEL
BCC .7 ...DOES NOT START WITH A-Z
JSR PACK
BCC .7 ...BAD SYMBOL
JSR STSRCH
BCC .3 ...IN TABLE ALREADY
LDA SYMBOL+7
ORA #$80
STA SYMBOL+7 SET THE .SE FLAG
JSR STADD
JMP .4
.3 LDY #7 CK .SE FLAG
>SYM LDA,TPTR
BPL .9 DOUBLE DEF IF NOT SET!
LDA TPTR USE SAME PTR AS STADD
STA PNTR
LDA TPTR+1
STA PNTR+1
LDA PASS HANDLE FORWARD REFERENCES
BEQ .5 ...IN PASS ONE
DEY POINT AT FLAGS
>SYM LDA,PNTR
ORA #$40
>SYM STA,PNTR
.4 JSR P.EXP.VALUE.DASH (IF LISTING)
.5 LDY #2 PUT VALUE IN SYMBOL TABLE
.8 LDA EXP.VALUE-2,Y
>SYM STA,PNTR
INY
CPY #6
BCC .8
RTS RETURN TO ASM WITH .CS.
.6 JMP NOLBLERR
.7 JMP ERR.BS
.9 JMP ERR.DBLDF
*--------------------------------
* ADD CHARACTER TO SKELETON
*--------------------------------
ADD.CHAR.TO.SKELETON
PHA SAVE CHAR
.DO AUXMEM
LDA EOT+1
CMP /$C000
BCC .1
JMP MFER MEM FULL ERROR
.1 STA WRAUX
LDX #0
PLA
STA (EOT,X)
STA WRMAIN
.ELSE
LDA EOT
CMP PP
LDA EOT+1
SBC PP+1
BCC .1 ROOM
JMP MFER MEM FULL ERROR
.1 LDX #0
PLA
STA (EOT,X)
.FIN
>INCD EOT
RTS
*--------------------------------
* SCAN TO OPCODE
*--------------------------------
SCAN.TO.OPCODE
JSR GNC.START GET FIRST CHAR
BEQ .2 ...BLANK OR END
JSR CHECK.COMMENT.CHAR
BEQ .3 ...YES, IT IS A COMMENT
.1 JSR GNC SCAN TO A BLANK
BNE .1 ...NOT BLANK YET
.2 JSR GNNB SCAN TO NON-BLANK
BCS .3 ...END OF LINE
CMP #'.' DIRECTIVE?
BNE .3 ...NO
JSR GNC.UC GET NEXT BYTE
CLC SIGNAL IT IS A DIRECTIVE
RTS
.3 SEC SIGNAL IT IS NOT A DIRECTIVE
RTS
*--------------------------------
* PROCESS MACRO CALL
*--------------------------------
MACER1 LDY #QNONAM
.HS 2C
MACER2 LDY #QERR.MACRO
JMP SOFT.ERROR
*--------------------------------
MACRO.CALL
LDA #'Z+1 MACRO KEY IN SYMBOL TABLE
STA SYMBOL+7
LDX #1
JSR GNC.UC GET FIRST CHAR OF MACRO NAME
JSR PACK.NAME
CPX #2
BCC MACER1 ERROR, NO NAME
STX SYMBOL+6 LENGTH OF NAME
JSR STSRCH
BCS MACER2 ERROR, NO SUCH MACRO
JSR P.ORIGIN
JSR LIST.SOURCE.IF.LISTING
JSR GNNB SCAN TO PARAMETER LIST
JSR BACKUP.CHAR.PNTR
LDA MACSTK+1 SAVE PNTR FOR LATER
PHA
LDA MACSTK
PHA
LDX #0 PROCESS PARAMETER LIST
LDA #9 FIND 9 PARAMETERS
STA PARAM.CNT
.1 JSR GET.ONE.PARAMETER
DEC PARAM.CNT
BNE .1
.2 LDA WBUF-1,X
JSR PUSH.MACSTK
DEX
BNE .2
PLA PUT OLD MACSTK PNTR ON MACRO STACK
JSR PUSH.MACSTK (LOW BYTE)
PLA
JSR PUSH.MACSTK (HIGH BYTE)
LDA SRCP
JSR PUSH.MACSTK
LDA SRCP+1
JSR PUSH.MACSTK
LDA LF.ALL save current list option
JSR PUSH.MACSTK
LDA CALL.NUM STACK CURRENT CALL #
JSR PUSH.MACSTK
LDA CALL.NUM+1
JSR PUSH.MACSTK
CLC COMPUTE ADDRESS OF SKELETON
LDA #7
LDY #6 POINT AT LENGTH OF MACRO NAME
>SYM ADC,STPNTR NAME LENGTH+7
ADC STPNTR
STA SRCP
LDA STPNTR+1
ADC #0
STA SRCP+1
LDA LF.MACRO
ORA LF.ALL DON'T LIST EXPANSION IF NOT LISTING
STA LF.ALL
INC MACRO.LEVEL
>INCD CALL.CNTR COUNT THIS MACRO CALL
LDA CALL.CNTR
STA CALL.NUM
LDA CALL.CNTR+1
STA CALL.NUM+1
JMP ASM2
*--------------------------------
* PUSH A BYTE ON MACSTK
*--------------------------------
PUSH.MACSTK
PHA SAVE BYTE TO BE PUSHED
.DO AUXMEM
LDA MACSTK+1
CMP /$0800
BCS .1
.ELSE
LDA EOT
CMP MACSTK
LDA EOT+1
SBC MACSTK+1
BCC .1 STILL ROOM
.FIN
JMP MFER NO ROOM
.1 LDA MACSTK
BNE .2
DEC MACSTK+1
.2 DEC MACSTK
PLA BYTE TO BE PUSHED
LDY #0
STA (MACSTK),Y
RTS
*--------------------------------
* GET ONE PARAMETER FROM MACRO CALL LINE
*--------------------------------
GET.ONE.PARAMETER
JSR GNC
BEQ .2 SPACE OR EOL, NO MORE PARAMETERS
CMP #', COMMA
BEQ .3 NULL PARAMETER
CMP #'" QUOTE
BEQ .4 QUOTED PARAMETER
.1 STA WBUF,X NORMAL PARAMETER
INX
JSR GNC
BEQ .2 END OF PARAMETER
CMP #', COMMA
BNE .1 MORE TO PARAMETER
BEQ .3 END OF PARAMETER
.2 JSR BACKUP.CHAR.PNTR
.3 LDA #0
STA WBUF,X
INX
RTS
.4 JSR GNC QUOTED PARAMETER
BCS .3 END OF LINE
CMP #'"
BEQ .5 END OF QUOTED PARAMETER
.6 STA WBUF,X
INX
BNE .4 ...ALWAYS
.5 JSR GNC
BEQ .2 END OF PARAMETER LIST
CMP #', COMMA
BEQ .3
BNE .6 ...ALWAYS
*--------------------------------
* DIRECTIVE SCAN OR FAIL
* COMPARE NEXT TWO CHARS WITH TABLE ENTRY
* ENTER: FIRST CHAR SET UP BY GNC.UC
* (X)=OFFSET OF TWO-BYTE ENTRY IN DIR.QTS
*--------------------------------
DIR.SCAN.OR.FAIL
CMP DIR.QTS,X
BNE .1 FAIL
LDY CHAR.PNTR
LDA WBUF,Y NEXT CHAR
AND #$DF MAP LOWER CASE TO UPPER CASE
CMP DIR.QTS+1,X
BNE .1 FAIL
JSR GNC.UC SCAN OVER SECOND CHAR
SEC SIGNAL SUCCESS
RTS
.1 CLC SIGNAL FAILURE
LDA CURRENT.CHAR RESTORE (A)
INX ADVANCE TO NEXT QUOTE
INX
RTS
*--------------------------------
DIR.QTS
DIR.QT.DO .EQ *-DIR.QTS
.AS /DO/
DIR.QT.EL .EQ *-DIR.QTS
.AS /EL/
DIR.QT.FI .EQ *-DIR.QTS
.AS /FI/
DIR.QT.MA .EQ *-DIR.QTS
.AS /MA/
DIR.QT.EM .EQ *-DIR.QTS
.AS /EM/
DIR.QT.IN .EQ *-DIR.QTS
.AS /IN/
DIR.QT.SE .EQ *-DIR.QTS
.AS /SE/
*--------------------------------------
MAN
SAVE usr/src/scmasm.31/scmasm.s.macro
LOAD usr/src/scmasm.31/scmasm.s
ASM
Reference in New Issue View Git Blame Copy Permalink