lawless-legends/PLASMA/src/plvm02.s
2014-06-23 18:55:52 -07:00

1549 lines
20 KiB
ArmAsm

;**********************************************************
;*
;* APPLE ][ 64K/128K PLASMA INTERPETER
;*
;* SYSTEM ROUTINES AND LOCATIONS
;*
;**********************************************************
;*
;* 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 "plvm02zp.inc"
STRBUF = $0280
INTERP = $03D0
;*
;* INTERPRETER INSTRUCTION POINTER INCREMENT MACRO
;*
!MACRO INC_IP {
INY
BNE * + 4
INC IPH
}
;******************************
;* *
;* INTERPRETER INITIALIZATION *
;* *
;******************************
* = $2000
LDX #$FF
TXS
;*
;* 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
;*
;* MOVE VM INTO LANGUAGE CARD
;*
BIT LCRWEN+LCBNK2
BIT LCRWEN+LCBNK2
LDA #<VMCORE
STA SRCL
LDA #>VMCORE
STA SRCH
LDA #$00
STA DSTL
LDA #$D0
STA DSTH
LDY #$00
- LDA (SRC),Y ; COPY VM+CMD INTO LANGUAGE CARD
STA (DST),Y
INY
BNE -
INC SRCH
INC DSTH
LDA DSTH
CMP #$E0
BNE -
;*
;* MOVE FIRST PAGE OF 'BYE' INTO PLACE
;*
LDY #$00
STY SRCL
LDA #$D1
STA SRCH
- LDA (SRC),Y
STA $1000,Y
INY
BNE -
;*
;* SAVE DEFAULT COMMAND INTERPRETER PATH IN LC
;*
JSR PRODOS ; GET PREFIX
!BYTE $C7
!WORD GETPFXPARMS
LDY STRBUF ; APPEND "CMD"
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
STY STRBUF
BIT LCRWEN+LCBNK2 ; COPY TO LC FOR BYE
BIT LCRWEN+LCBNK2
- LDA STRBUF,Y
STA LCDEFCMD,Y
DEY
BPL -
JMP CMDEXEC
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,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E
!WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E
!WORD LNOT,LOR,LAND,LA,LLA,CB,CW,SWAP ; 20 22 24 26 28 2A 2C 2E
!WORD DROP,DUP,PUSH,PULL,BRGT,BRLT,BREQ,BRNE ; 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,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,NEXTOP ; 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
;*
;* ENTER INTO BYTECODE INTERPRETER
;*
DINTERP PLA
STA IPL
PLA
STA IPH
LDY #$01
LDA #>OPTBL
STA OPPAGE
JMP FETCHOP
IINTRP PLA
STA TMPL
PLA
STA TMPH
LDY #$02
LDA (TMP),Y
STA IPH
DEY
LDA (TMP),Y
STA IPL
DEY
LDA #>OPTBL
STA OPPAGE
JMP FETCHOP
IINTRPX PLA
STA TMPL
PLA
STA TMPH
LDY #$02
LDA (TMP),Y
STA IPH
DEY
LDA (TMP),Y
STA IPL
DEY
LDA #>OPXTBL
STA OPPAGE
SEI
STA ALTRDON
JMP FETCHOP
;************************************************************
;* *
;* 'BYE' PROCESSING - COPIED TO $1000 ON PRODOS BYE COMMAND *
;* *
;************************************************************
!ALIGN 255,0
!PSEUDOPC $1000 {
BYE LDY DEFCMD
- LDA DEFCMD,Y ; SET DEFAULT COMMAND WHEN CALLED FROM 'BYE'
STA STRBUF,Y
DEY
BPL -
CMDEXEC = *
;
; DEACTIVATE 80 COL CARDS
;
BIT ROMEN
LDY #4
- LDA DISABLE80,Y
ORA #$80
JSR $FDED
DEY
BPL -
BIT $C054 ; SET TEXT MODE
BIT $C051
BIT $C058
JSR $FC58 ; HOME
;
; INSTALL PAGE 0 FETCHOP ROUTINE
;
LDY #$0F
- LDA PAGE0,Y
STA DROP,Y
DEY
BPL -
;
; INSTALL PAGE 3 VECTORS
;
LDY #$11
- 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
JMP $2000 ; JUMP TO LOADED SYSTEM COMMAND
;
; PRINT FAIL MESSAGE, WAIT FOR KEYPRESS, AND REBOOT
;
FAIL INC $3F4 ; INVALIDATE POWER-UP BYTE
LDY #$01
- LDA FAILMSG,Y
ORA #$80
JSR $FDED
INY
CPY FAILMSG
BNE -
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 $1100
!WORD 0
CLOSEPARMS !BYTE 1
!BYTE 0
DISABLE80 !BYTE 21, 13, '1', 26, 13
FAILMSG !BYTE 39
!TEXT "MISSING CMD. PRESS ANY KEY TO RESET..."
PAGE0 = *
;******************************
;* *
;* INTERP BYTECODE INNER LOOP *
;* *
;******************************
!PSEUDOPC $00EF {
INX ; DROP @ $EF
INY ; NEXTOP @ $F0
BEQ NEXTOPH
LDA $FFFF,Y ; FETCHOP @ $F3, IP MAPS OVER $FFFF @ $F4
STA OPIDX
JMP (OPTBL) ; OPIDX AND OPPAGE MAP OVER OPTBL
NEXTOPH INC IPH
BNE FETCHOP
}
PAGE3 = *
;*
;* PAGE 3 VECTORS INTO INTERPRETER
;*
!PSEUDOPC $03D0 {
BIT LCRDEN+LCBNK2 ; $03D0 - DIRECT INTERP ENTRY
JMP DINTERP
BIT LCRDEN+LCBNK2 ; $03D6 - INDIRECT INTERP ENTRY
JMP IINTRP
BIT LCRDEN+LCBNK2 ; $03DC - INDIRECT INTERPX ENTRY
JMP IINTRPX
}
DEFCMD !FILL 33
ENDBYE = *
}
LCDEFCMD = *-33 ; DEFCMD IN LC MEMORY
;*****************
;* *
;* OPXCODE TABLE *
;* *
;*****************
!ALIGN 255,0
OPXTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E
!WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E
!WORD LNOT,LOR,LAND,LA,LLA,CB,CW,SWAP ; 20 22 24 26 28 2A 2C 2E
!WORD DROP,DUP,PUSH,PULL,BRGT,BRLT,BREQ,BRNE ; 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,IBRNCH,CALLX,ICALX,ENTERX,LEAVEX,RETX,NEXTOP; 50 52 54 56 58 5A 5C 5E
!WORD LBX,LWX,LLBX,LLWX,LABX,LAWX,DLBX,DLWX ; 60 62 64 66 68 6A 6C 6E
!WORD SBX,SWX,SLBX,SLWX,SABX,SAWX,DABX,DAWX ; 70 72 74 76 78 7A 7C 7E
;*
;* ADD TOS TO TOS-1
;*
ADD LDA ESTKL,X
CLC
ADC ESTKL+1,X
STA ESTKL+1,X
LDA ESTKH,X
ADC ESTKH+1,X
STA ESTKH+1,X
INX
JMP NEXTOP
;*
;* SUB TOS FROM TOS-1
;*
SUB LDA ESTKL+1,X
SEC
SBC ESTKL,X
STA ESTKL+1,X
LDA ESTKH+1,X
SBC ESTKH,X
STA ESTKH+1,X
INX
JMP NEXTOP
;*
;* SHIFT TOS-1 LEFT BY 1, ADD TO TOS-1
;*
IDXW LDA ESTKL,X
ASL
ROL ESTKH,X
CLC
ADC ESTKL+1,X
STA ESTKL+1,X
LDA ESTKH,X
ADC ESTKH+1,X
STA ESTKH+1,X
INX
JMP NEXTOP
;*
;* MUL TOS-1 BY TOS
;*
MUL STY IPY
LDY #$10
LDA #$00
STA TMPL ; PRODL
STA TMPH ; PRODH
MULLP LSR ESTKH,X ; MULTPLRH
ROR ESTKL,X ; MULTPLRL
BCC +
LDA ESTKL+1,X ; MULTPLNDL
CLC
ADC TMPL ; PRODL
STA TMPL
LDA ESTKH+1,X ; MULTPLNDH
ADC TMPH ; PRODH
STA TMPH
+ ASL ESTKL+1,X ; MULTPLNDL
ROL ESTKH+1,X ; MULTPLNDH
DEY
BNE MULLP
INX
; LDA TMPH ; PRODH
STA ESTKH,X
LDA TMPL ; PRODL
STA ESTKL,X
LDY IPY
JMP NEXTOP
;*
;* INTERNAL DIVIDE ALGORITHM
;*
_NEG LDA #$00
SEC
SBC ESTKL,X
STA ESTKL,X
LDA #$00
SBC ESTKH,X
STA ESTKH,X
RTS
_DIV STY IPY
LDA ESTKH,X
AND #$80
STA DVSIGN
BPL +
JSR _NEG
INC DVSIGN
+ LDA ESTKH+1,X
BPL +
INX
JSR _NEG
DEX
INC DVSIGN
BNE _DIV1
+ ORA ESTKL+1,X ; DVDNDL
BNE _DIV1
STA TMPL
STA TMPH
RTS
_DIV1 LDY #$11 ; #BITS+1
LDA #$00
STA TMPL ; REMNDRL
STA TMPH ; REMNDRH
- ASL ESTKL+1,X ; DVDNDL
ROL ESTKH+1,X ; DVDNDH
DEY
BCC -
STY ESTKL-1,X
_DIVLP ROL TMPL ; REMNDRL
ROL TMPH ; REMNDRH
LDA TMPL ; REMNDRL
SEC
SBC ESTKL,X ; DVSRL
TAY
LDA TMPH ; REMNDRH
SBC ESTKH,X ; DVSRH
BCC +
STA TMPH ; REMNDRH
STY TMPL ; REMNDRL
+ ROL ESTKL+1,X ; DVDNDL
ROL ESTKH+1,X ; DVDNDH
DEC ESTKL-1,X
BNE _DIVLP
LDY IPY
RTS
;*
;* NEGATE TOS
;*
NEG LDA #$00
SEC
SBC ESTKL,X
STA ESTKL,X
LDA #$00
SBC ESTKH,X
STA ESTKH,X
JMP NEXTOP
;*
;* DIV TOS-1 BY TOS
;*
DIV JSR _DIV
INX
LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1
BCS NEG
JMP NEXTOP
;*
;* MOD TOS-1 BY TOS
;*
MOD JSR _DIV
INX
LDA TMPL ; REMNDRL
STA ESTKL,X
LDA TMPH ; REMNDRH
STA ESTKH,X
LDA DVSIGN ; REMAINDER IS SIGN OF DIVIDEND
BMI NEG
JMP NEXTOP
;*
;* INCREMENT TOS
;*
INCR INC ESTKL,X
BNE INCR1
INC ESTKH,X
INCR1 JMP NEXTOP
;*
;* DECREMENT TOS
;*
DECR LDA ESTKL,X
BNE DECR1
DEC ESTKH,X
DECR1 DEC ESTKL,X
JMP NEXTOP
;*
;* BITWISE COMPLIMENT TOS
;*
COMP LDA #$FF
EOR ESTKL,X
STA ESTKL,X
LDA #$FF
EOR ESTKH,X
STA ESTKH,X
JMP NEXTOP
;*
;* BITWISE AND TOS TO TOS-1
;*
BAND LDA ESTKL+1,X
AND ESTKL,X
STA ESTKL+1,X
LDA ESTKH+1,X
AND ESTKH,X
STA ESTKH+1,X
INX
JMP NEXTOP
;*
;* INCLUSIVE OR TOS TO TOS-1
;*
IOR LDA ESTKL+1,X
ORA ESTKL,X
STA ESTKL+1,X
LDA ESTKH+1,X
ORA ESTKH,X
STA ESTKH+1,X
INX
JMP NEXTOP
;*
;* EXLUSIVE OR TOS TO TOS-1
;*
XOR LDA ESTKL+1,X
EOR ESTKL,X
STA ESTKL+1,X
LDA ESTKH+1,X
EOR ESTKH,X
STA ESTKH+1,X
INX
JMP NEXTOP
;*
;* SHIFT TOS-1 LEFT BY TOS
;*
SHL STY IPY
LDA ESTKL,X
CMP #$08
BCC SHL1
LDY ESTKL+1,X
STY ESTKH+1,X
LDY #$00
STY ESTKL+1,X
SBC #$08
SHL1 TAY
BEQ SHL3
SHL2 ASL ESTKL+1,X
ROL ESTKH+1,X
DEY
BNE SHL2
SHL3 INX
LDY IPY
JMP NEXTOP
;*
;* SHIFT TOS-1 RIGHT BY TOS
;*
SHR STY IPY
LDA ESTKL,X
CMP #$08
BCC SHR2
LDY ESTKH+1,X
STY ESTKL+1,X
CPY #$80
LDY #$00
BCC SHR1
DEY
SHR1 STY ESTKH+1,X
SEC
SBC #$08
SHR2 TAY
BEQ SHR4
LDA ESTKH+1,X
SHR3 CMP #$80
ROR
ROR ESTKL+1,X
DEY
BNE SHR3
STA ESTKH+1,X
SHR4 INX
LDY IPY
JMP NEXTOP
;*
;* LOGICAL NOT
;*
LNOT LDA ESTKL,X
ORA ESTKH,X
BEQ LNOT1
LDA #$FF
LNOT1 EOR #$FF
STA ESTKL,X
STA ESTKH,X
JMP NEXTOP
;*
;* LOGICAL AND
;*
LAND LDA ESTKL,X
ORA ESTKH,X
BEQ LAND1
LDA ESTKL+1,X
ORA ESTKH+1,X
BEQ LAND1
LDA #$FF
LAND1 STA ESTKL+1,X
STA ESTKH+1,X
INX
JMP NEXTOP
;*
;* LOGICAL OR
;*
LOR LDA ESTKL,X
ORA ESTKH,X
ORA ESTKL+1,X
ORA ESTKH+1,X
BEQ LOR1
LDA #$FF
LOR1 STA ESTKL+1,X
STA ESTKH+1,X
INX
JMP NEXTOP
;*
;* SWAP TOS WITH TOS-1
;*
SWAP STY IPY
LDA ESTKL,X
LDY ESTKL+1,X
STA ESTKL+1,X
STY ESTKL,X
LDA ESTKH,X
LDY ESTKH+1,X
STA ESTKH+1,X
STY ESTKH,X
LDY IPY
JMP NEXTOP
;*
;* DUPLICATE TOS
;*
DUP DEX
LDA ESTKL+1,X
STA ESTKL,X
LDA ESTKH+1,X
STA ESTKH,X
JMP NEXTOP
;*
;* PUSH FROM EVAL STACK TO CALL STACK
;*
PUSH LDA ESTKL,X
PHA
LDA ESTKH,X
PHA
INX
JMP NEXTOP
;*
;* PULL FROM CALL STACK TO EVAL STACK
;*
PULL DEX
PLA
STA ESTKH,X
PLA
STA ESTKL,X
JMP NEXTOP
;*
;* CONSTANT
;*
ZERO DEX
LDA #$00
STA ESTKL,X
STA ESTKH,X
JMP NEXTOP
CB DEX
+INC_IP
LDA (IP),Y
STA ESTKL,X
LDA #$00
STA ESTKH,X
JMP NEXTOP
;*
;* LOAD ADDRESS & LOAD CONSTANT WORD (SAME THING, WITH OR WITHOUT FIXUP)
;*
LA = *
CW DEX
+INC_IP
LDA (IP),Y
STA ESTKL,X
+INC_IP
LDA (IP),Y
STA ESTKH,X
JMP NEXTOP
;*
;* LOAD VALUE FROM ADDRESS TAG
;*
LB LDA ESTKL,X
STA TMPL
LDA ESTKH,X
STA TMPH
STY IPY
LDY #$00
LDA (TMP),Y
STA ESTKL,X
STY ESTKH,X
LDY IPY
JMP NEXTOP
LW LDA ESTKL,X
STA TMPL
LDA ESTKH,X
STA TMPH
STY IPY
LDY #$00
LDA (TMP),Y
STA ESTKL,X
INY
LDA (TMP),Y
STA ESTKH,X
LDY IPY
JMP NEXTOP
;
LBX LDA ESTKL,X
STA TMPL
LDA ESTKH,X
STA TMPH
STY IPY
STA ALTRDOFF
LDY #$00
LDA (TMP),Y
STA ESTKL,X
STY ESTKH,X
LDY IPY
STA ALTRDON
JMP NEXTOP
LWX LDA ESTKL,X
STA TMPL
LDA ESTKH,X
STA TMPH
STY IPY
STA ALTRDOFF
LDY #$00
LDA (TMP),Y
STA ESTKL,X
INY
LDA (TMP),Y
STA ESTKH,X
LDY IPY
STA ALTRDON
JMP NEXTOP
;*
;* LOAD ADDRESS OF LOCAL FRAME OFFSET
;*
LLA +INC_IP
LDA (IP),Y
DEX
CLC
ADC IFPL
STA ESTKL,X
LDA #$00
ADC IFPH
STA ESTKH,X
JMP NEXTOP
;*
;* LOAD VALUE FROM LOCAL FRAME OFFSET
;*
LLB +INC_IP
LDA (IP),Y
STY IPY
TAY
DEX
LDA (IFP),Y
STA ESTKL,X
LDA #$00
STA ESTKH,X
LDY IPY
JMP NEXTOP
LLW +INC_IP
LDA (IP),Y
STY IPY
TAY
DEX
LDA (IFP),Y
STA ESTKL,X
INY
LDA (IFP),Y
STA ESTKH,X
LDY IPY
JMP NEXTOP
;
LLBX +INC_IP
LDA (IP),Y
STY IPY
TAY
DEX
STA ALTRDOFF
LDA (IFP),Y
STA ESTKL,X
LDA #$00
STA ESTKH,X
STA ALTRDON
LDY IPY
JMP NEXTOP
LLWX +INC_IP
LDA (IP),Y
STY IPY
TAY
DEX
STA ALTRDOFF
LDA (IFP),Y
STA ESTKL,X
INY
LDA (IFP),Y
STA ESTKH,X
STA ALTRDON
LDY IPY
JMP NEXTOP
;*
;* LOAD VALUE FROM ABSOLUTE ADDRESS
;*
LAB +INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
LDA (IP),Y
STA TMPH
STY IPY
LDY #$00
LDA (TMP),Y
DEX
STA ESTKL,X
STY ESTKH,X
LDY IPY
JMP NEXTOP
LAW +INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
LDA (IP),Y
STA TMPH
STY IPY
LDY #$00
LDA (TMP),Y
DEX
STA ESTKL,X
INY
LDA (TMP),Y
STA ESTKH,X
LDY IPY
JMP NEXTOP
;
LABX +INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
LDA (IP),Y
STA TMPH
STY IPY
STA ALTRDOFF
LDY #$00
LDA (TMP),Y
DEX
STA ESTKL,X
STY ESTKH,X
STA ALTRDON
LDY IPY
JMP NEXTOP
LAWX +INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
LDA (IP),Y
STA TMPH
STY IPY
STA ALTRDOFF
LDY #$00
LDA (TMP),Y
DEX
STA ESTKL,X
INY
LDA (TMP),Y
STA ESTKH,X
STA ALTRDON
LDY IPY
JMP NEXTOP
;*
;* STORE VALUE TO ADDRESS
;*
SB LDA ESTKL+1,X
STA TMPL
LDA ESTKH+1,X
STA TMPH
LDA ESTKL,X
STY IPY
LDY #$00
STA (TMP),Y
INX
INX
LDY IPY
JMP NEXTOP
SW LDA ESTKL+1,X
STA TMPL
LDA ESTKH+1,X
STA TMPH
STY IPY
LDY #$00
LDA ESTKL,X
STA (TMP),Y
INY
LDA ESTKH,X
STA (TMP),Y
INX
INX
LDY IPY
JMP NEXTOP
;
SBX LDA ESTKL+1,X
STA TMPL
LDA ESTKH+1,X
STA TMPH
LDA ESTKL,X
STY IPY
STA ALTRDOFF
LDY #$00
STA (TMP),Y
STA ALTRDON
INX
INX
LDY IPY
JMP NEXTOP
SWX LDA ESTKL+1,X
STA TMPL
LDA ESTKH+1,X
STA TMPH
STY IPY
STA ALTRDOFF
LDY #$00
LDA ESTKL,X
STA (TMP),Y
INY
LDA ESTKH,X
STA (TMP),Y
STA ALTRDON
INX
INX
LDY IPY
JMP NEXTOP
;*
;* STORE VALUE TO LOCAL FRAME OFFSET
;*
SLB +INC_IP
LDA (IP),Y
STY IPY
TAY
LDA ESTKL,X
STA (IFP),Y
INX
LDY IPY
JMP NEXTOP
SLW +INC_IP
LDA (IP),Y
STY IPY
TAY
LDA ESTKL,X
STA (IFP),Y
INY
LDA ESTKH,X
STA (IFP),Y
INX
LDY IPY
JMP NEXTOP
;
SLBX +INC_IP
LDA (IP),Y
STY IPY
STA ALTRDOFF
TAY
LDA ESTKL,X
STA (IFP),Y
STA ALTRDON
INX
LDY IPY
JMP NEXTOP
SLWX +INC_IP
LDA (IP),Y
STY IPY
STA ALTRDOFF
TAY
LDA ESTKL,X
STA (IFP),Y
INY
LDA ESTKH,X
STA (IFP),Y
STA ALTRDON
INX
LDY IPY
JMP NEXTOP
;*
;* STORE VALUE TO LOCAL FRAME OFFSET WITHOUT POPPING STACK
;*
DLB +INC_IP
LDA (IP),Y
STY IPY
TAY
LDA ESTKL,X
STA (IFP),Y
LDY IPY
JMP NEXTOP
DLW +INC_IP
LDA (IP),Y
STY IPY
TAY
LDA ESTKL,X
STA (IFP),Y
INY
LDA ESTKH,X
STA (IFP),Y
LDY IPY
JMP NEXTOP
;
DLBX +INC_IP
LDA (IP),Y
STY IPY
STA ALTRDOFF
TAY
LDA ESTKL,X
STA (IFP),Y
STA ALTRDON
LDY IPY
JMP NEXTOP
DLWX +INC_IP
LDA (IP),Y
STY IPY
STA ALTRDOFF
TAY
LDA ESTKL,X
STA (IFP),Y
INY
LDA ESTKH,X
STA (IFP),Y
STA ALTRDON
LDY IPY
JMP NEXTOP
;*
;* STORE VALUE TO ABSOLUTE ADDRESS
;*
SAB +INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
LDA (IP),Y
STA TMPH
LDA ESTKL,X
STY IPY
LDY #$00
STA (TMP),Y
INX
LDY IPY
JMP NEXTOP
SAW +INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
LDA (IP),Y
STA TMPH
STY IPY
LDY #$00
LDA ESTKL,X
STA (TMP),Y
INY
LDA ESTKH,X
STA (TMP),Y
INX
LDY IPY
JMP NEXTOP
;
SABX +INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
LDA (IP),Y
STA TMPH
LDA ESTKL,X
STY IPY
STA ALTRDOFF
LDY #$00
STA (TMP),Y
STA ALTRDON
INX
LDY IPY
JMP NEXTOP
SAWX +INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
LDA (IP),Y
STA TMPH
STY IPY
STA ALTRDOFF
LDY #$00
LDA ESTKL,X
STA (TMP),Y
INY
LDA ESTKH,X
STA (TMP),Y
STA ALTRDON
INX
LDY IPY
JMP NEXTOP
;*
;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK
;*
DAB +INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
LDA (IP),Y
STA TMPH
STY IPY
LDY #$00
LDA ESTKL,X
STA (TMP),Y
LDY IPY
JMP NEXTOP
DAW +INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
LDA (IP),Y
STA TMPH
STY IPY
LDY #$00
LDA ESTKL,X
STA (TMP),Y
INY
LDA ESTKH,X
STA (TMP),Y
LDY IPY
JMP NEXTOP
;
DABX +INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
LDA (IP),Y
STA TMPH
STY IPY
STA ALTRDOFF
LDY #$00
LDA ESTKL,X
STA (TMP),Y
STA ALTRDON
LDY IPY
JMP NEXTOP
DAWX +INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
LDA (IP),Y
STA TMPH
STY IPY
STA ALTRDOFF
LDY #$00
LDA ESTKL,X
STA (TMP),Y
INY
LDA ESTKH,X
STA (TMP),Y
STA ALTRDON
LDY IPY
JMP NEXTOP
;*
;* COMPARES
;*
ISEQ LDA ESTKL,X
CMP ESTKL+1,X
BNE ISFLS
LDA ESTKH,X
CMP ESTKH+1,X
BNE ISFLS
ISTRU LDA #$FF
INX
STA ESTKL,X
STA ESTKH,X
JMP NEXTOP
;
ISNE LDA ESTKL,X
CMP ESTKL+1,X
BNE ISTRU
LDA ESTKH,X
CMP ESTKH+1,X
BNE ISTRU
ISFLS LDA #$00
INX
STA ESTKL,X
STA ESTKH,X
JMP NEXTOP
;
ISGE LDA ESTKL+1,X
CMP ESTKL,X
LDA ESTKH+1,X
SBC ESTKH,X
BVC ISGE1
EOR #$80
ISGE1 BPL ISTRU
BMI ISFLS
;
ISGT LDA ESTKL,X
CMP ESTKL+1,X
LDA ESTKH,X
SBC ESTKH+1,X
BVC ISGT1
EOR #$80
ISGT1 BMI ISTRU
BPL ISFLS
;
ISLE LDA ESTKL,X
CMP ESTKL+1,X
LDA ESTKH,X
SBC ESTKH+1,X
BVC ISLE1
EOR #$80
ISLE1 BPL ISTRU
BMI ISFLS
;
ISLT LDA ESTKL+1,X
CMP ESTKL,X
LDA ESTKH+1,X
SBC ESTKH,X
BVC ISLT1
EOR #$80
ISLT1 BMI ISTRU
BPL ISFLS
;*
;* BRANCHES
;*
BRTRU INX
LDA ESTKH-1,X
ORA ESTKL-1,X
BNE BRNCH
NOBRNCH +INC_IP
+INC_IP
JMP NEXTOP
BRFLS INX
LDA ESTKH-1,X
ORA ESTKL-1,X
BNE NOBRNCH
BRNCH LDA IPH
STA TMPH
LDA IPL
+INC_IP
CLC
ADC (IP),Y
STA TMPL
LDA TMPH
+INC_IP
ADC (IP),Y
STA IPH
LDA TMPL
STA IPL
DEY
DEY
JMP NEXTOP
BREQ INX
LDA ESTKL-1,X
CMP ESTKL,X
BNE NOBRNCH
LDA ESTKL-1,X
CMP ESTKL,X
BEQ BRNCH
BNE NOBRNCH
BRNE INX
LDA ESTKL-1,X
CMP ESTKL,X
BNE BRNCH
LDA ESTKL-1,X
CMP ESTKL,X
BEQ NOBRNCH
BNE BRNCH
BRGT INX
LDA ESTKL-1,X
CMP ESTKL,X
LDA ESTKH-1,X
SBC ESTKH,X
BMI BRNCH
BPL NOBRNCH
BRLT INX
LDA ESTKL,X
CMP ESTKL-1,X
LDA ESTKH,X
SBC ESTKH-1,X
BMI BRNCH
BPL NOBRNCH
IBRNCH LDA IPL
CLC
ADC ESTKL,X
STA IPL
LDA IPH
ADC ESTKH,X
STA IPH
INX
JMP NEXTOP
;*
;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE)
;*
CALL +INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
LDA (IP),Y
STA TMPH
LDA IPH
PHA
LDA IPL
PHA
TYA
PHA
JSR JMPTMP
PLA
TAY
PLA
STA IPL
PLA
STA IPH
LDA #>OPTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE
STA OPPAGE
JMP NEXTOP
;
CALLX +INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
LDA (IP),Y
STA TMPH
LDA IPH
PHA
LDA IPL
PHA
TYA
PHA
STA ALTRDOFF
CLI
JSR JMPTMP
SEI
STA ALTRDON
PLA
TAY
PLA
STA IPL
PLA
STA IPH
LDA #>OPXTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE
STA OPPAGE
JMP NEXTOP
;*
;* INDIRECT CALL TO ADDRESS (NATIVE CODE)
;*
ICAL LDA ESTKL,X
STA TMPL
LDA ESTKH,X
STA TMPH
INX
LDA IPH
PHA
LDA IPL
PHA
TYA
PHA
JSR JMPTMP
PLA
TAY
PLA
STA IPL
PLA
STA IPH
LDA #>OPTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE
STA OPPAGE
JMP NEXTOP
;
ICALX LDA ESTKL,X
STA TMPL
LDA ESTKH,X
STA TMPH
INX
LDA IPH
PHA
LDA IPL
PHA
TYA
PHA
STA ALTRDOFF
CLI
JSR JMPTMP
SEI
STA ALTRDON
PLA
TAY
PLA
STA IPL
PLA
STA IPH
LDA #>OPXTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE
STA OPPAGE
JMP NEXTOP
;*
;* JUMP INDIRECT TRHOUGH TMP
;*
JMPTMP JMP (TMP)
;*
;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT
;*
ENTER +INC_IP
LDA (IP),Y
STA FRMSZ
+INC_IP
LDA (IP),Y
STA NPARMS
STY IPY
LDA IFPL
PHA
SEC
SBC FRMSZ
STA IFPL
LDA IFPH
PHA
SBC #$00
STA IFPH
LDY #$01
PLA
STA (IFP),Y
DEY
PLA
STA (IFP),Y
LDA NPARMS
BEQ ENTER5
ASL
TAY
INY
ENTER4 LDA ESTKH,X
STA (IFP),Y
DEY
LDA ESTKL,X
STA (IFP),Y
DEY
INX
DEC NPARMS
BNE ENTER4
ENTER5 LDY IPY
JMP NEXTOP
;
ENTERX +INC_IP
LDA (IP),Y
STA FRMSZ
+INC_IP
LDA (IP),Y
STA NPARMS
STY IPY
STA ALTRDOFF
LDA IFPL
PHA
SEC
SBC FRMSZ
STA IFPL
LDA IFPH
PHA
SBC #$00
STA IFPH
LDY #$01
PLA
STA (IFP),Y
DEY
PLA
STA (IFP),Y
LDA NPARMS
BEQ ENTERX5
ASL
TAY
INY
ENTERX4 LDA ESTKH,X
STA (IFP),Y
DEY
LDA ESTKL,X
STA (IFP),Y
DEY
INX
DEC NPARMS
BNE ENTERX4
ENTERX5 STA ALTRDON
LDY IPY
JMP NEXTOP
;*
;* LEAVE FUNCTION
;*
LEAVE LDY #$01
LDA (IFP),Y
DEY
PHA
LDA (IFP),Y
STA IFPL
PLA
STA IFPH
RET RTS
;
LEAVEX STA ALTRDOFF
CLI
LDY #$01
LDA (IFP),Y
DEY
PHA
LDA (IFP),Y
STA IFPL
PLA
STA IFPH
RTS
RETX STA ALTRDOFF
CLI
RTS
VMEND = *
}