source: Include/system/exception.ab@ 237

Last change on this file since 237 was 237, checked in by イグトランス (egtra), 17 years ago

#_fullcompileで検出されたエラーの修正(明らかに判るもののみ)

File size: 2.6 KB
Line 
1'TODO: ローカルオブジェクト確保及び解放時にTryServiceに通知する必要がある。
2
3Class TryLayer
4Public
5 Const AddressOfCatch As VoidPtr
6 Const StackPtr As LONG_PTR
7
8 Sub TryLayer( AddressOfCatch As VoidPtr, StackPtr As LONG_PTR )
9 This.AddressOfCatch = AddressOfCatch
10 This.StackPtr = StackPtr
11 End Sub
12 Sub ~TryLayer()
13 End Sub
14End Class
15
16Class ExceptionService
17 ppTryLayers As **TryLayer
18 nTryLayers As Long
19
20 Sub FreeLocalObjects()
21 'TODO: 破棄されていないローカルオブジェクトを破棄
22 End Sub
23Public
24
25 Sub ExceptionService()
26 ppTryLayers = _System_malloc( 1 )
27 nTryLayers = 0
28 End Sub
29 Sub ~ExceptionService()
30 Dim i As Long
31 For i = 0 To ELM( nTryLayers )
32 Delete ppTryLayers[i]
33 Next
34 _System_free( ppTryLayers )
35 ppTryLayers = 0
36 End Sub
37
38 'Try
39 Sub BeginTryScope( AddressOfCatch As VoidPtr, StackPtr As LONG_PTR )
40 ppTryLayers = _System_realloc( ppTryLayers, ( nTryLayers + 1 ) * SizeOf( *TryLayer ) )
41 ppTryLayers[nTryLayers] = New TryLayer( AddressOfCatch, StackPtr )
42 nTryLayers++
43 End Sub
44
45 'End Try
46 Sub EndTryScope()
47 nTryLayers--
48 Delete ppTryLayers[nTryLayers]
49 End Sub
50
51 'Throw
52 Sub _Throw()
53 If nTryLayers <= 0 then
54 '例外処理スコープ制御が無効なとき
55
56 'TODO: 適切なエラー処理
57
58 Return
59 End If
60
61 '未解放なローカルオブジェクトを解放する
62 FreeLocalObjects()
63
64
65
66 '--------------------------------------------------
67 ' スレッドのコンテキストを設定(Catchへ遷移する)
68 '--------------------------------------------------
69
70 'カレント スレッドを取得
71 Dim thread = Thread.CurrentThread
72
73 'レジスタ情報を取得
74 Dim context As CONTEXT
75 FillMemory(VarPtr(context),SizeOf(CONTEXT),0)
76 context.ContextFlags=CONTEXT_CONTROL
77 If thread.__GetContext( context ) = 0 Then
78 OutputDebugString(Ex"レジスタ情報の取得に失敗しました。\r\n")
79 Return
80 End If
81
82 '新しいip, spをセット
83#ifdef _WIN64
84 context.Rip = ppTryLayers[nTryLayers - 1]->AddressOfCatch As QWord
85 context.Rsp = ppTryLayers[nTryLayers - 1]->StackPtr
86#else
87 context.Eip = ppTryLayers[nTryLayers - 1]->AddressOfCatch As DWord
88 context.Esp = ppTryLayers[nTryLayers - 1]->StackPtr
89#endif
90 If thread.__SetContext( context ) = 0 Then
91 OutputDebugString(Ex"レジスタ情報の設定に失敗しました。\r\n")
92 Return
93 End If
94 End Sub
95
96 Sub _Throw( msg As String )
97 _Throw()
98 End Sub
99
100 Static Sub AllocateObject( pObj As VoidPtr )
101 Dim thread = Thread.CurrentThread
102 'TODO: ローカルオブジェクトを登録
103 End Sub
104
105 Static Sub DeallocateObject( pObj As VoidPtr )
106 'TODO: ローカルオブジェクトを破棄
107 End Sub
108End Class
109
Note: See TracBrowser for help on using the repository browser.