;*
;* JAVA BYTECODE MANAGER FOR 6502
;*
	.INCLUDE	"global.inc"
	.IMPORT	PRBLNK,PRBYTE,COUT,CROUT,PRNTAX
	.IMPORT	PUTS,PUTSLN,PRSTR,PRSTRLN,MEMSRC,MEMDST,MEMCPY,MUL_FIELDRECSZ,MUL_METHODRECSZ
	.IMPORT	HMEM_ALLOC,HMEM_ALLOC_FIXED,HMEM_ALLOC_CODE,HMEM_FREE,HMEM_LOCK,HMEM_UNLOCK,HMEM_UNLOCK_CODE
	.IMPORT	HMEM_PTR,HMEM_REF_INC,HMEM_REF_DEC
	.IMPORT	THROW_INTERNALERR,SYSTHROW
	.EXPORT	CODECPY,HCODE_ALLOC,HCODE_ACCESS,HCODE_UNACCESS,HCODE_LOCK,HCODE_UNLOCK,HCODE_ISBYTECODE,HCODE_FLAGS
	.EXPORT	HCODE_SETSTACK,HCODE_SETLOCALS,HCODE_SETOFFSET,HCODE_SETCLASS,HCODE_SETHEXCEPT,HCODE_SETEXCEPTLEN
	.EXPORT	HCODE_GETSTACK,HCODE_GETLOCALS,HCODE_GETOFFSET,HCODE_GETCLASS,HCODE_GETHEXCEPT,HCODE_GETEXCEPTLEN,HCODE_GETLEN
;*
;* BYTECODE BLOCK INTERNAL STRUCTURE
;*
CODEBLKSIG	EQU	$00		; 1 BYTE = $42 (UNUSED 6502/65C02/65802 OPCODE)
CODEBLKCLASS	EQU	$01		; 1 BYTE
CODEBLKSTACK	EQU	$02		; 1 BYTE
CODEBLKLOCALCNT	EQU	$03		; 1 BYTE
CODEBLKLOCALSZ 	EQU	$04		; 2 BYTES (MUL BY 5 IN SET LOCALS)
CODEBLKOFFST	EQU	$06		; 3 BYTES
CODEBLKHEXCEPT	EQU	$09		; 2 BYTES
CODEBLKEXCPTLEN	EQU	$0B		; 2 BYTES
CODELOCKCNT	EQU	$0D		; 2 BYTES
CODEBLKLEN	EQU	$0F		; 2 BYTES
CODEBLKFLAGS	EQU	$11		; 1 BYTE
CODEAUXADDR	EQU	$12		; 2 BYTES = ADDRESS OF CODE IN AUX MEMs
CODEBLKCODE	EQU	$14		; CODEBLKLEN BYTES, 32 BIT ALIGNED
CODEBLKPARMSZ	EQU	$14		; 32 BIT ALIGNED

	.DATA
HCODE:	.WORD	0
HCODEBLK:	.WORD	0

	.CODE
;*
;* COPY BYTECODES TO CODE MEMORY
;*
;* ENTRY: A = CODEBYTE
;*
CODECPY:
.IFDEF	DEBUG
	PHA
	LDA	HCODEBLK
	ORA	HCODEBLK+1
	BNE	:+
	PERR	"CODE NOT ACCESSED"
	JMP	THROW_INTERNALERR
:	PLA
.ENDIF
	LDY	#$00
	AUXMEM_WRACCESS_ON
	STA	(CODECOPYPTR),Y		; STORE CODE BYTE
	AUXMEM_WRACCESS_OFF
	INC	CODECOPYPTR		; INCREMENT POINTER
	BNE	:+
	INC	CODECOPYPTR+1
:	RTS
;*
;* ACCESS CODE BLOCK - WILL LOCK
;* ENTRY: AX = CODE HANDLE
;*
HCODE_ACCESS:
.IFDEF	DEBUG
	PHA
	LDA	HCODEBLK
	ORA	HCODEBLK+1
	BEQ	:+
	PERR	"CODE NOT UNACCESSED BEFORE ANOTHER ACCESS"
;	JMP	THROW_INTERNALERR
:	PLA
.ENDIF
	STA	HCODEBLK
	STX	HCODEBLK+1
	JSR	HCODE_LOCK
	STA	CODECOPYPTR
	STX	CODECOPYPTR+1
.IFDEF	BIGMEM
	LDA	HCODEBLK
	LDX	HCODEBLK+1
	JSR	HMEM_PTR
.ELSE
	SEC
	SBC	#CODEBLKCODE
	BCS	:+
	DEX
:
.ENDIF
	STA	CODEBLKPTR
	STX	CODEBLKPTR+1
	RTS
;*
;* UNACCESS CODE BLOCK - WILL UNLOCK
;*
HCODE_UNACCESS:	LDA	HCODEBLK
	LDX	HCODEBLK+1
.IFDEF	DEBUG
	BEQ	:+
	JSR	HCODE_UNLOCK
	LDA	#$00
	STA	HCODEBLK
	STA	HCODEBLK+1
:	RTS
.ENDIF
	JMP	HCODE_UNLOCK
;*
;* ALLOCATE CODE BLOCK
;*
;* ENTRY: AX = CODE SIZE
;*         Y = FLAGS
;* EXIT:  AX = HANDLE
;*         C = 1 :: SUCCESS
;*         C = 0 :: ERROR
;*
HCODE_ALLOC:
.IFDEF	BIGMEM
	CLC			; ROUND TO 32 BIT SIZE
	ADC	#$03
	BCC	:+
	INX
:	AND	#$FC
	PHA			; CODELEN
	TXA
	PHA			; CODELEN+1
	TYA
	PHA			; CODEFLAGS
	LDA	#CODEBLKPARMSZ
	LDX	#$00
.ELSE
	STA	TMP
	PHA			; CODELEN
	TXA
	PHA			; CODELEN+1
	TYA
	PHA			; CODEFLAGS
	LDA	TMP
	CLC
	ADC	#CODEBLKPARMSZ
	BCC	:+
	INX
:
.ENDIF
	LDY	#$01		; INITIAL REF COUNT
	JSR	HMEM_ALLOC_CODE
	STA	HCODE
	STX	HCODE+1
	JSR	HMEM_PTR
	STA	TMPTR
	STX	TMPTR+1
	LDY	#CODEBLKFLAGS		; SET CODE FLAGS
	PLA			; CODEFLAGS
	STA	(TMPTR),Y
	DEY			; LDY #CODEBLKLEN - SET CODELEN
	PLA			; CODELEN+1
	STA	(TMPTR),Y
	DEY
	PLA			; CODELEN
	STA	(TMPTR),Y
	DEY			; LDY #CODEBLKPARMSZ - ZERO OUT PARAMTERS
	LDA	#$00
:	STA	(TMPTR),Y
	DEY
	BNE	:-
	LDA	#$42		; UNUSED 6502/65C02/65802 OPCODE
	STA	(TMPTR),Y		; FOR BYTECODE SIGNATURE
.IFDEF	BIGMEM
	LDA	CODEHEAPTOP
	LDY	#CODEBLKLEN
	SEC
	SBC	(TMPTR),Y
	INY
	STA	CODEHEAPTOP
	TAX
	LDA	CODEHEAPTOP+1
	SBC	(TMPTR),Y
	CMP	#$08
	BCS	:+
	PERR	"OUT OF BYTECODE HEAP"
	LDA	#4		; OUT OF MEMORY
	JMP	SYSTHROW
:	STA	CODEHEAPTOP+1
	LDY	#CODEAUXADDR+1
	STA	(TMPTR),Y
	DEY
	TXA
	STA	(TMPTR),Y
.ENDIF
	LDA	HCODE
	LDX	HCODE+1
	CLC
	RTS

;*
;* SET CODE BLOCK PARAMETERS
;* ENTRY: A   = BYTE
;*        AX  = WORD
;*        AXY = 3 BYTES
;*
HCODE_SETCLASS:
.IFDEF	DEBUG
	PHA
	LDA	HCODEBLK
	ORA	HCODEBLK+1
	BNE	:+
	PERR	"CODE NOT ACCESSED"
	JMP	THROW_INTERNALERR
:	PLA
.ENDIF
	LDY	#CODEBLKCLASS
	STA	(CODEBLKPTR),Y
	RTS
HCODE_SETSTACK:
.IFDEF	DEBUG
	PHA
	LDA	HCODEBLK
	ORA	HCODEBLK+1
	BNE	:+
	PERR	"CODE NOT ACCESSED"
	JMP	THROW_INTERNALERR
:	PLA
.ENDIF
	LDY	#CODEBLKSTACK
	STA	(CODEBLKPTR),Y
	RTS
HCODE_SETLOCALS:
.IFDEF	DEBUG
	PHA
	LDA	HCODEBLK
	ORA	HCODEBLK+1
	BNE	:+
	PERR	"CODE NOT ACCESSED"
	JMP	THROW_INTERNALERR
:	PLA
.ENDIF
	LDY	#CODEBLKLOCALCNT
	STA	(CODEBLKPTR),Y
	INY			; LDY #CODEBLKLOCALSZ
	STA	TMP
	LDX	#$00
	ASL			; MULTIPLE A BY 5
	BCC	:+
	LDX	#$02
:	ASL
	BCC	:+
	INX
	CLC
:	ADC	TMP
	BCC	:+
	INX
:	STA	(CODEBLKPTR),Y
	INY
	TXA
	STA	(CODEBLKPTR),Y
	RTS
HCODE_SETOFFSET:
.IFDEF	DEBUG
	PHA
	LDA	HCODEBLK
	ORA	HCODEBLK+1
	BNE	:+
	PERR	"CODE NOT ACCESSED"
	JMP	THROW_INTERNALERR
:	PLA
.ENDIF
	STY	TMP
	LDY	#CODEBLKOFFST
	STA	(CODEBLKPTR),Y
	INY
	TXA
	STA	(CODEBLKPTR),Y
	INY
	LDA	TMP
	STA	(CODEBLKPTR),Y
	RTS
HCODE_SETHEXCEPT:
	LDY	#CODEBLKHEXCEPT
	BNE	HCODE_SETWORD
HCODE_SETEXCEPTLEN:
	LDY	#CODEBLKEXCPTLEN
HCODE_SETWORD:
.IFDEF	DEBUG
	PHA
	LDA	HCODEBLK
	ORA	HCODEBLK+1
	BNE	:+
	JMP	THROW_INTERNALERR
:	PLA
.ENDIF
	STA	(CODEBLKPTR),Y
	INY
	TXA
	STA	(CODEBLKPTR),Y
	RTS
;*
;* GET CODE BLOCK PARAMETERS
;* EXIT: A   = BYTE
;*       AX  = WORD
;*       AXY = 3 BYTES
;*
HCODE_GETCLASS:
.IFDEF	DEBUG
	LDA	HCODEBLK
	ORA	HCODEBLK+1
	BNE	:+
	PERR	"CODE NOT ACCESSED"
	JMP	THROW_INTERNALERR
:
.ENDIF
	LDY	#CODEBLKCLASS
	LDA	(CODEBLKPTR),Y
	RTS
HCODE_GETSTACK:
.IFDEF	DEBUG
	LDA	HCODEBLK
	ORA	HCODEBLK+1
	BNE	:+
	PERR	"CODE NOT ACCESSED"
	JMP	THROW_INTERNALERR
:
.ENDIF
	LDY	#CODEBLKSTACK
	LDA	(CODEBLKPTR),Y
	RTS
HCODE_GETLOCALS:
.IFDEF	DEBUG
	LDA	HCODEBLK
	ORA	HCODEBLK+1
	BNE	:+
	PERR	"CODE NOT ACCESSED"
	JMP	THROW_INTERNALERR
:
.ENDIF
	LDY	#CODEBLKLOCALSZ+1	; SIZE IN AX
	LDA	(CODEBLKPTR),Y
	DEY
	TAX
	LDA	(CODEBLKPTR),Y
	DEY
	STA	TMP
	LDA	(CODEBLKPTR),Y
	TAY			; COUNT IN Y
	LDA	TMP
	RTS
HCODE_GETOFFSET:
.IFDEF	DEBUG
	LDA	HCODEBLK
	ORA	HCODEBLK+1
	BNE	:+
	PERR	"CODE NOT ACCESSED"
	JMP	THROW_INTERNALERR
:
.ENDIF
	LDY	#CODEBLKOFFST+2
	LDA	(CODEBLKPTR),Y
	DEY
	STA	TMP
	LDA	(CODEBLKPTR),Y
	DEY
	TXA
	LDA	(CODEBLKPTR),Y
	LDY	TMP
	RTS
HCODE_GETLEN:
	LDY	#CODEBLKLEN+1
	BNE	HCODE_GETWORD
HCODE_GETHEXCEPT:
	LDY	#CODEBLKHEXCEPT+1
	BNE	HCODE_GETWORD
HCODE_GETEXCEPTLEN:
	LDY	#CODEBLKEXCPTLEN+1
HCODE_GETWORD:
.IFDEF	DEBUG
	LDA	HCODEBLK
	ORA	HCODEBLK+1
	BNE	:+
	PERR	"CODE NOT ACCESSED"
	JMP	THROW_INTERNALERR
:
.ENDIF
	LDA	(CODEBLKPTR),Y
	DEY
	TAX
	LDA	(CODEBLKPTR),Y
	RTS
;*
;* LOCK CODE BLOCK
;* ENTRY: AX = CODE HANDLE
;* EXIT:  AX = POINTER TO LOCKED CODE
;*
HCODE_LOCK:	STA	HCODE
	STX	HCODE+1
	JSR	HMEM_LOCK
	STA	TMPTR
	STX	TMPTR+1
	LDY	#CODELOCKCNT
	LDA	(TMPTR),Y
	CLC
	ADC	#$01
	STA	(TMPTR),Y
	BCC	:+
	INY
	LDA	(TMPTR),Y
	ADC	#$00
	STA	(TMPTR),Y
:
.IFDEF	BIGMEM
	LDY	#CODEAUXADDR+1
	LDA	(TMPTR),Y
	DEY
	TAX
	LDA	(TMPTR),Y
.ELSE
	LDA	TMPTR
	LDX	TMPTR+1
	CLC
	ADC	#CODEBLKCODE
	BCC	:+
	INX
:
.ENDIF
	RTS
;*
;* UNLOCK CODE BLOCK
;* ENTRY: AX = CODE HANDLE
;*
HCODE_UNLOCK:	STA	HCODE
	STX	HCODE+1
	JSR	HMEM_PTR
	STA	TMPTR
	STX	TMPTR+1
	LDY	#CODELOCKCNT
	LDA	(TMPTR),Y
	SEC
	SBC	#$01
	STA	(TMPTR),Y
	INY
	TAX
	LDA	(TMPTR),Y
	SBC	#$00
	STA	(TMPTR),Y
	BNE	:-
	CPX	#$00
	BNE	:-
	LDA	HCODE
	LDX	HCODE+1
	JMP	HMEM_UNLOCK_CODE
;*
;* CHECK FOR BYTECODE SIGNATURE
;* ENTRY: AX = HANDLE
;* EXIT:   Z = 1 :: IS BYTECODE
;*         Z = 0 :: IS NOT BYTECODE
;*
HCODE_ISBYTECODE:
	JSR	HMEM_PTR
	STA	TMPTR
	STX	TMPTR+1
	LDY	#CODEBLKSIG
	LDA	(TMPTR),Y
	CMP	#$42
	RTS
;*
;* RETURN HCODE FLAGS
;* ENTRY: AX = HANDLE
;* EXIT:   Z = 1 :: IS SYNCHRONIZED
;*         Z = 0 :: IS NOT SYNCHRONIZED
;*
HCODE_FLAGS:	JSR	HMEM_PTR
	STA	TMPTR
	STX	TMPTR+1
	LDY	#CODEBLKFLAGS
	LDA	(TMPTR),Y
	RTS