source: trunk/ab5.0/ablib/src/system/debug.sbp@ 560

'debug.sbp
'このファイル内のコードはデバッグ コンパイル時のみ有効です（リリース コンパイルでは無視されます）。

'Dim _DebugSys_dwThreadID[255] As DWord         - コンパイラが自動的に定義します
'Dim _DebugSys_ProcNum[255] As DWord            - コンパイラが自動的に定義します
'Dim _DebugSys_lplpObp[255] As *ULONG_PTR       - コンパイラが自動的に定義します
'Dim _DebugSys_lplpSpBase[255] As *ULONG_PTR    - コンパイラが自動的に定義します

Function _DebugSys_GetThread() As Long
    Dim dwThreadID As DWord
    Dim ThreadNum As Long

    dwThreadID=GetCurrentThreadId()
    ThreadNum=0
    Do
        If dwThreadID=_DebugSys_dwThreadID[ThreadNum] Then Exit Do
        ThreadNum=ThreadNum+1
        If ThreadNum>255 Then
            ThreadNum=-1
            Exit Do

            /*debug
            OutputDebugString(Ex"[GetThread]デバッグ情報が異常です。プロセスを終了します。\r\n")
            ExitProcess(0)*/
        End If
    Loop

    _DebugSys_GetThread=ThreadNum
End Function

/*!
@brief デバッグ用Set_LONG_PTR。
削除すると、ABプログラムが正常にデバッグ実行できなくなる。
*/
Sub _DebugSys_Set_LONG_PTR(pPtr As VoidPtr, lpData As LONG_PTR)
#ifdef _WIN64
    SetQWord(pPtr,lpData)
#else
    SetDWord(pPtr,lpData)
#endif
End Sub

Sub _DebugSys_StartProc(lpSpBase As ULONG_PTR, lpObp As ULONG_PTR)
    Dim i As Long

    Dim ThreadNum As Long
    ThreadNum=_DebugSys_GetThread()
    If ThreadNum=-1 Then Exit Sub

    If _DebugSys_lplpObp[ThreadNum] Then
        i=(_DebugSys_ProcNum[ThreadNum]+2)*SizeOf(ULONG_PTR)
        _DebugSys_lplpObp[ThreadNum]=HeapReAlloc(GetProcessHeap(),0,_DebugSys_lplpObp[ThreadNum],i)
        _DebugSys_lplpSpBase[ThreadNum]=HeapReAlloc(GetProcessHeap(),0,_DebugSys_lplpSpBase[ThreadNum],i)
    Else
        _DebugSys_ProcNum[ThreadNum]=0
        _DebugSys_lplpObp[ThreadNum]=HeapAlloc(GetProcessHeap(),0,SizeOf(ULONG_PTR)*2)
        _DebugSys_lplpSpBase[ThreadNum]=HeapAlloc(GetProcessHeap(),0,SizeOf(ULONG_PTR)*2)
    End If
    _DebugSys_Set_LONG_PTR(_DebugSys_lplpObp[ThreadNum]+_DebugSys_ProcNum[ThreadNum]*SizeOf(ULONG_PTR),lpObp)
    _DebugSys_Set_LONG_PTR(_DebugSys_lplpSpBase[ThreadNum]+_DebugSys_ProcNum[ThreadNum]*SizeOf(ULONG_PTR),lpSpBase)

    _DebugSys_ProcNum[ThreadNum]=_DebugSys_ProcNum[ThreadNum]+1
End Sub

Sub _DebugSys_EndProc()
    Dim ThreadNum As Long
    ThreadNum=_DebugSys_GetThread()
    If ThreadNum=-1 Then Exit Sub

    _DebugSys_ProcNum[ThreadNum]=_DebugSys_ProcNum[ThreadNum]-1
End Sub

Sub _DebugSys_SaveContext(lpSpBase As ULONG_PTR, lpObp As ULONG_PTR)
    Dim ThreadNum As Long
    ThreadNum=_DebugSys_GetThread()
    If ThreadNum=-1 Then Exit Sub

    If _DebugSys_lplpObp[ThreadNum]=0 Then
        _DebugSys_ProcNum[ThreadNum]=0
        _DebugSys_lplpObp[ThreadNum]=HeapAlloc(GetProcessHeap(),0,SizeOf(ULONG_PTR)*2)
        _DebugSys_lplpSpBase[ThreadNum]=HeapAlloc(GetProcessHeap(),0,SizeOf(ULONG_PTR)*2)
    End If
    _DebugSys_Set_LONG_PTR(_DebugSys_lplpObp[ThreadNum]+_DebugSys_ProcNum[ThreadNum]*SizeOf(ULONG_PTR), lpObp)
    _DebugSys_Set_LONG_PTR(_DebugSys_lplpSpBase[ThreadNum]+_DebugSys_ProcNum[ThreadNum]*SizeOf(ULONG_PTR), lpSpBase)
End Sub

Sub _esp_error()
    MessageBox( NULL, "esp is wrong value.", "debug check error", MB_OK or MB_ICONEXCLAMATION )
End Sub

Sub _System_DebugOnly_OutputDebugString(buffer As *Char)
#ifdef _DEBUG
    OutputDebugString(buffer)
#endif
End Sub