mirror of https://github.com/dschmenk/VM02.git
637 lines
11 KiB
ArmAsm
Executable File
637 lines
11 KiB
ArmAsm
Executable File
;*
|
|
;* JAVA CLASS CLASS FOR 6502
|
|
;*
|
|
.INCLUDE "global.inc"
|
|
.INCLUDE "class.inc"
|
|
.IMPORT HMEM_LOCK,HMEM_UNLOCK
|
|
.IMPORT HMEM_PTR,HMEM_REF_INC,HMEM_REF_DEC
|
|
.IMPORT HSTR_HASH,STR_HASH,HSTRPL_ADD,HSTRPL_DEL,PRHSTR
|
|
.IMPORT MEMSRC,MEMDST,MEMCLR,MEMCPY
|
|
.IMPORT LOADCLASS_FILE
|
|
.IMPORT THROW_INTERNALERR
|
|
.EXPORT HCLASS_INIT,HCLASS_NAME,HCLASS_HNDL,HCLASS_INDEX,HCLASS_ADD
|
|
.EXPORT CLASS_STRING,CLASS_MATCH_NAME,CLASS_MATCH_DESC,CLASS_VIRTCODE
|
|
.EXPORT RESOLVE_CLASS,RESOLVE_METHOD,CLASS_METHODPTR,RESOLVE_FIELD,CLASS_FIELDPTR
|
|
.EXPORT CLASS_LOCKMETHOD,CLASS_UNLOCKMETHOD,CLASS_LOCK,CLASS_UNLOCK,CLASS_OF
|
|
|
|
.SEGMENT "INIT"
|
|
;*
|
|
;* CLEAR CLASS TABLE
|
|
;*
|
|
HCLASS_INIT: LDA #<HCLASS_TBLL
|
|
LDX #>HCLASS_TBLL
|
|
AUXZP_ACCESS_ON
|
|
JSR MEMDST
|
|
LDA #$00
|
|
LDX #$01
|
|
JSR MEMCLR
|
|
AUXZP_ACCESS_OFF
|
|
RTS
|
|
|
|
.DATA
|
|
;HCLASS_TBLL: .RES 128, $00
|
|
;HCLASS_TBLH: .RES 128, $00
|
|
|
|
.CODE
|
|
;*
|
|
;* THE CLASS TABLE MATCHES NAMES TO CLASSES
|
|
;*
|
|
;* FIND A CLASS GIVEN IT'S NAME
|
|
;* ENTRY: AX = HSTRNAME
|
|
;* EXIT: AX = HCLASS
|
|
;* Y = INDEX
|
|
;* C = 0 :: SUCCESS
|
|
;* C = 1 :: FAILURE
|
|
;*
|
|
HCLASS_NAME: STA HSTR
|
|
STX HSTR+1
|
|
LDY #$01
|
|
FINDSTRLP: AUXZP_ACCESS_ON
|
|
LDA HCLASS_TBLL,Y
|
|
LDX HCLASS_TBLH,Y
|
|
AUXZP_ACCESS_OFF
|
|
BEQ FINDSTRNXT ; SKIP NULL HANDLES
|
|
STY CCLASSCNT
|
|
JSR HMEM_PTR ; CONVERT TO ADDRESS
|
|
STA CCLASSPTR
|
|
STX CCLASSPTR+1
|
|
LDY #CLASSTHIS
|
|
LDA (CCLASSPTR),Y
|
|
CMP HSTR
|
|
BNE :+
|
|
INY
|
|
LDA (CCLASSPTR),Y
|
|
CMP HSTR+1
|
|
BNE :+
|
|
LDY CCLASSCNT ; FOUND IT
|
|
AUXZP_ACCESS_ON
|
|
LDA HCLASS_TBLL,Y
|
|
LDX HCLASS_TBLH,Y
|
|
AUXZP_ACCESS_OFF
|
|
CLC ; RETURN SUCCESS
|
|
RTS
|
|
: LDY CCLASSCNT
|
|
FINDSTRNXT: INY
|
|
BPL FINDSTRLP ; KEEP CHECKING
|
|
SEC ; NOT FOUND
|
|
RTS ; RETURN FAIL
|
|
;*
|
|
;* FIND A CLASS GIVEN IT'S HANDLE
|
|
;* ENTRY: AX = HCLASS
|
|
;* EXIT: AX = HCLASS
|
|
;* Y = INDEX
|
|
;* C = 0 :: SUCCESS
|
|
;* C = 1 :: FAILURE
|
|
;*
|
|
HCLASS_HNDL: LDY #$01
|
|
FINDCLSLP: AUXZP_ACCESS_ON
|
|
CMP HCLASS_TBLL,Y
|
|
BNE FINDCLSNXT ; SEARCH FOR A MATCH
|
|
PHA
|
|
TXA
|
|
CMP HCLASS_TBLH,Y
|
|
BNE :+
|
|
PLA ; FOUND IT
|
|
AUXZP_ACCESS_OFF
|
|
CLC ; RETURN SUCCESS
|
|
RTS
|
|
: PLA
|
|
FINDCLSNXT: AUXZP_ACCESS_OFF
|
|
INY
|
|
BPL FINDCLSLP ; KEEP CHECKING
|
|
SEC ; NOT FOUND
|
|
RTS ; RETURN FAIL
|
|
;*
|
|
;* RETURN A CLASS HANDLE GIVEN ITS INDEX
|
|
;* ENTRY: Y = INDEX
|
|
;* EXIT: AX = HANDLE
|
|
;* Y = INDEX
|
|
;*
|
|
HCLASS_INDEX: AUXZP_ACCESS_ON
|
|
LDX HCLASS_TBLH,Y
|
|
LDA HCLASS_TBLL,Y
|
|
AUXZP_ACCESS_OFF
|
|
RTS
|
|
;*
|
|
;* RETURN A CLASS NAME STRING GIVEN ITS INDEX
|
|
;* ENTRY: Y = INDEX
|
|
;* EXIT: AX = HSTR
|
|
;*
|
|
CLASS_STRING: AUXZP_ACCESS_ON
|
|
LDA HCLASS_TBLL,Y
|
|
LDX HCLASS_TBLH,Y
|
|
AUXZP_ACCESS_OFF
|
|
JSR HMEM_PTR
|
|
STA CCINST
|
|
STX CCINST+1
|
|
LDY #CLASSTHIS+1
|
|
LDA (CCINST),Y
|
|
DEY
|
|
TAX
|
|
LDA (CCINST),Y
|
|
RTS
|
|
;*
|
|
;* ADD A NEW CLASS GIVEN IT'S HANDLE
|
|
;* ENTRY: AX = CLASS HANDLE
|
|
;* EXIT: AX = CLASS HANDLE
|
|
;* Y = INDEX
|
|
;* C = 0 :: SUCCESS
|
|
;* C = 1 :: FAILURE
|
|
;*
|
|
HCLASS_ADD: JSR HCLASS_HNDL
|
|
BCS :+
|
|
PERR "ADD CLASS ALREADY PRESENT"
|
|
RTS
|
|
: PHA
|
|
.IFDEF DEBUG
|
|
STA CCINST
|
|
STX CCINST+1
|
|
JSR HMEM_PTR
|
|
STA HSTR
|
|
STX HSTR+1
|
|
LDY #CLASSTHIS+1
|
|
LDA (HSTR),Y
|
|
DEY
|
|
TAX
|
|
LDA (HSTR),Y
|
|
JSR HCLASS_NAME
|
|
BCS :+
|
|
LDA HSTR
|
|
LDX HSTR+1
|
|
JSR PRHSTR
|
|
PERR " ALREADY EXISTS CLASS IN TABLE"
|
|
JMP THROW_INTERNALERR
|
|
: LDA CCINST
|
|
LDX CCINST+1
|
|
.ENDIF
|
|
LDY #$01
|
|
AUXZP_ACCESS_ON
|
|
HCLASSADDLP: LDA HCLASS_TBLH,Y
|
|
BEQ HCLASSADDIT
|
|
INY
|
|
BPL HCLASSADDLP
|
|
AUXZP_ACCESS_OFF
|
|
PERR "FULL CLASS TABLE"
|
|
PLA
|
|
SEC
|
|
RTS
|
|
HCLASSADDIT: AUXZP_ACCESS_OFF
|
|
PLA
|
|
AUXZP_ACCESS_ON
|
|
STA HCLASS_TBLL,Y
|
|
PHA
|
|
TXA
|
|
STA HCLASS_TBLH,Y
|
|
PLA
|
|
AUXZP_ACCESS_OFF
|
|
CLC
|
|
RTS
|
|
.IF 0
|
|
;*
|
|
;* DELETE A CLASS
|
|
;* ENTRY: AX = HANDLE
|
|
;* EXIT: C = 0 :: SUCCESS
|
|
;* C = 1 :: FAILURE
|
|
;*
|
|
HCLASS_DEL: JSR HCLASS_HNDL
|
|
BCS :+
|
|
HCLASS_IDEL: LDA #$00
|
|
AUXZP_ACCESS_ON
|
|
STA HCLASS_TBLL,Y
|
|
STA HCLASS_TBLH,Y
|
|
AUXZP_ACCESS_OFF
|
|
: RTS
|
|
.ENDIF
|
|
;*
|
|
;* SET HNAMESTR USED IN IFACE/FIELD/METHOD LOOKUPS
|
|
;* ENTRY: AX = HNAMESTR
|
|
;*
|
|
CLASS_MATCH_NAME: STA CCLASSNAME
|
|
STX CCLASSNAME+1
|
|
RTS
|
|
;*
|
|
;* SET HDESCSTR USED IN IFACE/FIELD/METHOD LOOKUPS
|
|
;* ENTRY: AX = HNDESCSTR
|
|
;*
|
|
CLASS_MATCH_DESC: STA CCLASSDESC
|
|
STX CCLASSDESC+1
|
|
RTS
|
|
;*
|
|
;* FIND CLASS GIVEN ITS NAME, LOAD IT IF NECESSARY
|
|
;* ENTRY: AX = HNAMESTR
|
|
;* EXIT: AX = CLASS HANDLE
|
|
;* Y = CLASS INDEX
|
|
;* C = 0 :: SUCCESS
|
|
;* C = 1 :: FAILURE
|
|
;*
|
|
RESOLVE_CLASS: JSR HCLASS_NAME ; LOOKUP CLASS IN TABLE
|
|
BCS :+
|
|
RTS
|
|
: LDA HSTR ; NOT FOUND, LOAD CLASS FROM FILE
|
|
LDX HSTR+1
|
|
JMP LOADCLASS_FILE ; LOAD CLASS AND SUPERCLASSES
|
|
;*
|
|
;* FIND A METHOD GIVEN CLASS INDEX AND DESCRIPTION
|
|
;* ENTRY: Y = CLASS INDEX
|
|
;* EXIT: AX = METHOD OFFSET
|
|
;* Y = CLASS INDEX (COULD BE SUPERCLASS)
|
|
;* C = 0 :: SUCCESS
|
|
;* C = 1 :: FAILURE
|
|
;*
|
|
RESOLVE_METHOD: STY CCLASSINDEX
|
|
.IF 0
|
|
PSTRLN "RESOLVING "
|
|
LDY CCLASSINDEX
|
|
JSR CLASS_STRING
|
|
JSR PRHSTR
|
|
PSTR ":"
|
|
LDA CCLASSNAME
|
|
LDX CCLASSNAME+1
|
|
JSR PRHSTR
|
|
LDA CCLASSDESC
|
|
LDX CCLASSDESC+1
|
|
JSR PRHSTR
|
|
SEI
|
|
.IMPORT KBWAIT
|
|
JSR KBWAIT
|
|
.IMPORT CROUT
|
|
CLI
|
|
JSR CROUT
|
|
LDY CCLASSINDEX
|
|
RESOLVE_METHOD1:
|
|
.ENDIF
|
|
AUXZP_ACCESS_ON
|
|
LDA HCLASS_TBLL,Y
|
|
LDX HCLASS_TBLH,Y
|
|
AUXZP_ACCESS_OFF
|
|
JSR HMEM_PTR
|
|
STA CCLASSPTR
|
|
STX CCLASSPTR+1
|
|
LDY #CLASSSUPER
|
|
LDA (CCLASSPTR),Y
|
|
STA CCLASSSUPR
|
|
LDY #CLASSMETHODCNT
|
|
LDA (CCLASSPTR),Y
|
|
BEQ RESLVSUPRMETHD ; NO METHODS DEFINED FOR THIS CLASS, CHECK SUPER
|
|
STA CCLASSCNT
|
|
LDY #CLASSMETHODTBL+1
|
|
LDA (CCLASSPTR),Y
|
|
DEY
|
|
TAX
|
|
LDA (CCLASSPTR),Y
|
|
JSR HMEM_PTR
|
|
STA CCTBLPTR
|
|
STA TMPTR
|
|
STX CCTBLPTR+1
|
|
STX TMPTR+1
|
|
LDX CCLASSCNT
|
|
FINDMETHODLP: LDY #METHODNAME
|
|
LDA (TMPTR),Y
|
|
CMP CCLASSNAME
|
|
BNE NEXTMETHOD
|
|
INY
|
|
LDA (TMPTR),Y
|
|
CMP CCLASSNAME+1
|
|
BNE NEXTMETHOD
|
|
INY
|
|
LDA (TMPTR),Y
|
|
CMP CCLASSDESC
|
|
BNE NEXTMETHOD
|
|
INY
|
|
LDA (TMPTR),Y
|
|
CMP CCLASSDESC+1
|
|
BNE NEXTMETHOD
|
|
LDA TMPTR ; FOUND MATCH
|
|
SEC ; CALC OFFSET INTO TABLE
|
|
SBC CCTBLPTR
|
|
TAY
|
|
LDA TMPTR+1
|
|
SBC CCTBLPTR+1
|
|
TAX
|
|
TYA
|
|
LDY CCLASSINDEX
|
|
CLC
|
|
RTS
|
|
NEXTMETHOD: LDA TMPTR
|
|
CLC
|
|
ADC #METHODRECSZ
|
|
STA TMPTR
|
|
BCC :+
|
|
INC TMPTR+1
|
|
: DEX
|
|
BNE FINDMETHODLP
|
|
RESLVSUPRMETHD: LDY CCLASSSUPR ; SEARCH SUPERCLASS
|
|
BNE RESOLVE_METHOD
|
|
.IF 0
|
|
LDY CCLASSINDEX
|
|
JSR CLASS_STRING
|
|
JSR PRHSTR
|
|
PSTR ":"
|
|
; PSTR "METHOD "
|
|
LDA CCLASSNAME
|
|
LDX CCLASSNAME+1
|
|
JSR PRHSTR
|
|
LDA CCLASSDESC
|
|
LDX CCLASSDESC+1
|
|
JSR PRHSTR
|
|
PSTRLN " UNRESOLVED"
|
|
.IMPORT KBWAIT
|
|
JSR KBWAIT
|
|
.ENDIF
|
|
SEC ; OUT OF SUPERCLASSES
|
|
RTS
|
|
;*
|
|
;* RETURN POINTER TO METHOD GIVEN INDECES
|
|
;* ENTRY: AX = METHOD OFFSET
|
|
;* Y = CLASS INDEX
|
|
;* EXIT: AX = METHOD POINTER
|
|
;*
|
|
CLASS_METHODPTR: STA CCTBLOFST
|
|
STX CCTBLOFST+1
|
|
AUXZP_ACCESS_ON
|
|
LDA HCLASS_TBLL,Y
|
|
LDX HCLASS_TBLH,Y
|
|
AUXZP_ACCESS_OFF
|
|
JSR HMEM_PTR
|
|
STA CCLASSPTR
|
|
STX CCLASSPTR+1
|
|
LDY #CLASSMETHODTBL+1
|
|
LDA (CCLASSPTR),Y
|
|
DEY
|
|
TAX
|
|
LDA (CCLASSPTR),Y
|
|
JSR HMEM_PTR
|
|
CLC
|
|
ADC CCTBLOFST
|
|
TAY
|
|
TXA
|
|
ADC CCTBLOFST+1
|
|
TAX
|
|
TYA
|
|
RTS
|
|
;*
|
|
;* LOCK CLASS METHOD AND RETURN POINTER
|
|
;* JUST LIKE CLASS_METHODPTR, BUT LOCK MEMORY
|
|
;* ENTRY: AX = METHOD OFFSET
|
|
;* Y = CLASS INDEX
|
|
;* EXIT: AX = METHOD POINTER
|
|
;*
|
|
CLASS_LOCKMETHOD: STA CCTBLOFST
|
|
STX CCTBLOFST+1
|
|
AUXZP_ACCESS_ON
|
|
LDA HCLASS_TBLL,Y
|
|
LDX HCLASS_TBLH,Y
|
|
AUXZP_ACCESS_OFF
|
|
JSR HMEM_PTR
|
|
STA CCLASSPTR
|
|
STX CCLASSPTR+1
|
|
LDY #CLASSMETHODTBL+1
|
|
LDA (CCLASSPTR),Y
|
|
DEY
|
|
TAX
|
|
LDA (CCLASSPTR),Y
|
|
JSR HMEM_LOCK
|
|
CLC
|
|
ADC CCTBLOFST
|
|
TAY
|
|
TXA
|
|
ADC CCTBLOFST+1
|
|
TAX
|
|
TYA
|
|
RTS
|
|
;*
|
|
;* UNLOCK METHOD, CALL AFTER DONE WITH ABOVE
|
|
;* ENTRY: Y = CLASSINDEX
|
|
;*
|
|
CLASS_UNLOCKMETHOD: AUXZP_ACCESS_ON
|
|
LDA HCLASS_TBLL,Y
|
|
LDX HCLASS_TBLH,Y
|
|
AUXZP_ACCESS_OFF
|
|
JSR HMEM_PTR
|
|
STA CCLASSPTR
|
|
STX CCLASSPTR+1
|
|
LDY #CLASSMETHODTBL+1
|
|
LDA (CCLASSPTR),Y
|
|
DEY
|
|
TAX
|
|
LDA (CCLASSPTR),Y
|
|
JMP HMEM_UNLOCK
|
|
;*
|
|
;* FIND A FIELD GIVEN CLASS INDEX AND DESCRIPTION
|
|
;* ENTRY: Y = CLASS INDEX
|
|
;* EXIT: AX = FIELD OFFSET
|
|
;* Y = CLASS INDEX (COULD BE SUPERCLASS)
|
|
;* C = 0 :: SUCCESS
|
|
;* C = 1 :: FAILURE
|
|
;*
|
|
RESOLVE_FIELD: STY CCLASSINDEX
|
|
AUXZP_ACCESS_ON
|
|
LDA HCLASS_TBLL,Y
|
|
LDX HCLASS_TBLH,Y
|
|
AUXZP_ACCESS_OFF
|
|
JSR HMEM_PTR
|
|
STA CCLASSPTR
|
|
STX CCLASSPTR+1
|
|
LDY #CLASSSUPER
|
|
LDA (CCLASSPTR),Y
|
|
STA CCLASSSUPR
|
|
LDY #CLASSFIELDCNT
|
|
LDA (CCLASSPTR),Y
|
|
BEQ RESLVSUPRFIELD ; NO FIELDS FOR THIS CLASS, CHECK SUPER
|
|
STA CCLASSCNT
|
|
LDY #CLASSFIELDTBL+1
|
|
LDA (CCLASSPTR),Y
|
|
DEY
|
|
TAX
|
|
LDA (CCLASSPTR),Y
|
|
JSR HMEM_PTR
|
|
STA CCTBLPTR
|
|
STA TMPTR
|
|
STX CCTBLPTR+1
|
|
STX TMPTR+1
|
|
LDX CCLASSCNT
|
|
FINDFIELDLP: LDY #FIELDNAME
|
|
LDA (TMPTR),Y
|
|
CMP CCLASSNAME
|
|
BNE NEXTFIELD
|
|
INY
|
|
LDA (TMPTR),Y
|
|
CMP CCLASSNAME+1
|
|
BNE NEXTFIELD
|
|
INY
|
|
LDA (TMPTR),Y
|
|
CMP CCLASSDESC
|
|
BNE NEXTFIELD
|
|
INY
|
|
LDA (TMPTR),Y
|
|
CMP CCLASSDESC+1
|
|
BNE NEXTFIELD
|
|
LDA TMPTR ; FOUND MATCH
|
|
SEC ; CALC OFFSET INTO TABLE
|
|
SBC CCTBLPTR
|
|
TAY
|
|
LDA TMPTR+1
|
|
SBC CCTBLPTR+1
|
|
TAX
|
|
TYA
|
|
LDY CCLASSINDEX
|
|
CLC
|
|
RTS
|
|
NEXTFIELD: LDA TMPTR
|
|
CLC
|
|
ADC #FIELDRECSZ
|
|
STA TMPTR
|
|
BCC :+
|
|
INC TMPTR+1
|
|
: DEX
|
|
BNE FINDFIELDLP
|
|
RESLVSUPRFIELD: LDY CCLASSSUPR ; SEARCH SUPERCLASS
|
|
BNE RESOLVE_FIELD
|
|
SEC ; OUT OF SUPERCLASSES
|
|
RTS
|
|
;*
|
|
;* RETURN POINTER TO FIELD GIVEN INDECES
|
|
;* ENTRY: AX = FIELD OFFSET
|
|
;* Y = CLASS INDEX
|
|
;* EXIT: AX = FIELD POINTER
|
|
;*
|
|
CLASS_FIELDPTR: STA CCTBLOFST
|
|
STX CCTBLOFST+1
|
|
AUXZP_ACCESS_ON
|
|
LDA HCLASS_TBLL,Y
|
|
LDX HCLASS_TBLH,Y
|
|
AUXZP_ACCESS_OFF
|
|
JSR HMEM_PTR
|
|
STA CCLASSPTR
|
|
STX CCLASSPTR+1
|
|
LDY #CLASSFIELDTBL+1
|
|
LDA (CCLASSPTR),Y
|
|
DEY
|
|
TAX
|
|
LDA (CCLASSPTR),Y
|
|
JSR HMEM_PTR
|
|
CLC
|
|
ADC CCTBLOFST
|
|
TAY
|
|
TXA
|
|
ADC CCTBLOFST+1
|
|
TAX
|
|
TYA
|
|
RTS
|
|
;*
|
|
;* LOCK CLASS AND RETURN POINTER
|
|
;* ENTRY: Y = CLASS INDEX
|
|
;* EXIT: AX = CLASS POINTER
|
|
;*
|
|
CLASS_LOCK: AUXZP_ACCESS_ON
|
|
LDA HCLASS_TBLL,Y
|
|
LDX HCLASS_TBLH,Y
|
|
AUXZP_ACCESS_OFF
|
|
JSR HMEM_LOCK
|
|
STA CCLASSPTR
|
|
STX CCLASSPTR+1
|
|
LDY #CLASSLOCKCNT
|
|
LDA (CCLASSPTR),Y
|
|
CLC
|
|
ADC #$01
|
|
STA (CCLASSPTR),Y
|
|
BCC :+
|
|
INY
|
|
; TAX
|
|
LDA (CCLASSPTR),Y
|
|
ADC #$00
|
|
STA (CCLASSPTR),Y
|
|
: LDA CCLASSPTR
|
|
; LDX CCLASSPTR+1
|
|
: RTS
|
|
;*
|
|
;* UNLOCK METHOD, CALL AFTER DONE WITH ABOVE
|
|
;* ENTRY: Y = CLASSINDEX
|
|
;*
|
|
CLASS_UNLOCK: STY CCLASSINDEX
|
|
AUXZP_ACCESS_ON
|
|
LDA HCLASS_TBLL,Y
|
|
LDX HCLASS_TBLH,Y
|
|
AUXZP_ACCESS_OFF
|
|
JSR HMEM_PTR
|
|
STA CCLASSPTR
|
|
STX CCLASSPTR+1
|
|
LDY #CLASSLOCKCNT
|
|
LDA (CCLASSPTR),Y
|
|
SEC
|
|
SBC #$01
|
|
STA (CCLASSPTR),Y
|
|
INY
|
|
TAX
|
|
LDA (CCLASSPTR),Y
|
|
SBC #$00
|
|
STA (CCLASSPTR),Y
|
|
BNE :-
|
|
CPX #$00
|
|
BNE :-
|
|
LDY CCLASSINDEX
|
|
AUXZP_ACCESS_ON
|
|
LDA HCLASS_TBLL,Y
|
|
LDX HCLASS_TBLH,Y
|
|
AUXZP_ACCESS_OFF
|
|
JMP HMEM_UNLOCK
|
|
;*
|
|
;* RETURN CODE HANDLE FROM VIRTUAL METHOD TABLE
|
|
;* ENTRY: AX = VIRTUAL TABLE OFFSET
|
|
;* Y = CLASS INDEX
|
|
;* EXIT: AX = CODE HANDLE
|
|
;*
|
|
CLASS_VIRTCODE: STA CCTBLOFST
|
|
STX CCTBLOFST+1
|
|
AUXZP_ACCESS_ON
|
|
LDA HCLASS_TBLL,Y
|
|
LDX HCLASS_TBLH,Y
|
|
AUXZP_ACCESS_OFF
|
|
JSR HMEM_PTR
|
|
STA CCLASSPTR
|
|
STX CCLASSPTR+1
|
|
LDY #CLASSVIRTBL+1
|
|
LDA (CCLASSPTR),Y
|
|
DEY
|
|
TAX
|
|
LDA (CCLASSPTR),Y
|
|
JSR HMEM_PTR
|
|
CLC
|
|
ADC CCTBLOFST
|
|
STA CCTBLPTR
|
|
TXA
|
|
ADC CCTBLOFST+1
|
|
STA CCTBLPTR+1
|
|
LDY #$01
|
|
LDA (CCTBLPTR),Y
|
|
DEY
|
|
TAX
|
|
LDA (CCTBLPTR),Y
|
|
RTS
|
|
;*
|
|
;* DETERMINE IF A CLASS IS A SUBCLASS OF ANOTHER
|
|
;* !!! NEEDS TO CHECK INTERFACES AND ARRAYS !!!
|
|
;* ENTRY: A = SUB CLASS
|
|
;* Y = SUPER CLASS
|
|
;* EXIT: C = 0 :: A IS SUBCLASS OF Y
|
|
;* C = 1 :: A IS NOT SUBCLASS OF Y
|
|
;*
|
|
CLASS_OF: STY CCLASSINDEX
|
|
CLASSOFCHK: CMP CCLASSINDEX
|
|
BNE :+
|
|
CLC
|
|
RTS
|
|
: TAY
|
|
AUXZP_ACCESS_ON
|
|
LDA HCLASS_TBLL,Y
|
|
LDX HCLASS_TBLH,Y
|
|
AUXZP_ACCESS_OFF
|
|
JSR HMEM_PTR
|
|
STA CCLASSPTR
|
|
STX CCLASSPTR+1
|
|
LDY #CLASSSUPER
|
|
LDA (CCLASSPTR),Y
|
|
BNE CLASSOFCHK
|
|
SEC
|
|
RTS
|