Apple-2-SW/A2osX
1
0
Fork 0
mirror of https://github.com/A2osX/A2osX.git synced 2024-11-22 16:31:07 +00:00
Code Issues Projects Releases Wiki Activity
a246b0d691
A2osX/SCMASM.30/SCMASM.S.EXP.txt

415 lines
11 KiB
Plaintext
Raw Normal View History

SCMASM.SYSTEM 3.0 & BASIC.SYSTEM 1.5 source code......many bugfxes & enh, new commands.....
2022-03-06 22:28:52 +00:00
NEW
AUTO 3,1
*--------------------------------------
* EXPRESSION CRACKER
*-------------------------------
EXPR.DEFINED
JSR EXPR
BMI .1
RTS
.1 JMP UNDF
*--------------------------------
OPERATOR.CHARS
.AS "^!|&<=>/*)], "
OPERATOR.CHARS.SIZE .EQ *-OPERATOR.CHARS
*--------------------------------
OPERATOR.INDEX
.HS 0C.0A.0A.08.0E.10.12.06.04.FF.FF.FF.FF
* ^ ! | & < = > / * ) ] , SPC
*--------------------------------
OPERATOR.TABLE
.DA EXP.SUBTRACT-1 0 FOR -<=>
.DA EXP.ADD-1 2 FOR +
.DA EXP.MULTIPLY-1 4 FOR *
.DA EXP.DIVIDE-1 6 FOR /
.DA EXP.AND-1 8 FOR &
.DA EXP.ORA-1 A FOR !|
.DA EXP.EOR-1 C FOR ^
.DA EXP.LESS-1 E FOR <
.DA EXP.EQUAL-1 10 FOR =
.DA EXP.GREATER-1 12 FOR >
*--------------------------------
ERBA3 JMP ERBA
*--------------------------------
EXPR JSR GNNB GET NEXT NON-BLANK
BCS ERBA3 NO EXPRESSION ON LINE
JSR BACKUP.CHAR.PNTR
*--------------------------------
EXP1 JSR ZERO.EXP.VALUE
STA EXP.NEW NEW EXPRESSION FLAG = 0
STA EXP.UNDEF ZERO UNDEF FLAG
LDX #$40 INIT FWD REF FLAG
STX EXP.FWDREF
*--------------------------------
EXP2 LDX #0 SET OPERATOR=0 FOR +
JSR GNC.UC
BCS .3 END OF LINE
CMP #'- MINUS
BEQ .6 X=0 FOR MINUS OR RELOPS
LDX #2 X=2 FOR ADDITION
CMP #'+ ADD
BEQ .6
LDY EXP.NEW NOT + OR -
BEQ .7 BUT IT IS NEW EXPR
LDX #OPERATOR.CHARS.SIZE-1
.1 LDA OPERATOR.CHARS,X
CMP CURRENT.CHAR
BEQ .2
DEX
BPL .1
JMP ERBA
*---FOUND OP OR TERM CHAR--------
.2 LDA OPERATOR.INDEX,X
BPL .5 ...OPERATOR
*---END OF EXPRESSION-----------
JSR BACKUP.CHAR.PNTR
.3 LDY EXP.UNDEF UNDEF FLAG
BPL .4
JSR ZERO.EXP.VALUE
TYA RECOVER UNDEF STATUS
.4 RTS
*--------------------------------
.5 TAX
.6 JSR GNC.UC
.7 INC EXP.NEW NOT A NEW EXPRESSION ANYMORE
LDA OPERATOR.TABLE+1,X
PHA
LDA OPERATOR.TABLE,X
PHA
*-------------------------------
* GET OPERAND
*-------------------------------
GET.OPERAND
JSR ZERO.SYM.VALUE
LDA CURRENT.CHAR
CMP #$30 FIRST CHAR OF OPERAND
BCC .3 PUNCTUATION
CMP #$3A
BCS .2 MIGHT BE LETTER, TRY LABEL
JSR DECN CONVERT DECIMAL NUMBER
.15 JMP BACKUP.CHAR.PNTR
*---TRY A LABEL------------------
.2 JSR PACK TRY LABEL
BCC .4 NO GOOD
JSR STSRCH LOOK UP THE VALUE
LDY #6 UPDATE FWD REF FLAG
>SYM LDA,STPNTR
AND EXP.FWDREF
STA EXP.FWDREF
BCC .1 DEFINED LABEL
ROR EXP.UNDEF UNDEFINED, MAKE FLAG NEGATIVE
.1 RTS
*---TRY LOCAL LABEL--------------
.3 CMP #'.
BEQ .2 LOCAL LABEL
*---TRY CONSTANTS----------------
LDX #3 3-->HEX CONSTANT
CMP #'$
BEQ .5 HEX CONSTANT
DEX 2-->OCT CONSTANT
CMP #'&'
BEQ .5 ...OCTAL
LDX #0 0-->BIN CONSTANT
CMP #'% BINARY CONSTANT
BEQ .5 ...BINARY
*---TRY LITERALS-----------------
CMP #'' (X = 0)
BEQ .6 LITERAL
CMP #'" LITERAL WITH HIGH BIT SET
BEQ .9
*---TRY STAR---------------------
CMP #'*
BNE .4 ...NONE OF THE ABOVE, ERROR
LDX #3 VALUE IS CURRENT LOCATION
.7 LDA ORGN,X
STA SYM.VALUE,X
DEX
BPL .7
RTS
*---INVALID OPERAND--------------
.4 JMP ERBA BAD ADDRESS ERROR
*---HEX/OCT/BIN CONSTANT--------
.5 JSR HEX.OCT.BIN.DGT $ABCD, &777, %1010
BCC .4 NO, ERROR BAD ADDRESS
.8 JSR HEX.OCT.BIN.DGT.1 GET ANOTHER DIGIT
BCS .8
BCC .15 ...ALWAYS
*---TICK & QUOTE LITERALS-------
.9 LDX #$80 HIBIT=1
.6 STX SYM.VALUE
STA DGTCNT SAVE ' OR " FOR OPTIONAL TERMCHAR
JSR GNC GET FOLLOWING CHAR
BCS .4 END OF LINE
ORA SYM.VALUE SET HIGH BIT
STA SYM.VALUE
JSR GNC SEE IF CLOSING QUOTE
CMP DGTCNT (IT IS OPTIONAL)
BNE .15 NO, BACK UP CHAR PNTR
RTS
*-------------------------------
* IF NEXT CHAR IS VALID DIGIT,
* APPEND IT TO CURRENT VALUE
*
* (X) DETERMINES BASE: 0-->2, 2-->8, 3-->16
*-------------------------------
HEX.DIGIT
LDX #3
HEX.OCT.BIN.DGT
STX BASE.INDEX
HEX.OCT.BIN.DGT.1
.1 JSR GNC.UC IGNORE CASE
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 .5 NOT A-F EITHER, RETURN CARRY CLEAR
AND #$0F TRIM HEX A...F
.3 LDX BASE.INDEX
CMP BASE.TABLE,X CHECK REAL RANGE
BCS .2 ...NOT VALID, CLR CARRY WITH 'CMP #$FA'
PHA SAVE DIGIT
.4 JSR ASL.SYM.VALUE
DEX MAKE ROOM FOR DIGIT
BPL .4
PLA GET DIGIT
ORA SYM.VALUE MERGE WITH PREVIOUS
STA SYM.VALUE
SEC FLAG GOT A DIGIT
.5 RTS
*--------------------------------
BASE.TABLE
.DA #2,#2,#8,#16
ASL.SYM.VALUE
CLC
ROL.SYM.VALUE
ROL SYM.VALUE
ROL SYM.VALUE+1
ROL SYM.VALUE+2
ROL SYM.VALUE+3
RTS
*--------------------------------
ZERO.EXP.VALUE
LDA #0
STA EXP.VALUE
STA EXP.VALUE+1
STA EXP.VALUE+2
STA EXP.VALUE+3
RTS
*--------------------------------
ZERO.EXP.VALUE64
LDA #0
STA EXP.VALUE64
STA EXP.VALUE64+1
STA EXP.VALUE64+2
STA EXP.VALUE64+3
RTS
*--------------------------------
ZERO.SYM.VALUE
LDA #0
STA SYM.VALUE
STA SYM.VALUE+1
STA SYM.VALUE+2
STA SYM.VALUE+3
RTS
*--------------------------------
EXP.AND
LDX #3
.1 LDA EXP.VALUE,X
AND SYM.VALUE,X
STA EXP.VALUE,X
DEX
BPL .1
JMP EXP2
*--------------------------------
EXP.ORA
LDX #3
.1 LDA EXP.VALUE,X
ORA SYM.VALUE,X
STA EXP.VALUE,X
DEX
BPL .1
JMP EXP2
*--------------------------------
EXP.EOR
LDX #3
.1 LDA EXP.VALUE,X
EOR SYM.VALUE,X
STA EXP.VALUE,X
DEX
BPL .1
JMP EXP2
*--------------------------------
EXP.ADD
CLC PLUS
LDX #-4
.1 LDA EXP.VALUE+4,X
ADC SYM.VALUE+4,X
STA EXP.VALUE+4,X
INX
BNE .1
JMP EXP2
*--------------------------------
EXP.SUBTRACT
JSR EXP.SUBTRACTION
JMP EXP2
*--------------------------------
EXP.SUBTRACTION
SEC
LDX #-4
.7 LDA EXP.VALUE+4,X
SBC SYM.VALUE+4,X
STA EXP.VALUE+4,X
INX
BNE .7
RTS
*--------------------------------
EXP.LESS
JSR EXP.SUBTRACTION
LDA EXP.VALUE+3
BMI EXP.TRUE
EXP.FALSE
CLC
EXP.TRUE.OR.FALSE
JSR ZERO.EXP.VALUE
ROL EXP.VALUE
JMP EXP2
*--------------------------------
EXP.EQUAL
JSR EXP.SUBTRACTION
JSR TEST.EXP.VALUE
BNE EXP.FALSE
EXP.TRUE
SEC
BCS EXP.TRUE.OR.FALSE
*--------------------------------
TEST.EXP.VALUE.ZP
LDA #0
.HS 2C
TEST.EXP.VALUE
LDA EXP.VALUE
ORA EXP.VALUE+1
ORA EXP.VALUE+2
ORA EXP.VALUE+3
RTS
*--------------------------------
EXP.GREATER
JSR EXP.SUBTRACTION
JSR TEST.EXP.VALUE
BEQ EXP.FALSE
LDA EXP.VALUE+3 LOOK AT SIGN BIT
BMI EXP.FALSE
BPL EXP.TRUE
*-------------------------------
EXP.DIVIDE
JSR EXP.DIVISION
JMP EXP2
*--------------------------------
EXP.DIVISION
JSR ZERO.EXP.VALUE64
LDY #32 32 BITS
.1 ASL EXP.VALUE SHIFT DIVIDEND/QUOTIENT LEFT
ROL EXP.VALUE+1
ROL EXP.VALUE+2
ROL EXP.VALUE+3
ROL EXP.VALUE64 SHIFT PARTIAL DIVIDEND LEFT
ROL EXP.VALUE64+1
ROL EXP.VALUE64+2
ROL EXP.VALUE64+3
SEC SUBTRACT DIVISOR FROM PARTIAL DIVIDEND
LDA EXP.VALUE64
SBC SYM.VALUE
PHA SAVE LO-BYTE OF DIFFERENCE ON STACK
LDA EXP.VALUE64+1
SBC SYM.VALUE+1
PHA
LDA EXP.VALUE64+2
SBC SYM.VALUE+2
PHA
LDA EXP.VALUE64+3
SBC SYM.VALUE+3
BCC .2 REMAINDER TOO SMALL
INC EXP.VALUE SET BIT IN QUOTIENT
STA EXP.VALUE64+3 HI-BYTE OF REMAINDER
PLA RETRIEVE NEXT BYTE OF REMAINDER
STA EXP.VALUE64+2
PLA
STA EXP.VALUE64+1
PLA
STA EXP.VALUE64
BCS .3
.2 PLA STACK BACK TO NORMAL
PLA
PLA
.3 DEY NEXT BIT
BNE .1
RTS
*--------------------------------
EXP.MULTIPLY
JSR ZERO.EXP.VALUE64
LDY #32 32-BIT MULTIPLY
.1 LDA EXP.VALUE CHECK LSB OF MULTIPLIER
LSR
BCC .2 IF 0, DON'T ADD MULTIPLICAND
CLC ADD MULTIPLICAND
LDA EXP.VALUE64
ADC SYM.VALUE
STA EXP.VALUE64
LDA EXP.VALUE64+1
ADC SYM.VALUE+1
STA EXP.VALUE64+1
LDA EXP.VALUE64+2
ADC SYM.VALUE+2
STA EXP.VALUE64+2
LDA EXP.VALUE64+3
ADC SYM.VALUE+3
STA EXP.VALUE64+3
.2 ROR EXP.VALUE64+3
ROR EXP.VALUE64+2
ROR EXP.VALUE64+1
ROR EXP.VALUE64
ROR EXP.VALUE+3
ROR EXP.VALUE+2
ROR EXP.VALUE+1
ROR EXP.VALUE
DEY
BNE .1
JMP EXP2
*-------------------------------
* MGO COMMAND
*-------------------------------
MGO JSR EXPR.DEFINED CRACK EXPRESSION
JMP (EXP.VALUE) ENTER USER'S PROGRAM
*--------------------------------
* VAL COMMAND
*--------------------------------
VAL JSR EXPR.DEFINED GET VALUE OF EXPRESSION
LDA #'$'
JSR CHO
JSR P.EXP.VALUE
LDA #'='
JSR CHO
JSR ZERO.SYM.VALUE
TAX X=0
LDA #10
STA SYM.VALUE
.1 JSR EXP.DIVISION
LDA EXP.VALUE64 REMAINDER
PHA
INX
JSR TEST.EXP.VALUE
BNE .1
.2 PLA
ORA #'0'
JSR CHO
DEX
BNE .2
JMP CRLF
*--------------------------------------
MAN
SAVE usr/src/scmasm.30/scmasm.s.exp
LOAD usr/src/scmasm.30/scmasm.s
ASM
Reference in New Issue Copy Permalink