A2osX/SCMASM.31/SCMASM.S.DIR1.txt
burniouf 9a7d20a7e1 ProDOS 203 / FX:TC mod for year 2022-2026
FORMAT: new switches & checks
SH:BREAK in FOR and WHILE
ASM / S-C MASM: new directives, CString support and .HX
LC / UC:bugfix
DHGR.DRV:bugfix
LIBGUI:wip
CC:wip
2022-12-07 08:02:29 +01:00

462 lines
11 KiB
Plaintext
Raw 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
*--------------------------------------
* DIRECTIVES
*--------------------------------
* .DUMMY -- START DUMMY SECTION
*--------------------------------
D.DUMMY
LDA DUMMY.FLAG DO NOTHING IF ALREADY IN DUMMY
BMI .2
LDX #3
.1 LDA ORGN,X
STA DUMMY.ORGN,X
DEX
BPL .1
STX DUMMY.FLAG SET FLAG NEGATIVE
.2 RTS
*--------------------------------
* .ED -- END DUMMY SECTION
*--------------------------------
D.END.DUMMY
LDA DUMMY.FLAG
BPL .2 DO NOTHING IF NOT IN .DUMMY
LDX #3
STX DUMMY.FLAG SET FLAG POSITIVE
.1 LDA DUMMY.ORGN,X
STA ORGN,X
DEX
BPL .1
.2 RTS RETURN TO MAIN LEVEL OF ASM
*---------------------------------
* .PH -- START PHASE
*--------------------------------
D.PHASE
JSR D.END.PHASE
JSR EXPR.DEFINED GET PHASE ORIGIN
LDX #3
.1 LDA ORGN,X SAVE ORIGIN
STA ORIGIN.SAVE,X
LDA EXP.VALUE,X
STA ORGN,X SET PHASE ORIGIN
DEX
BPL .1
SEC SET FLAG TO $80
ROR PHASE.FLAG
RTS RETURN TO MAIN LEVEL OF ASM
*--------------------------------
* .EP -- END PHASE
*--------------------------------
D.END.PHASE
ASL PHASE.FLAG TEST AND CLEAR FLAG
BCC .2 IT WAS ALREADY CLEAR
LDX #3
.1 LDA ORIGIN.SAVE,X
STA ORGN,X
DEX
BPL .1
.2 RTS
*---------------------------------
* .OR -- SET ORIGIN
*---------------------------------
PSOR JSR EXPR.DEFINED GET ORIGIN VALUE
LDX #3
.1 LDA EXP.VALUE,X STORE IT IN
STA ORGN,X LOCATION
DEX COUNTER
BPL .1
LDA DUMMY.FLAG IF IN DUMMY SECTION, DON'T
BMI RTS.1 ...IN DUMMY
NEW.TARGET
JSR TFEND END .TF IF DOING ONE
LDA EXP.VALUE STORE VALUE IN
STA TRGT TARGET ADDRESS
LDA EXP.VALUE+1
STA TRGT+1
RTS.1 RTS
*---------------------------------
* .TA -- SET TARGET ADDRESS
*---------------------------------
PSTA JSR EXPR.DEFINED GET EXPR VALUE
LDA EXP.VALUE+2
ORA EXP.VALUE+3
BEQ NEW.TARGET
JMP RAER
*--------------------------------------
DIR1.PS jsr GNNB
bcs .9
sta DLIM SAVE DELIMITER
ldx #$ff
ldy CHAR.PNTR
.1 inx
lda WBUF,Y
and #$7F
beq .9
iny
cmp DLIM
bne .1
txa
jsr EMIT
.2 jsr GNC
jsr EMIT
dex
bne .2
clc
rts
.9 jmp ERBA2
*--------------------------------------
DIR1.EscChars .AS "abefnrtv"
.HS 5C27223F25 \'"?%
DIR1.EscChars.L .EQ *-DIR1.EscChars
DIR1.EscCodes .HS 07081B0C0A0D090B
.HS 5C27223F25
*--------------------------------------
DIR1.CZ jsr DIR1.CS
jmp EMIT.ZERO
DIR1.CS lda #0
sec
jmp DIR1.String
*--------------------------------------
* .AT -- ASCII STRING WITH LAST BYTE FLAGGED
* .AS -- ASCII STRING WITH ALL BYTES SAME
* .AZ -- Same as .AS, but with 00 terminator byte.
*--------------------------------------
PSAZ jsr PSAS
jmp EMIT.ZERO
PSAT lda #$80 LAST BYTE HAS OPPOSITE BIT 7
.HS 2C ...SKIP OVER 2 BYTES
PSAS lda #0 ALL BYTES GET SAME BIT 7
clc
DIR1.String sta AT.HIBIT
ror BYTE C String Flag
jsr GNNB Scan to next non-blank
bcs .9 END OF LINE
dec CHAR.PNTR BACK UP
.1 jsr TRY.HEX.STRING
beq .5 ...END OF LINE
ldy #0
sty AS.HIBIT ...assume hibit is 0
cmp #'-' 1ST NON-BLANK A MINUS?
bne .15 ...no, hibit is 0
ror AS.HIBIT ...yes, hibit is 1
jsr GNC.UC
.15 sta DLIM SAVE DELIMITER
jsr GNC.UC GET NEXT CHAR
bcs .9 END OF LINE IS BAD NEWS
cmp DLIM CHK IF DELIMITER
beq .4 YES, NO STRING IN BETWEEN
.2 jsr GNC.UC GET NEXT CHAR
bcs .9 END OF LINE IS BAD NEWS
cmp DLIM CHK IF DELIMITER
beq .3 YES, FINISH UP AND RETURN
lda WBUF-2,Y ...NO, GET PREVIOUS CHAR
bit BYTE
bpl .27
cmp #'\' "\?" ?
bne .27
jsr GNC.UC GET NEXT CHAR
bcs .9 END OF LINE IS BAD NEWS
lda WBUF-2,Y get "?"
ldx #DIR1.EscChars.L-1
.20 cmp DIR1.EscChars,x
beq .21
dex
bpl .20
bmi .9
.21 lda DIR1.EscCodes,x
ldx WBUF-1,Y
cpx DLIM
beq .30
.27 ora AS.HIBIT MERGE WITH TOP BIT
jsr EMIT
jmp .2 GO FOR ANOTHER ONE
.3 lda WBUF-2,Y GET PREVIOUS CHAR
.30 ora AS.HIBIT MERGE WITH SELECTED BIT 7
eor AT.HIBIT TOGGLE BIT 7 IF IN .AT
jsr EMIT EMIT THE BYTE
.4 jsr GNC CHECK IF MORE IN LIST
beq .5
cmp #','
beq .1
.5 rts
.9 jmp ERBA2
*---------------------------------
* .HX -- HEX DIGIT STRING
*---------------------------------
PSHX jsr GNNB GET NEXT NON-BLANK CHAR
bcs ERBA2 END OF LINE
jsr BACKUP.CHAR.PNTR
.1 jsr PSHX.GetNibble
bcs .8
.2 sta SYM.VALUE
jsr PSHX.GetNibble
bcs .7
asl
asl
asl
asl
ora SYM.VALUE
jsr EMIT
jsr PSHX.GetNibble
bcc .2
clc
rts
.7 lda SYM.VALUE
jsr EMIT
.8 rts
*---------------------------------
PSHX.GetNibble
.1 jsr GNC.UC IGNORE CASE
beq .9
cmp #'.' ALLOW PERIODS
beq .1 ...BUT IGNORE THEM
eor #$30
cmp #$0A
bcc .3 ...0-9, TEXT VALIDITY
adc #$88 ...MIGHT BE A...F
.2 cmp #$FA
bcc .3 NOT A-F EITHER, RETURN CARRY CLEAR
and #$0F TRIM HEX A...F
.3 clc
rts
.9 sec
rts
*---------------------------------
* .HS -- HEX STRING
*---------------------------------
PSHS jsr GNNB GET NEXT NON-BLANK CHAR
bcs ERBA2 END OF LINE
jsr BACKUP.CHAR.PNTR
jsr TRY.HEX.STRING
bne ERBA2 ...ERROR, BAD ADDRESS
rts
*--------------------------------
THX1 jsr HEX.DIGIT GET NEXT HEX DIGIT
bcc ERBA2 ERROR, ODD DIGITS
lda SYM.VALUE GET CONVERTED VALUE
jsr EMIT
*--------------------------------
TRY.HEX.STRING jsr HEX.DIGIT
bcs THX1
lda CURRENT.CHAR
beq .2 ...END OF LINE
cmp #',' IF COMMA, GO GET MORE BYTES
beq TRY.HEX.STRING ...OKAY
cmp #' ' IF BLANK, VALID END OF STRING
.2 rts
*--------------------------------
ERBA2 jmp ERBA ERROR: BAD ADDRESS
GT255ERR ldy #QER8 VALUE > 255 ERROR
.HS 2C LONG "BIT" TO SKIP NEXT TWO BYTES
NOLBLERR ldy #QER1 "NO LABEL"
.HS 2C LONG "BIT" TO SKIP NEXT TWO BYTES
UNDF ldy #QER6 "UNDEF"
jmp SOFT.ERROR
*---------------------------------
* .EQ -- EQUATE
*---------------------------------
PSEQ LDY WBUF SEE IF ANY LABEL
CPY #$20
BEQ NOLBLERR NO LABEL ON LINE
LDA STPNTR SAVE STPNTR WHILE CALLING EXPR
PHA
LDA STPNTR+1
PHA
JSR EXPR.DEFINED GET VALUE
PLA RESTORE STPNTR
STA STPNTR+1
PLA
STA STPNTR
LDA PASS WHICH PASS
BNE .5 PASS 2, PRINT VALUE
*---PASS 1: DEFINE VALUE--------
LDY WBUF COLUMN 1 AGAIN
CPY #': PRIVATE LABEL?
BCC .4 ...LOCAL LABEL
BEQ .2 ...PRIVATE LABEL
*---NORMAL LABEL-----------------
LDY #2
.1 LDA EXP.VALUE-2,Y REDEFINE SYMBOL
>SYM STA,PNTR
INY
CPY #6
BCC .1
RTS
*---PRIVATE LABEL----------------
.2 LDY #0
.3 LDA EXP.VALUE,Y
>SYM STA,STPNTR
INY
CPY #4
BCC .3
RTS
*---LOCAL LABEL------------------
.4 LDY #2 COMPUTE LOCAL OFFSET
SEC
LDA EXP.VALUE
>SYM SBC,STPNTR
DEY
>SYM STA,PNTR
LDY #3
LDA EXP.VALUE+1
>SYM SBC,STPNTR
BNE GT255ERR VALUE > 255
RTS RETURN TO MAIN LEVEL OF ASM
*---PASS 2: PRINT VALUE---------
.5 JMP P.EXP.VALUE.DASH
*---------------------------------
* .DA -- DATA VALUE (8- OR 16-BITS)
*---------------------------------
PSDA LDA #0 UNDEF FLAG FOR LINE
PHA
.1 JSR GNNB GET NEXT NON-BLANK CHAR
BCS ERBA2 END OF LINE
STA DLIM
*---Could be $$dstringd----------
CMP #'$' $$dstringd value?
BNE .2 ...NO
LDA WBUF,Y Look for second $
CMP #'$'
BNE .25 ...NO, MUST BE SIMPLE HEX WORD
JSR GNC SKIP OVER SECOND '$'
JSR PSAS GET dstringd
JMP .5
*---Look for size char-----------
.2 LDY #1 ASSUME 1-BYTE DATA
CMP #'#'
BEQ .3
CMP #'/'
BEQ .3
LDY #3 ASSUME 3-BYTE DATA
CMP #'<' 24-BIT SIGNAL
BEQ .3 ...3-BYTE DATA
INY ASSUME 4-BYTE DATA
CMP #'>' 32-BIT SIGNAL
BEQ .3
*---Size is two bytes------------
.25 JSR BACKUP.CHAR.PNTR
LDY #2 2-BYTE DATA
*---Get expression, emit value---
.3 STY ADDR.LENGTH
JSR EXPR CRACK EXPRESSION
LDY DLIM If preceded by /, shift over
CPY #'/'
BNE .4 ...NOT /
JSR EXP.OVER.256
.4 JSR EMIT.VALUE ACCORDING TO ADDR.LENGTH
*---Update UNDEF flag------------
PLA .DA'S UNDEF FLAG
ORA EXP.UNDEF
PHA
*---Next item in list------------
.5 JSR GNC.UC LOOK FOR ANOTHER ITEM
CMP #', COMMA?
BEQ .1 YES, GET ANOTHER ONE
PLA GET .DA'S UNDEF FLAG
STA EXP.UNDEF MERGED VALUE
RTS LIST LINE OR REPORT UNDEF ERROR
*--------------------------------
* DO/ELSE/FIN
*--------------------------------
PSDO JSR EXPR.DEFINED GET VALUE
LDX DO.INDEX 0 IF EMPTY, ELSE 1-63
INX
CPX #64
BCC .2
LDY #QERDO2 ".DO NEST TOO DEEP"
JMP SOFT.ERROR
.2 LDA EXP.VALUE
ORA EXP.VALUE+1 TEST FOR ZERO
ORA EXP.VALUE+2
ORA EXP.VALUE+3
BEQ .3 ZERO, FALSE
SEC NONZERO, TRUE
.3 STX DO.INDEX
LDX #-8
.4 ROR DO.STACK+8,X
INX
BNE .4
RTS LIST THE LINE
*--------------------------------
PSEL LDX DO.INDEX
BEQ ERR.DO ERROR, NOT BTWN .DO AND .FIN
LDA DO.STACK
EOR #$80 TOGGLE CURRENT LOGIC LEVEL
STA DO.STACK
RTS RETURN TO MAIN LEVEL OF ASM
*--------------------------------
ERR.DO LDY #QERDO "MISSING .DO"
JMP SOFT.ERROR
*--------------------------------
PSFI LDX DO.INDEX
BEQ ERR.DO ERROR, NOT AFTER .DO
DEC DO.INDEX POP THIS DO
LDX #7
.1 ROL DO.STACK,X
DEX
BPL .1
RTS RETURN TO MAIN LEVEL OF ASM
*--------------------------------------
MAN
SAVE usr/src/scmasm.31/scmasm.s.dir1
LOAD usr/src/scmasm.31/scmasm.s
ASM