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

Class TryLayer
Public
	Const AddressOfCatch As VoidPtr
	Const StackPtr As LONG_PTR
	context As CONTEXT
	Const debugProcNum As DWord
	
	Sub TryLayer( AddressOfCatch As VoidPtr, StackPtr As LONG_PTR )
		This.AddressOfCatch = AddressOfCatch
		This.StackPtr = StackPtr

		context.ContextFlags=CONTEXT_ALL
		If Thread.CurrentThread().__GetContext(context) = 0 Then
			' TODO: エラー処理
			debug
		End If

#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, StackPtr As LONG_PTR ) As TryLayer
		ppTryLayers = _System_realloc( ppTryLayers, ( nTryLayers + 1 ) * SizeOf( *TryLayer ) )
		ppTryLayers[nTryLayers] = New TryLayer( AddressOfCatch, StackPtr )
		nTryLayers++

		Return ByVal ppTryLayers[nTryLayers-1]
	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 thread = Thread.CurrentThread

		'レジスタ情報を取得
		Dim context = ppTryLayers[nTryLayers - 1]->context
debug
		'新しいip, spをセット
#ifdef _WIN64
		context.Rip = ppTryLayers[nTryLayers - 1]->AddressOfCatch As QWord
		'context.Rsp = ppTryLayers[nTryLayers - 1]->StackPtr
#else
		context.Eip = ppTryLayers[nTryLayers - 1]->AddressOfCatch As DWord
		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 thread.__SetContext( context ) = 0 Then
			OutputDebugString(Ex"レジスタ情報の設定に失敗しました。\r\n")
			Return
		End If
	End Sub

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

	Static Sub AllocateObject( pObj As VoidPtr )
		Dim thread = Thread.CurrentThread
		'TODO: ローカルオブジェクトを登録
	End Sub

	Static Sub DeallocateObject( pObj As VoidPtr )
		'TODO: ローカルオブジェクトを破棄
	End Sub
End Class