Apple-2-Tools
/
VM02
mirror of https://github.com/dschmenk/VM02.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity
VM02/src/ops.s

3529 lines
48 KiB
ArmAsm
Executable File
Raw Permalink Blame History

;*
;* JAVA OPCODE INTERPRETER FOR 6502
;*
.INCLUDE "global.inc"
.INCLUDE "class.inc"
.INCLUDE "frame.inc"
.IMPORT COUT,CROUT,PRBYTE,MEMSRC,MEMDST,MEMCPY,MEMCLR
.IMPORT THREAD_LOCK,THREAD_UNLOCK
.IMPORT HMEM_ALLOC,HMEM_ALLOC_FIXED,HMEM_FREE,HMEM_LOCK,HMEM_UNLOCK,HMEM_UNLOCK_CODE
.IMPORT HMEM_PTR,HMEM_REF_INC,HMEM_REF_DEC,HMEM_CLR
.IMPORT HSTR_HASH,STR_HASH,HSTRPL_ADD,HSTRPL_DEL
.IMPORT HCLASS_NAME,HCLASS_HNDL,HCLASS_ADD,HCLASS_INDEX,RESOLVE_CLASS,CLASS_OF
.IMPORT CLASS_MATCH_NAME,CLASS_MATCH_DESC,RESOLVE_METHOD,CLASS_METHODPTR,RESOLVE_FIELD,CLASS_FIELDPTR
.IMPORT UNREF_OBJECT,WARM_INIT
.IMPORT INVOKE_VIRTUAL,INVOKE_STATIC,INVOKE_SPECIAL,EXIT_METHOD,CATCH_EXCEPTN
.IMPORT THROW_SYSEXCEPTN,THROW_INTERNALERR,CURRENTEXCEPTN
.EXPORT SCANDESCPARMS,EXECBYTECODES,LOOKUPCLASSIDX,SYSTHROW,INTERP_INIT,INTERP_END
.IFDEF BIGMEM
.MACRO LDB_BYTECODE
JSR READBYTECODEB
.ENDMACRO
.MACRO LDW_BYTECODE
JSR READBYTECODEW
.ENDMACRO
.ELSE ; BIGMEM
.MACRO LDB_BYTECODE
LDA (EXECPC),Y
.ENDMACRO
.MACRO LDW_BYTECODE
LDA (EXECPC),Y
INY
TAX
LDA (EXECPC),Y
.ENDMACRO
.ENDIF
.CODE
;*
;* CLASS HELPER ROUTINES
;*
SETCONSTPTR: CALC_CONSTPLRECSZ
CLC
ADC EXECCONSTPL
STA CONSTPTR
TXA
ADC EXECCONSTPL+1
STA CONSTPTR+1
RTS
GETCONSTB: JSR SETCONSTPTR
LDA (CONSTPTR),Y
RTS
GETCONSTW: JSR SETCONSTPTR
LDA (CONSTPTR),Y
INY
TAX
LDA (CONSTPTR),Y
RTS
;
; LOOKUP CLASS REFERENCE IN CONSTPOOL - CONSPTR PROBALY TRASHED
;
LOOKUPCLASSREF: LDY #$01 ; GET CLASS INDEX
LDA (CONSTPTR),Y
INY
TAX
LDA (CONSTPTR),Y
;
; LOOKUP CLASS INDEX IN CONST POOL
;
LOOKUPCLASSIDX: STA CCLASSINDEX ; SAVE CLASS INDEX
STX CCLASSINDEX+1
LDY #$01
JSR GETCONSTB
BPL :+
INY
LDA (CONSTPTR),Y ; CLASS ALREADY LINKED
INY
STA TARGETCLASS
LDA (CONSTPTR),Y
INY
TAX
LDA (CONSTPTR),Y
LDY TARGETCLASS
RTS
: LDA CCLASSINDEX
PHA
LDA CCLASSINDEX+1
PHA
LDY #$03 ; GET CLASS NAME INDEX
LDA (CONSTPTR),Y
INY
TAX
LDA (CONSTPTR),Y
DEY ; LDY #$03 ; GET CLASS NAME
JSR GETCONSTW
JSR RESOLVE_CLASS
BCS :+
STY TARGETCLASS
STA CCINST ; STEAL CLASS CLASS VAR FOR A SEC
STX CCINST+1
PLA ; RESTORE CLASS INDEX
TAX
PLA
JSR SETCONSTPTR
LDA CCINST
LDY #$04 ; SAVE LINKED CLASS
STA (CONSTPTR),Y ; HANDLE TO CLASS
DEY
LDA CCINST+1
TAX
STA (CONSTPTR),Y
DEY
LDA TARGETCLASS ; INDEX TO CLASS
STA (CONSTPTR),Y
DEY
LDA #$80
STA (CONSTPTR),Y
LDA CCINST
LDY TARGETCLASS
RTS
:
.IFDEF DEBUG
.IMPORT PRSTR
STA TMPTR
STX TMPTR+1
LDY #$03 ; GET CLASS NAME
LDA (TMPTR),Y
INY
TAX
LDA (TMPTR),Y
JSR PRSTR
LDA #':'
JSR COUT
PERR "UNABLE TO RESOLVE CLASS"
.ENDIF
JMP RETHROW
;
; LOOKUP REFERENCE NAME/TYPE
;
LOOKUPREF: LDY #$04
JSR GETCONSTB ; GET NAME/TYPE
DEY
PHA ; SAVE TYPE INDEX ON STACK
LDA (CONSTPTR),Y
PHA
LDY #$01 ; GET NAME INDEX
LDA (CONSTPTR),Y
INY
TAX
LDA (CONSTPTR),Y
LDY #$03
JSR GETCONSTW ; GET NAME
JSR CLASS_MATCH_NAME ; SAVE MATCH NAME
PLA ; RETRIEVE TYPE INDEX FROM STACK
TAX
PLA
LDY #$03
JSR GETCONSTW ; GET TYPE
JSR CLASS_MATCH_DESC ; SAVE MATCH TYPE
LDY TARGETCLASS
RTS
;
; GET POINTER TO FIELDS
;
GETFIELDPTR: STA CCLASSINDEX ; SAVE REF INDEX
STX CCLASSINDEX+1
LDY #$01
JSR GETCONSTB ; MSB MEANS ALREADY LINKED
BMI FLDLNK
LDA CCLASSINDEX
PHA
LDA CCLASSINDEX+1
PHA
LDY #$04 ; GET FIELD NAME/TYPE INDEX
LDA (CONSTPTR),Y
DEY
PHA
LDA (CONSTPTR),Y
PHA
JSR LOOKUPCLASSREF
PLA
TAX
PLA
JSR LOOKUPREF ; LOOKUP FIELD IN CONSTPTR
JSR RESOLVE_FIELD
BCC :+
LDA #10 ; NO SUCH FIELD
JMP SYSTHROW
: STY TARGETCLASS
STA CCINST ; STEAL CLASS CLASS VAR FOR A SEC
STX CCINST+1
PLA ; RESTORE CLASS INDEX
TAX
PLA
JSR SETCONSTPTR
LDA CCINST
LDY #$04 ; SAVE LINKED CLASS/FIELD OFFSET
STA (CONSTPTR),Y
DEY
LDA CCINST+1
STA (CONSTPTR),Y
DEY
LDA TARGETCLASS
STA (CONSTPTR),Y
DEY
LDA #$80
STA (CONSTPTR),Y
FLDLNK: INY
LDA (CONSTPTR),Y
INY
STA TARGETCLASS
LDA (CONSTPTR),Y
INY
TAX
LDA (CONSTPTR),Y
LDY TARGETCLASS
JSR CLASS_FIELDPTR
STA FIELDPTR
STX FIELDPTR+1
RTS
;
; GET POINTER TO METHOD
;
GETMETHODPTR: STA CCLASSINDEX ; SAVE REF INDEX
STX CCLASSINDEX+1
LDY #$01
JSR GETCONSTB ; MSB MEANS ALREADY LINKED
BMI MTHDLNK
LDA CCLASSINDEX
PHA
LDA CCLASSINDEX+1
PHA
LDY #$04 ; GET METHOD NAME/TYPE INDEX
LDA (CONSTPTR),Y
DEY
PHA
LDA (CONSTPTR),Y
PHA
JSR LOOKUPCLASSREF
PLA
TAX
PLA
JSR LOOKUPMETHODREF
STY TARGETCLASS ; MAY BE SUPERCLASS OF CLASS REF
STA CCINST ; STEAL CLASS CLASS VAR FOR A SEC
STX CCINST+1
PLA ; RESTORE CLASS INDEX
TAX
PLA
JSR SETCONSTPTR
LDA CCINST
LDY #$04 ; SAVE LINKED CLASS/METHOD OFFSET
STA (CONSTPTR),Y
DEY
LDA CCINST+1
STA (CONSTPTR),Y
DEY
LDA TARGETCLASS
STA (CONSTPTR),Y
DEY
LDA #$80
STA (CONSTPTR),Y
MTHDLNK: INY
LDA (CONSTPTR),Y
INY
STA TARGETCLASS
LDA (CONSTPTR),Y
INY
TAX
LDA (CONSTPTR),Y
LDY TARGETCLASS
RTS
;
; SCAN DESCRIPTOR STRING FOR PARAM COUNT
;
SCANDESCPARMS: JSR HMEM_PTR ; GET POINTER TO DESC STRING
STA TMPTR
STX TMPTR+1
LDX #$00
LDY #$02 ; BETTER START WITH '('
SCANDP_LP: LDA (TMPTR),Y
INY
CMP #')'
BEQ SCANDP_DONE
INX ; INC PARAM COUNT
CMP #'L'
BEQ SCANDP_REF
CMP #'['
BNE SCANDP_LP
SCANDP_ARRAY: LDA (TMPTR),Y
INY
CMP #'['
BEQ SCANDP_ARRAY ; EAT ARRAY
CMP #'L'
BNE SCANDP_LP ; FALL THROUGH FOR ARRAY OBJECTS
SCANDP_REF: LDA (TMPTR),Y
INY
CMP #';'
BNE SCANDP_REF
BEQ SCANDP_LP
SCANDP_DONE: TXA
ASL ; CONVERT PARAM COUNT TO BYTE COUNT
ASL
RTS
;*
;* ARRAY ROUTINES
;*
;
; CHECK ARRAY INDEX AND FILL IN OFFSET AND ARRAYPTR
;
CHKSTOREINDEX: INX
INX
INX
INX
CHKINDEX: LDA $0103,X
ORA $0104,X
BNE ARRAYINDEXERR
LDA $0102,X
STA TARGETOFFSET+1
LDA $0101,X
STA TARGETOFFSET
.IFDEF DEBUG
LDA $0107,X
AND #$7F
CMP #CL_ARRAY
BEQ :+
LDA #8 ; INCOMPATIBLE CLASS
JMP SYSTHROW
:
.ENDIF
LDA $0105,X ; GET POINTER TO ARRAY DATA
TAY
LDA $0106,X
BEQ NULLARRAYERR
TAX
TYA
JSR HMEM_PTR
STA TMPTR
STX TMPTR+1
CLC ; SKIP ARRAY LENGTH VALUE
ADC #$02
BCC :+
INX
: STA ARRAYPTR
STX ARRAYPTR+1
LDY #$00
LDA TARGETOFFSET
CMP (TMPTR),Y
INY
LDA TARGETOFFSET+1
SBC (TMPTR),Y
BCS ARRAYINDEXERR
RTS
ARRAYINDEXERR: LDA #18 ; INDEX OUT OF BOUNDS
JMP SYSTHROW
NULLARRAYERR: LDA #17 ; NULL POINTER
JMP SYSTHROW
;
; SCAN CLASS STRING FOR ARRAY TYPE INFORMATION
;
SCANARRAYTYPE: LDY #$01 ; LINKED CLASS MUST BE ANEWARRAY
LDA (CONSTPTR),Y
BPL :+
REFARRAYTYPE: LDA #T_REF ; ANEWARRAY REF TYPE
RTS
: LDY #$03 ; GET TYPE NAME INDEX
LDA (CONSTPTR),Y
INY
TAX
LDA (CONSTPTR),Y
DEY ; GET TYPE NAME
JSR GETCONSTW
JSR HMEM_PTR
STA SCANPTR
STX SCANPTR+1
LDY #$00
SCANARRAY: INY
LDA (SCANPTR),Y
CMP #'['
BEQ SCANARRAY
CPY #$01
BEQ REFARRAYTYPE
CMP #'B'
BNE :+
LDA #T_BYTE
RTS
: CMP #'S'
BNE :+
LDA #T_SHORT
RTS
: CMP #'I'
BNE :+
LDA #T_INT
RTS
: CMP #'Z'
BNE :+
LDA #T_BOOLEAN
RTS
: CMP #'C'
BNE :+
LDA #T_CHAR
RTS
.IFDEF DEBUG
: CMP #'L'
BNE :+
CMP #'D'
BNE :+
LDA #22 ; ARRAY STORE
JMP SYSTHROW
.ENDIF
: CMP #'F'
BNE REFARRAYTYPE
LDA #T_FLOAT
RTS
;
; ALLOCATE MULTIDIMENSIONAL ARRAY
; ENTRY: A = DEPTH OF ARRAY TO ALLOC
; X = PC INCREMENT
; Y = ANEWARRAY ADJUST
;
MULTIARRAY_ALLOC: STA TARGETDEPTH
JSR SCANARRAYTYPE
STA TARGETTYPE
TYA ; CALC LAST DIM TO ALLOC
CLC
ADC #$01
SEC
SBC TARGETDEPTH
ASL
ASL
ASL
ASL
STA ADEPTH
DEY ; GET ARRAY DIMENSION (SCANPOS - 1)
TYA
ASL
ASL
ASL
ASL
ORA TARGETTYPE
STA TARGETTYPE
LDA TARGETDEPTH ; CALC STACK OFFSET TO ARRAY DIM
SEC
SBC #$01
ASL
ASL
TSX
STX TMP
CLC
ADC TMP
TAX
LDY TARGETTYPE
JSR ALLOC_SUBARRAYS ; RECURSIVELY ALLOCATE ARRAYS
STA TMP
STX TMP+1
LDA TARGETDEPTH ; POP DIMENSION SIZES OFF STACK
ASL
ASL
TSX
STX TARGETDEPTH
CLC
ADC TARGETDEPTH
TAX
TXS
LDA TARGETTYPE
PHA
LDA #CL_ARRAY|$80 ; SET NO INC REF FLAG
PHA
LDA TMP+1
PHA
LDA TMP
PHA
LDA #$04
JMP INCANEXTOP
;
; ALLOCATE SINGLE DIMENSION OF REFERENCE ARRAY
;
REFARRAY_ALLOC: JSR SETCONSTPTR
JSR SCANARRAYTYPE
STA TARGETTYPE
TYA
ASL
ASL
ASL
ASL
ORA TARGETTYPE
TAX
PLA
STA TARGETSIZE
STA TMP
PLA
STA TARGETSIZE+1
STA TMP+1
PLA
BNE NEWARRAYERR
PLA
BNE NEWARRAYERR
TXA ; RETRIEVE TYPE
PHA ; PUSH TYPE AS PART OF ARRAY REF
LDA #CL_ARRAY|$80 ; PUSH CLASS AS PART OF ARRAY REF
PHA
CPX #$20
BCS :+
JSR ALLOCBASEARRAY ; ALLOC ARRAY OF OBJECTS
TAY
TXA
PHA ; PUSH HANDLE AS PART OF ARRAY REF
TYA
PHA
JMP INC3NEXTOP
: LDA TARGETSIZE ; ALLOC AND CLEAR ARRAY OF ARRAYS
ASL ; MUL BY 2 FOR SIZE
TAY
LDA TARGETSIZE+1
ROL
BCS NEWARRAYERR
TAX
TYA
CLC
ADC #$02 ; ADD 2 FOR ARRAY LENGTH VALUE
BCC :+
INX
: LDY #$01
JSR HMEM_ALLOC
JSR HMEM_CLR
TAY
TXA
PHA ; PUSH ARRAY HANDLE ON STACK
TYA
PHA
JSR HMEM_PTR
STA ARRAYPTR
STX ARRAYPTR+1
LDY #$01 ; SET ARRAY SIZE
LDA TARGETSIZE+1
STA (ARRAYPTR),Y
DEY
LDA TARGETSIZE
STA (ARRAYPTR),Y
JMP INC3NEXTOP
;
; ALLOC SIMPLE ARRAY TYPE
;
ARRAY_ALLOC: TAX
PLA
STA TARGETSIZE
STA TMP
PLA
STA TARGETSIZE+1
STA TMP+1
PLA
BNE NEWARRAYERR
PLA
BNE NEWARRAYERR
TXA ; RETRIEVE TYPE
ORA #$10 ; SET DIMENSION TO ONE
PHA ; PUSH TYPE AS PART OF ARRAY REF
TAX
LDA #CL_ARRAY|$80 ; PUSH CLASS AS PART OF ARRAY REF
PHA
JSR ALLOCBASEARRAY
TAY
TXA
PHA ; PUSH HANDLE AS PART OF ARRAY REF
TYA
PHA
LDA #$02
JMP INCANEXTOP
;
; NEW ARRAY ERROR
;
NEWARRAYERR: LDA #21 ; ARRAY SIZE NEG OR TOO BIG
JMP SYSTHROW
; ALLOC SUB ARRAYS
; ENTRY: Y = ARRAY TYPE
; X = STACK OFFSET OF SIZE PARAM
; EXIT: AX = HANDLE TO SUB ARRAY
;
ALLOC_SUBARRAYS: TYA
SEC
SBC #$10
PHA ; SAVE NEXT ARRAY TYPE = $0104,X
TXA
SEC
SBC #$04
PHA ; SAVE NEXT DIM SIZE OFFSET = $0103,X
LDA $0102,X ; COPY ARRAY SIZE = $0101,X $0102,X
STA TARGETSIZE+1
LDA $0101,X
STA TARGETSIZE
TYA ; RETRIEVE ARRAY TYPE
CMP ADEPTH ; CHECK FOR LAST DIM TO ALLOC
BCS ALLOCARRAY2
CMP #$20
TAX
PLA
PLA
BCC :+
LDA #$00 ; NOT FINAL ARRAY TYPE
TAX ; RETURN NULL
RTS
: LDA TARGETSIZE
STA TMP
LDA TARGETSIZE+1
STA TMP+1
;
; ALLOC BASE ARRAY
; ENTRY: X = TYPE
;
ALLOCBASEARRAY: TXA
AND #$03 ; CONVERT TYPE TO SIZE SHIFT COUNT
BEQ :+
TAX
BASEARRAYSHIFT: ASL TMP
ROL TMP+1
BCS NEWARRAYERR
DEX
BNE BASEARRAYSHIFT
: LDA TMP
LDX TMP+1
CLC ; ADD ROOM FOR LENGTH WORD
ADC #$02
BCC :+
INX
: LDY #$01 ; SET REF COUNT TO 1
JSR HMEM_ALLOC
JSR HMEM_CLR ; CLEAR INSTANCE MEMORY
STA ARRAYHNDL
STX ARRAYHNDL+1
JSR HMEM_PTR ; SET SIZE IN ARRAY
STA TMPTR
STX TMPTR+1
LDY #$00
LDA TARGETSIZE
STA (TMPTR),Y
INY
LDA TARGETSIZE+1
STA (TMPTR),Y
LDA ARRAYHNDL
LDX ARRAYHNDL+1
RTS
ALLOCARRAY2: LDA TARGETSIZE ; ALLOC AND FILL ARRAY OF ARRAYS
ASL ; MUL BY 2 FOR SIZE
TAY
LDA TARGETSIZE+1
ROL
BCS NEWARRAYERR
TAX
TYA
CLC
ADC #$02 ; ADD 2 FOR ARRAY LENGTH VALUE
BCC :+
INX
: LDY #$01
JSR HMEM_ALLOC
PHA ; PUSH ARRAY HANDLE ON STACK
TAY
TXA
PHA
TYA
JSR HMEM_PTR
STA ARRAYPTR
STX ARRAYPTR+1
LDY #$01 ; SET ARRAY SIZE
LDA TARGETSIZE+1
PHA ; SET CURRENT ARRAY FILL INDEX TO 0
STA (ARRAYPTR),Y
DEY
LDA TARGETSIZE
PHA ; SET CURRENT ARRAY FILL INDEX TO 0
STA (ARRAYPTR),Y
;
; LOCALS ON STACK:
; NEXT ARRAY TYPE = $0106,X
; NEXT ARRAY SIZE OFFSET = $0105,X
; ARRAY HANDLE = $0103,X $0104,X
; CURRENT FILL INDEX = $0101,X $0102,X
;
FILLARRAY: TSX
LDA $0106,X ; GET NEXT DIM TYPE
TAY
LDA $0105,X ; GET OFFSET TO NEXT DIM SIZE
TAX
JSR ALLOC_SUBARRAYS
STA TARGETOBJ
STX TARGETOBJ+1
TSX
LDA $0104,X ; RETRIEVE ARRAY HANDLE
TAY
LDA $0103,X
TAX
TYA
JSR HMEM_PTR
STA ARRAYPTR
STX ARRAYPTR+1
TSX
LDA $0102,X ; RETRIEVE FILL INDEX
STA TMP+1
LDA $0101,X
TAY
ORA TMP+1
BNE :+ ; CHECK FOR LAST INDEX
LDA $0104,X ; RETRIEVE ARRAY HANDLE
TAY
LDA $0103,X
STA TMP
TXA
CLC
ADC #$06
TAX
TXS
TYA
LDX TMP
RTS
: TYA
ASL ; MUL INDEX BY 2 FOR OFFSET
ROL TMP+1
CLC
ADC ARRAYPTR
STA ARRAYPTR
LDA TMP+1
ADC ARRAYPTR+1
STA ARRAYPTR+1
LDY #$01
LDA TARGETOBJ+1
STA (ARRAYPTR),Y
DEY
LDA TARGETOBJ
STA (ARRAYPTR),Y
LDA $0101,X
SEC
SBC #$01
STA $0101,X
BCS FILLARRAY
LDA $0102,X
SBC #$00
STA $0102,X
BCS FILLARRAY
.IFDEF DEBUG
PERR "FILL ARRAY END ERR"
JMP THROW_INTERNALERR
.ENDIF
;
; PUSH ARRAY SIZE
;
ARRAYLENGTH: PLA
TAY
PLA
TAX
PLA
.IFDEF DEBUG
AND #$7F
CMP #CL_ARRAY
BEQ :+
LDA #8 ; INCOMPATIBLE CLASS CHANGE
JMP SYSTHROW
:
.ENDIF
PLA
LDA #$00
PHA
PHA
TYA
BEQ :+ ; LENGTH OF NULL IS ZERO
JSR HMEM_PTR
STA TMPTR
STX TMPTR+1
LDY #$01
LDA (TMPTR),Y
DEY
PHA
LDA (TMPTR),Y
PHA
JMP INCNEXTOP
: PHA
PHA
JMP INCNEXTOP
;*
;* DEBUG VERSION OF OPCODE DISPATCH
;*
.IFDEF DEBUG_INTERP
DEBUGEXEC: PHA
ASL
BCS :+
TAX
LDA OPLTBL,X
STA OPADDR
LDA OPLTBL+1,X
STA OPADDR+1
JMP :++
: TAX
LDA OPHTBL,X
STA OPADDR
LDA OPHTBL+1,X
STA OPADDR+1
.IMPORT KBWAIT
: PSTR "OPCODE:"
PLA
PHA
JSR PRBYTE
JSR CROUT
JSR KBWAIT
PLA
LDY #$01
CMP #$80
JMP (OPADDR)
.ENDIF
;*
;* MOVE FLOATING POINT ROUTINES
;*
.IFDEF FLOATING_POINT
FNEG: TSX
LDA $0104,X
EOR #$80
STA $0104,X
JMP INCNEXTOP
FSUB: LDA #$80 ; TOGGLE SIGN
BNE :+
FADD: LDA #$00
: STA FP2SGN
PLA
STA FP2MAN0
PLA
STA FP2MAN1
PLA
CMP #$80 ; SET CARRY FROM MSB
ORA #$80 ; SET HIDDEN BIT
STA FP2MAN2
PLA
EOR FP2SGN ; TOGGLE SIGN FOR FSUB
ROL
STA FP2EXP
LDA #$00
STA FPSGN
BCC :+
SBC FP2MAN0
STA FP2MAN0
LDA #$00
SBC FP2MAN1
STA FP2MAN1
LDA #$00
SBC FP2MAN2
STA FP2MAN2
LDA #$FF
: STA FP2MAN3
PLA
STA FP1MAN0
PLA
STA FP1MAN1
PLA
CMP #$80 ; SET CARRY FROM MSB
ORA #$80 ; SET HIDDEN BIT
STA FP1MAN2
PLA
ROL
STA FP1EXP
LDA #$00
BCC :+
SBC FP1MAN0
STA FP1MAN0
LDA #$00
SBC FP1MAN1
STA FP1MAN1
LDA #$00
SBC FP1MAN2
STA FP1MAN2
LDA #$FF
: STA FP1MAN3
LDA FP1EXP ; CALCULATE WHICH MANTISSA TO SHIFT
STA FPEXP
SEC
SBC FP2EXP
BEQ FADDMAN
BCS :+
EOR #$FF
TAY
INY
LDA FP2EXP
STA FPEXP
LDA FP1MAN3
CPY #24 ; KEEP SHIFT RANGE VALID
BCC FP1SHFT
LDA #$00
STA FP1MAN3
STA FP1MAN2
STA FP1MAN1
STA FP1MAN0
BEQ FADDMAN
FP1SHFT: CMP #$80 ; SHIFT FP1 DOWN
ROR
ROR FP1MAN2
ROR FP1MAN1
ROR FP1MAN0
DEY
BNE FP1SHFT
STA FP1MAN3
JMP FADDMAN
: TAY
LDA FP2MAN3
CPY #24 ; KEEP SHIFT RANGE VALID
BCC FP2SHFT
LDA #$00
STA FP2MAN3
STA FP2MAN2
STA FP2MAN1
STA FP2MAN0
BEQ FADDMAN
FP2SHFT: CMP #$80 ; SHIFT FP2 DOWN
ROR
ROR FP2MAN2
ROR FP2MAN1
ROR FP2MAN0
DEY
BNE FP2SHFT
STA FP2MAN3
FADDMAN: LDA FP1MAN0
CLC
ADC FP2MAN0
STA FPMAN0
LDA FP1MAN1
ADC FP2MAN1
STA FPMAN1
LDA FP1MAN2
ADC FP2MAN2
STA FPMAN2
LDA FP1MAN3
ADC FP2MAN3
STA FPMAN3
BPL FPNORM
LDA #$80
STA FPSGN
LDA #$00
SBC FPMAN0
STA FPMAN0
LDA #$00
SBC FPMAN1
STA FPMAN1
LDA #$00
SBC FPMAN2
STA FPMAN2
LDA #$00
SBC FPMAN3
STA FPMAN3
FPNORM: BEQ FPNORMLEFT ; NORMALIZE FP, A = FPMANT3
FPNORMRIGHT: INC FPEXP
LSR
STA FPMAN3
ROR FPMAN2
ROR FPMAN1
LDA FPMAN0
ROR
ADC #$00
STA FPMAN0
LDA FPMAN1
ADC #$00
STA FPMAN1
LDA FPMAN2
ADC #$00
STA FPMAN2
LDA FPMAN3
ADC #$00
BNE FPNORMRIGHT
LDA FPEXP
ASL FPMAN2
LSR
ORA FPSGN
PHA
LDA FPMAN2
ROR
PHA
LDA FPMAN1
PHA
LDA FPMAN0
PHA
JMP INCNEXTOP
FPNORMLEFT: LDA FPMAN2
BNE FPNORMLEFT1
LDA FPMAN1
BNE FPNORMLEFT8
LDA FPMAN0
BNE FPNORMLEFT16
PHA ; RESULT IS ZERO
PHA
PHA
PHA
JMP INCNEXTOP
FPNORMLEFT16: TAX
LDA FPEXP
SEC
SBC #$10
STA FPEXP
LDA #$00
STA FPMAN1
STA FPMAN0
TXA
BNE FPNORMLEFT1
FPNORMLEFT8: TAX
LDA FPMAN0
STA FPMAN1
LDA FPEXP
SEC
SBC #$08
STA FPEXP
LDA #$00
STA FPMAN0
TXA
FPNORMLEFT1: BMI FPNORMDONE
: DEC FPEXP
ASL FPMAN0
ROL FPMAN1
ROL
BPL :-
FPNORMDONE: ASL
TAX
LDA FPEXP
LSR
ORA FPSGN
PHA
TXA
ROR
PHA
LDA FPMAN1
PHA
LDA FPMAN0
PHA
JMP INCNEXTOP
FMUL: PLA
STA FP2MAN0
PLA
STA FP2MAN1
PLA
CMP #$80 ; SET CARRY FROM MSB
ORA #$80 ; SET HIDDEN BIT
STA FP2MAN2
PLA
ROL
STA FP2EXP
BNE :+
TSX ; MUL BY ZERO, RESULT ZERO
; LDA #$00
STA $0101,X
STA $0102,X
STA $0103,X
STA $0104,X
JMP INCNEXTOP
: LDA #$00
ROR
STA FPSGN
PLA
STA FP1MAN0
PLA
STA FP1MAN1
PLA
CMP #$80 ; SET CARRY FROM MSB
ORA #$80 ; SET HIDDEN BIT
STA FP1MAN2
PLA
ROL
STA FP1EXP
BNE :+
; LDA #$00
PHA ; MUL BY ZERO, RESULT ZERO
PHA
PHA
PHA
JMP INCNEXTOP
: LDA #$00
ROR
EOR FPSGN
STA FPSGN
LDA FP1EXP
CLC ; ADD EXPONENTS
ADC FP2EXP
SEC ; SUBTRACT BIAS
SBC #$7F
STA FPEXP
LDX #$00
STX FPMAN0
STX FPMAN1
STX FPMAN2
STX FPMAN3
STX TMP
FMULNEXTBYTE: LDA FP1MAN0,X
BNE :+
LDX FPMAN1 ; SHORT CIRCUIT BYTE OF ZERO BITS
STX FPMAN0
LDX FPMAN2
STX FPMAN1
LDX FPMAN3
STX FPMAN2
STA FPMAN3
INC TMP
LDX TMP
CPX #$03
BNE FMULNEXTBYTE
LDA FPMAN3
JMP FPNORM
: EOR #$FF
LDX #$08
FMULTSTBITS: LSR FPMAN3
ROR FPMAN2
ROR FPMAN1
ROR FPMAN0
LSR
BCS FMULNEXTTST
TAY
LDA FP2MAN0
ADC FPMAN0
STA FPMAN0
LDA FP2MAN1
ADC FPMAN1
STA FPMAN1
LDA FP2MAN2
ADC FPMAN2
STA FPMAN2
LDA #$00
ADC FPMAN3
STA FPMAN3
TYA
FMULNEXTTST: DEX
BNE FMULTSTBITS
INC TMP
LDX TMP
CPX #$03
BNE FMULNEXTBYTE
LDA FPMAN3
JMP FPNORM
FDIV: PLA
STA FP2MAN0
PLA
STA FP2MAN1
PLA
CMP #$80 ; SET CARRY FROM MSB
ORA #$80 ; SET HIDDEN BIT
STA FP2MAN2
PLA
ROL
STA FP2EXP
BNE :+
LDA #23 ; DIVIDE BY ZERO, ERROR
JMP SYSTHROW
: LDA #$00
ROR
STA FPSGN
PLA
STA FP1MAN0
PLA
STA FP1MAN1
PLA
CMP #$80 ; SET CARRY FROM MSB
ORA #$80 ; SET HIDDEN BIT
STA FP1MAN2
PLA
ROL
STA FP1EXP
BNE :+
; LDA #$00
PHA ; DIVIDE ZERO, RESULT ZERO
PHA
PHA
PHA
JMP INCNEXTOP
: LDA #$00
STA FP1MAN3
ROR
EOR FPSGN
STA FPSGN
LDA FP1EXP
SEC ; SUBTRACT EXPONENTS
SBC FP2EXP
CLC
ADC #$7F ; ADD BACK BIAS
STA FPEXP
LDX #24 ; #BITS
FDIVLOOP: LDA FP1MAN0
SEC
SBC FP2MAN0
STA TMP
LDA FP1MAN1
SBC FP2MAN1
STA TMP+1
LDA FP1MAN2
SBC FP2MAN2
TAY
LDA FP1MAN3
SBC #$00
BCC FDIVNEXTBIT
STA FP1MAN3
STY FP1MAN2
LDA TMP+1
STA FP1MAN1
LDA TMP
STA FP1MAN0
FDIVNEXTBIT: ROL FPMAN0
ROL FPMAN1
ROL FPMAN2
ASL FP1MAN0
ROL FP1MAN1
ROL FP1MAN2
ROL FP1MAN3
DEX
BNE FDIVLOOP
LDA #$00
JMP FPNORM
FCMPL:
FCMPG: TSX
TXA
TAY
CLC
ADC #$08
TAX
TXS
LDA $0104,Y ; COMPARE SIGNS
AND #$80
STA FP2SGN
LDA $0108,Y
AND #$80
CMP FP2SGN
BCC FCMPGTSGN
BEQ :+
BCS FCMPLTSGN
: LDA $0108,Y ; COMPARE AS MAGNITUDE
CMP $0104,Y
BCC FCMPLT
BEQ :+
BCS FCMPGT
: LDA $0107,Y
CMP $0103,Y
BCC FCMPLT
BEQ :+
BCS FCMPGT
: LDA $0106,Y
CMP $0102,Y
BCC FCMPLT
BEQ :+
BCS FCMPGT
: LDA $0105,Y
CMP $0101,Y
BCC FCMPLT
BEQ FCMPEQ
BCS FCMPGT
FCMPEQ: PHA ; EQUAL
PHA
PHA
PHA
JMP INCNEXTOP
FCMPGT: LDA FP2SGN ; FLIP RESULT IF NEGATIVE #S
BMI FCMPLTSGN
FCMPGTSGN: LDA #$00 ; GREATER THAN
PHA
PHA
PHA
LDA #$01
PHA
JMP INCNEXTOP
FCMPLT: LDA FP2SGN ; FLIP RESULT IF NEGATIVE #S
BMI FCMPGTSGN
FCMPLTSGN: LDA #$FF ; LESS THAN
PHA
PHA
PHA
PHA
JMP INCNEXTOP
F2I: PLA
STA FPMAN0
PLA
STA FPMAN1
PLA
CMP #$80 ; SET CARRY FROM MSB
ORA #$80 ; SET HIDDEN BIT
STA FPMAN2
PLA
ROL
STA FPEXP
LDA #$00
ROR
STA FPSGN
LDA FPEXP ; CHECK FOR LESS THAN ONE
SEC
SBC #$7F
BCS :+
LDA #$00 ; RETURN ZERO
PHA
PHA
PHA
PHA
JMP INCNEXTOP
: CMP #23
BCS F2ISHL
STA FPEXP
LDA #23
SEC
SBC FPEXP
TAX ; SHIFT MANTISSA RIGHT
LDA FPMAN2
F2ISHR: LSR
ROR FPMAN1
ROR FPMAN0
DEX
BNE F2ISHR
STA FPMAN2
STX FPMAN3
F2ICHKNEG: LDA FPSGN
BPL :+ ; CHECK FOR NEGATIVE
ASL ; LDA #$00; SEC
SBC FPMAN0
STA FPMAN0
LDA #$00
SBC FPMAN1
STA FPMAN1
LDA #$00
SBC FPMAN2
STA FPMAN2
LDA #$00
SBC FPMAN3
STA FPMAN3
: LDA FPMAN3
PHA
LDA FPMAN2
PHA
LDA FPMAN1
PHA
LDA FPMAN0
PHA
JMP INCNEXTOP
F2ISHL: CMP #32
BCC :+
LDA #$FF ; OVERFLOW, STORE MAXINT
STA FPMAN0
STA FPMAN1
STA FPMAN2
LSR
STA FPMAN3
BNE F2ICHKNEG
: SEC
SBC #23
BNE :+
STA FPMAN3
BEQ F2ICHKNEG
: TAX ; SHIFT MANTISSA LEFT
LDA #$00
: ASL FPMAN0
ROL FPMAN1
ROL FPMAN2
ROL
DEX
BNE :-
STA FPMAN3
BEQ F2ICHKNEG
I2F: PLA
STA FPMAN0
PLA
STA FPMAN1
PLA
STA FPMAN2
PLA
STA FPMAN3
AND #$80
STA FPSGN
BPL :+
LDX #FPMAN0
JSR NEGINT
: LDA #$7F+23
STA FPEXP
LDA FPMAN3
JMP FPNORM
;*
;* UNIMPLEMENTED INSTRUCTIONS
;*
.ELSE
FNEG:
FADD:
FSUB:
FMUL:
FDIV:
FREM:
FCMPL:
FCMPG:
F2I:
I2F:
PSTRLN "FLOATING POINT UNIMPLEMENTED"
JMP THROW_INTERNALERR
.ENDIF
DCONST_0:
DCONST_1:
DLOAD:
DLOAD0:
DLOAD1:
DLOAD2:
DLOAD3:
DALOAD:
DSTORE:
DSTORE0:
DSTORE1:
DSTORE2:
DSTORE3:
DASTORE:
DADD:
DSUB:
DMUL:
DDIV:
DREM:
DNEG:
I2D:
D2I:
D2L:
D2F:
DCMPL:
DCMPG:
PSTRLN "DOUBLE PRECISION UNIMPLEMENTED"
; BRK
JMP THROW_INTERNALERR
LCONST_0:
LCONST_1:
LALOAD:
LSTORE:
LSTORE0:
LSTORE1:
LSTORE2:
LSTORE3:
LASTORE:
LADD:
LSUB:
LMUL:
LDIV:
LREM:
LNEG:
LSHL:
LSHR:
LUSHR:
LAND:
LOR:
LXOR:
L2F:
L2D:
F2L:
F2D:
LCMP:
PSTRLN "LONG INTS UNIMPLEMENTED"
JMP THROW_INTERNALERR
WIDE:
GOTO_W:
JSR_W:
BREAKPOINT:
XXX:
PSTRLN "UNIMPLEMENTED INSTRUCTION"
JMP THROW_INTERNALERR
.SEGMENT "INIT"
INTERP_SIZE EQU INTERP_END-INTERP_BEGIN
INTERP_INIT: LDA LCBNK2 ; SET LANGUAGE CARD BANK2 WRITE ENABLE
LDA LCBNK2
LDA WARM_INIT
BNE :+
LDA #<INTERP_RELOC
LDX #>INTERP_RELOC
JSR MEMSRC
LDA #<INTERP_BEGIN
LDX #>INTERP_BEGIN
JSR MEMDST
LDA #<(INTERP_SIZE)
LDX #>(INTERP_SIZE)
JSR MEMCPY ; RELOCATE INTERPRETER TO LANGUAGE CARD
LDA #$00
TAX
STA HEXECFRAME ; ZERO OUT CURRENT FRAME
STX HEXECFRAME+1
: RTS
INTERP_RELOC:
.ORG $D000
INTERP_BEGIN:
OPLTBL: .ADDR NOOP, ACONST_NULL, ICONST_M1, ICONST_0
.ADDR ICONST_1, ICONST_2, ICONST_3, ICONST_4
.ADDR ICONST_5, LCONST_0, LCONST_1, FCONST_0
.ADDR FCONST_1, FCONST_2, DCONST_0, DCONST_1
.ADDR BIPUSH, SIPUSH, LDC, LDC_W, LDC2_W
.ADDR ILOAD, LLOAD, FLOAD, DLOAD, ALOAD
.ADDR ILOAD0, ILOAD1, ILOAD2, ILOAD3
.ADDR LLOAD0, LLOAD1, LLOAD2, LLOAD3
.ADDR FLOAD0, FLOAD1, FLOAD2, FLOAD3
.ADDR DLOAD0, DLOAD1, DLOAD2, DLOAD3
.ADDR ALOAD0, ALOAD1, ALOAD2, ALOAD3
.ADDR IALOAD, LALOAD, FALOAD, DALOAD, AALOAD
.ADDR BALOAD, CALOAD, SALOAD
.ADDR ISTORE, LSTORE, FSTORE, DSTORE, ASTORE
.ADDR ISTORE0, ISTORE1, ISTORE2, ISTORE3
.ADDR LSTORE0, LSTORE1, LSTORE2, LSTORE3
.ADDR FSTORE0, FSTORE1, FSTORE2, FSTORE3
.ADDR DSTORE0, DSTORE1, DSTORE2, DSTORE3
.ADDR ASTORE0, ASTORE1, ASTORE2, ASTORE3
.ADDR IASTORE, LASTORE, FASTORE, DASTORE, AASTORE
.ADDR BASTORE, CASTORE, SASTORE
.ADDR POP, POP2, DUP, DUP_X1, DUP_X2
.ADDR DUP2, DUP2_X1, DUP2_X2, SWAP
.ADDR IADD, LADD, FADD, DADD
.ADDR ISUB, LSUB, FSUB, DSUB
.ADDR IMUL, LMUL, FMUL, DMUL
.ADDR IDIV, LDIV, FDIV, DDIV
.ADDR IREM, LREM, FREM, DREM
.ADDR INEG, LNEG, FNEG, DNEG
.ADDR ISHL, LSHL, ISHR, LSHR
.ADDR IUSHR, LUSHR, IAND, LAND
OPHTBL: .ADDR IOR, LOR, IXOR, LXOR, IINC
.ADDR NOOP, I2F, I2D ; I2L = NOOP
.ADDR NOOP, L2F, L2D ; L2I = NOOP
.ADDR F2I, F2L, F2D
.ADDR D2I, D2L, D2F
.ADDR I2B, I2C, I2S
.ADDR LCMP, FCMPL, FCMPG, DCMPL, DCMPG
.ADDR IFEQ, IFNE, IFLT, IFGE, IFGT, IFLE
.ADDR IF_ICMPEQ, IF_ICMPNE, IF_ICMPLT, IF_ICMPGE
.ADDR IF_ICMPGT, IF_ICMPLE, IF_ACMPEQ, IF_ACMPNE
.ADDR GOTO, JSUB, RET, TABLESWITCH, LOOKUPSWITCH
.ADDR IRETURN, LRETURN, FRETURN, DRETURN, ARETURN, RETURN
.ADDR GETSTATIC, PUTSTATIC, GETFIELD, PUTFIELD
.ADDR INVOKEVIRTUAL, INVOKESPECIAL, INVOKESTATIC, INVOKEINTERFACE
.ADDR UCODERET, NEW, NEWARRAY, ANEWARRAY, ARRAYLENGTH
.ADDR ATHROW, CHECKCAST, INSTANCEOF
.ADDR MONITORENTER, MONITOREXIT
.ADDR WIDE, MULTINEWARRAY, IFNULL, IFNONNULL
.ADDR GOTO_W, JSR_W, BREAKPOINT
; .ADDR NEW2, DECREFOBJ ; MY SPECIAL OPCODES
;*
;* FETCH BYTECODE AND INTERPRET.
;*
GOTO:
BRANCHNEXTOP: LDY #$01
LDW_BYTECODE
CLC
ADC EXECPC
STA EXECPC
TXA
ADC EXECPC+1
STA EXECPC+1
INC OPCNT
BNE EXECBYTECODES
YIELDOP: LDA #>(EXECBYTECODES-1) ; RETURN TO EXECBYTECODES
PHA
LDA #<(EXECBYTECODES-1)
PHA
JMP (LINK_YIELD) ; CALL THREAD_YIELD
INC3NEXTOP: LDY #$02
INCYNEXTOP: INY
TYA
INCANEXTOP: CLC
ADC EXECPC
STA EXECPC
BCC NEXTOP
BCS :+
NOOP:
I2B:
I2C:
I2S:
INCNEXTOP: INC EXECPC
BNE NEXTOP
: INC EXECPC+1
NEXTOP: INC OPCNT
BEQ YIELDOP
EXECBYTECODES:
LDY #$00
AUXMEM_RDACCESS_ON
LDA (EXECPC),Y
AUXMEM_RDACCESS_OFF
INY
.IFDEF DEBUG_INTERP
JMP DEBUGEXEC
.ELSE
ASL
BCS :+
STA OPL+1
OPL: JMP (OPLTBL)
: STA OPH+1
OPH: JMP (OPHTBL)
.ENDIF
;*
;* BIGMEM BYTECODE ACCESS ROUTINES
;*
.IFDEF BIGMEM
READBYTECODEB: AUXMEM_RDACCESS_ON
LDA (EXECPC),Y
AUXMEM_RDACCESS_OFF
RTS
READBYTECODEW: AUXMEM_RDACCESS_ON
LDA (EXECPC),Y
INY
TAX
LDA (EXECPC),Y
AUXMEM_RDACCESS_OFF
RTS
.ENDIF
;*
;* BYTECODE OPS IN ORDER (SORT OF)
;*
ACONST_NULL:
FCONST_0:
ICONST_0:
CONST_0: LDA #$00
CONST_N: PHA
PHA
PHA
PHA
JMP INCNEXTOP
ICONST_M1: LDA #$FF
BNE CONST_N
ICONST_5: INY ; LDY #$05
ICONST_4: INY ; LDY #$04
ICONST_3: INY ; LDY #$03
ICONST_2: INY ; LDY #$02
ICONST_1: LDA #$00 ; LDY #$01
PHA
PHA
PHA
TYA
PHA
JMP INCNEXTOP
FCONST_1: LDY #$80
LDA #$3F
FCONST_N: PHA
TYA
PHA
LDA #$00
PHA
PHA
JMP INCNEXTOP
FCONST_2: LDY #$00
LDA #$40
BNE FCONST_N
BIPUSH: AUXMEM_RDACCESS_ON
LDA (EXECPC),Y
AUXMEM_RDACCESS_OFF
TAX
AND #$80
BPL :+
LDA #$FF
: PHA
PHA
PHA
TXA
PHA
JMP INCYNEXTOP
SIPUSH: AUXMEM_RDACCESS_ON
LDA (EXECPC),Y
INY
TAX
AND #$80
BPL :+
LDA #$FF
: PHA
PHA
TXA
PHA
LDA (EXECPC),Y
AUXMEM_RDACCESS_OFF
PHA
JMP INCYNEXTOP
LDC: LDB_BYTECODE ; READ INDEX
LDX #$00
LDY #$00
JSR GETCONSTB ; CONVERT TO CONSTANT
CMP #CONST_STRING ; CHECK FOR STRING OBJECT
BNE :+
LDY #$03 ; FOLLOW INDEX
LDA (CONSTPTR),Y
INY
TAX
LDA (CONSTPTR),Y
JSR SETCONSTPTR ; STRING REFERENCE
: LDY #$01
LDA (CONSTPTR),Y
INY
PHA
LDA (CONSTPTR),Y
INY
PHA
LDA (CONSTPTR),Y
INY
PHA
LDA (CONSTPTR),Y
PHA
LDA #02
JMP INCANEXTOP
LDC2_W: LDW_BYTECODE
CLC
ADC #$01 ; FAKE 64 BIT LOADS AS 32 BITS
BCC :+
INX
BNE :+
LDC_W: LDW_BYTECODE
: LDY #$00
JSR GETCONSTB ; CONVERT TO POINTER
CMP #CONST_STRING ; CHECK FOR STRING OBJECT
BNE :+
LDY #$03 ; FOLLOW INDEX
LDA (CONSTPTR),Y
INY
TAX
LDA (CONSTPTR),Y
JSR SETCONSTPTR ; STRING REFERENCE
: LDY #$01
LDA (CONSTPTR),Y
INY
PHA
LDA (CONSTPTR),Y
INY
PHA
LDA (CONSTPTR),Y
INY
PHA
LDA (CONSTPTR),Y
PHA
JMP INC3NEXTOP
ILOAD:
FLOAD:
LLOAD:
ALOAD: LDB_BYTECODE
TAY
LDA (BP3),Y
PHA
LDA (BP2),Y
PHA
LDA (BP1),Y
PHA
LDA (BP0),Y
PHA
LDA #$02
JMP INCANEXTOP
ILOAD3:
FLOAD3:
LLOAD3:
ALOAD3: INY
ILOAD2:
FLOAD2:
LLOAD2:
ALOAD2: INY
ILOAD1:
FLOAD1:
LLOAD1:
ALOAD1: INY
ILOAD0:
FLOAD0:
LLOAD0:
ALOAD0: DEY
LDA (BP3),Y
PHA
LDA (BP2),Y
PHA
LDA (BP1),Y
PHA
LDA (BP0),Y
PHA
JMP INCNEXTOP
BALOAD: TSX
JSR CHKINDEX
LDA TARGETOFFSET
CLC
ADC ARRAYPTR
STA ARRAYPTR
LDA TARGETOFFSET+1
ADC ARRAYPTR+1
STA ARRAYPTR+1
TSX ; SKIP ARRAY REF AND INDEX
TXA
CLC
ADC #$08
TAX
TXS
LDY #$00
LDA (ARRAYPTR),Y
TAX
AND #$80
BPL :+
LDA #$FF
: PHA
PHA
PHA
TXA
PHA
JMP INCNEXTOP
SALOAD: TSX
JSR CHKINDEX
LDA TARGETOFFSET
ASL
ROL TARGETOFFSET+1
CLC
ADC ARRAYPTR
STA ARRAYPTR
LDA TARGETOFFSET+1
ADC ARRAYPTR+1
STA ARRAYPTR+1
TSX
TXA
CLC
ADC #$08
TAX
TXS
LDY #$01
LDA (ARRAYPTR),Y
DEY
TAX
AND #$80
BPL :+
LDA #$FF
: PHA
PHA
TXA
PHA
LDA (ARRAYPTR),Y
PHA
JMP INCNEXTOP
CALOAD: LDA #$00
STA TARGETCLASS
STA TARGETCLASS+1
TSX
U16ALOAD: JSR CHKINDEX
LDA TARGETOFFSET
ASL
ROL TARGETOFFSET+1
CLC
ADC ARRAYPTR
STA ARRAYPTR
LDA TARGETOFFSET+1
ADC ARRAYPTR+1
STA ARRAYPTR+1
TSX
TXA
CLC
ADC #$08
TAX
TXS
LDA TARGETCLASS+1 ; ALLOW CALOAD AND AALOAD(ARRAY) TO USE SAME CODE
PHA
LDA TARGETCLASS
PHA
LDY #$01
LDA (ARRAYPTR),Y
DEY
PHA
LDA (ARRAYPTR),Y
PHA
JMP INCNEXTOP
AALOAD: TSX
LDA $0108,X ; CHECK ATYPE
CMP #$20
BCC IALOAD+1 ; USE 32 BIT LOAD FOR REF ARRAY
; SEC
SBC #$10 ; DEC DIMENSION COUNT
STA TARGETCLASS+1
LDA #CL_ARRAY
STA TARGETCLASS
BNE U16ALOAD ; USE 16 BIT LOAD FOR ARRAY REF
IALOAD:
FALOAD: TSX
JSR CHKINDEX
LDA TARGETOFFSET
ASL
ROL TARGETOFFSET+1
ASL
ROL TARGETOFFSET+1
CLC
ADC ARRAYPTR
STA ARRAYPTR
LDA TARGETOFFSET+1
ADC ARRAYPTR+1
STA ARRAYPTR+1
TSX
TXA
CLC
ADC #$08
TAX
TXS
LDY #$03
LDA (ARRAYPTR),Y
DEY
PHA
LDA (ARRAYPTR),Y
DEY
PHA
LDA (ARRAYPTR),Y
DEY
PHA
LDA (ARRAYPTR),Y
PHA
JMP INCNEXTOP
ISTORE:
FSTORE: LDB_BYTECODE
TAY
PLA
STA (BP0),Y
PLA
STA (BP1),Y
PLA
STA (BP2),Y
PLA
STA (BP3),Y
LDA #$02
JMP INCANEXTOP
ASTORE: LDB_BYTECODE
TAY
LDA #$02
BCC :+
ASTORE3: INY
ASTORE2: INY
ASTORE1: INY
ASTORE0: DEY
LDA #$01
: TSX
PHA
LDA $0103,X
BMI :++
TYA
PHA
LDA $0101,X
TAY
LDA $0102,X
BEQ :+
TAX
TYA
JSR HMEM_REF_INC ; INC REF COUNT OF NEW STORED VALUE
: PLA
TAY
: LDA (BPT),Y
BPL :+
TYA
PHA
LDA (BP3),Y
PHA
LDA (BP2),Y
PHA
LDA (BP1),Y
PHA
LDA (BP0),Y
PHA
JSR UNREF_OBJECT
PLA
TAY
: PLA
TAX
LDA #T_REF|$80
STA (BPT),Y
PLA
STA (BP0),Y
PLA
STA (BP1),Y
PLA
AND #$7F ; CLEAR REF COUNT FLAG
STA (BP2),Y
PLA
STA (BP3),Y
TXA
JMP INCANEXTOP
ISTORE3:
FSTORE3: INY
ISTORE2:
FSTORE2: INY
ISTORE1:
FSTORE1: INY
ISTORE0:
FSTORE0: DEY
PLA
STA (BP0),Y
PLA
STA (BP1),Y
PLA
STA (BP2),Y
PLA
STA (BP3),Y
JMP INCNEXTOP
BASTORE: TSX
JSR CHKSTOREINDEX
LDA TARGETOFFSET
CLC
ADC ARRAYPTR
STA ARRAYPTR
LDA TARGETOFFSET+1
ADC ARRAYPTR+1
STA ARRAYPTR+1
TSX
LDY #$00
PLA
STA (ARRAYPTR),Y
TXA
CLC
ADC #$0C
TAX
TXS
JMP INCNEXTOP
CASTORE:
SASTORE: TSX
JSR CHKSTOREINDEX
LDA TARGETOFFSET
ASL
ROL TARGETOFFSET+1
CLC
ADC ARRAYPTR
STA ARRAYPTR
LDA TARGETOFFSET+1
ADC ARRAYPTR+1
STA ARRAYPTR+1
TSX
LDY #$00
PLA
STA (ARRAYPTR),Y
INY
PLA
STA (ARRAYPTR),Y
TXA
CLC
ADC #$0C
TAX
TXS
JMP INCNEXTOP
IASTORE:
FASTORE: TSX
JSR CHKSTOREINDEX
LDA TARGETOFFSET
ASL
ROL TARGETOFFSET+1
ASL
ROL TARGETOFFSET+1
CLC
ADC ARRAYPTR
STA ARRAYPTR
LDA TARGETOFFSET+1
ADC ARRAYPTR+1
STA ARRAYPTR+1
TSX
LDY #$00
PLA
STA (ARRAYPTR),Y
INY
PLA
STA (ARRAYPTR),Y
INY
PLA
STA (ARRAYPTR),Y
INY
PLA
STA (ARRAYPTR),Y
TXA
CLC
ADC #$0C
TAX
TXS
JMP INCNEXTOP
AASTORE: TSX
LDA $0103,X
BMI :+
LDY $0101,X
LDA $0102,X
BEQ :+
TAX
TYA
JSR HMEM_REF_INC ; INC REF COUNT OF NEW STORED VALUE
TSX
: JSR CHKSTOREINDEX
TSX
LDA $010C,X ; CHECK ARRAY DIMENSIONS
CMP #$20
BCC REFASTORE ; STORE INTO REF ARRAY
SBC #$10
STA TARGETTYPE
LDA TARGETOFFSET
ASL
ROL TARGETOFFSET+1
CLC
ADC ARRAYPTR
STA ARRAYPTR
LDA TARGETOFFSET+1
ADC ARRAYPTR+1
STA ARRAYPTR+1
LDA $0104,X ; FILL IN HIWORD OF ARRAY REFERENCE
BNE :+
LDA TARGETTYPE
: CMP TARGETTYPE
BNE REFSTOREERR
PHA
LDA #CL_ARRAY
PHA
LDY #$01
LDA (ARRAYPTR),Y
PHA
LDA $0102,X
STA (ARRAYPTR),Y
DEY
LDA (ARRAYPTR),Y
PHA
LDA $0101,X ; COPY NEW VALUE OVER BEFORE UNREF OLD OBJECT
STA (ARRAYPTR),Y
JSR UNREF_OBJECT
TSX
TXA
CLC
ADC #$0C
TAX
TXS
JMP INCNEXTOP
REFSTOREERR: LDA #8 ; INCOMPATIBLE CLASS CHANGE
JMP SYSTHROW
REFASTORE: LDA TARGETOFFSET
ASL
ROL TARGETOFFSET+1
ASL
ROL TARGETOFFSET+1
CLC
ADC ARRAYPTR
STA ARRAYPTR
LDA TARGETOFFSET+1
ADC ARRAYPTR+1
STA ARRAYPTR+1
LDY #$03
LDA (ARRAYPTR),Y
PHA
LDA $0104,X
STA (ARRAYPTR),Y
DEY
LDA (ARRAYPTR),Y
PHA
LDA $0103,X
AND #$7F ; CLEAR REF COUNT FLAG
STA (ARRAYPTR),Y
DEY
LDA (ARRAYPTR),Y
PHA
LDA $0102,X
STA (ARRAYPTR),Y
DEY
LDA (ARRAYPTR),Y
PHA
LDA $0101,X ; COPY NEW VALUE OVER BEFORE UNREF OLD OBJECT
STA (ARRAYPTR),Y
JSR UNREF_OBJECT
TSX
TXA
CLC
ADC #$0C
TAX
TXS
JMP INCNEXTOP
POP: PLA
PLA
PLA
PLA
JMP INCNEXTOP
POP2: TSX
TXA
ADC #$08
TAX
TXS
JMP INCNEXTOP
DUP: TSX
LDA $0104,X
PHA
LDA $0103,X
PHA
LDA $0102,X
PHA
LDA $0101,X
PHA
JMP INCNEXTOP
DUP2: TSX
LDA $0108,X
PHA
LDA $0107,X
PHA
LDA $0106,X
PHA
LDA $0105,X
PHA
LDA $0104,X
PHA
LDA $0103,X
PHA
LDA $0102,X
PHA
LDA $0101,X
PHA
JMP INCNEXTOP
DUP_X1: TSX
DEX
DEX
DEX
DEX
TXS
LDY #$08 ; MOVE TOP 2 STACK VALS UP
: LDA $0105,X
STA $0101,X
INX
DEY
BNE :-
TSX
LDA $0101,X ; COPY TOP STACK VAL TO EMPTY SPOT
STA $0109,X
LDA $0102,X
STA $010A,X
LDA $0103,X
STA $010B,X
LDA $0104,X
STA $010C,X
JMP INCNEXTOP
DUP_X2: TSX
DEX
DEX
DEX
DEX
TXS
LDY #$0C ; MOVE TOP 3 STACK VALS UP
: LDA $0105,X
STA $0101,X
INX
DEY
BNE :-
TSX
LDA $0101,X ; COPY TOP STACK VAL TO EMPTY SPOT
STA $010D,X
LDA $0102,X
STA $010E,X
LDA $0103,X
STA $010F,X
LDA $0104,X
STA $0110,X
JMP INCNEXTOP
DUP2_X1: TSX
TXA
SBC #$07 ; CARRY = 0, SUB 8
TAX
TXS
LDY #$0C ; MOVE TOP 3 STACK VALS UP
: LDA $0109,X
STA $0101,X
INX
DEY
BNE :-
TSX
LDY #$08
: LDA $0101,X
STA $010D,X
INX
DEY
BNE :-
JMP INCNEXTOP
DUP2_X2: TSX
TXA
SBC #$07 ; CARRY = 0, SUB 8
TAX
TXS
LDY #$10 ; MOVE TOP 4 STACK VALS UP
: LDA $0109,X
STA $0101,X
INX
DEY
BNE :-
TSX
LDY #$08
: LDA $0101,X
STA $0111,X
INX
DEY
BNE :-
JMP INCNEXTOP
SWAP: TSX
LDA $0104,X
TAY
LDA $0108,X
STA $0104,X
TYA
STA $0108,X
LDA $0103,X
TAY
LDA $0107,X
STA $0103,X
TYA
STA $0107,X
LDA $0102,X
TAY
LDA $0106,X
STA $0102,X
TYA
STA $0106,X
LDA $0101,X
TAY
LDA $0105,X
STA $0101,X
TYA
STA $0105,X
JMP INCNEXTOP
IADD: TSX
PLA
ADC $0105,X
STA $0105,X
PLA
ADC $0106,X
STA $0106,X
PLA
ADC $0107,X
STA $0107,X
PLA
ADC $0108,X
STA $0108,X
JMP INCNEXTOP
ISUB: TSX
LDA $0105,X
SEC
SBC $0101,X
STA $0105,X
INX
LDA $0105,X
SBC $0101,X
STA $0105,X
INX
LDA $0105,X
SBC $0101,X
STA $0105,X
INX
LDA $0105,X
SBC $0101,X
STA $0105,X
INX
TXS
JMP INCNEXTOP
IMUL: PLA
STA MULTPLR
PLA
STA MULTPLR+1
PLA
STA MULTPLR+2
PLA
STA MULTPLR+3
AND #$80 ; KEEP # OF 1 BITS DOWN
STA MULSIGN
BPL :+
LDX #MULTPLR
JSR NEGINT
: PLA
STA MULTPLND
PLA
STA MULTPLND+1
PLA
STA MULTPLND+2
PLA
STA MULTPLND+3
LDX #$00
STX PROD
STX PROD+1
STX PROD+2
STX PROD+3
STX MULIDX
IMULNEXTBYTE: LDA MULTPLR,X
BNE :+
LDX MULTPLND+2 ; SHORT CIRCUIT BYTE OF ZERO BITS
STX MULTPLND+3
LDX MULTPLND+1
STX MULTPLND+2
LDX MULTPLND
STX MULTPLND+1
STA MULTPLND
INC MULIDX
LDX MULIDX
CPX #$04
BNE IMULNEXTBYTE
BEQ IMULDONE
: EOR #$FF
LDX #$08
IMULTSTBITS: LSR
BCS IMULNEXTTST
TAY
LDA MULTPLND
ADC PROD
STA PROD
LDA MULTPLND+1
ADC PROD+1
STA PROD+1
LDA MULTPLND+2
ADC PROD+2
STA PROD+2
LDA MULTPLND+3
ADC PROD+3
STA PROD+3
TYA
IMULNEXTTST: ASL MULTPLND
ROL MULTPLND+1
ROL MULTPLND+2
ROL MULTPLND+3
DEX
BNE IMULTSTBITS
INC MULIDX
LDX MULIDX
CPX #$04
BNE IMULNEXTBYTE
IMULDONE: LDA MULSIGN
BPL :+
LDX #PROD
JSR NEGINT
: LDA PROD+3
PHA
LDA PROD+2
PHA
LDA PROD+1
PHA
LDA PROD
PHA
JMP INCNEXTOP
IDIV: LDA #<IDIVDONE
STA OPADDR
LDA #>IDIVDONE
STA OPADDR+1
BNE IDIVIDE
IDIVDONE: LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1
BCC :+
LDX #DVDND
JSR NEGINT
: LDA DVDND+3
PHA
LDA DVDND+2
PHA
LDA DVDND+1
PHA
LDA DVDND
PHA
JMP INCNEXTOP
IREM: LDA #<IREMDONE
STA OPADDR
LDA #>IREMDONE
STA OPADDR+1
BNE IDIVIDE ; REMAINDER IS SIGN OF DIVIDEND
IREMDONE: LDA DVSIGN
BPL :+
LDX #REMNDR
JSR NEGINT
: LDA REMNDR+3
PHA
LDA REMNDR+2
ROR
PHA
LDA REMNDR+1
ROR
PHA
LDA REMNDR
ROR
PHA
JMP INCNEXTOP
IDIVIDE: PLA
STA DVSR
PLA
STA DVSR+1
PLA
STA DVSR+2
PLA
STA DVSR+3
AND #$80
STA DVSIGN
BPL :+
LDX #DVSR
JSR NEGINT
INC DVSIGN
: PLA
STA DVDND
PLA
STA DVDND+1
PLA
STA DVDND+2
PLA
STA DVDND+3
BPL :+
LDX #DVDND
JSR NEGINT
INC DVSIGN
: LDX #33 ; #BITS+1
LDA DVSR
ORA DVSR+1
ORA DVSR+2
ORA DVSR+3
BNE :+
LDA #23 ; DIVIDE BY ZERO, ERROR
JMP SYSTHROW
: LDA DVDND
ORA DVDND+1
ORA DVDND+2
ORA DVDND+3
BNE IDIVFIND1
LDA #$00 ; DIVIDE ZERO
STA REMNDR
STA REMNDR+1
STA REMNDR+2
STA REMNDR+3
JMP (OPADDR)
IDIVFIND1: ASL DVDND
ROL DVDND+1
ROL DVDND+2
ROL DVDND+3
DEX
BCC IDIVFIND1
LDA #$00
STA REMNDR+3
STA REMNDR+2
STA REMNDR+1
ROL ; CARRY = 1, A = 1 AFTER ROL
STA REMNDR
IDIVLOOP: LDA REMNDR
SEC
SBC DVSR
STA TMP
LDA REMNDR+1
SBC DVSR+1
STA TMP+1
LDA REMNDR+2
SBC DVSR+2
TAY
LDA REMNDR+3
SBC DVSR+3
BCC IDIVNEXTBIT
STA REMNDR+3
STY REMNDR+2
LDA TMP+1
STA REMNDR+1
LDA TMP
STA REMNDR
IDIVNEXTBIT: ROL DVDND
ROL DVDND+1
ROL DVDND+2
ROL DVDND+3
ROL REMNDR
ROL REMNDR+1
ROL REMNDR+2
ROL REMNDR+3
DEX
BNE IDIVLOOP
JMP (OPADDR) ; RETURN TO IDIV OR IREM
NEGINT: LDA #$00
SEC
SBC $00,X
STA $00,X
LDA #$00
SBC $01,X
STA $01,X
LDA #$00
SBC $02,X
STA $02,X
LDA #$00
SBC $03,X
STA $03,X
RTS
INEG: TSX
DEY
TYA
SEC
SBC $0101,X
STA $0101,X
TYA
SBC $0102,X
STA $0102,X
TYA
SBC $0103,X
STA $0103,X
TYA
SBC $0104,X
STA $0104,X
JMP INCNEXTOP
.IFDEF FLOATING_POINT ; MUST BE IN LC
FREM: LDA #<FREMCODE
LDX #>FREMCODE
JMP EXECUCODE
FREMCODE: .BYTE $5C ; DUP2 ; INJECT BYTECODE TO EXECUTE OPERATION
.BYTE $6E ; FDIV ; FP1 - (INT(FP1/FP2) * FP2)
.BYTE $8B ; F2I
.BYTE $86 ; I2F
.BYTE $6A ; FMUL
.BYTE $66 ; FSUB
.BYTE $BA ; UCODERET ; HIJACK UNUSED OPCODE
.ENDIF
ISHL: PLA
TAY
PLA
PLA
PLA
TSX
CPY #$08
BCC :+
ISHL8: LDA $0103,X
STA $0104,X
LDA $0102,X
STA $0103,X
LDA $0101,X
STA $0102,X
LDA #$00
STA $0101,X
TYA
SEC
SBC #$08
BEQ ISHLEXIT
TAY
CPY #$08
BCS ISHL8
: ASL $0101,X
ROL $0102,X
ROL $0103,X
ROL $0104,X
DEY
BNE :-
ISHLEXIT: JMP INCNEXTOP
ISHR: PLA
TAY
PLA
PLA
PLA
TSX
CPY #$08
BCC :++
ISHR8: LDA $0102,X
STA $0101,X
LDA $0103,X
STA $0102,X
LDA $0104,X
STA $0103,X
AND #$80
BPL :+
LDA #$FF
: STA $0104,X
TYA
SEC
SBC #$08
BEQ ISHREXIT
TAY
CPY #$08
BCS ISHR8
: LDA $0104,X
: CMP #$80
ROR
ROR $0103,X
ROR $0102,X
ROR $0101,X
DEY
BNE :-
STA $0104,X
ISHREXIT: JMP INCNEXTOP
IUSHR: PLA
TAY
PLA
PLA
PLA
TYA
TSX
CPY #$08
BCC :+
IUSHR8: LDA $0102,X
STA $0101,X
LDA $0103,X
STA $0102,X
LDA $0104,X
STA $0103,X
LDA #$00
STA $0104,X
TYA
SEC
SBC #$08
BEQ IUSHREXIT
TAY
CPY #$08
BCS IUSHR8
: LSR $0104,X
ROR $0103,X
ROR $0102,X
ROR $0101,X
DEY
BNE :-
IUSHREXIT: JMP INCNEXTOP
IAND: TSX
PLA
AND $0105,X
STA $0105,X
PLA
AND $0106,X
STA $0106,X
PLA
AND $0107,X
STA $0107,X
PLA
AND $0108,X
STA $0108,X
JMP INCNEXTOP
IOR: TSX
PLA
ORA $0105,X
STA $0105,X
PLA
ORA $0106,X
STA $0106,X
PLA
ORA $0107,X
STA $0107,X
PLA
ORA $0108,X
STA $0108,X
JMP INCNEXTOP
IXOR: TSX
PLA
EOR $0105,X
STA $0105,X
PLA
EOR $0106,X
STA $0106,X
PLA
EOR $0107,X
STA $0107,X
PLA
EOR $0108,X
STA $0108,X
JMP INCNEXTOP
IINC: LDX #$00
AUXMEM_RDACCESS_ON
LDA (EXECPC),Y
INY
STA TMP
LDA (EXECPC),Y
AUXMEM_RDACCESS_OFF
BPL :+
DEX
: LDY TMP
CLC
ADC (BP0),Y
STA (BP0),Y
TXA
ADC (BP1),Y
STA (BP1),Y
TXA
ADC (BP2),Y
STA (BP2),Y
TXA
ADC (BP3),Y
STA (BP3),Y
JMP INC3NEXTOP
IFNULL: PLA
STA TMP
PLA
ORA TMP
STA TMP
PLA
PLA
LDA TMP
BEQ ISTRUE
BNE ISFALSE
IFNONNULL: PLA
STA TMP
PLA
ORA TMP
STA TMP
PLA
PLA
LDA TMP
BNE ISTRUE
BEQ ISFALSE
IFEQ: PLA
STA TMP
PLA
ORA TMP
STA TMP
PLA
ORA TMP
STA TMP
PLA
ORA TMP
BEQ ISTRUE
ISFALSE: JMP INC3NEXTOP
ISTRUE: JMP BRANCHNEXTOP
IFNE: PLA
STA TMP
PLA
ORA TMP
STA TMP
PLA
ORA TMP
STA TMP
PLA
ORA TMP
BNE ISTRUE
BEQ ISFALSE
IFLT: PLA
PLA
PLA
PLA
BMI ISTRUE
BPL ISFALSE
IFGE: PLA
PLA
PLA
PLA
BPL ISTRUE
BMI ISFALSE
IFLE: PLA
STA TMP
PLA
ORA TMP
STA TMP
PLA
ORA TMP
STA TMP
PLA
BMI ISTRUE
ORA TMP
BEQ ISTRUE
BNE ISFALSE
IFGT: PLA
STA TMP
PLA
ORA TMP
STA TMP
PLA
ORA TMP
STA TMP
PLA
BMI ISFALSE
ORA TMP
BEQ ISFALSE
BNE ISTRUE
IF_ICMPEQ:
IF_ACMPEQ: TSX
TXA
TAY
CLC
ADC #$08
TAX
LDA $0105,Y
CMP $0101,Y
BNE :+
LDA $0106,Y
CMP $0102,Y
BNE :+
LDA $0107,Y
CMP $0103,Y
BNE :+
LDA $0108,Y
CMP $0104,Y
BNE :+
TXS
JMP BRANCHNEXTOP
: TXS
JMP INC3NEXTOP
IF_ICMPNE:
IF_ACMPNE: TSX
TXA
TAY
CLC
ADC #$08
TAX
LDA $0105,Y
CMP $0101,Y
BNE :+
LDA $0106,Y
CMP $0102,Y
BNE :+
LDA $0107,Y
CMP $0103,Y
BNE :+
LDA $0108,Y
CMP $0104,Y
BNE :+
TXS
JMP INC3NEXTOP
: TXS
JMP BRANCHNEXTOP
; TOS-1 < TOS
IF_ICMPLT: TSX
TXA
TAY
CLC
ADC #$08
TAX
LDA $0105,Y
CMP $0101,Y
LDA $0106,Y
SBC $0102,Y
LDA $0107,Y
SBC $0103,Y
LDA $0108,Y
SBC $0104,Y
TXS
BVC :+
EOR #$80
: BMI :+
JMP INC3NEXTOP
: JMP BRANCHNEXTOP
; TOS-1 >= TOS
IF_ICMPGE: TSX
TXA
TAY
CLC
ADC #$08
TAX
LDA $0105,Y
CMP $0101,Y
LDA $0106,Y
SBC $0102,Y
LDA $0107,Y
SBC $0103,Y
LDA $0108,Y
SBC $0104,Y
TXS
BVC :+
EOR #$80
: BPL :+
JMP INC3NEXTOP
: JMP BRANCHNEXTOP
; TOS-1 > TOS -> TOS < TOS-1
IF_ICMPGT: TSX
TXA
TAY
CLC
ADC #$08
TAX
LDA $0101,Y
CMP $0105,Y
LDA $0102,Y
SBC $0106,Y
LDA $0103,Y
SBC $0107,Y
LDA $0104,Y
SBC $0108,Y
TXS
BVC :+
EOR #$80
: BMI :+
JMP INC3NEXTOP
: JMP BRANCHNEXTOP
; TOS-1 <= TOS -> TOS >= TOS-1
IF_ICMPLE: TSX
TXA
TAY
CLC
ADC #$08
TAX
LDA $0101,Y
CMP $0105,Y
LDA $0102,Y
SBC $0106,Y
LDA $0103,Y
SBC $0107,Y
LDA $0104,Y
SBC $0108,Y
TXS
BVC :+
EOR #$80
: BPL :+
JMP INC3NEXTOP
: JMP BRANCHNEXTOP
JSUB: LDA EXECPC ; GET INSTRUCTION PTR
LDX EXECPC+1
CLC ; CALC RETURN ADDRESS
ADC #$03
BCC :+
INX
: SEC ; CALC OFFSET FROM CODEPTR
SBC EXECCODEBASE
TAY
TXA
SBC EXECCODEBASE+1
PHA ; HIWORD DON'T CARE
PHA
PHA
TYA
PHA
JMP BRANCHNEXTOP
RET: LDB_BYTECODE
TAY
LDA (BP0),Y
CLC
ADC EXECCODEBASE
STA EXECPC
LDA (BP1),Y
ADC EXECCODEBASE+1
STA EXECPC+1
JMP NEXTOP
TABLESWITCH: LDA EXECPC
LDX EXECPC+1
CLC ; SKIP PADDING
ADC #$04
AND #$FC
BCC :+
INX
: STA TABLEPTR
STX TABLEPTR+1
AUXMEM_RDACCESS_ON
TSX
LDY #$0B ; CHECK HIGH VALUE
LDA (TABLEPTR),Y
CMP $0101,X
DEY
LDA (TABLEPTR),Y
SBC $0102,X
DEY
LDA (TABLEPTR),Y
SBC $0103,X
DEY
LDA (TABLEPTR),Y
SBC $0104,X
BVC :+
EOR #$80
: BMI TABLEDEF ; HIGH VALUE LESS THAN INDEX, USE DEFAULT
DEY ; LDY #$08 SUBTRACT LOW VALUE
LDA $0101,X
SEC
SBC (TABLEPTR),Y
STA TABLEIDX
DEY
LDA $0102,X
SBC (TABLEPTR),Y
STA TABLEIDX+1
DEY
LDA $0103,X
SBC (TABLEPTR),Y
STA TABLEIDX+2
DEY
LDA $0104,X
SBC (TABLEPTR),Y
STA TABLEIDX+3
BMI TABLEDEF ; BELOW LOW VALUE, USE DEFAULT
LDA TABLEIDX
CLC ; ADD OFFSET FOR DEF/HI/LO
ADC #$03
BCC :+
INC TABLEIDX+1
: ASL ; SHIFT FROM INDEX TO OFFSET
ROL TABLEIDX+1
ASL
ROL TABLEIDX+1
CLC
ADC TABLEPTR
STA TABLEPTR
LDA TABLEIDX+1
ADC TABLEPTR+1
STA TABLEPTR+1
LDY #$03
TABLEJMP: INX
INX
INX
INX
TXS
LDA (TABLEPTR),Y
DEY
CLC
ADC EXECPC
STA EXECPC
LDA (TABLEPTR),Y
ADC EXECPC+1
STA EXECPC+1
AUXMEM_RDACCESS_OFF
JMP NEXTOP
TABLEDEF: LDY #$03 ; OUT OF RANGE, USE DEFAULT OFFSET
BNE TABLEJMP
LOOKUPSWITCH: LDA EXECPC
LDX EXECPC+1
CLC ; SKIP PADDING
ADC #$04
AND #$FC
BCC :+
INX
: STA TABLEPTR
STX TABLEPTR+1
CLC ; CALC POINTER TO FIRST TEST
ADC #$08
BCC :+
INX
: STA MATCHPTR
STX MATCHPTR+1
AUXMEM_RDACCESS_ON
LDY #$07
LDA (TABLEPTR),Y ; COPY NUM LOOKUPS
DEY
STA MATCHCNT
LDA (TABLEPTR),Y
TAX
INX
STX MATCHCNT+1
TSX
LOOKUPMATCH: LDY #$03 ; CHECK FOR MATCH
LDA $0101,X
CMP (MATCHPTR),Y
BNE LOOKUPNEXT
DEY
LDA $0102,X
CMP (MATCHPTR),Y
BNE LOOKUPNEXT
DEY
LDA $0103,X
CMP (MATCHPTR),Y
BNE LOOKUPNEXT
DEY
LDA $0104,X
CMP (MATCHPTR),Y
BNE LOOKUPNEXT
LDY #$07
LOOKUPJMP: INX ; FOUND MATCH
INX
INX
INX
TXS
LDA (MATCHPTR),Y
DEY
CLC
ADC EXECPC
STA EXECPC
LDA (MATCHPTR),Y
ADC EXECPC+1
STA EXECPC+1
AUXMEM_RDACCESS_OFF
JMP NEXTOP
LOOKUPNEXT: LDA MATCHPTR
CLC ; NEXT MATCH
ADC #$08
STA MATCHPTR
BCC :+
INC MATCHPTR+1
: DEC MATCHCNT
BNE LOOKUPMATCH
DEC MATCHCNT+1
BNE LOOKUPMATCH
LOOKUPDEF: LDA TABLEPTR ; NO MATCH, USE DEFAULT OFFSET
STA MATCHPTR
LDA TABLEPTR+1
STA MATCHPTR+1
LDY #$03
BNE LOOKUPJMP
IRETURN:
LRETURN:
FRETURN:
DRETURN:
RETURN: LDA #$00 ; NULL MATCH REF
TAX
JMP EXIT_METHOD
ARETURN: TSX ; MATCH REF ON STACK
LDA $0101,X
TAY
LDA $0102,X
TAX
TYA
JMP EXIT_METHOD
GETSTATIC: LDW_BYTECODE
JSR GETFIELDPTR
LDY #FIELDSTATICVAL+3
LDA (FIELDPTR),Y
DEY
PHA
LDA (FIELDPTR),Y
DEY
PHA
LDA (FIELDPTR),Y
DEY
PHA
LDA (FIELDPTR),Y
PHA
JMP INC3NEXTOP
GETFIELD: LDW_BYTECODE
JSR GETFIELDPTR ; GET INSTANCE FIELD OFFSET
LDY #FIELDINSTOFFSET+1
LDA (FIELDPTR),Y
DEY
STA TARGETOFFSET+1
LDA (FIELDPTR),Y
DEY
STA TARGETOFFSET
LDA (FIELDPTR),Y
STA TARGETTYPE
PLA ; GET OBJECT INSTANCE OFF STACK
TAY
PLA
TAX
PLA
PLA
TYA
JSR HMEM_PTR
CLC
ADC TARGETOFFSET
STA FIELDPTR
TXA
ADC TARGETOFFSET+1
STA FIELDPTR+1
LDA TARGETTYPE
CMP #T_BYTE
BEQ GETS8FLD
CMP #T_BOOLEAN
BEQ GETS8FLD
CMP #T_SHORT
BEQ GETS16FLD
CMP #T_CHAR
BEQ GETU16FLD
LDY #$03
LDA (FIELDPTR),Y
DEY
PHA
LDA (FIELDPTR),Y
DEY
PHA
LDA (FIELDPTR),Y
DEY
PHA
LDA (FIELDPTR),Y
PHA
JMP INC3NEXTOP
GETS8FLD: LDY #$00
LDA (FIELDPTR),Y
TAX
AND #$80
BPL :+
LDA #$FF
: PHA
PHA
PHA
TXA
PHA
JMP INC3NEXTOP
GETU16FLD: LDY #$01
LDA (FIELDPTR),Y
DEY
TAX
LDA #$00
BEQ :+
GETS16FLD: LDY #$01
LDA (FIELDPTR),Y
DEY
TAX
AND #$80
BPL :+
LDA #$FF
: PHA
PHA
TXA
PHA
LDA (ARRAYPTR),Y
PHA
JMP INC3NEXTOP
PUTSTATIC: LDW_BYTECODE
JSR GETFIELDPTR
LDY #FIELDTYPE
LDA (FIELDPTR),Y
INY
CMP #T_REF|$80
BEQ PUTASTAT
PLA
STA (FIELDPTR),Y
INY
PLA
STA (FIELDPTR),Y
INY
PLA
STA (FIELDPTR),Y
INY
PLA
STA (FIELDPTR),Y
JMP INC3NEXTOP
PUTASTAT: TSX
LDY #FIELDSTATICVAL+3
JSR PUTREF
PLA
PLA
PLA
PLA
JMP INC3NEXTOP
;
; COMMON PUT FIELD/STATIC REF
;
PUTREF: LDA (FIELDPTR),Y
PHA
LDA $0104,X
STA (FIELDPTR),Y
DEY
LDA (FIELDPTR),Y
PHA
LDA $0103,X
AND #$7F ; CLEAR NO_INC FLAG
STA (FIELDPTR),Y
DEY
LDA (FIELDPTR),Y
PHA
LDA $0102,X
STA (FIELDPTR),Y
DEY
LDA (FIELDPTR),Y
PHA
LDA $0101,X
STA (FIELDPTR),Y
LDA $0103,X
BMI NOREFINC
LDA $0102,X
BEQ NOREFINC
LDY $0101,X
TAX
TYA
JSR HMEM_REF_INC ; INC REF COUNT OF NEW OBJECT
NOREFINC: JSR UNREF_OBJECT ; UNREF PREV OBJECT
RTS
PUTAFLD: LDY #$03
JSR PUTREF
TSX
JMP PUTFLDEXIT
PUTFIELD: LDW_BYTECODE
JSR GETFIELDPTR ; GET INSTANCE FIELD OFFSET
LDY #FIELDINSTOFFSET+1
LDA (FIELDPTR),Y
DEY
STA TARGETOFFSET+1
LDA (FIELDPTR),Y
DEY
STA TARGETOFFSET
LDA (FIELDPTR),Y
AND #$0F
STA TARGETTYPE
TSX ; EXTRACT OBJECT INSTANCE FROM STACK
LDA $0105,X
TAY
LDA $0106,X
TAX
TYA
JSR HMEM_PTR
CLC
ADC TARGETOFFSET
STA FIELDPTR
TXA
ADC TARGETOFFSET+1
STA FIELDPTR+1
LDY #$00
TSX
LDA TARGETTYPE
CMP #T_REF
BEQ PUTAFLD
AND #$03
BEQ PUT8FLD
CMP #$01
BEQ PUT16FLD
PUT32FLD: PLA
STA (FIELDPTR),Y
INY
PLA
STA (FIELDPTR),Y
INY
PUT16FLD: PLA
STA (FIELDPTR),Y
INY
PUT8FLD: PLA
STA (FIELDPTR),Y
PUTFLDEXIT: TXA ; POP DATA AND OBJECT INSTANCE OFF STACK
CLC
ADC #$08
TAX
TXS
JMP INC3NEXTOP
;
; LOOKUP METHOD IN CONSTPTR
;
LOOKUPMETHODREF: JSR LOOKUPREF
LOOKUPMETHOD: JSR RESOLVE_METHOD ; LOOK IT UP
BCS :+
RTS
: LDA #9 ; NO SUCH METHOD
JMP SYSTHROW
INVOKESPECIAL: LDW_BYTECODE
JSR GETMETHODPTR
JMP INVOKE_SPECIAL
INVOKESTATIC: LDW_BYTECODE
JSR GETMETHODPTR
JMP INVOKE_STATIC
INVOKEVIRTUAL: LDW_BYTECODE
JSR GETMETHODPTR
JMP INVOKE_VIRTUAL
INVOKEINTERFACE: LDW_BYTECODE
INC EXECPC ; INCREMENT PAST TWO DUMMY PARAMETERS
BNE :+
INC EXECPC+1
: INC EXECPC
BNE :+
INC EXECPC+1
: JSR LOOKUPREF ; GET NAME/TYPE - CLASS NOT DEFINED YET
JSR SCANDESCPARMS
TSX
STX TARGETCLASS
CLC
ADC TARGETCLASS
TAX
LDA $0103,X ; GET CLASS FROM *THIS* PARAMTER
; AND #$7F
TAY
JSR LOOKUPMETHOD ; MUST LOOKUP METHOD EVERY TIME
JMP INVOKE_VIRTUAL
NEW: LDW_BYTECODE
JSR LOOKUPCLASSIDX
JSR HMEM_PTR
STA TMPTR
STX TMPTR+1
LDY #CLASSINSTSIZE+1 ; GET INSTANCE SIZE FOR THIS CLASS
LDA (TMPTR),Y
DEY
TAX
LDA (TMPTR),Y
LDY #$00 ; SET ZERO REF COUNT - INC DURING STORE
JSR HMEM_ALLOC
JSR HMEM_CLR ; CLEAR INSTANCE MEMORY
TAY
LDA TARGETCLASS
PHA ; PUSH OBJECT ICLASS IN HIWORD
PHA
TXA ; PUSH OBJECT INSTANCE IN LOWORD
PHA
TYA
PHA
JMP INC3NEXTOP
NEWARRAY: LDB_BYTECODE ; ARRAY TYPE
JMP ARRAY_ALLOC
ANEWARRAY: LDW_BYTECODE ; ARRAY CLASS
JMP REFARRAY_ALLOC
MULTINEWARRAY: LDW_BYTECODE
JSR SETCONSTPTR ; ARRAY CLASS
LDY #$03
LDB_BYTECODE ; ARRAY DEPTH TO ALLOCATE
JMP MULTIARRAY_ALLOC
CHECKCAST: TSX
LDA $0101,X
ORA $0102,X
BNE :+
STA $0103,X
STA $0104,X
BEQ :++
: LDW_BYTECODE
JSR LOOKUPCLASSIDX
TSX
LDA $0103,X
AND #$7F ; MASK OFF NOINC FLAG
JSR CLASS_OF
BCC :+
LDA #24 ; CLASS CAST
JMP SYSTHROW
: JMP INC3NEXTOP
INSTANCEOF: LDW_BYTECODE
JSR LOOKUPCLASSIDX
CLC ;SEC ; SET CARRY = FALSE
TSX
LDA $0101,X ; CHECK FOR NULL REF
ORA $0102,X
BEQ :+
LDA $0103,X
AND #$7F ; MASK OFF NOINC FLAG
JSR CLASS_OF
TSX
LDA #$00
: STA $0104,X
STA $0103,X
STA $0102,X
ROL ; PUT CARRY INTO LSB
EOR #$01 ; INVERT TO MATCH TRUTH
STA $0101,X
JMP INC3NEXTOP
;*
;* MISC ROTUINES THAT DIDN'T FIT IN LC
;*
MONITORENTER: PLA
TAY
PLA
TAX
PLA
PLA
TYA
JSR THREAD_LOCK
JMP INCNEXTOP
MONITOREXIT: PLA
TAY
PLA
TAX
PLA
PLA
TYA
JSR THREAD_UNLOCK
JMP INCNEXTOP
SYSTHROW: JSR THROW_SYSEXCEPTN ; THROW SYSTEM EXCEPTION
RETHROW: LDA CURRENTEXCEPTN+3 ; RE-THROW AN EXCEPTION
PHA
LDA CURRENTEXCEPTN+2
PHA
LDA CURRENTEXCEPTN+1
PHA
LDA CURRENTEXCEPTN
PHA
ATHROW: TSX ; MATCH REF ON STACK
LDA $0101,X
STA RETURN_REF
LDA $0102,X
STA RETURN_REF+1
LDA #$80 ; SET EXCEPTION FLAG
STA EXECFLAGS
.IFDEF DEBUG_EXCEPT
; PERR "EXCEPTION THROWN IN METHOD"
; JSR KBWAIT
.ENDIF
LDA HEXECFRAME ; SET FRAME POINTER
LDX HEXECFRAME+1
JSR HMEM_PTR
STA FRAMEPTR
STX FRAMEPTR+1
LDY #FRAMEPC
LDA EXECPC ; SAVE INSTRUCTION PTR IN CURRENT FRAME
SEC ; SAVE AS OFFSET FROM CODEPTR
SBC EXECCODEBASE
STA (FRAMEPTR),Y
INY
LDA EXECPC+1
SBC EXECCODEBASE+1
STA (FRAMEPTR),Y
JMP CATCH_EXCEPTN
;*
;* THIS ALLOWS A BYTECODE SEQUENCE TO BE SUBSTITUTED FOR A SINGLE BYTECODE OPERATION
;* SEE FREM
;*
EXECUCODE: LDY EXECPC ; INJECT BYTECODE INTO OPERATION
STY UCODEPC
LDY EXECPC+1
STY UCODEPC+1
STA EXECPC
STX EXECPC+1
LDA OPCNT ; MAKE SURE NO RESCHED HAPPENS
AND #$F0
STA OPCNT
JMP EXECBYTECODES ; EXEC BYTECODE
UCODERET: LDA UCODEPC ; HIJACK UNUSED BYTECODE $BA
STA EXECPC
LDA UCODEPC+1
STA EXECPC+1
STY UCODEPC
STY UCODEPC+1
JMP INCNEXTOP
UCODEPC: .BYTE $00,$00 ; SAVED PC
INTERP_END EQU *
Reference in New Issue View Git Blame Copy Permalink