;* ;* 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 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