From 8da9f2d08403043dcc71674acdac1da54b33660a Mon Sep 17 00:00:00 2001
From: Martin <laz.git@mfriebe.de>
Date: Thu, 5 Oct 2023 16:16:59 +0200
Subject: [PATCH] FpDebug: fix for some missing stackframes

---
 components/fpdebug/fpdbgclasses.pp  |  93 ++++++++-
 components/fpdebug/fpdbgdisasx86.pp | 285 ++++++++++++++++++++++++++++
 components/fpdebug/fpdbgutil.pp     |  23 +++
 3 files changed, 398 insertions(+), 3 deletions(-)

diff --git a/components/fpdebug/fpdbgclasses.pp b/components/fpdebug/fpdbgclasses.pp
index d50cb4eede..508eaaa405 100644
--- a/components/fpdebug/fpdbgclasses.pp
+++ b/components/fpdebug/fpdbgclasses.pp
@@ -655,6 +655,8 @@ type
 
     function GetInstructionInfo(AnAddress: TDBGPtr): TDbgAsmInstruction; virtual; abstract;
     function GetFunctionFrameInfo(AnAddress: TDBGPtr; out AnIsOutsideFrame: Boolean): Boolean; virtual;
+    function IsAfterCallInstruction(AnAddress: TDBGPtr): boolean; virtual;
+    function UnwindFrame(var AnAddress, AStackPtr, AFramePtr: TDBGPtr; AQuick: boolean): boolean; virtual;
 
     property LastErrorWasMemReadErr: Boolean read GetLastErrorWasMemReadErr;
     property MaxInstructionSize: integer read GetMaxInstrSize;  // abstract
@@ -1875,6 +1877,17 @@ begin
   Result := False;
 end;
 
+function TDbgAsmDecoder.IsAfterCallInstruction(AnAddress: TDBGPtr): boolean;
+begin
+  Result := True; // if we don't know, then assume yes
+end;
+
+function TDbgAsmDecoder.UnwindFrame(var AnAddress, AStackPtr,
+  AFramePtr: TDBGPtr; AQuick: boolean): boolean;
+begin
+  Result := False;
+end;
+
 { TDbgInstance }
 
 
@@ -3299,6 +3312,7 @@ const
   MAX_FRAMES = 150000; // safety net
 var
   Address, FrameBase, LastFrameBase, Dummy: QWord;
+  PrevAddress, PrevFrameBase, PrevStackPtr: QWord;
   Size, CountNeeded, IP, BP, CodeReadErrCnt, SP, i,
     PrevStmtAddressOffs: integer;
   AnEntry, NewEntry: TDbgCallstackEntry;
@@ -3310,6 +3324,37 @@ var
   Row: TDwarfCallFrameInformationRow;
   CIE: TDwarfCIE;
   CU: TDwarfCompilationUnit;
+
+  procedure CheckFrame(var NextEntry: TDbgCallstackEntry; AForce: boolean = False);
+  begin
+    if (not AForce) and (NextEntry <> nil) and Process.Disassembler.IsAfterCallInstruction(Address) then
+      exit;
+
+    if not Process.Disassembler.UnwindFrame(PrevAddress, PrevStackPtr, PrevFrameBase, False) then
+      exit;
+
+    if (NextEntry <> nil) and
+       (Address = PrevAddress) and (FrameBase = PrevFrameBase) and (StackPtr = PrevStackPtr)
+    then
+      exit;
+    if not Process.Disassembler.IsAfterCallInstruction(PrevAddress) then
+      exit;
+
+    Address := PrevAddress;
+    FrameBase := PrevFrameBase;
+    StackPtr := PrevStackPtr;
+    NextEntry.Free;
+    NextEntry := TDbgCallstackEntry.create(Self, NextIdx, FrameBase, Address);
+    NextEntry.RegisterValueList.DbgRegisterAutoCreate[nIP].SetValue(Address, IntToStr(Address),Size, IP);
+    NextEntry.RegisterValueList.DbgRegisterAutoCreate[nBP].SetValue(FrameBase, IntToStr(FrameBase),Size, BP);
+    NextEntry.RegisterValueList.DbgRegisterAutoCreate[nSP].SetValue(StackPtr, IntToStr(StackPtr),Size, SP);
+    LastFrameBase := FrameBase;
+    {$PUSH}{$R-}{$Q-}
+    if LastFrameBase > 0 then
+      LastFrameBase := LastFrameBase - 1;
+    {$POP}
+  end;
+
 begin
   // TODO: use AFrameRequired // check if already partly done
   if FCallStackEntryList = nil then
@@ -3385,8 +3430,13 @@ begin
   CodeReadErrCnt := 0;
   while (CountNeeded > 0) do
   begin
+    PrevAddress := Address;
+    PrevFrameBase := FrameBase;
+    PrevStackPtr := StackPtr;
+    {$PUSH}{$R-}{$Q-}
     if (Process.DbgInfo as TFpDwarfInfo).FindCallFrameInfo(Address - PrevStmtAddressOffs, CIE, Row) and
        TDwarfCallFrameInformation.TryObtainNextCallFrame(AnEntry, CIE, Size, NextIdx, Self, Row, Process, NewEntry)
+    {$POP}
     then begin
       PrevStmtAddressOffs := 1;
       if not Assigned(NewEntry) then begin
@@ -3396,7 +3446,6 @@ begin
           Break;
       end
       else begin
-        FCallStackEntryList.Add(NewEntry);
         Address := NewEntry.AnAddress;
         StackReg := NewEntry.RegisterValueList.FindRegisterByDwarfIndex(SP);
         FrameReg := NewEntry.RegisterValueList.FindRegisterByDwarfIndex(BP);
@@ -3406,6 +3455,8 @@ begin
           FrameBase := FrameReg.FNumValue;
         end;
         AnEntry := NewEntry;
+        CheckFrame(NewEntry);
+        FCallStackEntryList.Add(NewEntry);
         Dec(CountNeeded);
         inc(NextIdx);
         If (NextIdx > MAX_FRAMES) then
@@ -3416,6 +3467,33 @@ begin
     end;
     PrevStmtAddressOffs := 1;
 
+    if Process.Disassembler.UnwindFrame(PrevAddress, PrevStackPtr, PrevFrameBase, True) and
+       Process.Disassembler.IsAfterCallInstruction(PrevAddress)
+    then begin
+      Address := PrevAddress;
+      FrameBase := PrevFrameBase;
+      StackPtr := PrevStackPtr;
+      AnEntry := TDbgCallstackEntry.create(Self, NextIdx, FrameBase, Address);
+      AnEntry.RegisterValueList.DbgRegisterAutoCreate[nIP].SetValue(Address, IntToStr(Address),Size, IP);
+      AnEntry.RegisterValueList.DbgRegisterAutoCreate[nBP].SetValue(FrameBase, IntToStr(FrameBase),Size, BP);
+      AnEntry.RegisterValueList.DbgRegisterAutoCreate[nSP].SetValue(StackPtr, IntToStr(StackPtr),Size, SP);
+      FCallStackEntryList.Add(AnEntry);
+      Dec(CountNeeded);
+      inc(NextIdx);
+      CodeReadErrCnt := 0;
+      If (NextIdx > MAX_FRAMES) then
+        break;
+      LastFrameBase := FrameBase;
+      {$PUSH}{$R-}{$Q-}
+      if LastFrameBase > 0 then
+        LastFrameBase := LastFrameBase - 1;
+      {$POP}
+      continue;
+    end;
+    Address := PrevAddress;
+    FrameBase := PrevFrameBase;
+    StackPtr := PrevStackPtr;
+
     if (FrameBase <> 0) and (FrameBase > LastFrameBase)
     then begin
       if StackPtr = 0 then
@@ -3446,7 +3524,8 @@ begin
         else begin
           {$PUSH}{$R-}{$Q-}
           StackPtr := StackPtr + 1 * Size; // After popping return-addr from "StackPtr"
-          LastFrameBase := LastFrameBase - 1; // Make the loop think thas LastFrameBase was smaller
+          if LastFrameBase > 0 then
+            LastFrameBase := LastFrameBase - 1; // Make the loop think thas LastFrameBase was smaller
           {$POP}
           // last stack has no frame
           //AnEntry.RegisterValueList.DbgRegisterAutoCreate[nBP].SetValue(0, '0',Size, BP);
@@ -3463,6 +3542,7 @@ begin
       AnEntry.RegisterValueList.DbgRegisterAutoCreate[nIP].SetValue(Address, IntToStr(Address),Size, IP);
       AnEntry.RegisterValueList.DbgRegisterAutoCreate[nBP].SetValue(FrameBase, IntToStr(FrameBase),Size, BP);
       AnEntry.RegisterValueList.DbgRegisterAutoCreate[nSP].SetValue(StackPtr, IntToStr(StackPtr),Size, SP);
+      CheckFrame(AnEntry, FrameBase < StackPtr);
       FCallStackEntryList.Add(AnEntry);
       Dec(CountNeeded);
       inc(NextIdx);
@@ -3471,7 +3551,14 @@ begin
         break;
     end
     else
-      Break;
+    begin
+      AnEntry := nil;
+      CheckFrame(AnEntry);
+      if AnEntry <> nil then
+        FCallStackEntryList.Add(AnEntry)
+      else
+        Break;
+    end;
   end;
   if CountNeeded > 0 then // there was an error / not possible to read more frames
     FCallStackEntryList.SetHasReadAllAvailableFrames;
diff --git a/components/fpdebug/fpdbgdisasx86.pp b/components/fpdebug/fpdbgdisasx86.pp
index a366746dc2..b8f79be0b8 100644
--- a/components/fpdebug/fpdbgdisasx86.pp
+++ b/components/fpdebug/fpdbgdisasx86.pp
@@ -568,6 +568,9 @@ type
 
     function GetFunctionFrameInfo(AnAddress: TDBGPtr; out
       AnIsOutsideFrame: Boolean): Boolean; override;
+    function IsAfterCallInstruction(AnAddress: TDBGPtr): boolean; override;
+    // Only Modify the values if result is true
+    function UnwindFrame(var AnAddress, AStackPtr, AFramePtr: TDBGPtr; AQuick: boolean): boolean; override;
   end;
 
 implementation
@@ -5172,6 +5175,288 @@ begin
   end;
 end;
 
+function TX86AsmDecoder.IsAfterCallInstruction(AnAddress: TDBGPtr): boolean;
+const
+  MAX_RET_LEN = 10;
+var
+  BytesRead: Cardinal;
+  i: Integer;
+  instr: TDbgAsmInstruction;
+begin
+  BytesRead := MAX_RET_LEN;
+  Result := (AnAddress > MAX_RET_LEN) and ReadCodeAt(AnAddress - MAX_RET_LEN, BytesRead) and
+     (BytesRead = MAX_RET_LEN);
+  if not Result then begin
+    BytesRead := 5;
+    Result := (AnAddress > MAX_RET_LEN) and ReadCodeAt(AnAddress - MAX_RET_LEN, BytesRead) and
+       (BytesRead = MAX_RET_LEN);
+  end;
+  if not Result then
+    exit;
+
+  // can be a false positive
+  Result := (FCodeBin[MAX_RET_LEN-3] in [$9A, $E8]) or (FCodeBin[MAX_RET_LEN-5] in [$9A, $E8]);
+  if Result then
+    exit;
+
+  for i := 2 to 6 do
+    if (FCodeBin[MAX_RET_LEN - i] = $FF) and
+       (FCodeBin[MAX_RET_LEN + 1 - i] and $38 in [$10, $18])
+    then begin
+      instr := GetInstructionInfo(AnAddress - i);
+      Result := instr.IsCallInstruction;
+      exit;
+    end;
+  if (FCodeBin[MAX_RET_LEN-10] = $FF) and
+     (FCodeBin[MAX_RET_LEN + 1 - 10] and $38 in [$10, $18])
+  then begin
+    instr := GetInstructionInfo(AnAddress-10);
+    Result := instr.IsCallInstruction;
+    exit;
+  end;
+end;
+
+function TX86AsmDecoder.UnwindFrame(var AnAddress, AStackPtr,
+  AFramePtr: TDBGPtr; AQuick: boolean): boolean;
+
+  function IsRegister(Val, Reg: String): boolean;
+  begin
+    Result := (Length(val) >= 2) and (val[1] in ['r', 'e']) and (strlcomp(@Val[2], PChar(Reg), Length(Reg)) = 0);
+  end;
+  function RegisterSize(Reg: String): Cardinal;
+  begin
+    Result := 4;
+    if (Reg <> '') and (Reg[1] = 'r') then
+      Result := 8;
+  end;
+
+const
+  MAX_SEARCH_ADDR = 1000;
+  MAX_SEARCH_CNT = 80;
+var
+  NewAddr, NewStack, NewFrame, MaxAddr, StartStack: TDBGPtr;
+  Cnt: Integer;
+  instr: TX86AsmInstruction;
+  RSize: Cardinal;
+  Val: Int64;
+  CurAddr: PByte;
+begin
+  Result := False;
+  NewAddr := AnAddress;
+  NewStack := AStackPtr;
+  StartStack := AStackPtr;
+  NewFrame := AFramePtr;
+
+  {$PUSH}{$R-}{$Q-}
+  MaxAddr := AnAddress + MAX_SEARCH_ADDR;
+  {$POP}
+  Cnt := MAX_SEARCH_CNT;
+  if AQuick then Cnt := 10;
+
+  while (NewAddr < MaxAddr) and (Cnt > 0) do begin
+    dec(Cnt);
+    instr := TX86AsmInstruction(GetInstructionInfo(NewAddr));
+    if instr.InstructionLength <= 0 then
+      exit;
+    NewAddr := NewAddr + instr.InstructionLength;
+    CurAddr := @instr.FCodeBin[0];
+
+    case instr.X86OpCode of
+      OPret:
+        begin
+          if instr.X86Instruction.OperCnt > 1 then
+            exit;
+
+          Val := 0;
+          if instr.X86Instruction.OperCnt = 1 then
+            Val := ValueFromMem(CurAddr[Instr.X86Instruction.Operand[1].CodeIndex], Instr.X86Instruction.Operand[1].ByteCount, Instr.X86Instruction.Operand[1].FormatFlags);
+          NewAddr := 0;
+          if FProcess.Mode = dm32 then begin
+            if not FProcess.ReadData(NewStack, 4, NewAddr, RSize) then
+              exit;
+            inc(NewStack, 4 + Val);
+          end
+          else begin
+            if not FProcess.ReadData(NewStack, 8, NewAddr, RSize) then
+              exit;
+            inc(NewStack, 8 + Val);
+          end;
+          Result := True;
+          AnAddress := NewAddr;
+          AStackPtr := NewStack;
+          AFramePtr := NewFrame;
+          exit;
+        end;
+      OPpush:
+        begin
+          if AQuick then
+            exit;
+          if (instr.X86Instruction.OperCnt <> 1) or
+             IsRegister(instr.X86Instruction.Operand[1].Value, 'bp') or
+             IsRegister(instr.X86Instruction.Operand[1].Value, 'sp')
+          then begin
+            exit; // false
+          end;
+          {$PUSH}{$R-}{$Q-}
+          NewStack := NewStack - RegisterSize(instr.X86Instruction.Operand[1].Value);
+          {$POP}
+        end;
+      OPpusha, OPpushf:
+        exit; // false
+      OPpopa, OPpopad:
+        exit; // false
+      OPpop:
+        begin
+          if instr.X86Instruction.OperCnt <> 1 then
+            exit;
+          if not(instr.X86Instruction.Operand[1].Value[1] in ['e', 'r'])
+          then
+            exit; // false
+          if IsRegister(instr.X86Instruction.Operand[1].Value, 'bp')
+          then begin
+            if NewStack < StartStack then
+              exit;
+            NewFrame := 0;
+            RSize := RegisterSize(instr.X86Instruction.Operand[1].Value);
+            if not FProcess.ReadData(NewStack, RSize, NewFrame, RSize) then
+              exit;
+          end;
+          {$PUSH}{$R-}{$Q-}
+          NewStack := NewStack + RegisterSize(instr.X86Instruction.Operand[1].Value);
+          {$POP}
+        end;
+      OPleave:
+        begin
+          NewStack := NewFrame;
+          NewFrame := 0;
+          if FProcess.Mode = dm32 then begin
+            if not FProcess.ReadData(NewStack, 4, NewFrame, RSize) then
+              exit;
+            inc(NewStack, 4);
+          end
+          else begin
+            if not FProcess.ReadData(NewStack, 8, NewFrame, RSize) then
+              exit;
+            inc(NewStack, 8);
+          end;
+        end;
+      OPmov:
+        begin
+          if instr.X86Instruction.OperCnt <> 2 then
+            exit;
+
+          if IsRegister(instr.X86Instruction.Operand[1].Value, 'sp')
+          then begin
+            if (not IsRegister(instr.X86Instruction.Operand[2].Value, 'bp')) or
+               (Instr.X86Instruction.Operand[2].ByteCount <> 0) or
+               (Instr.X86Instruction.Operand[2].ByteCount2 <> 0) or
+               (ofMemory in Instr.X86Instruction.Operand[2].Flags)
+            then
+              exit;
+            NewStack := NewFrame;
+          end;
+        end;
+      OPlea:
+        begin
+          if instr.X86Instruction.OperCnt <> 2 then
+            exit;
+          if IsRegister(instr.X86Instruction.Operand[1].Value, 'bp')
+          then begin
+            if (not IsRegister(instr.X86Instruction.Operand[2].Value, 'bp%s')) or
+               (Instr.X86Instruction.Operand[2].ByteCount = 0) or
+               (Instr.X86Instruction.Operand[2].ByteCount2 <> 0) or
+               not(ofMemory in Instr.X86Instruction.Operand[2].Flags)
+            then
+              exit;
+
+            Val := ValueFromMem(CurAddr[Instr.X86Instruction.Operand[2].CodeIndex], Instr.X86Instruction.Operand[2].ByteCount, Instr.X86Instruction.Operand[2].FormatFlags);
+            {$PUSH}{$R-}{$Q-}
+            NewFrame := NewFrame + Val;
+            {$POP}
+          end;
+          if IsRegister(instr.X86Instruction.Operand[1].Value, 'sp')
+          then begin
+            if (Instr.X86Instruction.Operand[2].ByteCount = 0) or
+               (Instr.X86Instruction.Operand[2].ByteCount2 <> 0) or
+               not(ofMemory in Instr.X86Instruction.Operand[2].Flags)
+            then
+              exit;
+
+            if (IsRegister(instr.X86Instruction.Operand[2].Value, 'sp%s')) then begin
+              Val := ValueFromMem(CurAddr[Instr.X86Instruction.Operand[2].CodeIndex], Instr.X86Instruction.Operand[2].ByteCount, Instr.X86Instruction.Operand[2].FormatFlags);
+              {$PUSH}{$R-}{$Q-}
+              NewStack := NewStack + Val;
+              {$POP}
+            end
+            else
+            if (IsRegister(instr.X86Instruction.Operand[2].Value, 'bp%s')) then begin
+              Val := ValueFromMem(CurAddr[Instr.X86Instruction.Operand[2].CodeIndex], Instr.X86Instruction.Operand[2].ByteCount, Instr.X86Instruction.Operand[2].FormatFlags);
+              {$PUSH}{$R-}{$Q-}
+              NewStack := NewFrame + Val;
+              {$POP}
+            end
+            else
+              exit;
+          end;
+        end;
+      OPadd:
+        begin
+          if instr.X86Instruction.OperCnt <> 2 then
+            exit;
+          if IsRegister(instr.X86Instruction.Operand[1].Value, 'sp')
+          then begin
+            if (instr.X86Instruction.Operand[2].Value <> '%s') or
+               (Instr.X86Instruction.Operand[2].ByteCount = 0) or
+               (Instr.X86Instruction.Operand[2].ByteCount2 <> 0) or
+               (ofMemory in Instr.X86Instruction.Operand[2].Flags)
+            then
+              exit;
+
+            Val := ValueFromMem(CurAddr[Instr.X86Instruction.Operand[2].CodeIndex], Instr.X86Instruction.Operand[2].ByteCount, Instr.X86Instruction.Operand[2].FormatFlags);
+            {$PUSH}{$R-}{$Q-}
+            NewStack := NewStack + Val;
+            {$POP}
+          end;
+        end;
+      OPjmp:
+        begin
+          if AQuick then
+            exit;
+          if instr.X86Instruction.OperCnt <> 1 then
+            exit;
+          if (instr.X86Instruction.Operand[1].Value <> '%s') then
+            exit; // false
+          if (Instr.X86Instruction.Operand[1].ByteCount = 0) or
+             (Instr.X86Instruction.Operand[1].ByteCount > 2) or
+             (Instr.X86Instruction.Operand[1].ByteCount2 <> 0)
+          then
+            exit;
+
+          Val := ValueFromMem(CurAddr[Instr.X86Instruction.Operand[1].CodeIndex], Instr.X86Instruction.Operand[1].ByteCount, Instr.X86Instruction.Operand[1].FormatFlags);
+          if Val <= 0 then
+            exit;
+
+          {$PUSH}{$R-}{$Q-}
+          NewAddr := NewAddr + Val
+          {$POP}
+        end;
+      OPjmpe, OPint, OPint1, OPint3:
+        exit; // false
+      else
+        begin
+          if (instr.X86Instruction.OperCnt >= 1) and
+             (not(ofMemory in Instr.X86Instruction.Operand[1].Flags)) and
+             ( IsRegister(instr.X86Instruction.Operand[1].Value, 'bp') or
+               IsRegister(instr.X86Instruction.Operand[1].Value, 'sp')
+             )
+          then begin
+            exit; // false
+          end;
+        end;
+    end;
+  end;
+end;
+
 
 initialization
   DBG_WARNINGS := DebugLogger.FindOrRegisterLogGroup('DBG_WARNINGS' {$IFDEF DBG_WARNINGS} , True {$ENDIF} );
diff --git a/components/fpdebug/fpdbgutil.pp b/components/fpdebug/fpdbgutil.pp
index 9654737cbe..59e1b90ebf 100644
--- a/components/fpdebug/fpdbgutil.pp
+++ b/components/fpdebug/fpdbgutil.pp
@@ -206,6 +206,7 @@ function QuickUtf8UpperCase(const AText: String): String;
 function QuickUtf8LowerCase(const AText: String): String;
 
 function AlignPtr(Src: Pointer; Alignment: Byte): Pointer;
+function ValueFromMem(const AValue; ASize: Byte; AFlags: THexValueFormatFlags): Int64;
 function HexValue(const AValue; ASize: Byte; AFlags: THexValueFormatFlags): String;
 function FormatAddress(const AAddress): String;
 
@@ -436,6 +437,28 @@ begin
   Result := HexValue(AAddress, DBGPTRSIZE[GMode], [hvfIncludeHexchar]);
 end;
 
+function ValueFromMem(const AValue; ASize: Byte; AFlags: THexValueFormatFlags
+  ): Int64;
+var
+  p: PByte;
+begin
+  Result := 0;
+  if ASize > 8 then
+    Exit;
+  if ASize = 0 then
+    Exit;
+
+  p := @AValue;
+  if p[ASize - 1] < $80
+  then Exclude(AFlags, hvfSigned);
+
+  if hvfSigned in AFlags
+  then Result := -1
+  else Result := 0;
+
+  Move(AValue, Result, ASize);
+end;
+
 function HexValue(const AValue; ASize: Byte; AFlags: THexValueFormatFlags): String;
 var
   i: Int64;