paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-10 02:28:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

--- Merging r40843 into '.':

Browse Source 
U    rtl/haiku/si_c.pp
U    rtl/haiku/si_dllc.pp
U    rtl/haiku/system.pp
--- Recording mergeinfo for merge of r40843 into '.':
 U   .
--- Merging r40844 into '.':
G    rtl/haiku/system.pp
--- Recording mergeinfo for merge of r40844 into '.':
 G   .
--- Merging r40845 into '.':
U    rtl/inc/exeinfo.pp
--- Recording mergeinfo for merge of r40845 into '.':
 G   .
--- Merging r42083 into '.':
U    rtl/haiku/Makefile
U    rtl/haiku/Makefile.fpc
--- Recording mergeinfo for merge of r42083 into '.':
 G   .

# revisions: 40843,40844,40845,42083

git-svn-id: branches/fixes_3_2@42117 -
This commit is contained in:
marco 2019-05-24 12:30:15 +00:00
parent d5027fceeb
commit 39a12910ef
6 changed files with 58 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
rtl/haiku/Makefile
View File

@ -3427,7 +3427,7 @@ strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
$(SYSTEMUNIT)$(PPUEXT)
unixtype$(PPUEXT) : $(UNIXINC)/unixtype.pp ptypes.inc $(UNIXINC)/ctypes.inc $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) $(UNIXINC)/unixtype.pp
baseunix$(PPUEXT) : $(UNIXINC)/unixtype.pp $(SYSTEMUNIT)$(PPUEXT)
baseunix$(PPUEXT) : baseunix.pp $(UNIXINC)/unixtype.pp $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) -Fi$(UNIXINC) -Fu$(UNIXINC) baseunix.pp
syscall$(PPUEXT) : $(UNIXINC)/syscall.pp $(SYSNRINC) $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) $(UNIXINC)/syscall.pp

2
rtl/haiku/Makefile.fpc
View File

@ -137,7 +137,7 @@ strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
unixtype$(PPUEXT) : $(UNIXINC)/unixtype.pp ptypes.inc $(UNIXINC)/ctypes.inc $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) $(UNIXINC)/unixtype.pp
baseunix$(PPUEXT) : $(UNIXINC)/unixtype.pp $(SYSTEMUNIT)$(PPUEXT)
baseunix$(PPUEXT) : baseunix.pp unixtype$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) -Fi$(UNIXINC) -Fu$(UNIXINC) baseunix.pp
syscall$(PPUEXT) : $(UNIXINC)/syscall.pp $(SYSNRINC) $(SYSTEMUNIT)$(PPUEXT)

2
rtl/haiku/si_c.pp
View File

@ -21,6 +21,7 @@ implementation
{ Bindings to RTL }
var
initialstkptr: pointer; public name '__stkptr';
argc: longint; public name 'operatingsystem_parameter_argc';
argv: pointer; public name 'operatingsystem_parameter_argv';
envp: pointer; public name 'operatingsystem_parameter_envp';
@ -43,6 +44,7 @@ procedure __exit(status: longint); cdecl; external libc name 'exit';
function _FPC_proc_start(_argc: longint; _argv: pointer; _envp: pointer): longint; cdecl; public name '_start';
begin
initialstkptr:=get_frame;
argc:=_argc;
argv:=_argv;
envp:=_envp;

2
rtl/haiku/si_dllc.pp
View File

@ -22,6 +22,7 @@ implementation
{ Bindings to RTL }
var
initialstkptr: pointer; public name '__stkptr';
argc: longint; public name 'operatingsystem_parameter_argc';
argv: pointer; public name 'operatingsystem_parameter_argv';
envp: pointer; public name 'operatingsystem_parameter_envp';
@ -42,6 +43,7 @@ procedure __exit(status: longint); cdecl; external libc name 'exit';
procedure _FPC_shared_lib_start; cdecl; public name 'initialize_after';
begin
initialstkptr:=get_frame;
argc:=__libc_argc;
argv:=__libc_argv;
envp:=environ;

9
rtl/haiku/system.pp
View File

@ -24,6 +24,9 @@ interface
implementation
var
initialstkptr : Pointer; external name '__stkptr';
procedure debugger(s : PChar); cdecl; external 'root' name 'debugger';
function disable_debugger(state : integer): integer; cdecl; external 'root' name 'disable_debugger';
@ -228,7 +231,7 @@ begin
{ initialize handler }
act.sa_mask[0] := 0;
act.sa_handler := SigActionHandler(@SignalToRunError);
act.sa_flags := SA_ONSTACK;
act.sa_flags := SA_ONSTACK or SA_SIGINFO;
FpSigAction(signum,@act,@oldact);
end;
@ -272,7 +275,11 @@ end;
begin
IsConsole := TRUE;
StackLength := CheckInitialStkLen(InitialStkLen);
{$if FPC_FULLVERSION >= 30301}
StackBottom := initialstkptr - StackLength;
{$else}
StackBottom := Sptr - StackLength;
{$endif}
ReturnNilIfGrowHeapFails := False;
{ Set up signals handlers }

121
rtl/inc/exeinfo.pp
View File

@ -67,7 +67,7 @@ implementation
uses
strings{$ifdef windows},windows{$endif windows};
{$if defined(unix)}
{$if defined(unix) and not defined(beos) and not defined(haiku)}
procedure GetModuleByAddr(addr: pointer; var baseaddr: pointer; var filename: string);
begin
@ -129,6 +129,37 @@ uses
filename:=ParamStr(0);
end;
{$elseif defined(beos) or defined(haiku)}
{$i ptypes.inc}
{$i ostypes.inc}
function get_next_image_info(team: team_id; var cookie:longint; var info:image_info; size: size_t) : status_t;cdecl; external 'root' name '_get_next_image_info';
procedure GetModuleByAddr(addr: pointer; var baseaddr: pointer; var filename: string);
const
B_OK = 0;
var
cookie : longint;
info : image_info;
begin
filename:='';
baseaddr:=nil;
cookie:=0;
fillchar(info, sizeof(image_info), 0);
while get_next_image_info(0,cookie,info,sizeof(info))=B_OK do
begin
if (info._type = B_APP_IMAGE) and
(addr >= info.text) and (addr <= (info.text + info.text_size)) then
begin
baseaddr:=info.text;
filename:=PChar(@info.name);
end;
end;
end;
{$else}
{$ifdef CPUI8086}
@ -161,6 +192,14 @@ uses
{$endif}
{$endif}
{$if defined(beos) or defined(haiku)}
{$ifdef cpu64}
{$define ELF64}
{$else}
{$define ELF32}
{$endif}
{$endif}
{$if defined(morphos)}
{$define ELF32}
{$endif}
@ -746,7 +785,7 @@ end;
ELF
****************************************************************************}
{$if defined(ELF32) or defined(BEOS)}
{$if defined(ELF32)}
type
telfheader=packed record
magic0123 : longint;
@ -790,7 +829,7 @@ type
p_flags : longword;
p_align : longword;
end;
{$endif ELF32 or BEOS}
{$endif ELF32}
{$ifdef ELF64}
type
telfheader=packed record
@ -840,7 +879,7 @@ type
{$endif ELF64}
{$if defined(ELF32) or defined(ELF64) or defined(BEOS)}
{$if defined(ELF32) or defined(ELF64)}
{$ifdef FIND_BASEADDR_ELF}
var
@ -1044,75 +1083,7 @@ begin
end;
end;
end;
{$endif ELF32 or ELF64 or BEOS}
{$ifdef beos}
{$i ptypes.inc}
type
// Descriptive formats
status_t = Longint;
team_id = Longint;
image_id = Longint;
{ image types }
const
B_APP_IMAGE = 1;
B_LIBRARY_IMAGE = 2;
B_ADD_ON_IMAGE = 3;
B_SYSTEM_IMAGE = 4;
B_OK = 0;
type
image_info = packed record
id : image_id;
_type : longint;
sequence: longint;
init_order: longint;
init_routine: pointer;
term_routine: pointer;
device: dev_t;
node: ino_t;
name: array[0..MAXPATHLEN-1] of char;
{ name: string[255];
name2: string[255];
name3: string[255];
name4: string[255];
name5: string[5];
}
text: pointer;
data: pointer;
text_size: longint;
data_size: longint;
end;
function get_next_image_info(team: team_id; var cookie:longint; var info:image_info; size: size_t) : status_t;cdecl; external 'root' name '_get_next_image_info';
function OpenElf32Beos(var e:TExeFile):boolean;
var
cookie : longint;
info : image_info;
begin
// The only BeOS specific part is setting the processaddress
cookie := 0;
OpenElf32Beos:=false;
fillchar(info, sizeof(image_info), 0);
while get_next_image_info(0,cookie,info,sizeof(info))=B_OK do
begin
if e.filename=String(pchar(@info.name)) then
begin
if (info._type = B_APP_IMAGE) then
e.processaddress := cardinal(info.text)
else
e.processaddress := 0;
OpenElf32Beos := OpenElf(e);
exit;
end;
end;
end;
{$endif beos}
{$endif ELF32 or ELF64}
{****************************************************************************
@ -1281,10 +1252,6 @@ const
openproc : @OpenElf;
findproc : @FindSectionElf;
{$endif ELF32 or ELF64}
{$ifdef BEOS}
openproc : @OpenElf32Beos;
findproc : @FindSectionElf;
{$endif BEOS}
{$ifdef darwin}
openproc : @OpenMachO32PPC;
findproc : @FindSectionMachO32PPC;