VM02/src/classload.s

1932 lines
34 KiB
ArmAsm
Executable File

;*
;* 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
LDX #>CODESTR
JSR HSTRPL_ADD
STA HCODESTR+2 ; POKE RIGHT INTO CODE
STX HCODESTR+1
LDA #<CONSTVALSTR
LDX #>CONSTVALSTR
JSR HSTRPL_ADD
STA HCONSTVALSTR+2
STX HCONSTVALSTR+1
LDA #<NATIVESTR
LDX #>NATIVESTR
JSR HSTRPL_ADD
STA HNATIVESTR+2
STX HNATIVESTR+1
LDA #<MAINNAMESTR
LDX #>MAINNAMESTR
JSR HSTRPL_ADD
STA HMAINNAMESTR
STX HMAINNAMESTR+1
LDA #<MAINDESCSTR
LDX #>MAINDESCSTR
JSR HSTRPL_ADD
STA HMAINDESCSTR
STX HMAINDESCSTR+1
LDA #<RUNNAMESTR
LDX #>RUNNAMESTR
JSR HSTRPL_ADD
STA HRUNNAMESTR
STX HRUNNAMESTR+1
LDA #<CLINITNAMESTR
LDX #>CLINITNAMESTR
JSR HSTRPL_ADD
STA CLINIT+1
STX CLINIT+3
LDA #<FINALNAMESTR
LDX #>FINALNAMESTR
JSR HSTRPL_ADD
STA HFINALNAMESTR
STX HFINALNAMESTR+1
LDA #<VOIDDESCSTR ; <CLINIT> AND <INIT> SHARE DESC
LDX #>VOIDDESCSTR
JSR HSTRPL_ADD
STA HVOIDDESCSTR
STX HVOIDDESCSTR+1
LDA #<BOOLSTR ; DATA TYPE STRINGS
LDX #>BOOLSTR
JSR HSTRPL_ADD
STA HBOOLSTR+2
STX HBOOLSTR+1
LDA #<BYTESTR
LDX #>BYTESTR
JSR HSTRPL_ADD
STA HBYTESTR+2
STX HBYTESTR+1
LDA #<CHARSTR
LDX #>CHARSTR
JSR HSTRPL_ADD
STA HCHARSTR+2
STX HCHARSTR+1
LDA #<SHORTSTR
LDX #>SHORTSTR
JSR HSTRPL_ADD
STA HSHORTSTR+2
STX HSHORTSTR+1
LDA #<INTSTR
LDX #>INTSTR
JSR HSTRPL_ADD
STA HINTSTR+2
STX HINTSTR+1
LDA #<FLOATSTR
LDX #>FLOATSTR
JSR HSTRPL_ADD
STA HFLOATSTR+2
STX HFLOATSTR+1
LDA #<LONGSTR
LDX #>LONGSTR
JSR HSTRPL_ADD
STA HLONGSTR+2
STX HLONGSTR+1
LDA #<DOUBLESTR
LDX #>DOUBLESTR
JSR HSTRPL_ADD
STA HDOUBLESTR+2
STX HDOUBLESTR+1
LDA #<CLASSPREFIX
LDX #>CLASSPREFIX
JSR PREFIX_GET
.IFDEF DEBUG_LOAD
JSR PUTS
.ASCIIZ "CLASS LOAD PATH:"
LDA #<CLASSPREFIX
LDX #>CLASSPREFIX
JSR PRSTRLN
.ENDIF
LDA #<LOADCLASS_FILE
STA LINK_CLASSLOAD
LDA #>LOADCLASS_FILE
STA LINK_CLASSLOAD+1
LC_DVM_SIZE EQU LC_DVM_END-LC_DVM_BEGIN
LDA #<LC_DVM_BEGIN
LDX #>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
LDX #>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
LDX #>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 <CLINIT> MESSES IT UP
LDA HCLASSLD+1
PHA
LDA ICLASSLD
PHA
;
; LOOK FOR <CLINIT> AND INVOKE IF FOUND
;
CLINIT: LDA #0 ; LOOK FOR METHOD <CLINIT>
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 <CLINIT>
.IFDEF DEBUG_LOAD
PHA
TXA
PHA
TYA
PHA
PSTRLN "CALLING <CLINIT>"
PLA
TAY
PLA
TAX
PLA
.ENDIF
JSR ASYNC_STATIC
.IFDEF DEBUG_LOAD
PHP
PSTRLN "BACK FROM <CLINIT>"
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,"<clinit>" ; 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
LDX #>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