'TODO: ローカルオブジェクト確保及び解放時にTryServiceに通知する必要がある。

Class TryLayer
Public
	Const addressOfCatch As VoidPtr
	Const basePtr As LONG_PTR
	Const stackPtr As LONG_PTR
	Const debugProcNum As DWord
	
	Sub TryLayer( addressOfCatch As VoidPtr, basePtr As LONG_PTR, stackPtr As LONG_PTR )
		This.addressOfCatch = addressOfCatch
		This.basePtr = basePtr
		This.stackPtr = stackPtr

#ifdef _DEBUG
		Dim ThreadNum As Long
		ThreadNum=_DebugSys_GetThread()
		If ThreadNum <> -1 Then
			debugProcNum = _DebugSys_ProcNum[ThreadNum]
		End If
#endif
	End Sub
	Sub ~TryLayer()
	End Sub
End Class

Class ExceptionService
	ppTryLayers As **TryLayer
	nTryLayers As Long

	Sub FreeLocalObjects()
		'TODO: 破棄されていないローカルオブジェクトを破棄
	End Sub
Public

	Sub ExceptionService()
		ppTryLayers = _System_malloc( 1 )
		nTryLayers = 0
	End Sub
	Sub ~ExceptionService()
		Dim i As Long
		For i = 0 To ELM( nTryLayers )
			Delete ppTryLayers[i]
		Next
		_System_free( ppTryLayers )
		ppTryLayers = 0
	End Sub

	'Try
	Function _BeginTryScope( addressOfCatch As VoidPtr, basePtr As LONG_PTR, stackPtr As LONG_PTR ) As TryLayer
		ppTryLayers = _System_realloc( ppTryLayers, ( nTryLayers + 1 ) * SizeOf( *TryLayer ) )
		ppTryLayers[nTryLayers] = New TryLayer( addressOfCatch, basePtr, stackPtr )
		nTryLayers++

		Return ByVal ppTryLayers[nTryLayers-1]
	End Function

	Static Function BeginTryScope( addressOfCatch As VoidPtr, basePtr As LONG_PTR, stackPtr As LONG_PTR ) As TryLayer
		Return _System_pobj_AllThreads->GetCurrentException()->_BeginTryScope( addressOfCatch, basePtr, stackPtr )
	End Function

	'End Try
	Sub EndTryScope()
		nTryLayers--
		Delete ppTryLayers[nTryLayers]
	End Sub

	'Throw
	Sub _Throw()
		If nTryLayers <= 0 then
			'例外処理スコープ制御が無効なとき

			'TODO: 適切なエラー処理
			MessageBox( NULL, "例外", "", MB_OK or MB_ICONEXCLAMATION )

			Return
		End If

		'未解放なローカルオブジェクトを解放する
		FreeLocalObjects()



		'--------------------------------------------------
		' スレッドのコンテキストを設定（Catchへ遷移する）
		'--------------------------------------------------

		Dim context As CONTEXT
		context.ContextFlags = CONTEXT_CONTROL or CONTEXT_INTEGER
		If GetThreadContext( GetCurrentThread(), context ) = 0 Then
			' TODO: エラー処理
			debug
		End If

		'新しいip, sp, bpをセット
#ifdef _WIN64
		context.Rip = ppTryLayers[nTryLayers - 1]->addressOfCatch As QWord
		context.Rbp = ppTryLayers[nTryLayers - 1]->basePtr
		context.Rsp = ppTryLayers[nTryLayers - 1]->stackPtr
#else
		context.Eip = ppTryLayers[nTryLayers - 1]->addressOfCatch As DWord
		context.Ebp = ppTryLayers[nTryLayers - 1]->basePtr
		context.Esp = ppTryLayers[nTryLayers - 1]->stackPtr
#endif

#ifdef _DEBUG
		Dim ThreadNum As Long
		ThreadNum=_DebugSys_GetThread()
		If ThreadNum <> -1 Then
			_DebugSys_ProcNum[ThreadNum] = ppTryLayers[nTryLayers - 1]->debugProcNum-1
		End If
#endif

		If SetThreadContext( GetCurrentThread(), context ) = 0 Then
			OutputDebugString(Ex"レジスタ情報の設定に失敗しました。\r\n")
			Return
		End If
	End Sub

	Sub _Throw( msg As String )
		_Throw()
	End Sub
End Class