PLASMA/src/vmsrc/apple/plvm802.s

1837 lines
44 KiB
ArmAsm

;**********************************************************
;*
;* APPLE ][ 65802/65816 PLASMA INTERPRETER
;*
;* SYSTEM ROUTINES AND LOCATIONS
;*
;**********************************************************
!CPU 65816
;*
;* THE DEFAULT CPU MODE FOR EXECUTING OPCODES IS:
;* 16 BIT A/M
;* 8 BIT X/Y
;*
;* THE EVALUATION STACK WILL BE THE HARDWARE STACK UNTIL
;* A CALL IS MADE. THE 16 BIT PARAMETERS WILL BE COPIED
;* TO THE ZERO PAGE INTERLEAVED EVALUATION STACK.
;*
;*
;* MONITOR SPECIAL LOCATIONS
;*
CSWL = $36
CSWH = $37
PROMPT = $33
;*
;* PRODOS
;*
PRODOS = $BF00
DEVCNT = $BF31 ; GLOBAL PAGE DEVICE COUNT
DEVLST = $BF32 ; GLOBAL PAGE DEVICE LIST
MACHID = $BF98 ; GLOBAL PAGE MACHINE ID BYTE
RAMSLOT = $BF26 ; SLOT 3, DRIVE 2 IS /RAM'S DRIVER VECTOR
NODEV = $BF10
;*
;* HARDWARE ADDRESSES
;*
KEYBD = $C000
CLRKBD = $C010
SPKR = $C030
LCRDEN = $C080
LCWTEN = $C081
ROMEN = $C082
LCRWEN = $C083
LCBNK2 = $00
LCBNK1 = $08
ALTZPOFF= $C008
ALTZPON = $C009
ALTRDOFF= $C002
ALTRDON = $C003
ALTWROFF= $C004
ALTWRON = $C005
!SOURCE "vmsrc/plvmzp.inc"
PSR = TMP+2
HWSP = PSR+1
DROP = $EF
NEXTOP = DROP+1
FETCHOP = NEXTOP+1
IP = FETCHOP+1
IPL = IP
IPH = IPL+1
OPIDX = FETCHOP+4
OPPAGE = OPIDX+1
;
; BUFFER ADDRESSES
;
STRBUF = $0300
JITMOD = $02F0
INTERP = $03D0
JITCOMP = $03E2
JITCODE = $03E4
;*
;* HARDWARE STACK OFFSETS
;*
TOS = $01 ; TOS
NOS = $03 ; TOS-1
;*
;* ACCUM/MEM SIZE MACROS
;*
!MACRO ACCMEM8 {
SEP #$20 ; 8 BIT A/M
!AS
}
!MACRO ACCMEM16 {
REP #$20 ; 16 BIT A/M
!AL
}
!MACRO INDEX8 {
SEP #$10 ; 8 BIT X/Y
!AS
}
!MACRO INDEX16 {
REP #$10 ; 16 BIT X/Y
!AL
}
;******************************
;* *
;* INTERPRETER INITIALIZATION *
;* *
;******************************
* = $2000
;*
;* MUST HAVE 128K FOR JIT
;*
+ LDA MACHID
AND #$30
CMP #$30
BEQ ++
LDY #$00
- LDA NEEDAUX,Y
BEQ +
ORA #$80
JSR $FDED
INY
BNE -
LDY #ANYKEY-BADCPU
BNE +++
NEEDAUX !TEXT "128K MEMORY REQUIRED.", 13, 0
;*
;* CHECK CPU TYPE
;*
++ CLC
XCE ; SWITCH TO NATIVE MODE
BCS ++
LDY #$00 ; NOPE, NOT 65802/65816
- LDA BADCPU,Y
BEQ +
ORA #$80
JSR $FDED
INY
+++ BNE -
+ LDA $C000
BPL -
LDA $C010
JSR PRODOS
!BYTE $65
!WORD BYEPARMS
BYEPARMS !BYTE 4
!BYTE 4
!WORD 0
!BYTE 0
!WORD 0
BADCPU !TEXT "65C802/65C816 CPU REQUIRED.", 13
ANYKEY !TEXT "PRESS ANY KEY...", 0
++ XCE ; SWITCH BACK TO EMULATED MODE
;*
;* DISCONNECT /RAM
;*
;SEI ; DISABLE /RAM
LDA MACHID
AND #$30
CMP #$30
BNE RAMDONE
LDA RAMSLOT
CMP NODEV
BNE RAMCONT
LDA RAMSLOT+1
CMP NODEV+1
BEQ RAMDONE
RAMCONT LDY DEVCNT
RAMLOOP LDA DEVLST,Y
AND #$F3
CMP #$B3
BEQ GETLOOP
DEY
BPL RAMLOOP
BMI RAMDONE
GETLOOP LDA DEVLST+1,Y
STA DEVLST,Y
BEQ RAMEXIT
INY
BNE GETLOOP
RAMEXIT LDA NODEV
STA RAMSLOT
LDA NODEV+1
STA RAMSLOT+1
DEC DEVCNT
RAMDONE ;CLI UNTIL I KNOW WHAT TO DO WITH THE UNENHANCED IIE
;*
;* MOVE VM INTO LANGUAGE CARD
;*
BIT LCRWEN+LCBNK2
BIT LCRWEN+LCBNK2
LDA #<VMCORE
STA SRCL
LDA #>VMCORE
STA SRCH
LDY #$00
STY DSTL
LDA #$D0
STA DSTH
- LDA (SRC),Y ; COPY VM+BYE INTO LANGUAGE CARD
STA (DST),Y
INY
BNE -
INC SRCH
INC DSTH
LDA DSTH
CMP #$E0
BNE -
;*
;* MOVE FIRST PAGE OF 'BYE' INTO PLACE
;*
- LDA $D100,Y
STA $1000,Y
INY
BNE -
;*
;* SAVE DEFAULT COMMAND INTERPRETER PATH IN LC
;*
JSR PRODOS ; GET PREFIX
!BYTE $C7
!WORD GETPFXPARMS
LDY STRBUF ; APPEND "CMD128"
LDA #"/"
CMP STRBUF,Y
BEQ +
INY
STA STRBUF,Y
+ LDA #"C"
INY
STA STRBUF,Y
LDA #"M"
INY
STA STRBUF,Y
LDA #"D"
INY
STA STRBUF,Y
LDA #"1"
INY
STA STRBUF,Y
LDA #"2"
INY
STA STRBUF,Y
LDA #"8"
INY
STA STRBUF,Y
STY STRBUF
BIT LCRWEN+LCBNK2 ; COPY TO LC FOR BYE
BIT LCRWEN+LCBNK2
- LDA STRBUF,Y
STA LCDEFCMD,Y
DEY
BPL -
JMP CMDENTRY
GETPFXPARMS !BYTE 1
!WORD STRBUF ; PATH STRING GOES HERE
;************************************************
;* *
;* LANGUAGE CARD RESIDENT PLASMA VM STARTS HERE *
;* *
;************************************************
VMCORE = *
!PSEUDOPC $D000 {
;****************
;* *
;* OPCODE TABLE *
;* *
;****************
!ALIGN 255,0
OPTBL !WORD ZERO,CN,CN,CN,CN,CN,CN,CN ; 00 02 04 06 08 0A 0C 0E
!WORD CN,CN,CN,CN,CN,CN,CN,CN ; 10 12 14 16 18 1A 1C 1E
!WORD MINUS1,BREQ,BRNE,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E
!WORD DROP,DROP2,DUP,DIVMOD,ADDI,SUBI,ANDI,ORI ; 30 32 34 36 38 3A 3C 3E
!WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E
!WORD BRNCH,SEL,CALL,ICAL,ENTER,LEAVE,RET,CFFB ; 50 52 54 56 58 5A 5C 5E
!WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E
!WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E
!WORD LNOT,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 80 82 84 86 88 8A 8C 8E
!WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 90 92 94 96 98 9A 9C 9E
!WORD BRGT,BRLT,INCBRLE,ADDBRLE,DECBRGE,SUBBRGE,BRAND,BROR ; A0 A2 A4 A6 A8 AA AC AE
!WORD ADDLB,ADDLW,ADDAB,ADDAW,IDXLB,IDXLW,IDXAB,IDXAW ; B0 B2 B4 B6 B8 BA BC BE
!WORD NATV,JUMPZ,JUMP ; C0 C2 C4
;*
;* ENTER INTO BYTECODE INTERPRETER - IMMEDIATELY SWITCH TO NATIVE
;*
!AS
DINTRP PHP
PLA
STA PSR
SEI
CLC ; SWITCH TO NATIVE MODE
XCE
+ACCMEM16 ; 16 BIT A/M
PLA
INC
STA IP
STX ESP
TSX
STX HWSP
LDX #ESTKSZ/2 ; COPY ZERO PAGE EVAL STACK TO HW STACK
CMP ESP
BEQ +
- LDY ESTKH,X
PHY
LDY ESTKL,X
PHY
DEX
CPX ESP
BNE -
+ LDX #>OPTBL
STX OPPAGE
LDY #$00 ; Y MUST BE ZERO FOR ENTER (DON'T CHANGE THIS)
JMP FETCHOP
;************************************************************
;* *
;* 'BYE' PROCESSING - COPIED TO $1000 ON PRODOS BYE COMMAND *
;* *
;************************************************************
!AS
!ALIGN 255,0
!PSEUDOPC $1000 {
BYE LDY DEFCMD
- LDA DEFCMD,Y ; SET DEFAULT COMMAND WHEN CALLED FROM 'BYE'
STA STRBUF,Y
DEY
BPL -
; INY ; CLEAR CMDLINE BUFF
; STY $01FF
CMDENTRY = *
;
; DEACTIVATE 80 COL CARDS AND SET DCI STRING FOR JIT MODULE
;
BIT ROMEN
LDY #4
- LDA DISABLE80,Y
ORA #$80
JSR $FDED
LDA JITDCI,Y
STA JITMOD,Y
DEY
BPL -
BIT $C054 ; SET TEXT MODE
BIT $C051
BIT $C05F
JSR $FC58 ; HOME
;
; INSTALL PAGE 0 FETCHOP ROUTINE
;
LDY #$0F
- LDA PAGE0,Y
STA DROP,Y
DEY
BPL -
;
; SET JMPTMP OPCODE
;
LDA #$4C
STA JMPTMP
;
; INSTALL PAGE 3 VECTORS
;
LDY #$12
- LDA PAGE3,Y
STA INTERP,Y
DEY
BPL -
;
; READ CMD INTO MEMORY
;
JSR PRODOS ; CLOSE EVERYTHING
!BYTE $CC
!WORD CLOSEPARMS
BNE FAIL
JSR PRODOS ; OPEN CMD
!BYTE $C8
!WORD OPENPARMS
BNE FAIL
LDA REFNUM
STA READPARMS+1
JSR PRODOS
!BYTE $CA
!WORD READPARMS
BNE FAIL
JSR PRODOS
!BYTE $CC
!WORD CLOSEPARMS
BNE FAIL
;
; INIT VM ENVIRONMENT STACK POINTERS
;
; LDA #$00
STA $01FF ; CLEAR CMDLINE BUFF
STA PPL ; INIT FRAME POINTER
STA IFPL
LDA #$AF ; FRAME POINTER AT $AF00, BELOW JIT BUFFER
STA PPH
STA IFPH
LDX #$FE ; INIT STACK POINTER (YES, $FE. SEE GETS)
TXS
LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX
;
; CHANGE CMD STRING TO SYSPATH STRING
;
LDA STRBUF
SEC
SBC #$06
STA STRBUF
JMP $2000 ; JUMP TO LOADED SYSTEM COMMAND
;
; PRINT FAIL MESSAGE, WAIT FOR KEYPRESS, AND REBOOT
;
FAIL INC $3F4 ; INVALIDATE POWER-UP BYTE
LDY #11
- LDA FAILMSG,Y
ORA #$80
JSR $FDED
DEY
BPL -
JSR $FD0C ; WAIT FOR KEYPRESS
JMP ($FFFC) ; RESET
OPENPARMS !BYTE 3
!WORD STRBUF
!WORD $0800
REFNUM !BYTE 0
READPARMS !BYTE 4
!BYTE 0
!WORD $2000
!WORD $9F00
!WORD 0
CLOSEPARMS !BYTE 1
!BYTE 0
DISABLE80 !BYTE 21, 13, '1', 26, 13
JITDCI !BYTE 'J'|$80,'I'|$80,'T'|$80,'1'|$80,'6'
FAILMSG !TEXT ".DMC GNISSIM"
PAGE0 = *
;******************************
;* *
;* INTERP BYTECODE INNER LOOP *
;* *
;******************************
!PSEUDOPC DROP {
PLA ; DROP @ $EF
INY ; NEXTOP @ $F0
LDX $FFFF,Y ; FETCHOP @ $F1, IP MAPS OVER $FFFF @ $F2
JMP (OPTBL,X) ; OPIDX AND OPPAGE MAP OVER OPTBL
}
PAGE3 = *
;*
;* PAGE 3 VECTORS INTO INTERPRETER
;*
!PSEUDOPC $03D0 {
BIT LCRDEN+LCBNK2 ; $03D0 - DIRECT INTERP ENTRY
JMP DINTRP
BIT LCRDEN+LCBNK2 ; $03D6 - JIT INDIRECT INTERPX ENTRY
JMP JITINTRPX
BIT LCRDEN+LCBNK2 ; $03DC - INDIRECT INTERPX ENTRY
JMP IINTRPX
}
DEFCMD = *
}
LCDEFCMD = * ; DEFCMD IN LC MEMORY
;*****************
;* *
;* OPXCODE TABLE *
;* *
;*****************
!ALIGN 255,0
OPXTBL !WORD ZERO,CN,CN,CN,CN,CN,CN,CN ; 00 02 04 06 08 0A 0C 0E
!WORD CN,CN,CN,CN,CN,CN,CN,CN ; 10 12 14 16 18 1A 1C 1E
!WORD MINUS1,BREQ,BRNE,LA,LLA,CB,CW,CSX ; 20 22 24 26 28 2A 2C 2E
!WORD DROP,DROP2,DUP,DIVMOD,ADDI,SUBI,ANDI,ORI ; 30 32 34 36 38 3A 3C 3E
!WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E
!WORD BRNCH,SEL,CALLX,ICALX,ENTER,LEAVE,RET,CFFB ; 50 52 54 56 58 5A 5C 5E
!WORD LBX,LWX,LLBX,LLWX,LABX,LAWX,DLB,DLW ; 60 62 64 66 68 6A 6C 6E
!WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E
!WORD LNOT,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 80 82 84 86 88 8A 8C 8E
!WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 90 92 94 96 98 9A 9C 9E
!WORD BRGT,BRLT,INCBRLE,ADDBRLE,DECBRGE,SUBBRGE,BRAND,BROR ; A0 A2 A4 A6 A8 AA AC AE
!WORD ADDLBX,ADDLWX,ADDABX,ADDAWX,IDXLBX,IDXLWX,IDXABX,IDXAWX ; B0 B2 B4 B6 B8 BA BC BE
!WORD NATV,JUMPZ,JUMP ; C0 C2 C4
;*
;* INDIRECT ENTRY INTO INTERPRETER
;*
!AS
IINTRPX PHP
PLA
STA PSR
SEI
CLC ; SWITCH TO NATIVE MODE
XCE
_INTRPX +ACCMEM16 ; 16 BIT A/M
LDY #$01
LDA (TOS,S),Y
STA IP
PLA ; DROP RETURN ADDRESS
STX ESP
TSX
STX HWSP
LDX #ESTKSZ/2 ; COPY ZERO PAGE EVAL STACK TO HW STACK
CMP ESP
BEQ +
- LDY ESTKH,X
PHY
LDY ESTKL,X
PHY
DEX
CPX ESP
BNE -
+ STX ALTRDON
LDX #>OPXTBL
STX OPPAGE
LDY #$00
JMP FETCHOP
;*
;* JIT PROFILING ENTRY INTO INTERPRETER
;*
!AS
JITINTRPX PHP
PLA
STA PSR
SEI
CLC ; SWITCH TO NATIVE MODE
XCE
LDY #$03 ; DEC JIT COUNT
LDA (TOS,S),Y
DEC
STA (TOS,S),Y
BNE _INTRPX
+ACCMEM16 ; 16 BIT A/M
RUNJIT PLA ; BACK UP DEF ENTRY TO POINT TO JSR
SEC
SBC #$0002
PHA
+ACCMEM8 ; 8 BIT A/M
DEX ; ADD PARAMETER TO DEF ENTRY
STA ESTKL,X
XBA
STA ESTKH,X
STX ESP
+ACCMEM16 ; 16 BIT A/M
LDA JITCOMP
STA SRC
LDY #$03
LDA (SRC),Y
STA IP
TSX
DEX ; TAKE INTO ACCOUNT JSR BELOW
DEX
STX HWSP
STX ALTRDON
LDX #>OPXTBL
STX OPPAGE
LDY #$00
JSR FETCHOP ; CALL JIT COMPILER
!AS ; RETURN IN EMULATION MODE
PLA
STA TMPL
PLA
STA TMPH
JMP (TMP) ; RE-CALL ORIGINAL DEF ENTRY
;*********************************************************************
;*
;* CODE BELOW HERE DEFAULTS TO NATIVE 16 BIT A/M, 8 BIT X,Y
;*
;*********************************************************************
!AL
;*
;* ADD TOS TO TOS-1
;*
ADD PLA
CLC
ADC TOS,S
STA TOS,S
JMP NEXTOP
;*
;* SUB TOS FROM TOS-1(NOS)
;*
SUB LDA NOS,S
SEC
SBC TOS,S
STA NOS,S
JMP DROP
;*
;* SHIFT TOS LEFT BY 1, ADD TO TOS-1
;*
IDXW PLA
ASL
CLC
ADC TOS,S
STA TOS,S
JMP NEXTOP
;*
;* MUL TOS-1 BY TOS
;*
MUL LDX #$10
LDA NOS,S
CMP TOS,S
BCS _MULSWP
- ASL ; SKIP LEADING ZEROS
BCS +
DEX
BNE -
BEQ _MULEX
+ EOR #$FFFF
STA TMP
LDA TOS,S
DEX
BEQ _MULEX
_MULLP ASL
ASL TMP ; MULTPLR
BCS +
ADC TOS,S ; MULTPLD
+ DEX
BNE _MULLP
_MULEX STA NOS,S ; PROD
JMP DROP
_MULSWP LDA TOS,S
- ASL ; SKIP LEADING ZEROS
BCS +
DEX
BNE -
BEQ _MULEX
+ EOR #$FFFF
STA TMP
LDA NOS,S
DEX
BEQ _MULEX
_MULSLP ASL
ASL TMP ; MULTPLR
BCS +
ADC NOS,S ; MULTPLD
+ DEX
BNE _MULSLP
STA NOS,S ; PROD
JMP DROP
;MUL LDX #$04
; LDA NOS,S
; EOR #$FFFF
; STA TMP
; LDA #$0000
;_MULLP ASL
; ASL TMP ; MULTPLR
; BCS +
; ADC TOS,S ; MULTPLD
;+ ASL
; ASL TMP ; MULTPLR
; BCS +
; ADC TOS,S ; MULTPLD
;+ ASL
; ASL TMP ; MULTPLR
; BCS +
; ADC TOS,S ; MULTPLD
;+ ASL
; ASL TMP ; MULTPLR
; BCS +
; ADC TOS,S ; MULTPLD
;+ DEX
; BNE _MULLP
; STA NOS,S ; PROD
; JMP DROP
;*
;* INTERNAL DIVIDE ALGORITHM
;*
_DIV STY IPY
LDY #$11 ; #BITS+1
LDX #$00
LDA NOS+2,S ; WE JSR'ED HERE SO OFFSET ACCORDINGLY
BPL +
LDX #$81
EOR #$FFFF
INC
+ STA TMP ; NOS,S
BEQ _DIVEX
LDA TOS+2,S
BPL +
INX
EOR #$FFFF
INC
STA TOS+2,S
+ LDA TMP
_DIV1 ASL ; DVDND
DEY
BCC _DIV1
STA TMP ; NOS,S ; DVDND
LDA #$0000 ; REMNDR
_DIVLP ROL ; REMNDR
CMP TOS+2,S ; DVSR
BCC +
SBC TOS+2,S ; DVSR
SEC
+ ROL TMP ; NOS,S ; DVDND
DEY
BNE _DIVLP
_DIVEX LDY IPY
RTS
;*
;* DIV TOS-1 BY TOS
;*
DIV JSR _DIV
LDA TMP
STA NOS,S
PLA
TXA ; DIVSGN
LSR ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1
BCS NEG
JMP NEXTOP
;*
;* MOD TOS-1 BY TOS
;*
MOD JSR _DIV
STA NOS,S ; REMNDR
PLA
CPX #$80 ; DIVSGN
BCS NEG ; REMAINDER IS SIGN OF DIVIDEND
JMP NEXTOP
;*
;* DIVMOD TOS-1 BY TOS - !!!HACK!!! MUST COPY ESTK TO HW STACK
;*
DIVMOD +ACCMEM8
LDX ESP
LDA ESTKH+1,X
PHA
LDA ESTKL+1,X
PHA
LDA ESTKH,X
PHA
LDA ESTKL,X
PHA
+ACCMEM16
JSR _DIV
CPX #$80 ; DIVSGN
BCC + ; REMAINDER IS SIGN OF DIVIDEND
EOR #$FFFF
INC
+ STA TOS,S ; REMNDR
TXA ; DIVSGN
LSR ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1
LDA TMP
BCC +
EOR #$FFFF
INC
+ STA NOS,S ; DVDND
+ACCMEM8
LDX ESP
PLA
STA ESTKL,X
PLA
STA ESTKH,X
PLA
STA ESTKL+1,X
PLA
STA ESTKH+1,X
+ACCMEM16
JMP NEXTOP
;*
;* NEGATE TOS
;*
NEG PLA
EOR #$FFFF
INC
PHA
JMP NEXTOP
;*
;* INCREMENT TOS
;*
INCR PLA
INC
PHA
JMP NEXTOP
;*
;* DECREMENT TOS
;*
DECR PLA
DEC
PHA
JMP NEXTOP
;*
;* BITWISE COMPLIMENT TOS
;*
COMP PLA
EOR #$FFFF
PHA
JMP NEXTOP
;*
;* BITWISE AND TOS TO TOS-1
;*
BAND PLA
AND TOS,S
STA TOS,S
JMP NEXTOP
;*
;* INCLUSIVE OR TOS TO TOS-1
;*
IOR PLA
ORA TOS,S
STA TOS,S
JMP NEXTOP
;*
;* EXLUSIVE OR TOS TO TOS-1
;*
XOR PLA
EOR TOS,S
STA TOS,S
JMP NEXTOP
;*
;* SHIFT TOS-1 LEFT BY TOS
;*
SHL PLA
TAX
BEQ +
PLA
- ASL
DEX
BNE -
PHA
+ JMP NEXTOP
;*
;* SHIFT TOS-1 RIGHT BY TOS
;*
SHR PLA
TAX
BEQ +
PLA
- CMP #$8000
ROR
DEX
BNE -
PHA
+ JMP NEXTOP
;*
;* DUPLICATE TOS
;*
DUP LDA TOS,S
PHA
JMP NEXTOP
;*
;* ADD IMMEDIATE TO TOS
;*
ADDI INY ;+INC_IP
LDA (IP),Y
AND #$00FF
CLC
ADC TOS,S
STA TOS,S
JMP NEXTOP
;*
;* SUB IMMEDIATE FROM TOS
;*
SUBI INY ;+INC_IP
LDA (IP),Y
AND #$00FF
EOR #$FFFF
SEC
ADC TOS,S
STA TOS,S
JMP NEXTOP
;*
;* AND IMMEDIATE TO TOS
;*
ANDI INY ;+INC_IP
LDA (IP),Y
AND #$00FF
AND TOS,S
STA TOS,S
JMP NEXTOP
;*
;* IOR IMMEDIATE TO TOS
;*
ORI INY ;+INC_IP
LDA (IP),Y
AND #$00FF
ORA TOS,S
STA TOS,S
JMP NEXTOP
;*
;* LOGICAL NOT
;*
LNOT PLA
BNE ZERO
;*
;* CONSTANT -1, ZERO, NYBBLE, BYTE, $FF BYTE, WORD (BELOW)
;*
MINUS1 PEA $FFFF
JMP NEXTOP
ZERO PEA $0000
JMP NEXTOP
CN TXA
LSR ; A = CONST * 2
PHA
JMP NEXTOP
CB INY ;+INC_IP
LDA (IP),Y
AND #$00FF
PHA
JMP NEXTOP
CFFB INY ;+INC_IP
LDA (IP),Y
ORA #$FF00
PHA
JMP NEXTOP
;*
;* LOAD ADDRESS & LOAD CONSTANT WORD (SAME THING, WITH OR WITHOUT FIXUP)
;*
LA INY ;+INC_IP
LDA (IP),Y
PHA
INY
BMI +
JMP NEXTOP
+ JMP FIXNEXT
CW INY ;+INC_IP
LDA (IP),Y
PHA
INY ;+INC_IP
JMP NEXTOP
;*
;* CONSTANT STRING
;*
CS ;INY ;+INC_IP
TYA ; NORMALIZE IP AND SAVE STRING ADDR ON ESTK
SEC
ADC IP
STA IP
PHA
LDA (IP)
TAY
JMP NEXTOP
CSX ;INY ;+INC_IP
TYA ; NORMALIZE IP
SEC
ADC IP
STA IP
LDA PP ; SCAN POOL FOR STRING ALREADY THERE
_CMPPSX STA TMP
CMP IFP ; CHECK FOR END OF POOL
BCS _CPYSX ; AT OR BEYOND END OF POOL, COPY STRING OVER
_CMPSX +ACCMEM8 ; 8 BIT A/M
STX ALTRDOFF ; CHECK FOR MATCHING STRING
LDA (TMP) ; COMPARE STRINGS FROM AUX MEM TO STRINGS IN MAIN MEM
STX ALTRDON
CMP (IP) ; COMPARE STRING LENGTHS
BNE _CNXTSX1
TAY
- STX ALTRDOFF
LDA (TMP),Y ; COMPARE STRING CHARS FROM END
STX ALTRDON
CMP (IP),Y
BNE _CNXTSX
DEY
BNE -
LDA TMPH ; MATCH - SAVE EXISTING ADDR ON ESTK AND MOVE ON
PHA
LDA TMPL
PHA
BRA _CEXSX
_CNXTSX STX ALTRDOFF
LDA (TMP)
STX ALTRDON
_CNXTSX1 +ACCMEM16 ; 16 BIT A/M
AND #$00FF
SEC ; SKIP OVER STRING+LEN BYTE
ADC TMP
BRA _CMPPSX
_CPYSX LDA (IP) ; COPY STRING FROM AUX TO MAIN MEM POOL
TAY ; MAKE ROOM IN POOL AND SAVE ADDR ON ESTK
AND #$00FF
EOR #$FFFF
CLC
ADC PP
STA PP
PHA ; SAVE ADDRESS ON ESTK
+ACCMEM8 ; 8 BIT A/M
- LDA (IP),Y ; ALTRD IS ON, NO NEED TO CHANGE IT HERE
STA (PP),Y ; ALTWR IS OFF, NO NEED TO CHANGE IT HERE
DEY
CPY #$FF
BNE -
_CEXSX LDA (IP) ; SKIP TO NEXT OP ADDR AFTER STRING
TAY
+ACCMEM16 ; 16 BIT A/M
JMP NEXTOP
;*
;* LOAD VALUE FROM ADDRESS TAG
;*
LB TYX
LDY #$00
TYA ; QUICKY CLEAR OUT MSB
+ACCMEM8 ; 8 BIT A/M
LDA (TOS,S),Y
+ACCMEM16 ; 16 BIT A/M
STA TOS,S
TXY
JMP NEXTOP
LW TYX
LDY #$00
LDA (TOS,S),Y
STA TOS,S
TXY
JMP NEXTOP
LBX TYX
LDY #$00
TYA ; QUICKY CLEAR OUT MSB
STX ALTRDOFF
+ACCMEM8 ; 8 BIT A/M
LDA (TOS,S),Y
+ACCMEM16 ; 16 BIT A/M
STX ALTRDON
STA TOS,S
TXY
JMP NEXTOP
LWX TYX
LDY #$00
STX ALTRDOFF
LDA (TOS,S),Y
STX ALTRDON
STA TOS,S
TXY
JMP NEXTOP
;*
;* LOAD ADDRESS OF LOCAL FRAME OFFSET
;*
- TYA
CLC
ADC IP
STA IP
LDY #$FF
LLA INY ;+INC_IP
BMI -
LDA (IP),Y
AND #$00FF
CLC
ADC IFP
PHA
JMP NEXTOP
;*
;* LOAD VALUE FROM LOCAL FRAME OFFSET
;*
LLB INY ;+INC_IP
TYX
LDA (IP),Y
TAY
LDA (IFP),Y
AND #$00FF
PHA
TXY
JMP NEXTOP
LLW INY ;+INC_IP
TYX
LDA (IP),Y
TAY
LDA (IFP),Y
PHA
TXY
JMP NEXTOP
LLBX INY ;+INC_IP
TYX
LDA (IP),Y
TAY
STX ALTRDOFF
LDA (IFP),Y
STX ALTRDON
AND #$00FF
PHA
TXY
JMP NEXTOP
LLWX INY ;+INC_IP
TYX
LDA (IP),Y
TAY
STX ALTRDOFF
LDA (IFP),Y
STX ALTRDON
PHA
TXY
JMP NEXTOP
;*
;* ADD VALUE FROM LOCAL FRAME OFFSET
;*
ADDLB INY ;+INC_IP
TYX
LDA (IP),Y
TAY
LDA (IFP),Y
AND #$00FF
TXY
CLC
ADC TOS,S
STA TOS,S
JMP NEXTOP
ADDLBX INY ;+INC_IP
TYX
LDA (IP),Y
TAY
STX ALTRDOFF
LDA (IFP),Y
STX ALTRDON
AND #$00FF
TXY
CLC
ADC TOS,S
STA TOS,S
JMP NEXTOP
ADDLW INY ;+INC_IP
TYX
LDA (IP),Y
TAY
LDA (IFP),Y
TXY
CLC
ADC TOS,S
STA TOS,S
JMP NEXTOP
ADDLWX INY ;+INC_IP
TYX
LDA (IP),Y
TAY
STX ALTRDOFF
LDA (IFP),Y
STX ALTRDON
TXY
CLC
ADC TOS,S
STA TOS,S
JMP NEXTOP
;*
;* INDEX VALUE FROM LOCAL FRAME OFFSET
;*
IDXLB INY ;+INC_IP
TYX
LDA (IP),Y
TAY
LDA (IFP),Y
AND #$00FF
TXY
ASL
CLC
ADC TOS,S
STA TOS,S
JMP NEXTOP
IDXLBX INY ;+INC_IP
TYX
LDA (IP),Y
TAY
STX ALTRDOFF
LDA (IFP),Y
STX ALTRDON
AND #$00FF
TXY
ASL
CLC
ADC TOS,S
STA TOS,S
JMP NEXTOP
IDXLW INY ;+INC_IP
TYX
LDA (IP),Y
TAY
LDA (IFP),Y
TXY
ASL
CLC
ADC TOS,S
STA TOS,S
JMP NEXTOP
IDXLWX INY ;+INC_IP
TYX
LDA (IP),Y
TAY
STX ALTRDOFF
LDA (IFP),Y
STX ALTRDON
TXY
ASL
CLC
ADC TOS,S
STA TOS,S
JMP NEXTOP
;*
;* LOAD VALUE FROM ABSOLUTE ADDRESS
;*
LAB INY ;+INC_IP
LDA (IP),Y
STA TMP
TYA ; QUICKY CLEAR OUT MSB
+ACCMEM8 ; 8 BIT A/M
LDA (TMP)
+ACCMEM16 ; 16 BIT A/M
PHA
INY ;+INC_IP
JMP NEXTOP
LAW INY ;+INC_IP
LDA (IP),Y
STA TMP
LDA (TMP)
PHA
INY ;+INC_IP
JMP NEXTOP
LABX INY ;+INC_IP
LDA (IP),Y
STA TMP
TYA ; QUICKY CLEAR OUT MSB
STX ALTRDOFF
+ACCMEM8 ; 8 BIT A/M
LDA (TMP)
+ACCMEM16 ; 16 BIT A/M
STX ALTRDON
PHA
INY ;+INC_IP
JMP NEXTOP
LAWX INY ;+INC_IP
LDA (IP),Y
STA TMP
STX ALTRDOFF
LDA (TMP)
STX ALTRDON
PHA
INY ;+INC_IP
JMP NEXTOP
;*
;* ADD VALUE FROM ABSOLUTE ADDRESS
;*
ADDAB INY ;+INC_IP
LDA (IP),Y
STA TMP
TYA ; QUICKY CLEAR OUT MSB
+ACCMEM8 ; 8 BIT A/M
LDA (TMP)
+ACCMEM16 ; 16 BIT A/M
INY ;+INC_IP
CLC
ADC TOS,S
STA TOS,S
JMP NEXTOP
ADDABX INY ;+INC_IP
LDA (IP),Y
STA TMP
TYA ; QUICKY CLEAR OUT MSB
STX ALTRDOFF
+ACCMEM8 ; 8 BIT A/M
LDA (TMP)
+ACCMEM16 ; 16 BIT A/M
STX ALTRDON
INY ;+INC_IP
CLC
ADC TOS,S
STA TOS,S
JMP NEXTOP
ADDAW INY ;+INC_IP
LDA (IP),Y
STA TMP
LDA (TMP)
INY ;+INC_IP
CLC
ADC TOS,S
STA TOS,S
JMP NEXTOP
ADDAWX INY ;+INC_IP
LDA (IP),Y
STA TMP
STX ALTRDOFF
LDA (TMP)
STX ALTRDON
INY ;+INC_IP
CLC
ADC TOS,S
STA TOS,S
JMP NEXTOP
;*
;* INDEX VALUE FROM ABSOLUTE ADDRESS
;*
IDXAB INY ;+INC_IP
LDA (IP),Y
STA TMP
TYA ; QUICKY CLEAR OUT MSB
+ACCMEM8 ; 8 BIT A/M
LDA (TMP)
+ACCMEM16 ; 16 BIT A/M
INY ;+INC_IP
ASL
CLC
ADC TOS,S
STA TOS,S
JMP NEXTOP
IDXABX INY ;+INC_IP
LDA (IP),Y
STA TMP
TYA ; QUICKY CLEAR OUT MSB
STX ALTRDOFF
+ACCMEM8 ; 8 BIT A/M
LDA (TMP)
+ACCMEM16 ; 16 BIT A/M
STX ALTRDON
INY ;+INC_IP
ASL
CLC
ADC TOS,S
STA TOS,S
JMP NEXTOP
IDXAW INY ;+INC_IP
LDA (IP),Y
STA TMP
LDA (TMP)
INY ;+INC_IP
ASL
CLC
ADC TOS,S
STA TOS,S
JMP NEXTOP
IDXAWX INY ;+INC_IP
LDA (IP),Y
STA TMP
STX ALTRDOFF
LDA (TMP)
STX ALTRDON
INY ;+INC_IP
ASL
CLC
ADC TOS,S
STA TOS,S
JMP NEXTOP
;*
;* STORE VALUE TO ADDRESS
;*
SB TYX
LDY #$00
+ACCMEM8 ; 8 BIT A/M
LDA NOS,S
STA (TOS,S),Y
+ACCMEM16 ; 16 BIT A/M
TXY
PLA
JMP DROP
SW TYX
LDY #$00
LDA NOS,S
STA (TOS,S),Y
TXY
;*
;* DROP TOS, TOS-1
;*
DROP2 PLA
JMP DROP
;*
;* STORE VALUE TO LOCAL FRAME OFFSET
;*
SLB INY ;+INC_IP
TYX
LDA (IP),Y
TAY
PLA
+ACCMEM8 ; 8 BIT A/M
STA (IFP),Y
+ACCMEM16 ; 16 BIT A/M
TXY
BMI +
JMP NEXTOP
SLW INY ;+INC_IP
LDA (IP),Y
TYX
TAY
PLA
STA (IFP),Y
TXY
BMI +
JMP NEXTOP
+ JMP FIXNEXT
;*
;* STORE VALUE TO LOCAL FRAME OFFSET WITHOUT POPPING STACK
;*
DLB INY ;+INC_IP
TYX
+ACCMEM8 ; 8 BIT A/M
LDA (IP),Y
TAY
LDA TOS,S
STA (IFP),Y
+ACCMEM16 ; 16 BIT A/M
AND #$00FF
STA TOS,S
TXY
JMP NEXTOP
DLW INY ;+INC_IP
LDA (IP),Y
TYX
TAY
LDA TOS,S
STA (IFP),Y
TXY
JMP NEXTOP
;*
;* STORE VALUE TO ABSOLUTE ADDRESS
;*
SAB INY ;+INC_IP
LDA (IP),Y
STA TMP
PLA
+ACCMEM8 ; 8 BIT A/M
STA (TMP)
+ACCMEM16 ; 16 BIT A/M
INY
BMI +
JMP NEXTOP
SAW INY ;+INC_IP
LDA (IP),Y
STA TMP
PLA
STA (TMP)
INY
BMI +
JMP NEXTOP
+ JMP FIXNEXT
;*
;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK
;*
DAB INY ;+INC_IP
LDA (IP),Y
STA TMP
+ACCMEM8 ; 8 BIT A/M
LDA TOS,S
STA (TMP)
+ACCMEM16 ; 16 BIT A/M
AND #$00FF
STA TOS,S
INY ;+INC_IP
JMP NEXTOP
DAW INY ;+INC_IP
LDA (IP),Y
STA TMP
LDA TOS,S
STA (TMP)
INY ;+INC_IP
JMP NEXTOP
;*
;* COMPARES
;*
ISEQ PLA
CMP TOS,S
BNE ISFLS
ISTRU LDA #$FFFF
STA TOS,S
JMP NEXTOP
ISNE PLA
CMP TOS,S
BNE ISTRU
ISFLS LDA #$0000
STA TOS,S
JMP NEXTOP
ISGE PLA
SEC
SBC TOS,S
BVS +
BMI ISTRU
BEQ ISTRU
BPL ISFLS
+ BMI ISFLS
BEQ ISFLS
BPL ISTRU
ISGT PLA
SEC
SBC TOS,S
BVS +
BMI ISTRU
BPL ISFLS
+ BMI ISFLS
BPL ISTRU
ISLE PLA
SEC
SBC TOS,S
BVS +
BPL ISTRU
BMI ISFLS
+ BPL ISFLS
BMI ISTRU
ISLT PLA
SEC
SBC TOS,S
BVS +
BMI ISFLS
BEQ ISFLS
BPL ISTRU
+ BMI ISTRU
BEQ ISTRU
BPL ISFLS
;*
;* BRANCHES
;*
SEL TYA ; FLATTEN IP
SEC
ADC IP
INY ;+INC_IP
;CLC ; ADD BRANCH OFFSET (BETTER NOT CARRY OUT OF IP+Y)
ADC (IP),Y
STA IP
LDY #$00
LDA (IP),Y
TAX ; CASE COUNT
PLA
INC IP
CASELP CMP (IP),Y
BEQ +
BMI CASEEND ; CASE VALS IN ASCENDING ORDER, EXIT WHEN LESS
INY
INY
INY
DEX
BEQ FIXNEXT
INY
BNE CASELP
+ACCMEM8 ; 8 BIT A/M
INC IPH
+ACCMEM16 ; 16 BIT A/M
BRA CASELP
+ INY
BRA BRNCH
CASEEND TXA ; SKIP REMAINING CASES
ASL
ASL
DEC
; CLC
ADC IP
STA IP
FIXNEXT TYA
LDY #$00
SEC
ADC IP
STA IP
JMP FETCHOP
BRAND LDA TOS,S
BEQ BRNCH
PLA ; DROP LEFT HALF OF AND
BRA NOBRNCH
BROR LDA TOS,S
BNE BRNCH
PLA ; DROP LEFT HALF OF OR
BRA NOBRNCH
BREQ PLA
CMP TOS,S
BNE +
PLA
BRA BRNCH
BRNE PLA
CMP TOS,S
BEQ +
PLA
BRA BRNCH
+ PLA
BRA NOBRNCH
BRTRU PLA
BNE BRNCH
NOBRNCH INY ;+INC_IP
INY
BMI FIXNEXT
JMP NEXTOP
BRFLS PLA
BNE NOBRNCH
BRNCH TYA ; FLATTEN IP
SEC
ADC IP
INY ;+INC_IP
;CLC ; ADD BRANCH OFFSET (BETTER NOT CARRY OUT OF IP+Y)
ADC (IP),Y
STA IP
LDY #$00
JMP FETCHOP
;*
;* FOR LOOPS PUT TERMINAL VALUE AT ESTK+1 AND CURRENT COUNT ON ESTK
;*
BRGT LDA NOS,S
SEC
SBC TOS,S
BVS +
BPL NOBRNCH
BMI BRNCH
BRLT LDA TOS,S
SEC
SBC NOS,S
BVS +
BPL NOBRNCH
BMI BRNCH
+ BMI NOBRNCH
BPL BRNCH
DECBRGE PLA
DEC
PHA
_BRGE LDA TOS,S
SEC
SBC NOS,S
BVS +
BPL BRNCH
BMI NOBRNCH
INCBRLE PLA
INC
PHA
_BRLE LDA NOS,S
SEC
SBC TOS,S
BVS +
BPL BRNCH
BMI NOBRNCH
+ BMI BRNCH
BPL NOBRNCH
SUBBRGE LDA NOS,S
SEC
SBC TOS,S
STA NOS,S
PLA
BRA _BRGE
ADDBRLE PLA
CLC
ADC TOS,S
STA TOS,S
BRA _BRLE
;*
;* INDIRECT CALL TO ADDRESS (NATIVE CODE)
;*
ICAL PLA
BRA EMUSTK
;*
;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE)
;*
CALL INY ;+INC_IP
LDA (IP),Y
INY
EMUSTK STA TMP
TYA ; FLATTEN IP
SEC
ADC IP
STA IP
SEC ; SWITCH TO EMULATION MODE
XCE
!AS
TSC ; MOVE HW EVAL STACK TO ZP EVAL STACK
CLC
ADC #ESTKSZ
SEC
SBC HWSP ; PARAM STACK SIZE
LSR ; PARAM STACK COUNT
TAX
CPX #ESTKSZ/2
BEQ +
TAY
- PLA
STA ESTKL,Y
PLA
STA ESTKH,Y
INY
CPY #ESTKSZ/2
BNE -
+ PEI (IP) ; SAVE INSTRUCTION POINTER
LDA PSR
PHA
PLP
JSR JMPTMP
PHP
PLA
STA PSR
SEI
CLC ; SWITCH BACK TO NATIVE MODE
XCE
+ACCMEM16 ; 16 BIT A/M
PLA
STA IP
STX ESP
TSX
STX HWSP
LDX #ESTKSZ/2 ; COPY ZERO PAGE EVAL STACK TO HW STACK
CMP ESP
BEQ +
- LDY ESTKH,X
PHY
LDY ESTKL,X
PHY
DEX
CPX ESP
BNE -
+ LDX #>OPTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE
STX OPPAGE
LDY #$00
JMP FETCHOP
;*
;* INDIRECT CALL TO ADDRESS (NATIVE CODE)
;*
ICALX PLA
BRA EMUSTKX
;*
;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE)
;*
CALLX INY ;+INC_IP
LDA (IP),Y
INY
EMUSTKX STA TMP
TYA ; FLATTEN IP
SEC
ADC IP
STA IP
SEC ; SWITCH TO EMULATION MODE
XCE
!AS
TSC ; MOVE HW EVAL STACK TO ZP EVAL STACK
CLC
ADC #ESTKSZ
SEC
SBC HWSP ; PARAM STACK SIZE
LSR ; PARAM STACK COUNT
TAX
CPX #ESTKSZ/2
BEQ +
TAY
- PLA
STA ESTKL,Y
PLA
STA ESTKH,Y
INY
CPY #ESTKSZ/2
BNE -
+ PEI (IP) ; SAVE INSTRUCTION POINTER
STA ALTRDOFF
LDA PSR
PHA
PLP
JSR JMPTMP
PHP
PLA
STA PSR
SEI
CLC ; SWITCH BACK TO NATIVE MODE
XCE
+ACCMEM16 ; 16 BIT A/M
PLA
STA IP
STX ESP
TSX
STX HWSP
LDX #ESTKSZ/2 ; COPY ZERO PAGE EVAL STACK TO HW STACK
CMP ESP
BEQ +
- LDY ESTKH,X
PHY
LDY ESTKL,X
PHY
DEX
CPX ESP
BNE -
+ STX ALTRDON
LDX #>OPXTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE
STX OPPAGE
LDY #$00
JMP FETCHOP
;*
;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT
;*
ENTER LDA IFP
STA TMP
INY
LDA (IP),Y ; FRAME SIZE
AND #$00FF
TAX
INC
INC ; SAVE SPACE FOR PREV IFP
EOR #$FFFF ; ALLOCATE FRAME
SEC
ADC PP
STA PP
STA IFP
INY
LDA (IP),Y ; PARAM COUNT
AND #$00FF
BEQ +
ASL
TAY
- PLA ; COPY PARAMS FROM STACK INTO FRAME
DEY
DEY
STA (IFP),Y
BNE -
+ TXY ; SAVE PREVIOUS IFP AT TOP OF FRAME
LDA TMP
STA (IFP),Y
LDY #$03
JMP FETCHOP
;*
;* LEAVE FUNCTION
;*
LEAVE STX ALTRDOFF
INY ;+INC_IP
LDA (IP),Y ; DEALLOCATE POOL + FRAME
AND #$00FF
TAY
CLC
ADC #$02 ; PREVIOUS IFP HIDDEN AT END OF FRAME
ADC IFP
STA PP
LDA (IFP),Y ; RESTORE PREVIOUS FRAME
STA IFP
RET STX ALTRDOFF
SEC ; SWITCH TO EMULATION MODE
XCE
!AS
TSC ; MOVE HW EVAL STACK TO ZP EVAL STACK
CLC
ADC #ESTKSZ
SEC
SBC HWSP ; PARAM STACK SIZE
LSR ; PARAM STACK COUNT
TAX
CPX #ESTKSZ/2
BEQ +
TAY
- PLA
STA ESTKL,Y
PLA
STA ESTKH,Y
INY
CPY #ESTKSZ/2
BNE -
+ LDA PSR
PHA
PLP
RTS ; RETURN IN EMULATION MODE
;*
;* RETURN TO NATIVE CODE
;*
NATV TYA ; FLATTEN IP
SEC
ADC IP
STA IP
+INDEX16 ; SET 16 BIT X/Y
JMP (IP)
;*
;* JUMPS FOR FORTH COMPILER
;*
JUMPZ PLA
BEQ JUMP
INY ;+INC_IP
INY
BMI +
JMP NEXTOP
+ JMP FIXNEXT
JUMP INY
LDA (IP),Y
STA IP
LDY #$00
JMP FETCHOP
VMEND = *
}