;* ;* JAVA CLASS LOADER FOR 6502/DVM ;* .INCLUDE "global.inc" .INCLUDE "class.inc" .INCLUDE "dvm.inc" .IMPORT INIT_START,INIT_END .IMPORT PRBYTE,COUT,CROUT,PRNTAX,PRHSTR,PRHSTRLN,PRHEX .IMPORT PUTS,PUTSLN,PRSTR,PRSTRLN,KBWAIT,MEMSRC,MEMDST,MEMCPY,MEMCLR,MUL_FIELDRECSZ,MUL_METHODRECSZ .IMPORT FILE_OPEN,FILE_SETBUFFER,FILE_READ,FILE_CLOSE,PREFIX_GET .IMPORT HMEM_ALLOC,HMEM_ALLOC_CODE,HMEM_ALLOC_FIXED,HMEM_FREE,HMEM_CLR .IMPORT HMEM_PTR,HMEM_LOCK,HMEM_UNLOCK,HMEM_REF_INC,HMEM_REF_DEC .IMPORT HSTR_HASH,STR_HASH,HSTRPL_ADD,HSTRPL_DEL .IMPORT HMEM_DUMP .IMPORT HCLASS_NAME,HCLASS_INDEX,HCLASS_HNDL,HCLASS_ADD,CLASS_STRING .IMPORT CLASS_MATCH_NAME,CLASS_MATCH_DESC,RESOLVE_METHOD,CLASS_METHODPTR,SCANDESCPARMS .IMPORT ASYNC_STATIC .IMPORT CODECPY,HCODE_ACCESS,HCODE_UNACCESS,HCODE_ALLOC .IMPORT HCODE_ISBYTECODE,HCODE_SETSTACK,HCODE_SETLOCALS,HCODE_SETCLASS,HCODE_SETOFFSET,HCODE_SETHEXCEPT,HCODE_SETEXCEPTLEN .IMPORT THROW_INTERNALERR,THROW_SYSEXCEPTN,CURRENTEXCEPTN .EXPORT LOADCLASS_INIT,LOADCLASS_MEM,LOADCLASS_FILE,CLASSPREFIX .EXPORT HMAINNAMESTR,HMAINDESCSTR,HRUNNAMESTR,HFINALNAMESTR,HVOIDDESCSTR .MACRO PERR_DVM MSG .IFDEF DEBUG DVM_END PERR MSG DVM_BEGIN .ENDIF .ENDMACRO .MACRO PLAX PLA TAY PLA TAX TYA .ENDMACRO .MACRO PHAX TAY TXA PHA TYA PHA .ENDMACRO .SEGMENT "INIT" ;* ;* ADD STRING CONSTANTS USED FOR CLASS LOADING INTO STRING POOL. ;* NO ADDITIONAL SPACE WILL BE ALLOCATED FOR MATCHES IN THE CONSTANT POOL. ;* LOADCLASS_INIT: LDA #CODESTR JSR HSTRPL_ADD STA HCODESTR+2 ; POKE RIGHT INTO CODE STX HCODESTR+1 LDA #CONSTVALSTR JSR HSTRPL_ADD STA HCONSTVALSTR+2 STX HCONSTVALSTR+1 LDA #NATIVESTR JSR HSTRPL_ADD STA HNATIVESTR+2 STX HNATIVESTR+1 LDA #MAINNAMESTR JSR HSTRPL_ADD STA HMAINNAMESTR STX HMAINNAMESTR+1 LDA #MAINDESCSTR JSR HSTRPL_ADD STA HMAINDESCSTR STX HMAINDESCSTR+1 LDA #RUNNAMESTR JSR HSTRPL_ADD STA HRUNNAMESTR STX HRUNNAMESTR+1 LDA #CLINITNAMESTR JSR HSTRPL_ADD STA CLINIT+1 STX CLINIT+3 LDA #FINALNAMESTR JSR HSTRPL_ADD STA HFINALNAMESTR STX HFINALNAMESTR+1 LDA # AND SHARE DESC LDX #>VOIDDESCSTR JSR HSTRPL_ADD STA HVOIDDESCSTR STX HVOIDDESCSTR+1 LDA #BOOLSTR JSR HSTRPL_ADD STA HBOOLSTR+2 STX HBOOLSTR+1 LDA #BYTESTR JSR HSTRPL_ADD STA HBYTESTR+2 STX HBYTESTR+1 LDA #CHARSTR JSR HSTRPL_ADD STA HCHARSTR+2 STX HCHARSTR+1 LDA #SHORTSTR JSR HSTRPL_ADD STA HSHORTSTR+2 STX HSHORTSTR+1 LDA #INTSTR JSR HSTRPL_ADD STA HINTSTR+2 STX HINTSTR+1 LDA #FLOATSTR JSR HSTRPL_ADD STA HFLOATSTR+2 STX HFLOATSTR+1 LDA #LONGSTR JSR HSTRPL_ADD STA HLONGSTR+2 STX HLONGSTR+1 LDA #DOUBLESTR JSR HSTRPL_ADD STA HDOUBLESTR+2 STX HDOUBLESTR+1 LDA #CLASSPREFIX JSR PREFIX_GET .IFDEF DEBUG_LOAD JSR PUTS .ASCIIZ "CLASS LOAD PATH:" LDA #CLASSPREFIX JSR PRSTRLN .ENDIF LDA #LOADCLASS_FILE STA LINK_CLASSLOAD+1 LC_DVM_SIZE EQU LC_DVM_END-LC_DVM_BEGIN LDA #LC_DVM_BEGIN JSR MEMSRC LDA #<(LC_DVM_SIZE) LDX #>(LC_DVM_SIZE) LDY #$01 JSR HMEM_ALLOC BCC :+ JSR PUTS .ASCIIZ "ALLOC LOADCLASS_DVM MEMORY FAILED" BRK : STA HLOADCLASSPROC STX HLOADCLASSPROC+1 JSR HMEM_PTR JSR MEMDST LDA #<(LC_DVM_SIZE) LDX #>(LC_DVM_SIZE) JSR MEMCPY ; RELOCATE LOADCLASS_DVM TO MEMORY BLOCK RTS LC_DVM_BEGIN: ;***************************************************************************** ;* ;* BEGINNING OF RELOCATED LOADCLASS CODE. ALL 6502 CODE MUST BE RELATIVE. ;* ;***************************************************************************** ; DVM_BEGIN DUPW ; CHECK FOR NULL HANDLE PASSED IN BRNZW FILELOAD POPB STB CLBUFFOFST LDCW READBUFF_MEM STW READBUFFPROC LDCW CURRENTOFST_MEM STW CURRENTOFSTPROC LDCW RELEASEBUFF_MEM STW RELEASEBUFFPROC JUMP MEMLOAD FILELOAD: DVM_END PLA TAX PLA JSR HMEM_PTR STA LDPTR STX LDPTR+1 LDX #$00 ; COPY CLASS LOAD PREFIX LDY #$01 LDA (LDPTR),Y AND #$7F CMP #'/' BEQ :+ COPYCLASSPREFIX: CPX CLASSPREFIX BEQ :+ INX LDA CLASSPREFIX,X STA CLASSFILE,X BNE COPYCLASSPREFIX : STX CLASSFILE LDY #$00 LDA (LDPTR),Y CMP #16 ; CLAMP BASENAME TO 16 CHARACTERS BCC BASENAMEOK STA TMP TAY : LDA (LDPTR),Y AND #$7F CMP #'/' ; CHECK FOR DIR SEPARATOR BEQ :+ DEY BNE :- : LDA TMP STY TMP LDY #$00 SEC SBC TMP CMP #16 BCS :+ LDA (LDPTR),Y BNE BASENAMEOK : LDA TMP CLC ADC #15 BASENAMEOK: ADC CLASSFILE STA CLASSFILE ; SAVE FILENAME LENGTH COPYCLASSNAME: INY LDA (LDPTR),Y INX STA CLASSFILE,X CPX CLASSFILE BNE COPYCLASSNAME .IFDEF DEBUG_LOAD .IMPORT KBWAIT PSTR "LOADING CLASS FILE:" LDA #CLASSFILE JSR PRSTRLN ; JSR KBWAIT .ENDIF LDA #$00 ; SIZE OF DATA BUFFER LDX #$01 LDY #$00 JSR HMEM_ALLOC STA HCLASSFILEBUFF STX HCLASSFILEBUFF+1 JSR HMEM_LOCK STA CLBUFFPTR STX CLBUFFPTR+1 LDA #CLASSFILE LDY #>CLASSFILE_IO_BUFF ; CLASSLOAD SYSTEM I/O BUFFER JSR FILE_OPEN BCC :+ .IFDEF DEBUG_LOAD JSR PRBYTE PSTR " - ERROR OPENING FILE: " .ENDIF JMP FILECLASS_ERR : STY CLREFNUM LDY #$00 STY CLBUFFOFST STY CLBUFFPAGE JSR READBUFF_FILE DVM_BEGIN LDCW READBUFF_FILE STW READBUFFPROC LDCW CURRENTOFST_FILE STW CURRENTOFSTPROC LDCW RELEASEBUFF_FILE STW RELEASEBUFFPROC MEMLOAD: .IFDEF DEBUG_LOAD LDCW $6969 ; STACK MARKER .ENDIF .IFDEF DEBUG_DVM DVM_END TSX STX STACKCHK DVM_BEGIN .ENDIF .IFDEF DEBUG_LOAD DVM_END PSTR "LOADCLASS..." ; JSR KBWAIT PSTR "MAGIC: " DVM_BEGIN .ENDIF CALL READWORD ; VERIFY CLASS HEADER .IFDEF DEBUG_LOAD DUPW DVM_END PLA TAX PLA JSR PRNTAX DVM_BEGIN .ENDIF LDCW $CAFE BRNEQW BADMAGIC CALL READWORD .IFDEF DEBUG_LOAD DUPW DVM_END PLA TAX PLA JSR PRNTAX DVM_BEGIN .ENDIF LDCW $BABE BREQUW :+ BADMAGIC: PERR_DVM "BAD MAGIC" JUMP LOADCLASS_ERR : .IFDEF DEBUG_LOAD DVM_END JSR CROUT ; JSR KBWAIT PSTR "VERSION: " DVM_BEGIN .ENDIF CALL READWORD ; READ VERSION CALL READWORD .IFDEF DEBUG_LOAD LD0W SWAPW SWAPB CALL_02 PRNTAX POPB LDCB '.' CALL_02 COUT POP2W LD0W SWAPW SWAPB CALL_02 PRNTAX CALL_02 CROUT .ENDIF POP2W ; ; READ CONSTANT POOL ; LD0W LDCW $0100 CALL_02 HMEM_ALLOC STW HREADSTRBUFF ; ALLOC TEMP STRING BUFFER POPW CALL READWORD .IFDEF DEBUG_LOAD DUPW DVM_END PSTR "CONST POOL COUNT: " PLA TAX PLA JSR PRNTAX JSR CROUT ; JSR KBWAIT DVM_BEGIN .ENDIF DECRW DUPW ; SAVE FOR A LITTLE LATER ON... DUPW STZPW LDCNT DUPW SHLW ; CALC CONSTPLRECSZ - MUL BY 5 SHLW ADDW LDCW CLASSBASESZ ; ADD STATIC CLASS STRUCTURE SIZE ADDW LD1W ; LOAD STATUS/Y SWAPW CALL_02 HMEM_ALLOC ; ALLOCATE CLASS STRUCTURE CALL_02 HMEM_CLR ; CLEAR IT DUPW STW HCLASSLD CALL_02 HMEM_LOCK ; LOCK CLASS STRUCTURE IN PLACE DUPW STZPW CLASSLDPTR LDCW CLASSBASESZ ; CALC OFFSET IN CLASS TO CONST POOL ADDW STZPW LDPTR POPW ; DROP STATUS AND YREG STPW (CLASSLDPTR), CLASSCONSTCNT ; SAVE CONST COUNT (ON STACK FRM EARLIER) IN CLASS STRUCTURE LOADCONSTPL: CALL READBYTE ; READ TYPE .IFDEF DEBUG_LOAD DUPB DVM_END PLA JSR PRBYTE LDA #' ' JSR COUT DVM_BEGIN .ENDIF DUPB STPB (LDPTR), 0 ; AND STORE IT SWTCHB 10 CASEB CONST_UTF8, LDUTF8 ; CONST UTF8 CASEB CONST_STRING, LDCONST16 ; STRING OBJECT CASEB CONST_INTEGER, LDCONST32 ; CONST INTEGER CASEB CONST_FLOAT, LDCONST32 ; CONST FLOAT CASEB CONST_FIELDREF, LDCONST32 ; FIELD REF CASEB CONST_METHDREF, LDCONST32 ; METHOD REF CASEB CONST_IFACEMETHDREF, LDCONST32 ; INTERFACE METHOD REF CASEB CONST_NAMETYPE, LDCONST32 ; NAME AND TYPE CASEB CONST_CLASS, LDCONST16 ; CLASS CASEB CONST_LONG, LDCONST64 ; 64 BIT LONG PERR_DVM "UNKOWN CONSTANT POOL TYPE" JUMP LOADCLASS_ERR LDUTF8: LD0W LDW HREADSTRBUFF CALL_02 HMEM_PTR DUPW ; SAVE FOR HSTRPL_ADD LATER STZPW DSTADDR CALL READWORD ; READ STRING LENGTH SWAPB BRNZB STRINGTOOBIG ; CHECK MSB FOR 0 OR ITS TOO LONG .IF 0 DUPB STPINCB (DSTADDR) BRNCH :+ READUTF8: CALL READBYTE .IFDEF DEBUG_LOAD DVM_END PLA PHA JSR COUT DVM_BEGIN .ENDIF STPINCB (DSTADDR) DECRB : DUPB BRNZB READUTF8 POPB ; DISCARD COUNT CALL_02 HSTRPL_ADD ; ADD STRING TO POOL SWAPB STPW (LDPTR), 3 ; SAVE HANDLE IN LOWORD STPB (LDPTR), 1 ; HASH INDEX IN HIWORD[0] POPB LDCB CL_STR STPB (LDPTR), 2 ; CLASS INDEX IN HIWORD[1] .ELSE DVM_END PLA TAX INX READUTF8: LDY #$00 STA (DSTADDR),Y DEX BEQ ADDUTF8 INC DSTADDR BNE :+ INC DSTADDR+1 : LDY CLBUFFOFST LDA (CLBUFFPTR),Y .IFDEF DEBUG_LOAD PHA TAY TXA PHA TYA JSR COUT PLA TAX PLA .ENDIF INC CLBUFFOFST BNE READUTF8 PHA TXA PHA JSR READBUFF PLA TAX PLA BNE READUTF8 ADDUTF8: PLAX JSR HSTRPL_ADD ; ADD STRING TO POOL PHA TYA LDY #$01 STA (LDPTR),Y INY LDA #CL_STR STA (LDPTR),Y INY TXA STA (LDPTR),Y INY PLA STA (LDPTR),Y PLA PLA DVM_BEGIN .ENDIF BRNCH NEXTCONSTPL STRINGTOOBIG: PERR_DVM "STRING TOO LARGE" JUMP LOADCLASS_ERR LDCONST64: CALL READWORD ; SKIP HI 32 BITS CALL READWORD POP2W LDZPW LDPTR LDCW CONSTPLRECSZ ADDW STZPW LDPTR LDZPW LDCNT DECRW STZPW LDCNT LDCONST32: CALL READWORD SWAPB STPW (LDPTR), 1 LDCONST16: CALL READWORD SWAPB STPW (LDPTR), 3 NEXTCONSTPL: LDZPW LDPTR LDCW CONSTPLRECSZ ADDW STZPW LDPTR .IFDEF DEBUG_LOAD DVM_END JSR CROUT DVM_BEGIN .ENDIF .IFDEF DEBUG_DVM DVM_END TSX CPX STACKCHK BEQ :+ PERR "STACK CHECK FAIL DURING LOAD CONST POOL" BRK : DVM_BEGIN .ENDIF DECJNZW LDCNT, LOADCONSTPL .IFDEF DEBUG_DVM DVM_END TSX CPX STACKCHK BEQ :+ PERR "STACK CHECK FAIL AFTER LOAD CONST POOL" BRK : DVM_BEGIN .ENDIF LD0W LDW HREADSTRBUFF CALL_02 HMEM_FREE ; FREE TEMP STRING BUFFER POP2W ; ; LOAD ACCESS FLAGS ; LOADACCFLGS: CALL READWORD STPW (CLASSLDPTR), CLASSACCESS ; ; LOAD CLASS/SUPERCLASS ; CALL READWORD CALL LDCONST .IFDEF DEBUG_LOAD LDPB (CLDPTR), 0 LDCB $07 ; CHECK FOR CLASS TYPE BREQUB :+ PERR_DVM "BAD CLASS CONST TYPE" JUMP LOADCLASS_ERR : .ENDIF CALL LDCONST .IFDEF DEBUG_LOAD LDPB (CLDPTR), 0 LDCB $01 ; CHECK FOR UTF8 TYPE BREQUB :+ PERR_DVM "BAD CLASS STR CONST TYPE" JUMP LOADCLASS_ERR : .ENDIF STPW (CLASSLDPTR), CLASSTHIS CALL READWORD ; GET SUPERCLASS DUPW BRZW SETSUPER ; THIS BETTER BE CLASS OBJECT CALL LDCONST .IFDEF DEBUG_LOAD LDPB (CLDPTR), 0 LDCB $07 ; CHECK FOR CLASS TYPE BREQUB :+ PERR_DVM "BAD SUPERCLASS CONST TYPE" JUMP LOADCLASS_ERR : .ENDIF CALL LDCONST .IFDEF DEBUG_LOAD LDPB (CLDPTR), 0 LDCB $01 ; CHECK FOR UTF8 TYPE BREQUB :+ PERR_DVM "BAD SUPERCLASS STR CONST TYPE" JUMP LOADCLASS_ERR : .ENDIF SETSUPER: STW SUPERCLASS ; ; LOAD INTERFACES ; CALL READWORD SWAPB BRZB :+ PERR_DVM "INTERFACE COUNT > 255" JUMP LOADCLASS_ERR : DUPB STPB (CLASSLDPTR), CLASSIFACECNT DUPB STZPB LDCNT BRZB LOADFIELDCNT LOADIFACE: CALL READWORD .IFDEF DEBUG_LOAD CALL LDCONST ; GET STRING HANDLE CALL LDCONST LDPB (CLDPTR), 0 DUPW LD1B BREQUB :+ ; READ UTF8 PERR_DVM "BAD TYPE IN LOAD IFACES" : LD0W SWAPW CALL_02 PRHSTR POPW .ENDIF POPW ; DISCARD DECJNZB LDCNT, LOADIFACE .IFDEF DEBUG_DVM DVM_END TSX CPX STACKCHK BEQ :+ PERR "STACK CHECK FAIL AFTER LOAD IFACE" BRK : DVM_BEGIN .ENDIF ; ; LOAD FIELDS ; LOADFIELDCNT: CALL READWORD SWAPB BRZB :+ PERR_DVM "FIELD COUNT > 255" JUMP LOADCLASS_ERR : DUPB STPB (CLASSLDPTR), CLASSFIELDCNT DUPB STZPB LDCNT BRNZB :+ JUMP LOADMETHODCNT : .IFDEF DEBUG_LOAD DVM_END PSTR "FIELD COUNT: " LDA LDCNT JSR PRBYTE JSR CROUT ; JSR KBWAIT DVM_BEGIN .ENDIF LD1W LDZPB LDCNT ZEXTB CALL_02 MUL_FIELDRECSZ ; FIELD RECORD SIZE CALL_02 HMEM_ALLOC ; ALLOC THE FIELD TABLE DUPW STPW (CLASSLDPTR), CLASSFIELDTBL CALL_02 HMEM_LOCK ; LOCK FIELD TABLE IN MEMORY STZPW LDPTR POPW LOADFIELD: CALL READWORD ; ACCESS FLAGS STPB (LDPTR), FIELDACCESS POPB ; DISCARD MSB .IFDEF DEBUG_LOAD LDPB (LDPTR), FIELDACCESS DVM_END PLA JSR PRBYTE LDA #' ' JSR COUT DVM_BEGIN .ENDIF CALL READWORD ; NAME STRING INDEX CALL LDCONST ; GET STRING HANDLE CALL READWORD ; DESCRIPTION STRING INDEX CALL LDCONST ; GET STRING HANDLE DUPW HBOOLSTR: LDCW 0 BRNEQW :+ LDCB T_BOOLEAN BRNCH LDFLDTYPE : DUPW HBYTESTR: LDCW 0 BRNEQW :+ LDCB T_BYTE BRNCH LDFLDTYPE : DUPW HCHARSTR: LDCW 0 BRNEQW :+ LDCB T_CHAR BRNCH LDFLDTYPE : DUPW HSHORTSTR: LDCW 0 BRNEQW :+ LDCB T_SHORT BRNCH LDFLDTYPE : DUPW HINTSTR: LDCW 0 BRNEQW :+ LDCB T_INT BRNCH LDFLDTYPE : DUPW HFLOATSTR: LDCW 0 BRNEQW :+ LDCB T_FLOAT BRNCH LDFLDTYPE : DUPW HLONGSTR: LDCW 0 BREQUW BADTYPE DUPW HDOUBLESTR: LDCW 0 BRNEQW :+ BADTYPE: PERR_DVM "UNIMPLEMENTED TYPE" JUMP LOADCLASS_ERR : LDCB $80|T_REF LDFLDTYPE: STPB (LDPTR), FIELDTYPE STPW (LDPTR), FIELDDESC STPW (LDPTR), FIELDNAME .IFDEF DEBUG_LOAD DVM_END LDY #FIELDNAME+1 LDA (LDPTR),Y DEY TAX LDA (LDPTR),Y JSR HMEM_PTR JSR PRSTR LDA #' ' JSR COUT LDY #FIELDDESC+1 LDA (LDPTR),Y DEY TAX LDA (LDPTR),Y JSR HMEM_PTR JSR PRSTR LDA #' ' JSR COUT DVM_BEGIN .ENDIF LDPB (LDPTR), FIELDACCESS LDCB $08 ANDB ; CHECK FOR STATIC FIELD BRZB :+ LD0W LD0W STPW (LDPTR), FIELDSTATICVAL ; ZERO OUT STATIC FIELD STPW (LDPTR), FIELDSTATICVAL+2 BRNCH LDFLDATRCNT : LDPW (CLASSLDPTR), CLASSINSTSIZE ; SAVE OFFSET TO INSTANCE FIELD STPW (LDPTR), FIELDINSTOFFSET LDPB (LDPTR), FIELDTYPE ; CONVERT TYPE TO SIZE LD3B ANDB ; CLEVERLY MASK SIZE INDEX BITS ZEXTB LDCW TYPE2SIZE ; ADDRESS OF TYPE2SIZE ADDW ; ADD TYPE INDEX LDINDB ; LOAD TYPE SIZE .IFDEF DEBUG_LOAD DVM_END LDA #'#' JSR COUT PLA PHA JSR PRBYTE LDA #' ' JSR COUT DVM_BEGIN .ENDIF ZEXTB LDPW (CLASSLDPTR), CLASSINSTSIZE ; INCREMENT INSTANCE SIZE ADDW STPW (CLASSLDPTR), CLASSINSTSIZE LDFLDATRCNT: CALL READWORD ; FIELD ATTRIB COUNT SWAPB BRZB :+ PERR_DVM "TOO MANY METHOD ATTRIBUTES" JUMP LOADCLASS_ERR : DUPB STZPB ACNT BRZB NEXTFIELD LDFLDATR: CALL READWORD ; FIELD ATTRIB NAME CALL LDCONST .IFDEF DEBUG_LOAD DUPW DVM_END PLAX JSR HMEM_PTR JSR PRSTR DVM_BEGIN .ENDIF HCONSTVALSTR: LDCW 0 BREQUW :+ CALL SKIPATTRIB BRNCH NEXTFLDATR : CALL READWORD ; FIELD ATTRIB LENL - THIS BETTER BE 2 LD2W BRNEQW :+ PERR_DVM "BAD CONSTVAL" JUMP LOADCLASS_ERR : CALL READWORD ; FIELD ATTRIB LENH POPW CALL READWORD ; FIELD ATTRIB CONST INDEX CALL LDCONST STPW (LDPTR), FIELDSTATICVAL ; SAVE LOWORD CONSTANTVALUE IN STATIC FIELD LDPW (CLDPTR), 1 SWAPB STPW (LDPTR), FIELDSTATICVAL+2 ; SAVE HIWORD CONSTANTVALUE IN STATIC FIELD .IFDEF DEBUG_LOAD DVM_END LDA #' ' JSR COUT LDY #FIELDSTATICVAL+2 LDA (LDPTR),Y INY TAX LDA (LDPTR),Y JSR PRNTAX LDY #FIELDSTATICVAL LDA (LDPTR),Y INY TAX LDA (LDPTR),Y JSR PRNTAX DVM_BEGIN .ENDIF NEXTFLDATR: DECJNZB ACNT, LDFLDATR NEXTFIELD: .IFDEF DEBUG_LOAD DVM_END JSR CROUT DVM_BEGIN .ENDIF LDZPW LDPTR LDCW FIELDRECSZ ; NEXT FIELD RECORD ADDW STZPW LDPTR DECJNZB LDCNT, LOADFIELD .IFDEF DEBUG_DVM DVM_END TSX CPX STACKCHK BEQ :+ PERR "STACK CHECK FAIL AFTER LOAD FIELDS" BRK : DVM_BEGIN .ENDIF ; ; LOAD METHODS INTO TABLE. STATIC METHODS HAVE A CODE HANDLE DIRECTLY IN THE ENTRY, VIRTUAL ; METHODS HAVE AN OFFSET INTO THE VIRTUAL TABLE TO LOOK UP THE CODE HANDLE ; LOADMETHODCNT: CALL READWORD SWAPB BRZB :+ PERR_DVM "METHOD COUNT > 255" JUMP LOADCLASS_ERR : DUPB STPB (CLASSLDPTR), CLASSMETHODCNT DUPB STZPB LDCNT BRNZB :+ JUMP RESOLVESUPER : DVM_END .IFDEF DEBUG_LOAD PSTR "METHOD COUNT: " LDA LDCNT JSR PRBYTE JSR CROUT ; JSR KBWAIT .ENDIF LDA LDCNT LDX #$00 JSR MUL_METHODRECSZ ; 20 BYTES PER METHOD RECORD LDY #$01 JSR HMEM_ALLOC ; ALLOC THE METHOD TABLE LDY #CLASSMETHODTBL STA (CLASSLDPTR),Y INY PHA TXA STA (CLASSLDPTR),Y PLA JSR HMEM_LOCK ; LOCK METHOD TABLE IN MEMORY STA LDPTR STX LDPTR+1 DVM_BEGIN LOADMETHOD: CALL READWORD ; ACCESS FLAGS STPW (LDPTR), METHODACCESS .IFDEF DEBUG_LOAD DVM_END LDY #METHODACCESS LDA (LDPTR),Y TAX INY LDA (LDPTR),Y JSR PRNTAX DVM_BEGIN .ENDIF CALL READWORD ; NAME STRING INDEX CALL LDCONST ; GET STRING HANDLE STPW (LDPTR), METHODNAME .IFDEF DEBUG_LOAD DVM_END LDA #'-' JSR COUT LDY #METHODNAME+1 LDA (LDPTR),Y DEY TAX LDA (LDPTR),Y JSR PRHSTR LDA #' ' JSR COUT DVM_BEGIN .ENDIF LD0W CALL READWORD ; DESCRIPTION STRING INDEX CALL LDCONST ; GET STRING HANDLE DUPW STPW (LDPTR), METHODDESC .IFDEF DEBUG_LOAD DVM_END LDY #METHODDESC+1 LDA (LDPTR),Y DEY TAX LDA (LDPTR),Y JSR PRHSTR LDA #' ' JSR COUT DVM_BEGIN .ENDIF CALL_02 SCANDESCPARMS .IFDEF DEBUG_LOAD DVM_END PLA PHA JSR PRBYTE PSTR " PARAM BYTES " DVM_BEGIN .ENDIF STPB (LDPTR), METHODPARAMS POPB POPW CALL READWORD ; METHOD ATTRIB COUNT SWAPB BRZB :+ PERR_DVM "TOO MANY METHOD ATTRIBUTES" JUMP LOADCLASS_ERR : DUPB STZPB ACNT BRNZB LDMTHDATR JUMP NEXTMETHOD LDMTHDATR: CALL READWORD ; METHOD ATTRIB NAME CALL LDCONST .IFDEF DEBUG_LOAD DUPW DVM_END PLAX JSR HMEM_PTR JSR PRSTR DVM_BEGIN .ENDIF DUPW HCODESTR: LDCW 0 BREQUW LDCODE DUPW HNATIVESTR: LDCW 0 BREQUW CHKNATV POPW CALL SKIPATTRIB ; DEFAULT: SKIP ATTRIB JUMP NEXTMTHDATR CHKNATV: LDPB (LDPTR), METHODACCESS+1 LD1B ANDB ; CHECK FOR NATIVE FLAG BRNZB LDCODE PERR_DVM "MISSING NATIVE ACCESS FLAG FOR 6502 METHOD" JUMP LOADCLASS_ERR ; ; LOAD JAVA BYTECODE/NATIVE 6502 CODE SEGMENT FROM FILE/MEMORY INTO METHOD ; LDCODE: POPW CALL READWORD ; CODE ATTRIB LENH CALL READWORD ; CODE ATTRIB LENL POP2W CALL READWORD ; READ CODE BLOCK SWAPB ; CODE MAX STACK BRZB :+ PERR_DVM "METHOD STACK OVERFLOW" JUMP LOADCLASS_ERR : STB MAXSTACK ; SAVE TEMP CALL READWORD ; CODE MAX LOCALS SWAPB BRZB :+ ; MUST BE LESS THAN 256 PERR_DVM "METHOD LOCALS OVERFLOW" JUMP LOADCLASS_ERR : STB MAXLOCALS CALL READWORD ; CODE LENH BRZW :+ PERR_DVM "METHOD CODE SIZE OVERFLOW" JUMP LOADCLASS_ERR : CALL READWORD ; CODE LENL STZPW CCNT LDW CURRENTOFSTPROC ; GET CURRENT FILE OFFSET CALLIND STW CODEOFST LDPB (LDPTR), METHODACCESS+1 LD1B ANDB ; CHECK FOR NATIVE FLAG BRZB READBYTECODE LD1W LDZPW CCNT ; READ NATIVE CODE CALL_02 HMEM_ALLOC ; ALLOCATE REGULAR MEMORY DUPW STPW (LDPTR), METHODSTATICODE CALL_02 HMEM_PTR STZPW DSTADDR POPW LDZPW CCNT CALL READMEM ; COPY CODE FROM FILE BUFFER TO MEMORY BLOCK CALL READWORD ; CODE EXCEPTION COUNT BRNZW :+ JUMP LDCODEATRCNT ; MUST BE ZERO FOR NATIVE : PERR_DVM "NATIVE EXCEPTIONS NOT ALLOWED" JUMP LOADCLASS_ERR READBYTECODE: LD0B LDPB (LDPTR), METHODACCESS LDCB $20 ; MASK SYNCHRONIZED FLAG ANDB LDZPW CCNT CALL_02 HCODE_ALLOC ; ALLOCATE CODE BLOCK DUPW STPW (LDPTR), METHODSTATICODE CALL_02 HCODE_ACCESS ; SET THIS CODE BLOCK AS CURRENTLY ACCESSED POP2W LD0W LDW CODEOFST CALL_02 HCODE_SETOFFSET POPB LDB MAXSTACK CALL_02 HCODE_SETSTACK POPB LDB MAXLOCALS CALL_02 HCODE_SETLOCALS .IFDEF DEBUG_LOAD LD0W LDCW '{' CALL_02 COUT POP2W .ENDIF .IF 0 : POPB CALL READBYTE CALL_02 CODECPY ; COPY CODE INTO CODE BLOCK DECJNZW CCNT, :- .ELSE DVM_END RDBCLP: LDY CLBUFFOFST LDA (CLBUFFPTR),Y INC CLBUFFOFST BNE :+ PHA JSR READBUFF PLA : JSR CODECPY LDA CCNT SEC SBC #$01 STA CCNT LDA CCNT+1 SBC #$00 STA CCNT+1 ORA CCNT BNE RDBCLP DVM_BEGIN .ENDIF .IFDEF DEBUG_LOAD LD0W LDCW '}' CALL_02 COUT POP2W .ENDIF POPW CALL READWORD ; CODE EXCEPTION COUNT DUPW BRZW READCODEUNACC ; ZERO SIZE, SKIP LOAD OF EXCEPTIONS .IFDEF DEBUG_LOAD LD0W LDCW '[' CALL_02 COUT POP2W .ENDIF DUP2W CALL_02 HCODE_SETEXCEPTLEN POP2W SHLW ; MULTIPLY BY 8 TO GET SIZE SHLW SHLW DUPW STW CCNT SWAPW POPW LD1W SWAPW CALL_02 HMEM_ALLOC ; ALLOCATE EXCEPTION BLOCK DUP2W CALL_02 HCODE_SETHEXCEPT POP2W CALL_02 HMEM_PTR STZPW DSTADDR LDW CCNT CALL READMEM ; COPY EXCEPT TABLE FROM FILE BUFFER TO MEMORY BLOCK .IFDEF DEBUG_LOAD LD0W LDCW ']' CALL_02 COUT POP2W .ENDIF LD0W READCODEUNACC: CALL_02 HCODE_UNACCESS ; CLEAR CURRENT CODE ACCESS POP2W LDCODEATRCNT: CALL READWORD ; CODE ATTRIB COUNT SWAPB BRZB :+ PERR_DVM "TOO MANY CODE ATTRIBS" JUMP LOADCLASS_ERR : DUPB STZPB ACNT+1 BRZB NEXTMTHDATR LDCODEATR: CALL READWORD ; SKIP ATTRIB NAME POPW CALL SKIPATTRIB ; SKIP ATTRIB DATA NEXTCODEATR: DECJNZB ACNT+1, LDCODEATR NEXTMTHDATR: DECJNZB ACNT, LDMTHDATR NEXTMETHOD: .IFDEF DEBUG_LOAD LD0W LD0W CALL_02 CROUT POP2W .ENDIF LDZPW LDPTR LDCW METHODRECSZ ; NEXT METHOD RECORD ADDW STZPW LDPTR DECJNZB LDCNT, LOADMETHOD .IFDEF DEBUG_DVM DVM_END TSX CPX STACKCHK BEQ :+ PERR "STACK CHECK FAIL AFTER LOAD METHODS" BRK : DVM_BEGIN .ENDIF ; ; FINISHED LOADING CLASS FILE. NOW RESOLVE OUTSANDING FIXUPS. ; RESOLVESUPER: DVM_END JSR RELEASEBUFF LDY #$00 LDA SUPERCLASS ; RESOLVE SUPERCLASS LDX SUPERCLASS+1 BEQ ALLDEPENDS JSR HCLASS_NAME BCC ALLDEPENDS ; ALL DEPENDENCIES MET LOADSUPERCLASS: LDA HCLASSLD ; SUPERCLASS NOT FOUND, LOAD IT PHA LDA HCLASSLD+1 PHA LDA SUPERCLASS ; RESOLVE SUPERCLASS LDX SUPERCLASS+1 JSR LOADCLASS_FILE ; LOAD THE SUPERCLASS BCC :+ PERR "ERROR LOADING SUPERCLASS" PLA PLA SEC RTS : JSR HCLASS_HNDL ; GET INDEX TO SUPERCLASS STY ISUPER PLA ; RESTORE HANDLE TO LOADING CLASS STA HCLASSLD+1 TAX PLA STA HCLASSLD JSR HMEM_PTR ; RESTORE POINTER TO LOADING CLASS STA CLASSLDPTR STX CLASSLDPTR+1 LDY ISUPER ALLDEPENDS: STY ISUPER TYA ; SAVE SUPERCLASS INDEX LDY #CLASSSUPER STA (CLASSLDPTR),Y LDA HCLASSLD ; ADD THIS ALMOST COMPETE CLASS TO DATABASE LDX HCLASSLD+1 JSR HCLASS_ADD STY ICLASSLD ; ; GET POINTER TO SUPERCLASS ; .IFDEF DEBUG_LOAD PSTR "FIXUP METHOD/VTBL FOR CLASS:" LDY ICLASSLD JSR CLASS_STRING JSR PRHSTRLN ; JSR KBWAIT .ENDIF .IFDEF DEBUG_DVM TSX STX STACKCHK .ENDIF DVM_BEGIN LDB ISUPER .IFDEF DEBUG_DVM BRNZB :+ JUMP VTBLINIT : .ELSE BRZB VTBLINIT ; BETTER BE CLASS OBJECT .ENDIF LD0B LDB ISUPER LD0W CALL_02 HCLASS_INDEX CALL_02 HMEM_LOCK ; LOCK SUPERCLASS STZPW SUPERPTR POPW LDPW (SUPERPTR), CLASSINSTSIZE ; GET SUPERCLASS' INSTANCE SIZE DUPW STW ENTRYOFFSET ; ADD THIS OFFSET TO INSTANCE SIZE AND FIELD INST OFFSETS LDPW (CLASSLDPTR), CLASSINSTSIZE ; UPDATE INSTANCE SIZE ADDW STPW (CLASSLDPTR), CLASSINSTSIZE LDPB (CLASSLDPTR), CLASSFIELDCNT .IFDEF DEBUG_DVM BRNZB :+ JUMP VTBLINIT : .ELSE BRZB VTBLINIT .ENDIF LDPB (CLASSLDPTR), CLASSFIELDCNT STZPB LDCNT LD0W LDPW (CLASSLDPTR), CLASSFIELDTBL CALL_02 HMEM_PTR ; STILL LOCKED FROM EARLIER STZPW LDPTR POPW .IFDEF DEBUG_DVM DVM_END TSX CPX STACKCHK BEQ :+ PERR "STACK CHECK FAIL AFTER SUPER SETUP" BRK : DVM_BEGIN .ENDIF ; ; FIXUP FIELD OFFSETS ; UPDATEFLDLP: LDPB (LDPTR), FIELDACCESS LDCB $08 ANDB ; CHECK FOR STATIC FIELD BRNZB UPDATENXTFLD LDPW (LDPTR), FIELDINSTOFFSET ; UPDATE FIELD INSTANCE OFFSET LDW ENTRYOFFSET ADDW STPW (LDPTR), FIELDINSTOFFSET UPDATENXTFLD: LDCW FIELDRECSZ LDZPW LDPTR ADDW STZPW LDPTR DECJNZB LDCNT, UPDATEFLDLP LD0W LDPW (CLASSLDPTR), CLASSFIELDTBL ; UNLOCK THE FIELD TABLE CALL_02 HMEM_UNLOCK POP2W .IFDEF DEBUG_DVM DVM_END TSX CPX STACKCHK BEQ :+ PERR "STACK CHECK FAIL AFTER FIXUP FIELDS" BRK : DVM_BEGIN .ENDIF ; ; FIXUP VIRTUAL TABLE ENTRIES ; VTBLINIT: LD0B LDB ISUPER BRZB :+ POPB LDPB (SUPERPTR), CLASSVTBLCNT : STZPB VCNT ; THIS WILL BE THE ACTUAL VIRT TABLE SIZE LDPB (CLASSLDPTR), CLASSMETHODCNT ; GET UPPER BOUNDS ON SIZE OF VIRT TABLE DUPB STZPB LDCNT ZEXTB LDZPB VCNT ZEXTB ADDW ; THIS WILL BE ACTUAL VTBL SIZE SWAPB BRZB :+ POPB LDCB $FF ; HOPE WE DON'T OVERFLOW : DUPB STZPB ACNT ; KEEP ALLOCATED SIZE AROUND ZEXTB SHLW LD1W SWAPW CALL_02 HMEM_ALLOC ; ALLOCATE VIRT TABLE DUPW STPW (CLASSLDPTR), CLASSVIRTBL CALL_02 HMEM_LOCK ; LOCK VIRT TABLE DUPW STZPW LDPTR STZPW DSTADDR POPW LDB ISUPER ; COPY SUPER VTBL INTO THIS VTBL BRZB NOSUPERVTBL LD0W LDPW (SUPERPTR), CLASSVIRTBL ; GET POINTER TO SUPER VIRT TABLE CALL_02 HMEM_PTR STZPW SRCADDR LDZPB VCNT ZEXTB SHLW CALL_02 MEMCPY ; COPY IT OVER POP2W NOSUPERVTBL: .IFDEF DEBUG_DVM DVM_END TSX CPX STACKCHK BEQ :+ PERR "STACK CHECK FAIL AFTER VTABLE INIT" BRK : DVM_BEGIN .ENDIF LDZPB LDCNT BRNZB :+ ; CHECK FOR *THIS* METHODS JUMP VTBLDONE ; NO NEW METHODS, SKIP VTBL CHECK : LD0W LDPW (CLASSLDPTR), CLASSMETHODTBL ; GET POINTER TO METHODS CALL_02 HMEM_PTR ; STILL LOCKED FROM EARLIER STZPW METHODPTR POPW VTBLINDXTLP: LDPB (METHODPTR), METHODACCESS ; CHECK FOR STATIC METHODS LDCB $08 ANDB BRZB VTBLSRCHSUPR LDPW (METHODPTR), METHODVINDEX CALL SETCODECLASS ; SET CLASS FOR METHOD JUMP VTBLINDXNXT VTBLSRCHSUPR: LDB ISUPER BRZB VTBLNEWINDX ; NO SUPER, ADD NEW INDEX LDB ISUPER ZEXTB LDPW (METHODPTR), METHODDESC ; LOOK FOR MATCHING METHOD CALL_02 CLASS_MATCH_DESC POPW LDPW (METHODPTR), METHODNAME CALL_02 CLASS_MATCH_NAME CALL_02 RESOLVE_METHOD SWAPW DUPW LDCW $0100 ; CHECK CARRY FLAG FOR RESULT ANDW BRZW :+ POP2W BRNCH VTBLNEWINDX ; NOT FOUND, ALLOCATE NEW INDEX : SWAPW CALL_02 CLASS_METHODPTR ; FOUND A MATCH, GET ITS INDEX/OFFSET STZPW TMPTR POPW LDPW (TMPTR), METHODVINDEX STW ENTRYOFFSET .IFDEF DEBUG_LOAD DVM_END PSTR "OVERRIDE METHOD:" LDY #METHODNAME+1 LDA (METHODPTR),Y DEY TAX LDA (METHODPTR),Y JSR PRHSTR LDY #METHODDESC+1 LDA (METHODPTR),Y DEY TAX LDA (METHODPTR),Y JSR PRHSTR PSTR " VTBL OFST:" LDA ENTRYOFFSET+1 JSR PRBYTE LDA ENTRYOFFSET JSR PRBYTE JSR CROUT ; JSR KBWAIT DVM_BEGIN .ENDIF JUMP VTBLINSRTINDX VTBLNEWINDX: LDZPB VCNT .IFDEF DEBUG DUPB LDZPB ACNT BRBEB :+ PERR "OVERFLOWED ALLLOCATED COUNT" BRK : .ENDIF DUPB INCRB DUPB STZPB VCNT BRNZB :+ DVM_END PERR "VIRTUAL TABLE OVERFLOW" JMP THROW_INTERNALERR : ZEXTB SHLW STW ENTRYOFFSET .IFDEF DEBUG_LOAD DVM_END PSTR "ADD METHOD:" LDY #METHODNAME+1 LDA (METHODPTR),Y DEY TAX LDA (METHODPTR),Y JSR PRHSTR LDY #METHODDESC+1 LDA (METHODPTR),Y DEY TAX LDA (METHODPTR),Y JSR PRHSTR PSTR " VTBL OFST:" LDA ENTRYOFFSET+1 JSR PRBYTE LDA ENTRYOFFSET JSR PRBYTE JSR CROUT ; JSR KBWAIT DVM_BEGIN .ENDIF VTBLINSRTINDX: LDPW (METHODPTR), METHODVINDEX ; UPDATE METHOD ENTRY WITH VTBL INDEX DUPW CALL SETCODECLASS ; SET CLASS OF METHOD LDW ENTRYOFFSET DUPW STPW (METHODPTR), METHODVINDEX LDZPW LDPTR ADDW ; CALC ADDRESS FOR INDEX STINDW ; PULL HCODE OFF STACK AND SAVE IN VTBL VTBLINDXNXT: LDCW METHODRECSZ ; NEXT METHOD LDZPW METHODPTR ADDW STZPW METHODPTR DECJNZB LDCNT, VTBLINDXTLP METHDTBLDONE: LD0W LDPW (CLASSLDPTR), CLASSMETHODTBL ; UNLOCK METHOD TABLE CALL_02 HMEM_UNLOCK POP2W .IFDEF DEBUG_DVM DVM_END TSX CPX STACKCHK BEQ :+ PERR "STACK CHECK FAIL AFTER VTABLE FIXUPS" BRK : DVM_BEGIN .ENDIF VTBLDONE: LD0W LDPW (CLASSLDPTR), CLASSVIRTBL ; UNLOCK VIRT TABLE CALL_02 HMEM_UNLOCK POP2W LDZPB VCNT ; SAVE ACTUAL VTBL SIZE STPB (CLASSLDPTR), CLASSVTBLCNT ; SAVE VTBL SIZE DVM_END ; ; UNLOCK THE CLASSES ; LDY ISUPER BEQ :+ JSR HCLASS_INDEX ; UNLOCK SUPERCLASS JSR HMEM_UNLOCK : LDA HCLASSLD LDX HCLASSLD+1 JSR HMEM_UNLOCK ; UNLOCK THIS CLASS LDA HCLASSLD ; SAVE CLASS INFO JUST PHA ; IN CASE MESSES IT UP LDA HCLASSLD+1 PHA LDA ICLASSLD PHA ; ; LOOK FOR AND INVOKE IF FOUND ; CLINIT: LDA #0 ; LOOK FOR METHOD LDX #0 ; VALUES WERE POKED IN DURING INIT JSR CLASS_MATCH_NAME LDA HVOIDDESCSTR LDX HVOIDDESCSTR+1 JSR CLASS_MATCH_DESC LDY ICLASSLD JSR RESOLVE_METHOD BCS CLASSLOADDONE ; NO .IFDEF DEBUG_LOAD PHA TXA PHA TYA PHA PSTRLN "CALLING " PLA TAY PLA TAX PLA .ENDIF JSR ASYNC_STATIC .IFDEF DEBUG_LOAD PHP PSTRLN "BACK FROM " PLP .ENDIF BCC CLASSLOADDONE ; CHECK FOR EXCEPTION PLA STA CURRENTEXCEPTN PLA STA CURRENTEXCEPTN+1 PLA STA CURRENTEXCEPTN+2 PLA STA CURRENTEXCEPTN+3 BCS :+ CLASSLOADDONE: CLC : PLA ; YIPEE, ALL DONE TAY PLA TAX PLA .IFDEF DEBUG_LOAD STA TMP PLA CMP #$69 BNE BADSTACK PLA CMP #$69 BEQ OKSTACK BADSTACK: PERR "LOADCLASS BAD STACK POINTER" LDA #$EE ; SET STACK MARKER PHA PHA BRK OKSTACK: LDA TMP CLC .ENDIF RTS ;* ;* READ CLASS DATA FROM FILE BUFFER ;* ONE BYTE VALUE IS RETURNED ;* IN A ;* ENTRY: ;* EXIT: TOSB = DATA ;* READBYTE: DVM_END LDY CLBUFFOFST LDA (CLBUFFPTR),Y PHA INC CLBUFFOFST BNE :+ JSR READBUFF : DVM_BEGIN RET ;* ;* READ CLASS DATA FROM FILE BUFFER ;* ENTRY: ;* EXIT: TOSW = DATA ;* READWORD: DVM_END LDY CLBUFFOFST LDA (CLBUFFPTR),Y PHA INY BNE :+ JSR READBUFF LDY #$00 : LDA (CLBUFFPTR),Y PHA INY BNE :+ JSR READBUFF LDY #$00 : STY CLBUFFOFST DVM_BEGIN RET ;* ;* READ DATA INTO MEMORY. ;* ENTRY: DSTADDR = ADDRESS OF MEMORY TO READ INTO ;* TOSW = NUMBER OF BYTES TO READ ;* READMEM: DVM_END PLAX STA CCNT STX CCNT+1 RDMEMLP: LDY CLBUFFOFST LDA (CLBUFFPTR),Y INC CLBUFFOFST BNE :+ PHA JSR READBUFF PLA : LDY #$00 STA (DSTADDR),Y INC DSTADDR BNE :+ INC DSTADDR+1 : LDA CCNT SEC SBC #$01 STA CCNT LDA CCNT+1 SBC #$00 STA CCNT+1 ORA CCNT BNE RDMEMLP DVM_BEGIN RET ;* ;* READ ATTRIBUTE DATA AND DISCARD ;* SKIPATTRIB: CALL READWORD ; LENH BRNZW SKIPATTRIB_ERR CALL READWORD ; LENL SKIPBYTES: LDZPB CLBUFFOFST ZEXTB ADDW STZPB CLBUFFOFST DUPB BRZB SKIPPED SKIPPAGES: LD0W LD0W CALL_02 READBUFF POP2W DECRB DUPB BRNZB SKIPPAGES SKIPPED: POPB RET SKIPATTRIB_ERR: JUMP LOADCLASS_ERR ;* ;* CALCULATE INDEX INTO CONSTANT POOL AND RETURN LOWORD AT CONST POOL INDEX ;* ENTRY: TOS = INDEX ;* EXIT: TOS = LOWORD ;* LDCONST: DVM_END PLAX CALC_CONSTPLRECSZ CLC ; CALC OFFSET IN CLASS TO CONST POOL ADC #CLASSBASESZ-CONSTPLRECSZ BCC :+ INX CLC : ADC CLASSLDPTR STA CLDPTR TXA ADC CLASSLDPTR+1 STA CLDPTR+1 LDY #$03 LDA (CLDPTR),Y INY PHA LDA (CLDPTR),Y PHA DVM_BEGIN RET ;* ;* CLASS LOAD ERROR. ;* LOADCLASS_ERR: DVM_END .IFDEF DEBUG_LOAD JSR KBWAIT PERR "ERROR LOADING CLASS: " LDY #CLASSTHIS+1 LDA (CLASSLDPTR),Y DEY TAX BEQ :+ LDA (CLASSLDPTR),Y JSR HMEM_PTR JSR PRSTRLN : .ENDIF JMP READCLASS_ERR ;* ;* SET CLASS INDEX OF BYTECODE METHOD ;* SETCODECLASS: DVM_END PLAX STA HCODE STX HCODE+1 JSR HCODE_ISBYTECODE BNE :+ LDA HCODE LDX HCODE+1 JSR HCODE_ACCESS ; SET THE CLASS FOR THE CODE LDA ICLASSLD JSR HCODE_SETCLASS JSR HCODE_UNACCESS : DVM_BEGIN RET ;***************************************************************************** ;* ;* END OF RELOCATED DVM CODE ;* ;***************************************************************************** LC_DVM_END: CODESTR: .BYTE 4, "Code" ; CODE ATTRIBUTE CONSTVALSTR: .BYTE 13, "ConstantValue" ; CONSTANT VALUE ATTRIBUTE NATIVESTR: .BYTE 4, "6502" ; NATIVE 6502 CODE ATTRIBUTE MAINNAMESTR: .BYTE 4, "main" ; MAIN ENRTYPOINT METHOD NAME MAINDESCSTR: .BYTE 22, "([Ljava/lang/String;)V" ; MAIN ENTRYPOINT METHOD DESC RUNNAMESTR: .BYTE 3, "run" ; THREAD ENTRYPOINT METHOD NAME CLINITNAMESTR: .BYTE 8,"" ; CLASS INIT METHOD FINALNAMESTR: .BYTE 8,"finalize" ; FINALIZER METHOD VOIDDESCSTR: .BYTE 3,"()V" ; VOID METHOD DESC BOOLSTR: .BYTE 1,"Z" ; BOOLEAN TYPE BYTESTR: .BYTE 1,"B" ; BYTE TYPE CHARSTR: .BYTE 1,"C" ; CHARACTER TYPE SHORTSTR: .BYTE 1,"S" ; SHORT TYPE INTSTR: .BYTE 1,"I" ; INTEGER TYPE FLOATSTR: .BYTE 1,"F" ; FLOAT TYPE LONGSTR: .BYTE 1,"J" ; LONG TYPE DOUBLESTR: .BYTE 1,"D" ; DOUBLE TYPE .DATA LOADCLASSCALLCNT: .BYTE 0 CLASSFILEBASE: .ADDR $0000 CLASSPREFIX: .RES 65 CLASSFILE: .RES 65 CLREFNUM: .BYTE $00 HCLASSFILEBUFF: .WORD $0000 READBUFFPROC: .ADDR 0 RELEASEBUFFPROC: .ADDR 0 HLOADCLASSPROC: .WORD 0 LOADCLASSPROC: .WORD 0 HMAINNAMESTR: .WORD $0000 ; ENTRYPOINT METHOD NAME HMAINDESCSTR: .WORD $0000 ; ENTRYPOINT METHOD DESC HRUNNAMESTR: .WORD $0000 ; ENTRYPOINT METHOD NAME HFINALNAMESTR: .WORD $0000 ; FINALIZER METHOD NAME HVOIDDESCSTR: .WORD $0000 ; VOID METHOD DESC HCLASSLD: .WORD $0000 ; HANDLE TO CLASS BEING LOADED ICLASSLD: .BYTE $00 ; INDEX TO LOADED CLASS IN HCLASS TABLE SUPERCLASS: .WORD $0000 ; HSTR TO SUPERCLASS ISUPER: .BYTE $00 ENTRYOFFSET: .WORD $0000 HREADSTRBUFF: .WORD $0000 ; TEMPORARY STRING BUFFER MAXSTACK: .BYTE $00 MAXLOCALS: .BYTE $00 HCODE: ; ALIAS WITH CODE OFFSET CODEOFST: .WORD $0000 TYPE2SIZE: .BYTE 1,2,4,0 CURRENTOFSTPROC: .ADDR 0 .IFDEF DEBUG_DVM STACKCHK: .BYTE $00 ; USE THIS TO VALIDATE STACK DEPTH .ENDIF .CODE ;* ;* READ A CLASS FROM A MEMORY IMAGE ;* ENTRY: AX = POINTER TO CLASS IMAGE ;* LOADCLASS_MEM: STA CLASSFILEBASE STX CLASSFILEBASE+1 STA CLBUFFPTR STX CLBUFFPTR+1 DVM_BEGIN LD0W ; NULL HANDLE = LOADCLASS_MEM JUMP LOADCLASS_INTERNAL ;* ;* READ A CLASS FROM A FILE ;* ENTRY: AX = HANDLE TO CLASS NAME ;* EXIT: AX = HANDLE TO CLASS ;* Y = CLASS INDEX ;* LOADCLASS_FILE: PHA ; OUSH HANDLE ON STACK TXA PHA DVM_BEGIN ;* ;* LOAD A CLASS AND CREATE AN INTERNAL CLASS STRUCTURE ;* CALLED FROM EITHER LOADCLASS_MEM OR LOADCLASS_FILE ;* LOADCLASS_INTERNAL: LDCW LOADCLASS_INTRET-1 ; SET UP OUR RETURN ADDRESS (IN 6502 LAND) SWAPW DVM_END LDA LOADCLASSCALLCNT BNE :+ LDA HLOADCLASSPROC LDX HLOADCLASSPROC+1 JSR HMEM_LOCK ; FIND THE CODE MODULE AND LOCK IT IN PLACE STA LOADCLASSPROC STX LOADCLASSPROC+1 : INC LOADCLASSCALLCNT DVM_BEGIN LDW LOADCLASSPROC .IFDEF DEBUG_LOAD DUPW BRNZW :+ PERR_DVM "BAD LOADCLASSPROC" JUMP LOADCLASS_ERR : .ENDIF JUMPIND ; JUMP TO IT LOADCLASS_INTRET:PHP ; SAVE RETURN VALUES DEC LOADCLASSCALLCNT BNE :+ PHA TXA PHA TYA PHA LDA HLOADCLASSPROC ; UNLOCK THE CODE MODULE LDX HLOADCLASSPROC+1 JSR HMEM_UNLOCK .IFDEF DEBUG_LOAD LDA #$00 STA LOADCLASSPROC STA LOADCLASSPROC+1 .ENDIF PLA ; RESTORE RETURN VALUES AND RETURN TAY PLA TAX PLA : PLP RTS ;* ;* CLASS FILE READ ERROR. ;* ;* ;* CLASS LOAD ERROR. ;* READCLASS_ERR: .IFDEF DEBUG_LOAD PERR "ERROR READING CLASS FILE: " .ENDIF JSR RELEASEBUFF LDA #7 ; CLASS FORMAT JMP THROW_SYSEXCEPTN FILECLASS_ERR: .IFDEF DEBUG_LOAD LDA #CLASSFILE JSR PRSTRLN .ENDIF LDA #6 ; NO CLASS DEF FOUND JMP THROW_SYSEXCEPTN ;* ;* RETURN CURRENT READ OFFSET POSITION IN CLASS FILE ;* ;* EXIT: TOS = OFFSET WORD ;* CURRENTOFST_MEM: LD0W RET CURRENTOFST_FILE: LDB CLBUFFPAGE LDB CLBUFFOFST RET ;* ;* INDIRECT JUMPS TO BELOW ROUTINES ;* READBUFF: JMP (READBUFFPROC) RELEASEBUFF: JMP (RELEASEBUFFPROC) ;* ;* READ FROM FILE INTO BUFFER ;* READBUFF_MEM: INC CLBUFFPTR+1 RTS READBUFF_FILE: LDA CLBUFFPTR LDX CLBUFFPTR+1 JSR FILE_SETBUFFER LDA #$00 LDX #$01 LDY CLREFNUM JSR FILE_READ BCC :+ .IFDEF DEBUG_LOAD JSR PRBYTE PERR " - ERROR FILE READ, " .ENDIF JMP READCLASS_ERR : INC CLBUFFPAGE RTS ;* ;* RELEASE CLASSFILE ;* RELEASEBUFF_MEM: RTS RELEASEBUFF_FILE: LDY CLREFNUM JSR FILE_CLOSE .IFDEF DEBUG_LOAD BCC :+ JSR PRBYTE PERR " - ERROR CLOSING FILE: " JMP FILECLASS_ERR : .ENDIF LDA HCLASSFILEBUFF ; RELEASE FILE BUFFER LDX HCLASSFILEBUFF+1 JMP HMEM_FREE