;* ;* 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 JSR MEMSRC LDA #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+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+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 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 *