* more alignment

git-svn-id: trunk@9157 -

debugger/windebug/fpwd/fpwdloop.pas

@@ -240,11 +240,36 @@ procedure DebugLoop;
     {$ifdef cpui386}
     with GCurrentContext^ do WriteLN(Format('DS: 0x%x, ES: 0x%x, FS: 0x%x, GS: 0x%x', [SegDs, SegEs, SegFs, SegGs]));
     with GCurrentContext^ do WriteLN(Format('EAX: 0x%x, EBX: 0x%x, ECX: 0x%x, EDX: 0x%x, EDI: 0x%x, ESI: 0x%x', [Eax, Ebx, Ecx, Edx, Edi, Esi]));
-    with GCurrentContext^ do WriteLN(Format('CS: 0x%x, SS: 0x%x, EBP: 0x%x, EIP: 0x%x, ESP: 0x%x, EFlags: 0x%x', [SegCs, SegSs, Ebp, Eip, Esp, EFlags]));
+    with GCurrentContext^ do Write(Format('CS: 0x%x, SS: 0x%x, EBP: 0x%x, EIP: 0x%x, ESP: 0x%x, EFlags: 0x%x [', [SegCs, SegSs, Ebp, Eip, Esp, EFlags]));
+    {$else}
+    with GCurrentContext^ do WriteLN(Format('SegDS: 0x%4.4x, SegES: 0x%4.4x, SegFS: 0x%4.4x, SegGS: 0x%4.4x', [SegDs, SegEs, SegFs, SegGs]));
+    with GCurrentContext^ do WriteLN(Format('RAX: 0x%16.16x, RBX: 0x%16.16x, RCX: 0x%16.16x, RDX: 0x%16.16x, RDI: 0x%16.16x, RSI: 0x%16.16x, R9: 0x%16.16x, R10: 0x%16.16x, R11: 0x%16.16x, R12: 0x%16.16x, R13: 0x%16.16x, R14: 0x%16.16x, R15: 0x%16.16x', [Rax, Rbx, Rcx, Rdx, Rdi, Rsi, R9, R10, R11, R12, R13, R14, R15]));
+    with GCurrentContext^ do Write(Format('SegCS: 0x%4.4x, SegSS: 0x%4.4x, RBP: 0x%16.16x, RIP: 0x%16.16x, RSP: 0x%16.16x, EFlags: 0x%8.8x [', [SegCs, SegSs, Rbp, Rip, Rsp, EFlags]));
+    {$endif}
+    // luckely flag and debug registers are named the same
     with GCurrentContext^ do
     begin
+      if EFlags and (1 shl 0) <> 0 then Write('CF ');
+      if EFlags and (1 shl 2) <> 0 then Write('PF ');
+      if EFlags and (1 shl 4) <> 0 then Write('AF ');
+      if EFlags and (1 shl 6) <> 0 then Write('ZF ');
+      if EFlags and (1 shl 7) <> 0 then Write('SF ');
+      if EFlags and (1 shl 8) <> 0 then Write('TF ');
+      if EFlags and (1 shl 9) <> 0 then Write('IF ');
+      if EFlags and (1 shl 10) <> 0 then Write('DF ');
+      if EFlags and (1 shl 11) <> 0 then Write('OF ');
+      if (EFlags shr 12) and 3 <> 0 then Write('IOPL=', (EFlags shr 12) and 3);
+      if EFlags and (1 shl 14) <> 0 then Write('NT ');
+      if EFlags and (1 shl 16) <> 0 then Write('RF ');
+      if EFlags and (1 shl 17) <> 0 then Write('VM ');
+      if EFlags and (1 shl 18) <> 0 then Write('AC ');
+      if EFlags and (1 shl 19) <> 0 then Write('VIF ');
+      if EFlags and (1 shl 20) <> 0 then Write('VIP ');
+      if EFlags and (1 shl 21) <> 0 then Write('ID ');
+      WriteLn(']');
+
       Write(Format('DR0: 0x%x, DR1: 0x%x, DR2: 0x%x, DR3: 0x%x', [Dr0, Dr1, Dr2, Dr3]));
-      Write(' DR6: 0x', IntToHex(Dr6, 8), ' [');
+      Write(' DR6: 0x', IntToHex(Dr6, SizeOf(Pointer) * 2), ' [');
       if Dr6 and $0001 <> 0 then Write('B0 ');
       if Dr6 and $0002 <> 0 then Write('B1 ');
       if Dr6 and $0004 <> 0 then Write('B2 ');
@@ -252,7 +277,7 @@ procedure DebugLoop;
       if Dr6 and $2000 <> 0 then Write('BD ');
       if Dr6 and $4000 <> 0 then Write('BS ');
       if Dr6 and $8000 <> 0 then Write('BT ');
-      Write('] DR7: 0x', IntToHex(Dr7, 8), ' [');
+      Write('] DR7: 0x', IntToHex(Dr7, SizeOf(Pointer) * 2), ' [');
       if Dr7 and $01 <> 0 then Write('L0 ');
       if Dr7 and $02 <> 0 then Write('G0 ');
       if Dr7 and $04 <> 0 then Write('L1 ');
@@ -280,11 +305,6 @@ procedure DebugLoop;
       end;
       WriteLN(']');
     end;
-    {$else}
-    with GCurrentContext^ do WriteLN(Format('SegDS: 0x%4.4x, SegES: 0x%4.4x, SegFS: 0x%4.4x, SegGS: 0x%4.4x', [SegDs, SegEs, SegFs, SegGs]));
-    with GCurrentContext^ do WriteLN(Format('RAX: 0x%16.16x, RBX: 0x%16.16x, RCX: 0x%16.16x, RDX: 0x%16.16x, RDI: 0x%16.16x, RSI: 0x%16.16x, R9: 0x%16.16x, R10: 0x%16.16x, R11: 0x%16.16x, R12: 0x%16.16x, R13: 0x%16.16x, R14: 0x%16.16x, R15: 0x%16.16x', [Rax, Rbx, Rcx, Rdx, Rdi, Rsi, R9, R10, R11, R12, R13, R14, R15]));
-    with GCurrentContext^ do WriteLN(Format('SegCS: 0x%4.4x, SegSS: 0x%4.4x, RBP: 0x%16.16x, RIP: 0x%16.16x, RSP: 0x%16.16x, EFlags: 0x%8.8x', [SegCs, SegSs, Rbp, Rip, Rsp, EFlags]));
-    {$endif}
     WriteLN('---');
   end;
 
@@ -316,8 +336,7 @@ begin
     then begin
       if GCurrentProcess.HandleDebugEvent(MDebugEvent) then Continue;
       if not GCurrentProcess.GetThread(MDebugEvent.dwTHreadID, GCurrentThread)
-      then WriteLN('LOOP: Unable to retrieve current thread')
+      then WriteLN('LOOP: Unable to retrieve current thread');
-      else WriteLN('LOOP: ID:', MDebugEvent.dwTHreadID, ' -> H:', GCurrentThread.Handle);
     end;
 
     FillChar(GCurrentContext^, SizeOf(GCurrentContext^), $EE);
@@ -325,17 +344,10 @@ begin
     if GCurrentThread <> nil
     then begin
       // TODO: move to TDbgThread
-      {$ifdef cpui386}
+      GCurrentContext^.ContextFlags := CONTEXT_SEGMENTS or CONTEXT_INTEGER or CONTEXT_CONTROL or CONTEXT_DEBUG_REGISTERS;
-      GCurrentContext^.ContextFlags := CONTEXT_SEGMENTS or CONTEXT_INTEGER or CONTEXT_CONTROL {or CONTEXT_DEBUG_REGISTERS};
-      {$else}
-      GCurrentContext^.ContextFlags := CONTEXT_SEGMENTS_AMD64 or CONTEXT_INTEGER_AMD64 or CONTEXT_CONTROL_AMD64;
-      {$endif}
       SetLastError(0);
-//      SuspendTHread(GCurrentThread.Handle);
       if not GetThreadContext(GCurrentThread.Handle, GCurrentContext^)
-      then WriteLN('LOOP: Unable to retrieve thread context')
+      then WriteLN('LOOP: Unable to retrieve thread context');
-      else WriteLN('LOOP context: ', IntToHex(GCurrentContext^.ContextFlags, SizeOf(Pointer) * 2), ' error: ', GetLastErrorText);
-//      ResumeThread(GCurrentThread.Handle);
     end;
 
     case MDebugEvent.dwDebugEventCode of

debugger/windebug/fpwd/fpwdtype.pas

@@ -90,6 +90,7 @@ type
   EXCEPTION_POINTERS64 = _EXCEPTION_POINTERS64;
 *)
 //  PExceptionDebugInfo64 = QWORD;
+(*
   PExceptionDebugInfo64 = ^_EXCEPTION_DEBUG_INFO64;
   _EXCEPTION_DEBUG_INFO64 = record
     ExceptionRecord: TExceptionRecord64;
@@ -97,6 +98,7 @@ type
   end;
   TExceptionDebugInfo64 = _EXCEPTION_DEBUG_INFO64;
   EXCEPTION_DEBUG_INFO64 = _EXCEPTION_DEBUG_INFO64;
+*)
 (*
   PCreateThreadDebugInfo64 = QWORD;
   _CREATE_THREAD_DEBUG_INFO64 = record
@@ -184,7 +186,10 @@ type
   TDebugEvent64 = _DEBUG_EVENT64;
   DEBUG_EVENT64 = _DEBUG_EVENT64;
 *)
+
+{$ifdef __dont_use__}
 const
+
   CONTEXT_AMD64 =  $100000;
 
 // MWE: added _AMD64 postfix to distinguish between i386 and amd64
@@ -416,6 +421,8 @@ type
   CONTEXTAMD64 = _CONTEXTAMD64;
   TContextAMD64 = _CONTEXTAMD64;
   PContextAMD64 = ^TContextAMD64;
+  
+{$endif}
 
 implementation
 

debugger/windebug/windebugger.pp

@@ -366,56 +366,67 @@ begin
 end;
 
 function TDbgProcess.HandleDebugEvent(const ADebugEvent: TDebugEvent): Boolean;
-var
+  function DoBreak: Boolean;
-  Context: TContext;
+  begin
+    if not FBreakMap.GetData(TDbgPtr(ADebugEvent.Exception.ExceptionRecord.ExceptionAddress), FSingleStepBreak) then Exit;
+    if FSingleStepBreak = nil then Exit;
+
+    Result := True;
+    if not FSingleStepBreak.Hit(ADebugEvent.dwThreadId)
+    then FSingleStepBreak := nil; // no need for a singlestep if we continue
+  end;
+
+  function DoSingleStep: Boolean;
+  var
+  _UC: record
+    C: TContext;
+    D: array[1..16] of Byte;
+  end;
+  Context: PContext;
+  begin
+    // check if we are interupting
+    Context := AlignPtr(@_UC, $10);
+    Context^.ContextFlags := CONTEXT_DEBUG_REGISTERS;
+    if GetThreadContext(FInfo.hThread, Context^)
+    then begin
+      if Context^.Dr6 and 1 <> 0
+      then begin
+        // interrupt !
+        // disable break.
+        Context^.Dr7 := Context^.Dr7 and not $1;
+        Context^.Dr0 := 0;
+        if not SetThreadContext(FInfo.hThread, Context^)
+        then begin
+          // Heeellppp!!
+          Log('Thread %u: Unable to reset BR0', [ADebugEvent.dwThreadId]);
+        end;
+        // check if we are also singlestepping
+        // if not, then exit, else proceed to next check
+        if Context^.Dr6 and $40 = 0
+        then Exit;
+      end;
+    end
+    else begin
+      // if we cant get the context, we probable weren't able to set it either
+      Log('Thread %u: Unable to get context', [ADebugEvent.dwThreadId]);
+    end;
+
+    // check if we are single stepping
+    if FSingleStepBreak = nil then Exit;
+
+    FSingleStepBreak.SetBreak;
+    FSingleStepBreak := nil;
+    Result := FSingleStepSet;
+    FSingleStepSet := False;
+  end;
+  
 begin
   Result := False;
   case ADebugEvent.dwDebugEventCode of
     EXCEPTION_DEBUG_EVENT: begin
       case ADebugEvent.Exception.ExceptionRecord.ExceptionCode of
-        EXCEPTION_BREAKPOINT: begin
+        EXCEPTION_BREAKPOINT:  Result := DoBreak;
-          if not FBreakMap.GetData(TDbgPtr(ADebugEvent.Exception.ExceptionRecord.ExceptionAddress), FSingleStepBreak) then Exit;
+        EXCEPTION_SINGLE_STEP: Result := DoSingleStep;
-          if FSingleStepBreak = nil then Exit;
-
-          Result := True;
-          if not FSingleStepBreak.Hit(ADebugEvent.dwThreadId)
-          then FSingleStepBreak := nil; // no need for a singlestep if we continue
-        end;
-        EXCEPTION_SINGLE_STEP: begin
-          // check if we are interupting
-          Context.ContextFlags := CONTEXT_DEBUG_REGISTERS;
-          if GetThreadContext(FInfo.hThread, Context)
-          then begin
-            if Context.Dr6 and 1 <> 0
-            then begin
-              // interrupt !
-              // disable break.
-              Context.Dr7 := Context.Dr7 and not $1;
-              Context.Dr0 := 0;
-              if not SetThreadContext(FInfo.hThread, Context)
-              then begin
-                // Heeellppp!!
-                Log('Thread %u: Unable to reset BR0', [ADebugEvent.dwThreadId]);
-              end;
-              // check if we are also singlestepping
-              // if not, then exit, else proceed to next check
-              if Context.Dr6 and $40 = 0
-              then Exit;
-            end;
-          end
-          else begin
-            // if we cant get the context, we probable weren't able to set it either
-            Log('Thread %u: Unable to get context', [ADebugEvent.dwThreadId]);
-          end;
-
-          // check if we are single stepping
-          if FSingleStepBreak = nil then Exit;
-
-          FSingleStepBreak.SetBreak;
-          FSingleStepBreak := nil;
-          Result := FSingleStepSet;
-          FSingleStepSet := False;
-        end;
       end;
     end;
     CREATE_THREAD_DEBUG_EVENT: begin
@@ -435,35 +446,38 @@ end;
 
 procedure TDbgProcess.Interrupt;
 var
-  Context: TContext;
+  _UC: record
+    C: TContext;
+    D: array[1..16] of Byte;
+  end;
+  Context: PContext;
   r: DWORD;
 begin
+  Context := AlignPtr(@_UC, $10);
   r := SuspendThread(FInfo.hThread);
   try
-    Context.ContextFlags := CONTEXT_CONTROL or CONTEXT_DEBUG_REGISTERS;
+    Context^.ContextFlags := CONTEXT_CONTROL or CONTEXT_DEBUG_REGISTERS;
-    if not GetThreadContext(FInfo.hThread, Context)
+    if not GetThreadContext(FInfo.hThread, Context^)
     then begin
-//        Log('Thread %u: Unable to get context', [FID]);
+      Log('Proces %u interrupt: Unable to get context', [FProcessID]);
       Exit;
     end;
 
-
+    Context^.ContextFlags := CONTEXT_DEBUG_REGISTERS;
-    Context.ContextFlags := CONTEXT_DEBUG_REGISTERS;
     {$ifdef cpui386}
-    Context.Dr0 := Context.Eip;
+    Context^.Dr0 := Context^.Eip;
-    Context.Dr7 := (Context.Dr7 and $FFF0FFFF) or $1;
     {$else}
-    Context.Dr0 := Context.Rip;
+    Context^.Dr0 := Context^.Rip;
-    Context.Dr7 := (Context.Dr7 and $FFFFFFFFFFF0FFFF) or $1;
     {$endif}
+    Context^.Dr7 := (Context^.Dr7 and $FFF0FFFF) or $1;
 
 //      Context.EFlags := Context.EFlags or $100;
 
 
 
-    if not SetThreadContext(FInfo.hThread, Context)
+    if not SetThreadContext(FInfo.hThread, Context^)
     then begin
-//        Log('Thread %u: Unable to set context', [FID]);
+      Log('Proces %u interrupt: Unable to set context', [FProcessID]);
       Exit;
     end;
   finally
@@ -573,19 +587,24 @@ end;
 
 function TDbgThread.SingleStep: Boolean;
 var
-  Context: TContext;
+  _UC: record
+    C: TContext;
+    D: array[1..16] of Byte;
+  end;
+  Context: PContext;
 begin
-  Context.ContextFlags := CONTEXT_CONTROL;
+  Context := AlignPtr(@_UC, $10);
-  if not GetThreadContext(FHandle, Context)
+  Context^.ContextFlags := CONTEXT_CONTROL;
+  if not GetThreadContext(FHandle, Context^)
   then begin
     Log('Thread %u: Unable to get context', [FID]);
     Exit;
   end;
 
-  Context.ContextFlags := CONTEXT_CONTROL;
+  Context^.ContextFlags := CONTEXT_CONTROL;
-  Context.EFlags := Context.EFlags or $100;
+  Context^.EFlags := Context^.EFlags or $100;
 
-  if not SetThreadContext(FHandle, Context)
+  if not SetThreadContext(FHandle, Context^)
   then begin
     Log('Thread %u: Unable to set context', [FID]);
     Exit;
@@ -633,7 +652,11 @@ end;
 function TDbgBreakpoint.Hit(const AThreadID: Integer): Boolean;
 var
   Thread: TDbgThread;
-  Context: TContext;
+  _UC: record
+    C: TContext;
+    D: array[1..16] of Byte;
+  end;
+  Context: PContext;
 begin
   Result := False;
   if FOrgValue = $CC then Exit; // breakpoint on a hardcoded breakpoint
@@ -641,22 +664,24 @@ begin
   ResetBreak;
 
   if not FProcess.GetThread(AThreadId, Thread) then Exit;
+  
+  Context := AlignPtr(@_UC, $10);
 
-  Context.ContextFlags := CONTEXT_CONTROL;
+  Context^.ContextFlags := CONTEXT_CONTROL;
-  if not GetThreadContext(Thread.Handle, Context)
+  if not GetThreadContext(Thread.Handle, Context^)
   then begin
     Log('Break $s: Unable to get context', [FormatAdress(FLocation)]);
     Exit;
   end;
 
-  Context.ContextFlags := CONTEXT_CONTROL;
+  Context^.ContextFlags := CONTEXT_CONTROL;
   {$ifdef cpui386}
-  Dec(Context.Eip);
+  Dec(Context^.Eip);
   {$else}
-  Dec(Context.Rip);
+  Dec(Context^.Rip);
   {$endif}
 
-  if not SetThreadContext(Thread.Handle, Context)
+  if not SetThreadContext(Thread.Handle, Context^)
   then begin
     Log('Break %s: Unable to set context', [FormatAdress(FLocation)]);
     Exit;

debugger/windebug/windextra.pp

@@ -43,6 +43,7 @@ uses
 function FormatAdress(const P): String;
 function GetLastErrorText(AErrorCode: Cardinal): String; {$IFNDEF FPC} overload; {$ENDIF}
 function GetLastErrorText: String; {$IFNDEF FPC} overload; {$ENDIF}
+function AlignPtr(Src: Pointer; Alignment: Byte): Pointer;
 
 
 //function OpenThread(dwDesiredAccess: DWORD; bInheritHandle: BOOL; dwThreadId: DWORD): THandle; stdcall;
@@ -100,5 +101,10 @@ begin
   then LocalFree(HLOCAL(Temp));
 end;
 
+function AlignPtr(Src: Pointer; Alignment: Byte): Pointer;
+begin
+  Result := Pointer(((PtrUInt(Src) + Alignment - 1) and not PtrUInt(Alignment - 1)));
+end;
+
 end.