Kaynağa Gözat

--- Merging r40843 into '.':
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 -

marco 6 yıl önce
ebeveyn
işleme
39a12910ef

+ 1 - 1
rtl/haiku/Makefile

@@ -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

+ 1 - 1
rtl/haiku/Makefile.fpc

@@ -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 - 0
rtl/haiku/si_c.pp

@@ -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 - 0
rtl/haiku/si_dllc.pp

@@ -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;

+ 8 - 1
rtl/haiku/system.pp

@@ -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 }

+ 44 - 77
rtl/inc/exeinfo.pp

@@ -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;