paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-21 12:39:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: Linux, Use unit "SysCall" rather than "external name". Provide option to define FPDEBUG_USE_LIBC to force use of libc instead of DoSysCall (related to issue #40575)

Browse Source
This commit is contained in:
Martin 2024-01-11 17:07:58 +01:00
parent 8c268c4992
commit 9700c1459b
1 changed files with 32 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
components/fpdebug/fpdbglinuxextra.pas
View File

@ -7,11 +7,19 @@ interface
uses uses
Classes, Classes,
BaseUnix, BaseUnix,
{$ifdef linux} {$ifdef linux}{$ifNdef FPDEBUG_USE_LIBC}
SysCall, SysCall,
{$endif} {$endif}{$endif}
SysUtils; SysUtils;
{$ifdef darwin}
{$DEFINE FPDEBUG_USE_LIBC}
{$else}
{$IF not declared(Do_SysCall)}
{$IFDEF SUNOS} {$DEFINE FPDEBUG_USE_LIBC} {$ENDIF}
{$ENDIF}
{$endif}
const const
PTRACE_TRACEME = 0; PTRACE_TRACEME = 0;
PTRACE_PEEKTEXT = 1; PTRACE_PEEKTEXT = 1;
@ -56,24 +64,27 @@ function fpPTrace(ptrace_request: cint; pid: TPid; addr: Pointer; data: pointer)
implementation implementation
type {$ifdef FPDEBUG_USE_LIBC}
// all platforms, cint=32-bit. (* ** ptrace ** *)
// On platforms with off_t =64-bit, people should
// use int64, and typecast all calls that don't
// return off_t to cint.
{$ifdef cpux86_64}
TSysResult = int64;
TSysParam = int64;
{$else}
TSysResult = cint32;
TSysParam = cint32;
{$endif cpux86_64}
{$ifdef darwin}
Function ptrace(ptrace_request: cInt; pid: TPid; addr:pointer; data:pointer): cint; cdecl; external clib name 'ptrace'; Function ptrace(ptrace_request: cInt; pid: TPid; addr:pointer; data:pointer): cint; cdecl; external clib name 'ptrace';
{$endif darwin}
{$ifdef linux} function fpPTrace(ptrace_request: cint; pid: TPid; addr: Pointer; data: pointer): PtrInt; inline;
function Do_SysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; {$ifdef cpui386}register;{$endif} external name 'FPC_SYSCALL4'; begin
result := ptrace(ptrace_request, pid, addr, data);
end;
{$else} // FPDEBUG_USE_LIBC
{$IF not declared(Do_SysCall)}
(* ** ptrace not available ** *)
function fpPTrace(ptrace_request: cint; pid: TPid; addr: Pointer; data: pointer): PtrInt; inline;
begin
raise Exception.Create('not supported');
end;
{$else} // not declared(Do_SysCall)
(* ** Use Do_SysCall ** *)
const const
{$ifdef cpux86_64} {$ifdef cpux86_64}
@ -82,19 +93,11 @@ const
syscall_nr_ptrace = 26; syscall_nr_ptrace = 26;
{$endif} {$endif}
{$endif linux}
function fpPTrace(ptrace_request: cint; pid: TPid; addr: Pointer; data: pointer): PtrInt; function fpPTrace(ptrace_request: cint; pid: TPid; addr: Pointer; data: pointer): PtrInt;
{$ifdef linux}
var var
res : TSysResult; res : TSysResult;
ret : PtrInt; ret : PtrInt;
{$endif linux}
begin begin
{$ifdef darwin}
result := ptrace(ptrace_request, pid, addr, data);
{$endif}
{$ifdef linux}
if (ptrace_request > 0) and (ptrace_request < 4) then if (ptrace_request > 0) and (ptrace_request < 4) then
data := @ret; data := @ret;
@ -106,8 +109,10 @@ begin
end end
else else
result := res; result := res;
{$endif linux}
end; end;
{$endif} // declared(Do_SysCall)
{$endif FPDEBUG_USE_LIBC}
end. end.