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