uglobal
  hDebugThread dd ?
  hDebugFileImage dd ?
endg



; helper routine for running applications with
; programs such debuggers/emulators
proc RunIndirect, .pszApplication
.sinfo  STARTUPINFO
.pinfo  PROCESSINFO
begin
;        stdcall FileExists, [.pszApplication]
;        test    eax,eax
;        jz      .finish

        mov     ecx, sizeof.STARTUPINFO/4
        lea     edi,[.sinfo]
        xor     eax, eax
        rep     stosd
        mov     [.sinfo.cb], sizeof.STARTUPINFO
        mov     [.sinfo.dwFlags], STARTF_USESHOWWINDOW
        mov     [.sinfo.wShowWindow], SW_HIDE
        lea     ecx,[.pinfo]
        lea     eax,[.sinfo]
        push    ecx eax
        stdcall StrDup, [.pszApplication]
        mov     ebx,eax
        stdcall StrCharCat, ebx,' '
        stdcall StrCat, ebx, [CompiledFileName]
        stdcall StrPtr,ebx
        invoke  CreateProcess, NULL, eax, NULL, NULL, FALSE, NORMAL_PRIORITY_CLASS , NULL, NULL
        test    eax,eax
        jnz     .ok
        stdcall LastError
   .ok:
        invoke  CloseHandle,[.pinfo.hThread]
        invoke  CloseHandle,[.pinfo.hProcess]
   .finish:
        return
endp


proc Execute, .hLine
.process PROCESS_INFORMATION
.startup STARTUPINFO
.exit_code dd ?
begin
        push    edi ecx edx

        lea     edi, [.startup]
        xor     eax, eax
        mov     ecx, sizeof.STARTUPINFO / 4
        rep stosd
        mov     [.startup.cb], sizeof.STARTUPINFO

        lea     edi, [.process]
        xor     eax, eax
        mov     ecx, sizeof.PROCESS_INFORMATION / 4
        rep stosd

        stdcall StrPtr, [.hLine]
        lea     ecx, [.process]
        lea     edx, [.startup]
        invoke  CreateProcess, NULL, eax, NULL, NULL, FALSE, NORMAL_PRIORITY_CLASS , NULL, NULL, edx, ecx
        test    eax, eax
        jz      .failed
        invoke  WaitForSingleObject, [.process.hProcess], 1000
        cmp     eax, WAIT_TIMEOUT
        je      .timeout

        lea     ecx, [.exit_code]
        invoke  GetExitCodeProcess, [.process.hProcess], ecx
.ok:
        clc
        pop     edx ecx edi
        return


.timeout:
        invoke  TerminateProcess, [.process.hProcess], -1
        xor     eax, eax
        dec     eax

.failed:
        stc
        pop     edx ecx edi
        return
endp




iglobal
  LinuxFull      db ' windows/FreshProgram', 0
  LinuxProg      db '\FreshProgram', 0
  AndCmd         db '\Launcher\andCmd.exe" ', 0
  LinuxScript666 db 'chmod 666 windows/FreshProgram', 0
  LinuxScriptRM  db 'rm windows/FreshProgram', 0
  LinuxScript777 db 'chmod 777 windows/FreshProgram', 0
endg



proc RunInLinux, .fDebug

.htarget dd ?
.sinfo  STARTUPINFO
.pinfo  PROCESSINFO
.hexec dd ?
.filename dd ?
.wine_get_unix_file_name dd ?

cKernel32 text 'kernel32.dll'
cWineOnlyFunction text 'wine_get_unix_file_name'

begin
        pushad

; check for wine
        invoke  LoadLibrary, cKernel32
        test    eax, eax
        jz      .finish         ; Strange error???

        invoke  GetProcAddress, eax, cWineOnlyFunction
        test    eax, eax
        jz      .andLinux

; run it directly
        mov     [.wine_get_unix_file_name], eax

; get the Linux filename of the executable.
        stdcall utf8ToWideChar, [CompiledFileName]
        push    eax

        ccall   [.wine_get_unix_file_name], eax         ; Possible bug - what to do with the memory returned???

        stdcall FreeMem ; from the stack.
        stdcall StrDup, eax
        mov     [.filename], eax

        mov     eax, cLinuxTerminalKey
        cmp     [.fDebug], FALSE
        je      @f
        mov     eax, cLinuxDbgKey
@@:
        stdcall GetParamFromINI, eax
        jc      .err_runelf

        stdcall StrCharCat, eax, ' '
        stdcall StrCat, eax, [.filename]
        mov     [.hexec], eax

        mov     ecx, sizeof.STARTUPINFO
        shr     ecx, 2
        lea     edi,[.sinfo]
        xor     eax, eax
        rep stosd
        mov     [.sinfo.cb], sizeof.STARTUPINFO
        mov     [.sinfo.dwFlags],0
        lea     ecx,[.pinfo]
        lea     eax,[.sinfo]
        push    ecx eax
        stdcall StrPtr, [.hexec]

        invoke  CreateProcess, NULL, eax, NULL, NULL, FALSE, NORMAL_PRIORITY_CLASS, NULL, NULL
        test    eax,eax
        jnz     .ok

        stdcall LastError
.ok:
        invoke  CloseHandle,[.pinfo.hThread]
        invoke  CloseHandle,[.pinfo.hProcess]
        stdcall StrDel, [.hexec]
        stdcall StrDel, [.filename]

        clc
        popad
        return

.err_runelf:
        stdcall StrDel, [.filename]
        stc
        popad
        return

; run it using andLinux
.andLinux:
        stdcall GetParamFromINI, cAndLinuxSharedKey
        jc      .finish

        mov     [.htarget], eax
        stdcall StrCat, eax, LinuxProg

        stdcall GetParamFromINI, cAndLinuxKey
        jc      .finish2

        mov     ebx, eax
        stdcall StrCat, ebx, AndCmd
        stdcall StrCharInsert, ebx, '"', 0

; change mode
        stdcall StrDup, ebx
        mov     esi, eax

; change permisions to 666
        stdcall StrCat, esi, LinuxScript666
        stdcall Execute, esi
        jc      .failed

; remove the file
        stdcall StrCopy, esi, ebx
        stdcall StrCat, esi, LinuxScriptRM
        stdcall Execute, esi
        jc      .failed

; copy the file
        stdcall StrPtr, [CompiledFileName]
        stdcall LoadBinaryFile, eax
        jc      .failed

        push    eax

        push    ecx
        push    eax

        stdcall StrPtr, [.htarget]
        stdcall SaveBinaryFile, eax  ; remaining, arguments from stack
        pop     ecx
        pushf
        stdcall FreeMem, ecx
        popf
        jc      .failed

; change permisions to 777
        stdcall StrCopy, esi, ebx
        stdcall StrCat, esi, LinuxScript777

        stdcall Execute, esi
        jc      .failed

; so what to do?
        mov     eax, cLinuxTerminalKey
        cmp     [.fDebug], 0
        je      .keyok

        mov     eax, cLinuxDbgKey

.keyok:
        stdcall StrCopy, esi, ebx

        stdcall GetParamFromINI, eax
        jc      .failed

        push    eax
        stdcall StrCat, esi, eax
        stdcall StrDel ; from the stack
        stdcall StrCat, esi, LinuxFull
        stdcall Execute, esi
        jc      .failed

        stdcall StrDel, esi
        stdcall StrDel, [.htarget]
        clc
        popad
        return

.failed:
        stdcall StrDel, esi

.finish2:
        stdcall StrDel, [.htarget]

.finish:
        stc
        popad
        return
endp



proc OnRun, .wparam, .lparam
begin
        cmp     [idDbgThread], 0
        jne     .rundebugged

        stdcall OnCompile, 0, 0

        cmp     eax, MR_OK
        jne     .finish         ; There are errors during compilation.

        cmp     [output_format],5
        je      .runELF

        cmp     [output_format],4
        jae     .runObject

        cmp     [output_format], 3
        jne     .dos

        invoke  SendMessage, [frmMsg], MWM_CLEARMESSAGES, 0, 0

        invoke  CreateThread, NULL, $4000, DebuggerThread, [output_file], 0, idDbgThread
        mov     [hDebugThread], eax
        test    eax, eax
        jz      .errorthread
        return

.errorthread:
        call    LastError
.finish:
        return

.runObject:
        invoke  MessageBox, [hApplication], cRunObjectError, NULL, MB_ICONERROR+MB_OK
        return

.runELF:
        stdcall RunInLinux, FALSE
        jnc     .elfok
        invoke  MessageBox, [hApplication], cRunLinuxError, NULL, MB_ICONERROR+MB_OK
.elfok:
        return

iglobal
  cRunLinuxError db "Linux application can't be started.",0
endg

.dos:
        stdcall OnRunDirect, 3, 0
        return

.rundebugged:
        cmp     [dbgStatus], dsPaused
        jne     .finish

        call    ResetSingleStep
        return
endp

iglobal
  cRunObjectError db "Can't execute object file.",0
endg


; --------------------------------------------------------------
; if wparam = 3 then the source is compiled, so simply run it.
; --------------------------------------------------------------
proc OnRunDirect, .wparam, .lparam
.sinfo  STARTUPINFO
.pinfo  PROCESSINFO
begin
        cmp     [.wparam], 3
        je      .compileok

        stdcall OnCompile, 0, 0
        cmp     eax, MR_OK
        jne     .finish         ; There are errors during compilation.

.compileok:
        cmp     [output_format],5
        je      OnRun.runELF

        cmp     [output_format],4
        jae     OnRun.runObject

        mov     ecx, sizeof.STARTUPINFO
        shr     ecx, 2
        lea     edi,[.sinfo]
        xor     eax, eax
        rep stosd
        mov     [.sinfo.cb], sizeof.STARTUPINFO
        mov     [.sinfo.dwFlags],0
        lea     ecx,[.pinfo]
        lea     eax,[.sinfo]
        push    ecx eax
        stdcall StrPtr, [CompiledFileName]
        invoke  CreateProcess,eax,NULL,NULL,NULL,FALSE, NORMAL_PRIORITY_CLASS,NULL,NULL
        test    eax,eax
        jnz     .ok

        stdcall LastError
.ok:
        invoke  CloseHandle,[.pinfo.hThread]
        invoke  CloseHandle,[.pinfo.hProcess]

.finish:
        return
endp





proc OnStepInto, .wparam, .lparam
begin
        cmp     [dbgStatus], dsPaused
        jne     .finish

        call    WaitForCommandOrTimeout
        jc      .finish

        mov     [dbgCommand], dbgcStepInto

.finish:
        return
endp


proc OnStepOver, .wparam, .lparam
begin
        cmp     [dbgStatus], dsPaused
        jne     .finish

        call    WaitForCommandOrTimeout
        jc      .finish

        mov     [dbgCommand], dbgcStepOver

.finish:
        return
endp


proc OnPause, .wparam, .lparam
begin
        call    WaitForCommandOrTimeout
        jc      @f
        mov     [dbgCommand], dbgcPause
@@:
        return
endp


proc OnStop, .wparam, .lparam
begin
        call     WaitForCommandOrTimeout
        jc       @f
        mov      [dbgCommand], dbgcKillProcess
@@:
        return
endp




proc ResetSingleStep
begin
        mov     [dbgContext.ContextFlags], CONTEXT_CONTROL
        invoke  GetThreadContext, [dbgPInfo.hThread], dbgContext
        and     [dbgContext.regFlag], $fffffeff
        invoke  SetThreadContext, [dbgPInfo.hThread], dbgContext
        call    WaitForCommandOrTimeout
        jc      @f
        mov     [dbgCommand], dbgcContinue
@@:
        return
endp



iglobal
cDebugNumberHex = ntsHex or ntsUnsigned or ntsFixedWidth or 8
DebuggerProperties:
      PropInfo                                                                      \
        'EAX', ptDword, CONTEXT.regEax, IntPropEditor,    cDebugNumberHex, 0,       \
        'EBX', ptDword, CONTEXT.regEbx, IntPropEditor,    cDebugNumberHex, 0,       \
        'ECX', ptDword, CONTEXT.regEcx, IntPropEditor,    cDebugNumberHex, 0,       \
        'EDX', ptDword, CONTEXT.regEdx, IntPropEditor,    cDebugNumberHex, 0,       \
        'ESI', ptDword, CONTEXT.regEsi, IntPropEditor,    cDebugNumberHex, 0,       \
        'EDI', ptDword, CONTEXT.regEdi, IntPropEditor,    cDebugNumberHex, 0,       \
        'EBP', ptDword, CONTEXT.regEbp, IntPropEditor,    cDebugNumberHex, 0,       \
        'ESP', ptDword, CONTEXT.regEsp, IntPropEditor,    cDebugNumberHex, 0,       \
        'EIP', ptDword, CONTEXT.regEip, IntPropEditor,    cDebugNumberHex, 0,       \
        'flags', ptDword, CONTEXT.regFlag, IntPropEditor, cDebugNumberHex, 0
;        'CS:', ptDword, CONTEXT.regCs, IntPropEditor,    cDebugNumberHex, 0,       \
;        'SS:', ptDword, CONTEXT.regSs, IntPropEditor,    cDebugNumberHex, 0,       \
;        'DS:', ptDword, CONTEXT.regDs, IntPropEditor,    cDebugNumberHex, 0,       \
;        'ES:', ptDword, CONTEXT.regEs, IntPropEditor,    cDebugNumberHex, 0,       \
;        'FS:', ptDword, CONTEXT.regFs, IntPropEditor,    cDebugNumberHex, 0,       \
;        'GS:', ptDword, CONTEXT.regGs, IntPropEditor,    cDebugNumberHex, 0
endg



proc WaitForCommandOrTimeout
begin

.wait:
        cmp     [dbgCommand], 0
        je      .finish

        invoke  GetCurrentThread
        invoke  WaitForSingleObject, eax, 100
        cmp     [dbgCommand], 0
        jne     .timeout

.finish:
        clc
        return
.timeout:
        stc
        return
endp



proc UpdateThreadContext, .ptrContext
begin
        cmp     [dbgStatus], dsPaused
        jne     @f

        mov     [dbgContext.ContextFlags], CONTEXT_FULL
        invoke  SetThreadContext, [dbgPInfo.hThread], [.ptrContext]
@@:
        return
endp




iglobal
  TblDebugEvents dd  DbgEventUnknown
                 dd  DbgEventException
                 dd  DbgEventCreateThread
                 dd  DbgEventCreateProcess
                 dd  DbgEventExitThread
                 dd  DbgEventExitProcess
                 dd  DbgEventLoadDll
                 dd  DbgEventUnloadDll
                 dd  DbgEventOutputString
                 dd  DbgEventRIP

  cDbgEventUnknown        db      'Unknown debug event.', 0
  cDbgEventException      db      'Exception:',0
  cDbgEventCreateThread   db      'New thread created',0
  cDbgEventCreateProcess  db      'New process created',0
  cDbgEventExitThread     db      'Thread terminated',0
  cDbgEventExitProcess    db      'Process terminated',0
  cDbgEventLoadDll        db      'DLL loaded: ',0
  cDbgEventUnloadDll      db      'DLL unloaded: ',0
  cDbgEventOutputString   db      'String output: ',0
  cDbgEventRIP            db      'Internal debuger error.',0
endg


proc DbgEventUnknown
begin
        stdcall StrNew
        stdcall StrCopy, eax, cDbgEventUnknown
        return
endp


proc DbgEventException
begin
        mov     ecx, [dbgEvent.Exception.ExceptionRecord.ExceptionCode]
        cmp     ecx, EXCEPTION_SINGLE_STEP
        jne     .logexception
        xor     eax, eax
        return

.logexception:
        stdcall StrDup, cDbgEventException
        mov     edx, eax

        stdcall GetExceptionText, ecx
        stdcall StrCat, edx, ecx
        stdcall StrDel, ecx
        stdcall StrCharCat, edx, ' at '
        stdcall NumToStr, [dbgEvent.Exception.ExceptionRecord.ExceptionAddress], ntsHex or ntsFixedWidth or ntsUnsigned or 8
        stdcall StrCat, edx, eax
        stdcall StrDel, eax
        mov     eax, edx
        return
endp


proc GetExceptionText, .number
begin
        push    eax edx esi

        mov     esi, tblExceptions
.loop:
        mov     eax, dword [esi]
        test    eax, eax
        jz      .notfound

        cmp     eax, [.number]
        je      .found

        add     esi, 4
        jmp     .loop

.found:
        stdcall StrDup, [esi+4]
        jmp     .finish

.notfound:
        stdcall NumToStr, [.number], ntsHex or ntsUnsigned or ntsFixedWidth or 8
        stdcall StrCharInsert, eax, '$', 0

.finish:
        mov     ecx, eax
        pop     esi edx eax
        return
endp


macro KeyString [key, string] {
  forward
    local  ptrstr
    dd     key, ptrstr
  common
    dd  0
  forward
ptrstr db  string, 0
}


iglobal

tblExceptions:
     KeyString                                                            \
          EXCEPTION_ACCESS_VIOLATION,           'Access violation',       \
          EXCEPTION_DATATYPE_MISALIGNMENT,      'Datatype misalignment',  \
          EXCEPTION_BREAKPOINT,                 'Breakpoint',             \
          EXCEPTION_SINGLE_STEP,                'Single step',            \
          EXCEPTION_ARRAY_BOUNDS_EXCEEDED,      'Array bounds exceeded',  \
          EXCEPTION_FLT_DENORMAL_OPERAND,       'FPU Denormal operand',   \
          EXCEPTION_FLT_DIVIDE_BY_ZERO,         'FPU Divide by zero',     \
          EXCEPTION_FLT_INEXACT_RESULT,         'FPU Inexact result',     \
          EXCEPTION_FLT_INVALID_OPERATION,      'FPU Invalid operation',  \
          EXCEPTION_FLT_OVERFLOW,               'FPU Overflow',           \
          EXCEPTION_FLT_STACK_CHECK,            'FPU Stack check',        \
          EXCEPTION_FLT_UNDERFLOW,              'FPU Underflow',          \
          EXCEPTION_INT_DIVIDE_BY_ZERO,         'Divide by zero',         \
          EXCEPTION_INT_OVERFLOW,               'Overflow',               \
          EXCEPTION_ILLEGAL_INSTRUCTION,        'Illegal instruction',    \
          EXCEPTION_PRIV_INSTRUCTION,           'Privileged instruction', \
          EXCEPTION_IN_PAGE_ERROR,              'Page error'
endg





proc DbgEventCreateThread
begin
        stdcall StrNew
        stdcall StrCopy, eax, cDbgEventCreateThread
        return
endp

proc DbgEventCreateProcess
begin
        stdcall StrNew
        stdcall StrCopy, eax, cDbgEventCreateProcess
        return
endp

proc DbgEventExitThread
begin
        stdcall StrNew
        stdcall StrCopy, eax, cDbgEventExitThread
        return
endp

proc DbgEventExitProcess
begin
        stdcall StrNew
        stdcall StrCopy, eax, cDbgEventExitProcess
        return
endp


proc DbgEventLoadDll
.name rb 512
.buffer rd 128
begin
        stdcall StrNew
        mov     edi, eax
        stdcall StrCopy, edi, cDbgEventLoadDll

        lea     ecx, [.buffer]
        invoke  ReadProcessMemory, [dbgPInfo.hProcess], [dbgEvent.LoadDll.lpImageName], ecx, 4, NULL
        test    eax, eax
        jz      .finish

        mov     esi, [.buffer]
        test    esi, esi
        jz      .finish

        lea     ecx, [.buffer]
        invoke  ReadProcessMemory, [dbgPInfo.hProcess], esi, ecx, 512, NULL
        test    eax, eax
        jz      .finish

        push    edi

        lea     esi, [.buffer]
        lea     edi, [.name]
        xor     ecx, ecx
        cmp     [dbgEvent.LoadDll.fUnicode], 0
        jz      @f
        inc     ecx
@@:
        lodsb
        stosb
        add     esi, ecx
        test    al,al
        jnz     @b

        pop    edi

        lea     eax, [.name]
        stdcall StrCat, edi, eax

.finish:
        mov     eax, edi
        return
endp

proc DbgEventUnloadDll
begin
        stdcall StrNew
        stdcall StrCopy, eax, cDbgEventUnloadDll
        return
endp

proc DbgEventOutputString
begin
        stdcall StrNew
        stdcall StrCopy, eax, cDbgEventOutputString
        stdcall StrCat, eax, [dbgEvent.DebugString.lpDebugStringData]
        return
endp

proc DbgEventRIP
begin
        stdcall StrNew
        stdcall StrCopy, eax, cDbgEventRIP
        return
endp



;---------------------------------------------------------------------
; Goto address dialog form.
;---------------------------------------------------------------------
iglobal
  Window dlgGotoAddr, $3, $0, 'TForm', 'Goto address', $6C80000, $10001, 0, 373, 322, 159, 113, NULL
  Window NONE, $0, $0, 'Static', 'Input the address:', $50000000, $0, 0, 16, 8, 88, 13, NULL
  Window NONE, $0, $0, 'Edit', 'h', $50800080 or WS_TABSTOP, $0, 100, 16, 24, 121, 18, NULL
  Window NONE, $2, $0, 'Button', 'Go', $50000001 or WS_TABSTOP, $0, MR_OK, 40, 56, 64, 24, NULL
endg

;---------------------------------------------------------------------
; Goto address function action procedure.
;---------------------------------------------------------------------
proc OnGotoAddr, .wparam, .lparam
.pos AEPOS
.buff rb 256
begin
        stdcall CreateForm, dlgGotoAddr, [hApplication]

        stdcall ShowModal, ebx, MSF_CENTER
        cmp     eax, MR_OK
        jne     .finish

        lea     esi, [.buff]
        invoke  SendDlgItemMessage, ebx, 100, WM_GETTEXT, 256, esi

        invoke  DestroyWindow, ebx

        stdcall StrToFasmNum, esi
        stdcall FindAddressPosition, eax
        test    eax, eax
        jz      .notfound

        stdcall PosEditor, [eax+TDebugLine.ptrFile], [eax+TDebugLine.LineNum]

.finish:
        return

.notfound:
        invoke  MessageBox, [hApplication], cAddressNotFound, NULL, MB_OK or MB_ICONERROR
        return
endp

cAddressNotFound text 'Address not found. Check the value.'




proc OnShowListing, .wparam, .lparam
begin
        invoke  IsWindowVisible, [hLister]
        test    eax, eax
        jz      .show

        invoke  SendMessage, [hLister], WM_SETTEXT, 0, 0
        invoke  SendMessage, [hLister], LM_SHOW, FALSE, 0
        return

.show:
        cmp     [ptrListing], 0
        je      .exit

        invoke  SendMessage, [hLister], LM_SHOW, TRUE, 0

        invoke  SendMessage, [hLister], WM_SETTEXT, 0, 0
        mov     esi, [ptrListing]
        mov     edi, [esi+TMemoryStream.offset]
        add     edi, esi
        lea     esi, [esi+TMemoryStream.data]

        stdcall StrNew
        mov     ebx, eax

.loop:
        stdcall StrCat, ebx, esi
        stdcall StrCharCat, ebx, 10
        stdcall StrLen, esi
        lea     esi, [esi+eax+1]
        cmp     esi, edi
        jb      .loop

        stdcall StrPtr, ebx
        invoke  SendMessage, [hLister], WM_SETTEXT, 0, eax
        stdcall StrDel, ebx

        stdcall AlignChildren, [hEditorsHost]
;        invoke  RedrawWindow, [hLister], NULL, NULL, RDW_ERASE or RDW_INVALIDATE or RDW_ERASENOW or RDW_UPDATENOW
.exit:
        return
endp