mirror of
https://github.com/A2osX/A2osX.git
synced 2024-11-24 14:31:05 +00:00
9a7d20a7e1
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
462 lines
11 KiB
Plaintext
462 lines
11 KiB
Plaintext
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
|