mirror of https://github.com/dschmenk/VM02.git
976 lines
18 KiB
ArmAsm
Executable File
976 lines
18 KiB
ArmAsm
Executable File
;*
|
|
;* JAVA THREAD SUPPORT FOR 6502
|
|
;*
|
|
;*
|
|
;* THREADS CONSIST OF ALL THE STATE REQUIRED FOR EXECUTING A STREAM
|
|
;* OF JAVA BYTECODES IN A STOPPABLE AND RESTARTABLE FASION. THE
|
|
;* THREAD TABLE IS ORGANIZED AS:
|
|
;* STATE
|
|
;* PRIORITY
|
|
;* HMETHOD
|
|
;* PC_OFS
|
|
;* HFRAME
|
|
;* BASE_OFS
|
|
;* STACK_OFS
|
|
;* TOP_OF_STACK
|
|
;* THE THREAD TABLE IS INTERLEAVED SO ALL THE DATA CAN BE ADDRESSED BY PUTTING THE THREAD
|
|
;* ID INTO AN INDEX REGISTER AN INDEXING INTO THE FIELDS.
|
|
;*
|
|
|
|
.INCLUDE "global.inc"
|
|
.INCLUDE "class.inc"
|
|
.IMPORT HMEM_ALLOC,HMEM_PTR,HMEM_FREE,HMEM_LOCK,HMEM_UNLOCK
|
|
.IFDEF IDLE_GC
|
|
.IMPORT HMEM_GC_IDLE
|
|
.ENDIF
|
|
.IFDEF SWAPPING
|
|
.IMPORT HMEM_CLRACCESS
|
|
.ENDIF
|
|
.IMPORT HSTRPL_ADD
|
|
.IMPORT COUT,MEMDST,MEMCLR
|
|
.IMPORT HCLASS_NAME,HCLASS_HNDL,CLASS_MATCH_NAME,CLASS_MATCH_DESC,CLASS_STRING
|
|
.IMPORT RESOLVE_CLASS,RESOLVE_METHOD,CLASS_METHODPTR,INVOKE_STATIC,INVOKE_VIRTUAL
|
|
.IMPORT UNREF_OBJECT
|
|
.IMPORT LOADCLASS_MEM,HRUNNAMESTR,HVOIDDESCSTR
|
|
.IMPORT THROW_SYSEXCEPTN,THROW_INTERNALERR,UNHANDLED_EXCEPTN
|
|
.IMPORT EXECBYTECODES,SYSTHROW,CURRENTEXCEPTN
|
|
.IMPORT VM_RESTART
|
|
.EXPORT CURRENT_THREAD,THREAD_INIT,THREAD_NEW,THREAD_START,THREAD_SETRUN
|
|
.EXPORT ITHREAD_PUSH_SP,THREAD_PUSH_TLS,ITHREAD_PUSH_TLS,THREAD_POP_TLS,ITHREAD_POP_TLS
|
|
.EXPORT THREAD_YIELD,THREAD_LOCK,THREAD_UNLOCK,SYSTEM_TIC,BEST_THREAD,LOADEXECSTATE
|
|
.EXPORT THREAD_WAIT_HOBJL,THREAD_WAIT_HOBJH,THREAD_WAITQ
|
|
.EXPORT THREAD_NOTIMEOUT,THREAD_NOTIFYIO,THREAD_WAITIO,THREAD_SELECTIO
|
|
.EXPORT THREAD_SELECTIO,IO_NOTIFY, SLOT2MASK
|
|
|
|
MAX_SYNC_QUEUES EQU MAX_THREADS*4
|
|
DEFAULT_PRIORITY EQU 5
|
|
|
|
.SEGMENT "INIT"
|
|
|
|
THREAD_INIT: LDA #<THREAD_LOCK
|
|
STA LINK_LOCKENTER
|
|
LDA #>THREAD_LOCK
|
|
STA LINK_LOCKENTER+1
|
|
LDA #<THREAD_UNLOCK
|
|
STA LINK_LOCKEXIT
|
|
LDA #>THREAD_UNLOCK
|
|
STA LINK_LOCKEXIT+1
|
|
LDA #<THREAD_NEW
|
|
STA LINK_THREADNEW
|
|
LDA #>THREAD_NEW
|
|
STA LINK_THREADNEW+1
|
|
LDA #<ITHREAD_PUSH_SP
|
|
STA LINK_THREADPUSH
|
|
LDA #>ITHREAD_PUSH_SP
|
|
STA LINK_THREADPUSH+1
|
|
LDA #<THREAD_START
|
|
STA LINK_THREADSTART
|
|
LDA #>THREAD_START
|
|
STA LINK_THREADSTART+1
|
|
LDA #<THREAD_EXIT
|
|
STA LINK_THREADEXIT
|
|
LDA #>THREAD_EXIT
|
|
STA LINK_THREADEXIT+1
|
|
LDA #<THREAD_KILL
|
|
STA LINK_THREADKILL
|
|
LDA #>THREAD_KILL
|
|
STA LINK_THREADKILL+1
|
|
LDA #<THREAD_SETSTATE
|
|
STA LINK_THREADSETSTATE
|
|
LDA #>THREAD_SETSTATE
|
|
STA LINK_THREADSETSTATE+1
|
|
LDA #<THREAD_GETSTATE
|
|
STA LINK_THREADGETSTATE
|
|
LDA #>THREAD_GETSTATE
|
|
STA LINK_THREADGETSTATE+1
|
|
LDA #<THREAD_SETPRIORITY
|
|
STA LINK_THREADSETPRIORITY
|
|
LDA #>THREAD_SETPRIORITY
|
|
STA LINK_THREADSETPRIORITY+1
|
|
LDA #<THREAD_GETPRIORITY
|
|
STA LINK_THREADGETPRIORITY
|
|
LDA #>THREAD_GETPRIORITY
|
|
STA LINK_THREADGETPRIORITY+1
|
|
LDA #<THREAD_SETTIMEOUTL
|
|
STA LINK_THREADSETTIMEOUTL
|
|
LDA #>THREAD_SETTIMEOUTL
|
|
STA LINK_THREADSETTIMEOUTL+1
|
|
LDA #<THREAD_SETTIMEOUTH
|
|
STA LINK_THREADSETTIMEOUTH
|
|
LDA #>THREAD_SETTIMEOUTH
|
|
STA LINK_THREADSETTIMEOUTH+1
|
|
LDA #<THREAD_NOTIMEOUT
|
|
STA LINK_THREADNOTIMEOUT
|
|
LDA #>THREAD_NOTIMEOUT
|
|
STA LINK_THREADNOTIMEOUT+1
|
|
LDA #<THREAD_SETREF
|
|
STA LINK_THREADSETREF
|
|
LDA #>THREAD_SETREF
|
|
STA LINK_THREADSETREF+1
|
|
LDA #<THREAD_SETCLASS
|
|
STA LINK_THREADSETCLASS
|
|
LDA #>THREAD_SETCLASS
|
|
STA LINK_THREADSETCLASS+1
|
|
LDA #<THREAD_GETCLASS
|
|
STA LINK_THREADGETCLASS
|
|
LDA #>THREAD_GETCLASS
|
|
STA LINK_THREADGETCLASS+1
|
|
LDA #<THREAD_GETREF
|
|
STA LINK_THREADGETREF
|
|
LDA #>THREAD_GETREF
|
|
STA LINK_THREADGETREF+1
|
|
LDA #<THREAD_GETCURRENT
|
|
STA LINK_THREADGETCURRENT
|
|
LDA #>THREAD_GETCURRENT
|
|
STA LINK_THREADGETCURRENT+1
|
|
LDA #<SYSTEM_TIC
|
|
STA LINK_SYSTEMTIC
|
|
LDA #>SYSTEM_TIC
|
|
STA LINK_SYSTEMTIC+1
|
|
LDA #<SYSTEM_GETTICL
|
|
STA LINK_GETTICL
|
|
LDA #>SYSTEM_GETTICL
|
|
STA LINK_GETTICL+1
|
|
LDA #<SYSTEM_GETTICH
|
|
STA LINK_GETTICH
|
|
LDA #>SYSTEM_GETTICH
|
|
STA LINK_GETTICH+1
|
|
LDX #MAX_THREADS-1
|
|
: LDA #S_FREE ; FREE ALL THREADS
|
|
STA THREAD_STATE,X
|
|
LDA #$00
|
|
STA THREAD_HEXECL,X
|
|
STA THREAD_HEXECH,X
|
|
DEX
|
|
BPL :-
|
|
LDX #MAX_SYNC_QUEUES-1 ; NO LOCKED OBJECTS
|
|
LDA #$00
|
|
: STA SYNCQ_HOBJL,X
|
|
STA SYNCQ_HOBJH,X
|
|
DEX
|
|
BPL :-
|
|
LDY #ZP_THREAD_SIZE-1
|
|
LDA #$00
|
|
: STA ZP_THREAD_STATE,Y ; ZERO THREAD STATE
|
|
DEY
|
|
BPL :-
|
|
STA IO_NOTIFY ; CLEAR PENDING NOTIFICATIONS
|
|
LDA CLRKBD
|
|
LDA #$00
|
|
STA OPCNT
|
|
RTS
|
|
|
|
.CODE
|
|
;*
|
|
;* PUSH WORD ON THREAD'S 6502 STACK
|
|
;* ENTRY: AX = WORD TO PUSH
|
|
;* Y = THREAD ID
|
|
;* EXIT: Y = THREAD ID
|
|
;*
|
|
ITHREAD_PUSH_SP:
|
|
STA TMP ; PUSH X FIRST
|
|
TXA
|
|
PHA
|
|
LDA TMP
|
|
PHA ; THEN PUSH A
|
|
TYA ; SAVE ITHREAD
|
|
PHA
|
|
LDA THREAD_HEXECL,Y
|
|
LDX THREAD_HEXECH,Y
|
|
JSR HMEM_PTR
|
|
STA TMPTR
|
|
STX TMPTR+1
|
|
PLA ; RETRIEVE ITHREAD INTO X
|
|
TAX
|
|
LDY THREAD_SP,X
|
|
PLA ; PULL A, PUSH THREAD STACK
|
|
STA (TMPTR),Y
|
|
DEY
|
|
PLA ; PULL X, PUSH THREAD STACK
|
|
STA (TMPTR),Y
|
|
DEY
|
|
TYA
|
|
STA THREAD_SP,X
|
|
TXA
|
|
TAY
|
|
RTS
|
|
;*
|
|
;* PUSH WORD ON THREAD LOCAL STORAGE HEAP
|
|
;* ENTRY: AX = WORD TO PUSH
|
|
;*
|
|
THREAD_PUSH_TLS: LDY CURRENT_THREAD
|
|
;*
|
|
;* PUSH WORD ON THREAD LOCAL STORAGE HEAP
|
|
;* ENTRY: AX = WORD TO PUSH
|
|
;* Y = THREAD ID
|
|
;* EXIT: Y = THREAD ID
|
|
;*
|
|
ITHREAD_PUSH_TLS: PHA
|
|
TXA
|
|
PHA
|
|
LDA THREAD_TOS,Y ; INC TLS POINTER
|
|
CLC
|
|
ADC #$02
|
|
STA THREAD_TOS,Y
|
|
TYA
|
|
ASL ; MULTIPLY BY 16
|
|
ASL
|
|
ASL
|
|
ASL
|
|
CLC
|
|
ADC THREAD_TOS,Y
|
|
TAY
|
|
PLA
|
|
TAX
|
|
PLA
|
|
AUXZP_ACCESS_ON
|
|
STA TLS-2,Y
|
|
TXA
|
|
STA TLS-1,Y
|
|
AUXZP_ACCESS_OFF
|
|
RTS
|
|
;*
|
|
;* POP WORD FROM THREAD LOCAL STORAGE HEAP
|
|
;* EXIT: AX = WORD POPPED
|
|
;*
|
|
THREAD_POP_TLS: LDY CURRENT_THREAD
|
|
;*
|
|
;* POP WORD FROM THREAD LOCAL STORAGE HEAP
|
|
;* ENTRY: Y = THREAD_ID
|
|
;* EXIT: AX = WORD POPPED
|
|
;* Y = THREAD ID
|
|
;*
|
|
ITHREAD_POP_TLS: LDA THREAD_TOS,Y
|
|
SEC ; DEC TLS POINTER
|
|
SBC #$02
|
|
STA THREAD_TOS,Y
|
|
TYA
|
|
ASL ; MULTIPLY BY 16
|
|
ASL
|
|
ASL
|
|
ASL
|
|
CLC
|
|
ADC THREAD_TOS,Y
|
|
TAY
|
|
AUXZP_ACCESS_ON
|
|
LDA TLS+1,Y
|
|
TAX
|
|
LDA TLS,Y
|
|
AUXZP_ACCESS_OFF
|
|
RTS
|
|
;*
|
|
;* SETUP NEW THREAD
|
|
;* ENTRY: AX = THREAD OBJECT INSTANCE
|
|
;* EXIT: Y = THREAD ID
|
|
;* C = 0 :: SUCCESS
|
|
;* C = 1 :: FAILURE
|
|
;*
|
|
THREAD_NEW: PHA
|
|
TXA
|
|
PHA
|
|
.IFDEF DEBUG_THREAD
|
|
PERR "THREAD_NEW"
|
|
.IMPORT KBWAIT
|
|
JSR KBWAIT
|
|
.ENDIF
|
|
LDY #MAX_THREADS-1
|
|
FINDFREE: LDA THREAD_STATE,Y
|
|
CMP #S_FREE
|
|
BNE FNDNXTFREE
|
|
PLA
|
|
STA THREAD_HOBJH,Y
|
|
PLA
|
|
STA THREAD_HOBJL,Y
|
|
LDA #$00
|
|
STA THREAD_TOS,Y
|
|
LDA #$FF
|
|
STA THREAD_SP,Y
|
|
LDA #DEFAULT_PRIORITY
|
|
STA THREAD_PRIORITY,Y
|
|
STY BEST_THREAD
|
|
LDA #ZP_THREAD_SIZE ; ALLOC MEMORY FOR EXEC STATE (STACK+ZP)
|
|
LDX #$01
|
|
LDY #$00
|
|
JSR HMEM_ALLOC
|
|
LDY BEST_THREAD
|
|
STA THREAD_HEXECL,Y
|
|
TXA
|
|
STA THREAD_HEXECH,Y
|
|
LDA #S_IDLE
|
|
STA THREAD_STATE,Y
|
|
LDA THREAD_HEXECL,Y
|
|
JSR HMEM_PTR
|
|
JSR MEMDST
|
|
LDA #ZP_THREAD_SIZE ; CLEAR MEMORY FOR EXEC STATE (STACK+ZP)
|
|
LDX #$01
|
|
JSR MEMCLR
|
|
LDY BEST_THREAD
|
|
CLC
|
|
RTS
|
|
FNDNXTFREE: DEY
|
|
BPL FINDFREE
|
|
SEC
|
|
PLA
|
|
PLA
|
|
RTS
|
|
;*
|
|
;* SET THREAD RUNNABLE
|
|
;* ENTRY: A = CLASS INDEX
|
|
;* Y = THREAD ID
|
|
;* THREADSTACK = PARAM
|
|
;*
|
|
THREAD_START: STA $A0
|
|
STY $A1
|
|
.IFDEF DEBUG_THREAD
|
|
PERR "THREAD_START"
|
|
.IMPORT KBWAIT
|
|
JSR KBWAIT
|
|
LDY $A1
|
|
.ENDIF
|
|
LDA HRUNNAMESTR ; RUN METHOD
|
|
LDX HRUNNAMESTR+1
|
|
JSR ITHREAD_PUSH_SP
|
|
LDA HVOIDDESCSTR
|
|
LDX HVOIDDESCSTR+1
|
|
JSR ITHREAD_PUSH_SP
|
|
LDY $A0 ; RETRIEVE CLASS NAME
|
|
JSR CLASS_STRING
|
|
LDY $A1
|
|
JSR ITHREAD_PUSH_SP
|
|
THREAD_SETRUN: LDA #>(THREAD_RUN-1)
|
|
LDX #<(THREAD_RUN-1)
|
|
JSR ITHREAD_PUSH_SP
|
|
LDA #S_RUNNABLE
|
|
STA THREAD_STATE,Y
|
|
RTS
|
|
;*
|
|
;* SET THREAD STATE
|
|
;*
|
|
THREAD_SETSTATE: STA THREAD_STATE,Y
|
|
JMP (LINK_YIELD) ; RUN SCHEDULER WHEN THREAD STATE CHANGES
|
|
;*
|
|
;* GET THREAD STATE
|
|
;*
|
|
THREAD_GETSTATE: LDA THREAD_STATE,Y
|
|
RTS
|
|
;*
|
|
;* SET THREAD REF
|
|
;*
|
|
THREAD_SETREF: STA THREAD_HOBJL,Y
|
|
TXA
|
|
STA THREAD_HOBJH,Y
|
|
RTS
|
|
;*
|
|
;* SET THREAD CLASS
|
|
;*
|
|
THREAD_SETCLASS: STA THREAD_HOBJCLL,Y
|
|
TXA
|
|
STA THREAD_HOBJCLH,Y
|
|
RTS
|
|
;*
|
|
;* GET THREAD REF
|
|
;*
|
|
THREAD_GETREF: LDA THREAD_HOBJL,Y
|
|
LDX THREAD_HOBJH,Y
|
|
RTS
|
|
;*
|
|
;* GET THREAD CLASS
|
|
;*
|
|
THREAD_GETCLASS: LDA THREAD_HOBJCLL,Y
|
|
LDX THREAD_HOBJCLH,Y
|
|
RTS
|
|
;*
|
|
;* SET THREAD PRIORITY
|
|
;*
|
|
THREAD_SETPRIORITY: STA THREAD_PRIORITY,Y
|
|
JMP (LINK_YIELD) ; RUN SCHEDULER IF THREAD PRIORITY CHANGES
|
|
;*
|
|
;* GET THREAD PRIORITY
|
|
;*
|
|
THREAD_GETPRIORITY: LDA THREAD_PRIORITY,Y
|
|
RTS
|
|
;*
|
|
;* SET THREAD TIMEOUT
|
|
;* ENTRY: AX = LOW/HIGH 32 BITS OF TIMEOUT
|
|
;* Y = THREAD ID
|
|
;*
|
|
THREAD_SETTIMEOUTL:
|
|
SEI
|
|
CLC
|
|
ADC TIC_COUNT
|
|
STA THREAD_TIMEOUT0,Y
|
|
TXA
|
|
ADC TIC_COUNT+1
|
|
STA THREAD_TIMEOUT1,Y
|
|
LDA #$00
|
|
ADC TIC_COUNT+2
|
|
STA THREAD_TIMEOUT2,Y
|
|
LDA #$00
|
|
ADC TIC_COUNT+3
|
|
STA THREAD_TIMEOUT3,Y
|
|
RTS
|
|
THREAD_SETTIMEOUTH:
|
|
CLC
|
|
ADC THREAD_TIMEOUT2,Y
|
|
STA THREAD_TIMEOUT2,Y
|
|
TXA
|
|
ADC THREAD_TIMEOUT3,Y
|
|
STA THREAD_TIMEOUT3,Y
|
|
RTS
|
|
;*
|
|
;* SET THREAD NO TIMEOUT
|
|
;*
|
|
THREAD_NOTIMEOUT: LDA #$FF
|
|
STA THREAD_TIMEOUT0,Y
|
|
STA THREAD_TIMEOUT1,Y
|
|
STA THREAD_TIMEOUT2,Y
|
|
STA THREAD_TIMEOUT3,Y
|
|
RTS
|
|
;*
|
|
;* GET CURRENT THREAD
|
|
;*
|
|
THREAD_GETCURRENT: LDY CURRENT_THREAD
|
|
.IFDEF DEBUG
|
|
CPY #MAX_THREADS
|
|
BCC :+
|
|
PERR "INVALID CURRENT_THREAD"
|
|
JMP THROW_INTERNALERR
|
|
:
|
|
.ENDIF
|
|
LDA THREAD_HOBJL,Y
|
|
LDX THREAD_HOBJH,Y
|
|
RTS
|
|
;*
|
|
;* THREAD STARTUP ROUTINE
|
|
;*
|
|
THREAD_RUN:
|
|
.IFDEF DEBUG_THREAD
|
|
PERR "THREAD_RUN"
|
|
.IMPORT KBWAIT
|
|
JSR KBWAIT
|
|
.ENDIF
|
|
PLA ; RESOLVE CLASS
|
|
TAX
|
|
PLA
|
|
JSR RESOLVE_CLASS
|
|
BCS THREAD_ERR
|
|
TYA
|
|
JSR THREAD_PUSH_TLS ; SAVE CLASS INDEX
|
|
PLA
|
|
TAX
|
|
PLA
|
|
JSR CLASS_MATCH_DESC
|
|
PLA
|
|
TAX
|
|
PLA
|
|
JSR CLASS_MATCH_NAME
|
|
JSR THREAD_POP_TLS ; RETRIEVE CLASS INDEX
|
|
TAY
|
|
JSR RESOLVE_METHOD ; RESOLVE METHOD
|
|
BCS THREAD_NOMETHD
|
|
STA $A0
|
|
STX $A1
|
|
STY $A2
|
|
LDA #>(THREAD_EXIT-1) ; SET RETURN ADDRESS TO THREAD_EXIT
|
|
LDX #<(THREAD_EXIT-1)
|
|
JSR THREAD_PUSH_TLS
|
|
LDA #$00
|
|
TAX
|
|
; STA HEXECFRAME ; ZERO OUT CURRENT FRAME
|
|
; STX HEXECFRAME+1 ; SHOULD BE ZEROD FROM THREAD STATE
|
|
JSR THREAD_PUSH_TLS
|
|
LDA $A0
|
|
LDX $A1
|
|
LDY $A2
|
|
JSR CLASS_METHODPTR
|
|
STA $A3
|
|
STX $A4
|
|
LDY #METHODACCESS ; CHECK FOR STATIC METHOD
|
|
LDA ($A3),Y
|
|
AND #$08
|
|
BNE :+
|
|
LDA $A0
|
|
LDX $A1
|
|
LDY $A2
|
|
JMP INVOKE_VIRTUAL
|
|
: LDA $A0
|
|
LDX $A1
|
|
LDY $A2
|
|
JMP INVOKE_STATIC
|
|
THREAD_NOMETHD: LDA #9 ; NO METHOD DEF FOUND
|
|
JSR THROW_SYSEXCEPTN
|
|
SEC
|
|
THREAD_ERR: LDA CURRENTEXCEPTN+3
|
|
PHA
|
|
LDA CURRENTEXCEPTN+2
|
|
PHA
|
|
LDA CURRENTEXCEPTN+1
|
|
PHA
|
|
LDA CURRENTEXCEPTN
|
|
PHA
|
|
;*
|
|
;* THREAD EXIT ROUTINE
|
|
;*
|
|
THREAD_EXIT: BCC :+
|
|
JSR UNHANDLED_EXCEPTN
|
|
JSR UNREF_OBJECT
|
|
:
|
|
.IFDEF DEBUG_THREAD
|
|
PERR "THREAD_EXIT"
|
|
.IMPORT KBWAIT
|
|
JSR KBWAIT
|
|
.ENDIF
|
|
LDY CURRENT_THREAD
|
|
THREAD_KILL: LDA #S_FREE
|
|
STA THREAD_STATE,Y
|
|
LDA THREAD_HEXECL,Y
|
|
LDX THREAD_HEXECH,Y
|
|
JSR HMEM_FREE ; FREE UP SAVED 6502 STACK
|
|
LDY CURRENT_THREAD
|
|
LDY #MAX_THREADS-1
|
|
LDX #$00
|
|
CHKEXIT: LDA THREAD_STATE,Y
|
|
CMP #S_IDLE+1
|
|
BCS :+
|
|
INX
|
|
: DEY
|
|
BPL CHKEXIT
|
|
CPX #MAX_THREADS
|
|
BEQ :+
|
|
JMP (LINK_YIELD)
|
|
: LDA #$00
|
|
TAX
|
|
JMP VM_RESTART ; ALL DONE, EXIT VM
|
|
;*
|
|
;* INCREMENT SYSTEM TICS
|
|
;* ENTRY: AX = TIC INCREMENT
|
|
;*
|
|
SYSTEM_TIC:
|
|
.IFDEF DEBUG_TIMER
|
|
BIT $C030
|
|
.ENDIF
|
|
CLC
|
|
ADC TIC_COUNT
|
|
STA TIC_COUNT
|
|
TXA
|
|
ADC TIC_COUNT+1
|
|
STA TIC_COUNT+1
|
|
LDA #$00
|
|
ADC TIC_COUNT+2
|
|
STA TIC_COUNT+2
|
|
LDA #$00
|
|
ADC TIC_COUNT+3
|
|
STA TIC_COUNT+3
|
|
RTS
|
|
;*
|
|
;* RETURN CURRENT TIC COUNT
|
|
;* EXIT: AX = TIC_COUNT(L/H)
|
|
;*
|
|
SYSTEM_GETTICL: SEI
|
|
LDX TIC_COUNT+1
|
|
LDA TIC_COUNT
|
|
RTS
|
|
SYSTEM_GETTICH: SEI
|
|
LDX TIC_COUNT+3
|
|
LDA TIC_COUNT+2
|
|
RTS
|
|
;*
|
|
;* YIELD CURRENT THREAD, SCHEDULE NEXT THREAD
|
|
;*
|
|
THREAD_YIELD:
|
|
.IFDEF DEBUG
|
|
LDA $0100 ; CHECK FOR STACK OVERFLOW
|
|
CMP #$69
|
|
BNE STACKOVERFLOW
|
|
LDA $0101
|
|
CMP #$69
|
|
BEQ :+
|
|
STACKOVERFLOW: PERR "STACK OVERFLOWED"
|
|
JMP THROW_INTERNALERR
|
|
:
|
|
.ENDIF
|
|
.IFDEF SWAPPING
|
|
JSR HMEM_CLRACCESS ; CLEAR HMEM ACCESSED FLAGS IN INCREMENTAL, ROUND-ROBIN FASHION
|
|
.ENDIF
|
|
SEI ; DISABLE INTERRUPTS
|
|
LDY #$FF ; THIS WILL BE THE BEST THREAD PRIORITY
|
|
STY BEST_THREAD
|
|
INY
|
|
LDX CURRENT_THREAD
|
|
DEX
|
|
BPL FINDBEST
|
|
LDX #MAX_THREADS-1
|
|
FINDBEST: LDA THREAD_STATE,X
|
|
CMP #S_SUSPEND
|
|
BCC CHECKNEXT
|
|
CMP #S_RUNNABLE
|
|
BCS ISBEST
|
|
LDA THREAD_TIMEOUT0,X ; CHECK FOR TIMEOUT
|
|
CMP TIC_COUNT
|
|
LDA THREAD_TIMEOUT1,X
|
|
SBC TIC_COUNT+1
|
|
LDA THREAD_TIMEOUT2,X
|
|
SBC TIC_COUNT+2
|
|
LDA THREAD_TIMEOUT3,X
|
|
SBC TIC_COUNT+3
|
|
BCS CHECKNEXT
|
|
LDA THREAD_STATE,X
|
|
CMP #S_SLEEP
|
|
BNE :+
|
|
LDA #S_RUNNABLE ; TIMED OUT, SET RUNNABLE
|
|
BNE :++
|
|
: LDA #S_INTERRUPTED ; TIMED OUT, SET EXCEPTION
|
|
: STA THREAD_STATE,X
|
|
ISBEST: TYA
|
|
CMP THREAD_PRIORITY,X
|
|
BCS CHECKNEXT
|
|
SAVEBEST: STX BEST_THREAD
|
|
LDY THREAD_PRIORITY,X
|
|
CHECKNEXT: CPX CURRENT_THREAD
|
|
BEQ FOUNDBEST
|
|
DEX
|
|
BPL FINDBEST
|
|
LDX #MAX_THREADS-1
|
|
BPL FINDBEST
|
|
FOUNDBEST: LDX BEST_THREAD
|
|
BPL SELECTTHREAD
|
|
;
|
|
; NOTHING RUNNABLE - CHECK FOR ANY GARBAGE COLLECTION TO DO
|
|
;
|
|
IDLE: CLI
|
|
INC OPCNT
|
|
.IFDEF IDLE_GC
|
|
BNE IDLELOOP
|
|
DEC IDLECNT
|
|
BNE IDLELOOP
|
|
LDA #IDLE_GC_DELAY
|
|
STA IDLECNT
|
|
JSR HMEM_GC_IDLE
|
|
IDLELOOP: JMP (LINK_YIELD) ; NOTHING RUNNABLE, KEEP WAITING
|
|
IDLECNT: .BYTE IDLE_GC_WAIT
|
|
.ELSE
|
|
IDLELOOP: JMP (LINK_YIELD) ; NOTHING RUNNABLE, KEEP WAITING
|
|
.ENDIF
|
|
;
|
|
; SELECT BEST THREAD
|
|
;
|
|
SELECTTHREAD: CPX CURRENT_THREAD
|
|
BEQ RUNTHREAD ; IN CASE OF INTERRUPTED STATE
|
|
;
|
|
; SAVE CURRENT THREAD STATE
|
|
;
|
|
LDY CURRENT_THREAD
|
|
LDA THREAD_STATE,Y
|
|
BEQ LOADEXECSTATE ; INVALID CURRENT THREAD, SKIP SAVE
|
|
SAVEEXECSTATE: LDA THREAD_HEXECL,Y
|
|
LDX THREAD_HEXECH,Y
|
|
JSR HMEM_PTR
|
|
STA TMPTR
|
|
STX TMPTR+1
|
|
TSX
|
|
TXA
|
|
LDX CURRENT_THREAD
|
|
STA THREAD_SP,X
|
|
TAY
|
|
INY
|
|
BEQ :+
|
|
SAVESTACK: LDA $0100,Y
|
|
STA (TMPTR),Y
|
|
INY
|
|
BNE SAVESTACK
|
|
: INC TMPTR+1 ; POINT TO ZP SAVE AREA
|
|
LDY #ZP_THREAD_SIZE-1
|
|
SAVEZP: LDA ZP_THREAD_STATE,Y ; COPY CURRENT THREAD STATE
|
|
STA (TMPTR),Y
|
|
DEY
|
|
BPL SAVEZP
|
|
LDA THREAD_STATE,X
|
|
CMP #S_RUNNING ; ONLY SET RUNNABLE IF CURRENTLY RUNNING
|
|
BNE LOADEXECSTATE
|
|
LDA #S_RUNNABLE
|
|
STA THREAD_STATE,X
|
|
;
|
|
; LOAD BEST THREAD STATE
|
|
;
|
|
LOADEXECSTATE: LDY BEST_THREAD
|
|
LDX THREAD_HEXECH,Y
|
|
LDA THREAD_HEXECL,Y
|
|
JSR HMEM_PTR
|
|
STA TMPTR
|
|
STX TMPTR+1
|
|
LDY BEST_THREAD
|
|
LDA THREAD_SP,Y
|
|
TAX
|
|
TXS
|
|
TAY
|
|
INY
|
|
BEQ :+
|
|
LOADSTACK: LDA (TMPTR),Y
|
|
STA $0100,Y
|
|
INY
|
|
BNE LOADSTACK
|
|
: STY OPCNT ; RESET OPCNT FOR NEW THREAD
|
|
INC TMPTR+1 ; POINT TO ZP SAVE AREA
|
|
LDY #ZP_THREAD_SIZE-1
|
|
LOADZP: LDA (TMPTR),Y ; COPY BEST THREAD STATE
|
|
STA ZP_THREAD_STATE,Y
|
|
DEY
|
|
BPL LOADZP
|
|
RUNTHREAD: LDY BEST_THREAD
|
|
LDX THREAD_STATE,Y
|
|
.IFDEF IDLE_GC
|
|
LDA #IDLE_GC_WAIT
|
|
STA IDLECNT
|
|
.ENDIF
|
|
LDA #S_RUNNING
|
|
STA THREAD_STATE,Y
|
|
STY CURRENT_THREAD
|
|
CLI ; ENABLE INTERRUPTS
|
|
CPX #S_INTERRUPTED
|
|
BEQ INTERRUPTED
|
|
RTS
|
|
INTERRUPTED: LDA #14 ; INTERRUPTED EXCEPTION
|
|
JMP SYSTHROW
|
|
;*
|
|
;* GRAB OBJECT LOCK
|
|
;* ENTER: AX = OBJECT HANDLE
|
|
;*
|
|
THREAD_LOCK:
|
|
.IFDEF DEBUG_LOCK
|
|
.IMPORT KBWAIT
|
|
PHA
|
|
TXA
|
|
PHA
|
|
; PERR "LOCKING THREAD"
|
|
; JSR KBWAIT
|
|
PLA
|
|
TAX
|
|
PLA
|
|
.ENDIF
|
|
STA TMP
|
|
LDY #MAX_SYNC_QUEUES-1 ; SEARCH FOR LOCKED OBJECT
|
|
SRCHLCKQ: CMP SYNCQ_HOBJL,Y
|
|
BNE :++
|
|
TXA
|
|
CMP SYNCQ_HOBJH,Y
|
|
BNE :+
|
|
LDA CURRENT_THREAD
|
|
CMP SYNCQ_OWNER,Y
|
|
BEQ LOCKINC
|
|
TAX ; BLOCK ON THIS OBJECT
|
|
TYA
|
|
STA THREAD_SYNCQ,X
|
|
LDA #$FF
|
|
STA THREAD_TIMEOUT0,X
|
|
STA THREAD_TIMEOUT1,X
|
|
STA THREAD_TIMEOUT2,X
|
|
STA THREAD_TIMEOUT3,X
|
|
LDA #S_BLOCK
|
|
STA THREAD_STATE,X
|
|
.IFDEF DEBUG_LOCK
|
|
PERR "SYNCING ON OBJECT"
|
|
.ENDIF
|
|
JMP (LINK_YIELD)
|
|
: LDA TMP
|
|
: DEY
|
|
BPL SRCHLCKQ
|
|
LDY #MAX_SYNC_QUEUES-1 ; SEARCH FOR AVAILABLE SYNC Q
|
|
SRCHFREEQ: LDA SYNCQ_HOBJH,Y
|
|
BEQ :+
|
|
DEY
|
|
BPL SRCHFREEQ
|
|
PERR "NO AVAILABLE WAIT QS"
|
|
LDA #4 ; OUT OF MEMORY
|
|
JMP SYSTHROW
|
|
: LDA TMP ; INIT WAIT Q
|
|
STA SYNCQ_HOBJL,Y
|
|
TXA
|
|
STA SYNCQ_HOBJH,Y
|
|
LDA CURRENT_THREAD
|
|
STA SYNCQ_OWNER,Y
|
|
LOCKINC: LDA SYNCQ_COUNTL,Y
|
|
CLC
|
|
ADC #$01
|
|
STA SYNCQ_COUNTL,Y
|
|
BCS :+
|
|
RTS
|
|
STA SYNCQ_COUNTH,Y
|
|
ADC #$00
|
|
STA SYNCQ_COUNTH,Y
|
|
BEQ :+
|
|
PERR "THREAD LOCK COUNT OVERFLOW"
|
|
LDA #12 ; ILLEGAL MONITOR STATE
|
|
JMP SYSTHROW
|
|
: RTS
|
|
;*
|
|
;* RELEASE OBJECT LOCK
|
|
;* ENTER: AX = OBJECT HANDLE
|
|
;*
|
|
THREAD_UNLOCK:
|
|
.IFDEF DEBUG_LOCK
|
|
.IMPORT KBWAIT
|
|
PHA
|
|
TXA
|
|
PHA
|
|
; PERR "UNLOCKING THREAD"
|
|
; JSR KBWAIT
|
|
PLA
|
|
TAX
|
|
PLA
|
|
.ENDIF
|
|
STA TMP
|
|
LDY #MAX_SYNC_QUEUES-1 ; SEARCH FOR LOCKED OBJECT
|
|
SRCHUNLCKQ: CMP SYNCQ_HOBJL,Y
|
|
BNE :++
|
|
TXA
|
|
CMP SYNCQ_HOBJH,Y
|
|
BNE :+
|
|
LDA SYNCQ_COUNTL,Y
|
|
SEC
|
|
SBC #$01
|
|
STA SYNCQ_COUNTL,Y
|
|
BCC LOCKDECH
|
|
BEQ RELEASELOCK
|
|
RTS ; COUNT NOT ZERO
|
|
: LDA TMP
|
|
: DEY
|
|
BPL SRCHUNLCKQ
|
|
PERR "UNLOCK OBJECT NOT FOUND IN WAIT Q"
|
|
LDA #12 ; ILLEGAL MONITOR STATE
|
|
JMP SYSTHROW
|
|
LOCKDECH: LDA SYNCQ_COUNTH,Y
|
|
SBC #$00
|
|
STA SYNCQ_COUNTH,Y
|
|
BCS :+
|
|
PERR "UNLOCK OBJECT COUNT UNDERFLOW"
|
|
LDA #12 ; ILLEGAL MONITOR STATE
|
|
JMP SYSTHROW
|
|
: RTS
|
|
RELEASELOCK: LDX #MAX_THREADS-1
|
|
SRCHSYNCQ: LDA THREAD_STATE,X
|
|
CMP #S_BLOCK
|
|
BNE :+
|
|
TYA
|
|
CMP THREAD_SYNCQ,X
|
|
BNE :+
|
|
LDA #S_RUNNABLE ; TRANSFER Q OWNER TO WAITING THREAD
|
|
STA THREAD_STATE,X
|
|
TXA
|
|
STA SYNCQ_OWNER,Y
|
|
LDA #$01
|
|
STA SYNCQ_COUNTL,Y
|
|
.IFDEF DEBUG_LOCK
|
|
PERR "WAKING UP OBJECT"
|
|
.ENDIF
|
|
JMP (LINK_YIELD)
|
|
; LDA #$FF
|
|
; STA OPCNT ; CAUSE SCHEDULER TO RUN SOON
|
|
; RTS
|
|
: DEX
|
|
BPL SRCHSYNCQ
|
|
LDA #$00 ; RELINQUISH WAIT Q
|
|
STA SYNCQ_HOBJH,Y
|
|
RTS
|
|
;*
|
|
;* THREAD NOTIFY IO
|
|
;* ENTRTY: Y = SLOT #
|
|
;*
|
|
THREAD_NOTIFYIO: LDA SLOT2MASK,Y
|
|
STA TMP
|
|
LDY #$00
|
|
LDX #MAX_THREADS-1
|
|
SRCHWAITIO: LDA THREAD_STATE,X
|
|
CMP #S_WAITIO ; IS THIS THREAD WAITING ON IO?
|
|
BNE :+
|
|
LDA THREAD_SLOTIO,X ; WAITING ON THIS SLOT?
|
|
AND TMP
|
|
BEQ :+
|
|
STA THREAD_SLOTIO,X ; SAVE WHICH SLOT WOKE UP
|
|
LDA #S_RUNNABLE ; WAKE IT UP
|
|
STA THREAD_STATE,X
|
|
LDA #$FF
|
|
STA OPCNT ; CAUSE SCHEDULER TO RUN SOON
|
|
INY
|
|
: DEX
|
|
BPL SRCHWAITIO
|
|
TYA ; IF NO THREAD WOKEN UP, SET NOTIFY FLAG
|
|
BEQ :+
|
|
RTS
|
|
: LDA TMP
|
|
ORA IO_NOTIFY
|
|
STA IO_NOTIFY
|
|
RTS
|
|
;*
|
|
;* THREAD WAIT IO
|
|
;* ENTRY: Y = SLOT #
|
|
;*
|
|
THREAD_WAITIO: LDA SLOT2MASK,Y
|
|
;*
|
|
;* THREAD SELECT IO
|
|
;* ENTRY: A = SLOT SELECT MASK
|
|
;*
|
|
THREAD_SELECTIO: SEI ; CLEAR INTERRUPTS
|
|
LDX CURRENT_THREAD
|
|
BIT IO_NOTIFY ; HAS ANY SELECTED SLOT NOTIFIED?
|
|
BEQ :+
|
|
AND IO_NOTIFY
|
|
STA THREAD_SLOTIO,X ; SAVE WHICH SLOT(S) HAS IO READY
|
|
EOR IO_NOTIFY ; CLEAR NOTIFICATION(S)
|
|
STA IO_NOTIFY
|
|
SELECTIORET: LDX CURRENT_THREAD
|
|
LDA THREAD_SLOTIO,X
|
|
RTS
|
|
: STA THREAD_SLOTIO,X ; SAVE WHICH SLOTS THREAD IS WAITING ON
|
|
LDA #S_WAITIO
|
|
STA THREAD_STATE,X
|
|
LDA #>(SELECTIORET-1) ; RETURN WITH SLOT NOTIFY IN ACCUM
|
|
PHA
|
|
LDA #<(SELECTIORET-1)
|
|
PHA
|
|
JMP (LINK_YIELD)
|
|
|
|
.DATA
|
|
;*
|
|
;* THREAD TABLE
|
|
;*
|
|
CURRENT_THREAD: .BYTE MAX_THREADS-1
|
|
BEST_THREAD: .BYTE $00
|
|
THREAD_STATE: .RES MAX_THREADS ; PROCESS STATE
|
|
THREAD_PRIORITY: .RES MAX_THREADS ; EXECUTION PRIORITY
|
|
THREAD_HEXECL: .RES MAX_THREADS ; HANDLE TO EXEC STATE (STACK+ZP)
|
|
THREAD_HEXECH: .RES MAX_THREADS
|
|
THREAD_HOBJL: .RES MAX_THREADS ; HANDLE TO THREAD OBJECT INSTANCE
|
|
THREAD_HOBJH: .RES MAX_THREADS
|
|
THREAD_HOBJCLL: .RES MAX_THREADS ; OBJECT CLASS
|
|
THREAD_HOBJCLH: .RES MAX_THREADS ; OBJECT CLASS
|
|
THREAD_SP: .RES MAX_THREADS ; SAVED 6502 STACK
|
|
THREAD_TOS: .RES MAX_THREADS ; TOP OF THREAD LOCAL STORAGE
|
|
THREAD_SYNCQ: .RES MAX_THREADS ; OBJECT SYNC QUEUE CURRENTLY BLOCKED ON
|
|
THREAD_WAIT_HOBJL: .RES MAX_THREADS ; OBJECT WAIT/NOTIFY TABLE
|
|
THREAD_WAIT_HOBJH: .RES MAX_THREADS ; MANAGED IN OBJECT CLASS
|
|
THREAD_WAITQ: .RES MAX_THREADS ; WAIT ORDER (THREAD ID)
|
|
THREAD_SLOTIO: .RES MAX_THREADS ; SLOT IO WAIT MASK
|
|
THREAD_TIMEOUT0: .RES MAX_THREADS ; TIMEOUT IN MSECS
|
|
THREAD_TIMEOUT1: .RES MAX_THREADS
|
|
THREAD_TIMEOUT2: .RES MAX_THREADS
|
|
THREAD_TIMEOUT3: .RES MAX_THREADS
|
|
;*
|
|
;* SYNC QUEUE TABLE. TO AVOID PER INSTANCE DATA FOR SYNCHRONIZED OBJECT, A SMALL NUMBER
|
|
;* OF CURRENT SYNC QUEUES ARE MAINTAINED HERE. THEY ARE DYNAMICALLY ALLOCATED
|
|
;* AND ARE FREED WHEN COUNT = 0.
|
|
;*
|
|
SYNCQ_HOBJL: .RES MAX_SYNC_QUEUES
|
|
SYNCQ_HOBJH: .RES MAX_SYNC_QUEUES
|
|
SYNCQ_COUNTL: .RES MAX_SYNC_QUEUES
|
|
SYNCQ_COUNTH: .RES MAX_SYNC_QUEUES
|
|
SYNCQ_OWNER: .RES MAX_SYNC_QUEUES
|
|
;*
|
|
;* PER SLOT I/O NOTIFICATIONS
|
|
;*
|
|
IO_NOTIFY: ;.BYTE $00
|
|
SLOT2MASK: .BYTE $00,$02,$04,$08,$10,$20,$40,$80 ; SLOT 0 IS UNUSED FOR IO
|
|
;*
|
|
;* SYSTEM TIC COUNT
|
|
;*
|
|
TIC_COUNT: .BYTE $00,$00,$00,$00
|