Browse Source

+ implement pascal inline asm start/halt code for linux/i386

git-svn-id: trunk@5181 -
micha 19 years ago
parent
commit
ad7d549965

+ 3 - 0
compiler/fpcdefs.inc

@@ -45,6 +45,9 @@
   {$define SUPPORT_MMX}
   {$define SUPPORT_MMX}
   {$define cpumm}
   {$define cpumm}
   {$define fewintregisters}
   {$define fewintregisters}
+  {$ifdef linux}
+    {$define has_internal_sysinit}
+  {$endif}
 {$endif i386}
 {$endif i386}
 
 
 {$ifdef x86_64}
 {$ifdef x86_64}

+ 6 - 0
compiler/link.pas

@@ -47,6 +47,7 @@ interface
       public
       public
          HasResources,
          HasResources,
          HasExports      : boolean;
          HasExports      : boolean;
+         SysInitUnit     : string[20];
          ObjectFiles,
          ObjectFiles,
          SharedLibFiles,
          SharedLibFiles,
          StaticLibFiles  : TStringList;
          StaticLibFiles  : TStringList;
@@ -59,6 +60,7 @@ interface
          Procedure AddStaticCLibrary(const S : String);
          Procedure AddStaticCLibrary(const S : String);
          Procedure AddSharedCLibrary(S : String);
          Procedure AddSharedCLibrary(S : String);
          procedure AddImportSymbol(const libname,symname:string;OrdNr: longint;isvar:boolean);virtual;
          procedure AddImportSymbol(const libname,symname:string;OrdNr: longint;isvar:boolean);virtual;
+         Procedure InitSysInitUnitName;virtual;
          Function  MakeExecutable:boolean;virtual;
          Function  MakeExecutable:boolean;virtual;
          Function  MakeSharedLibrary:boolean;virtual;
          Function  MakeSharedLibrary:boolean;virtual;
          Function  MakeStaticLibrary:boolean;virtual;
          Function  MakeStaticLibrary:boolean;virtual;
@@ -472,6 +474,10 @@ Implementation
       end;
       end;
 
 
 
 
+    procedure TLinker.InitSysInitUnitName;
+      begin
+      end;
+
     function TLinker.MakeExecutable:boolean;
     function TLinker.MakeExecutable:boolean;
       begin
       begin
         MakeExecutable:=false;
         MakeExecutable:=false;

+ 7 - 0
compiler/pmodules.pas

@@ -1395,6 +1395,13 @@ implementation
          { do we need to add the variants unit? }
          { do we need to add the variants unit? }
          maybeloadvariantsunit;
          maybeloadvariantsunit;
 
 
+{$ifdef has_internal_sysinit}
+         linker.initsysinitunitname;
+
+         { add start/halt unit }
+         AddUnit('si_'+linker.sysinitunit);
+{$endif}         
+
 {$ifdef arm}
 {$ifdef arm}
          { Insert .pdata section for arm-wince.
          { Insert .pdata section for arm-wince.
            It is needed for exception handling. }
            It is needed for exception handling. }

+ 21 - 0
compiler/script.pas

@@ -87,8 +87,11 @@ type
   end;
   end;
 
 
   TLinkRes = Class (TScript)
   TLinkRes = Class (TScript)
+    section: string[30];
     procedure Add(const s:string);
     procedure Add(const s:string);
     procedure AddFileName(const s:string);
     procedure AddFileName(const s:string);
+    procedure EndSection(const s:string);
+    procedure StartSection(const s:string);
   end;
   end;
 
 
 var
 var
@@ -495,6 +498,11 @@ end;
 
 
 procedure TLinkRes.AddFileName(const s:string);
 procedure TLinkRes.AddFileName(const s:string);
 begin
 begin
+  if section<>'' then
+   begin
+    inherited Add(section);
+    section:='';
+   end;
   if s<>'' then
   if s<>'' then
    begin
    begin
      if not(s[1] in ['a'..'z','A'..'Z','/','\','.','"']) then
      if not(s[1] in ['a'..'z','A'..'Z','/','\','.','"']) then
@@ -509,4 +517,17 @@ begin
    end;
    end;
 end;
 end;
 
 
+procedure TLinkRes.EndSection(const s:string);
+begin
+  { only terminate if we started the section }
+  if section='' then
+    inherited Add(s);
+  section:='';
+end;
+
+procedure TLinkRes.StartSection(const s:string);
+begin
+  section:=s;
+end;
+
 end.
 end.

+ 77 - 5
compiler/systems/t_linux.pas

@@ -45,10 +45,17 @@ interface
     tlinkerlinux=class(texternallinker)
     tlinkerlinux=class(texternallinker)
     private
     private
       libctype:(libc5,glibc2,glibc21,uclibc);
       libctype:(libc5,glibc2,glibc21,uclibc);
+{$ifdef has_internal_sysinit}      
+      reorder : boolean;
+      linklibc: boolean;
+{$endif}      
       Function  WriteResponseFile(isdll:boolean) : Boolean;
       Function  WriteResponseFile(isdll:boolean) : Boolean;
     public
     public
       constructor Create;override;
       constructor Create;override;
       procedure SetDefaultInfo;override;
       procedure SetDefaultInfo;override;
+{$ifdef has_internal_sysinit}      
+      procedure InitSysInitUnitName;override;
+{$endif}      
       function  MakeExecutable:boolean;override;
       function  MakeExecutable:boolean;override;
       function  MakeSharedLibrary:boolean;override;
       function  MakeSharedLibrary:boolean;override;
       function  postprocessexecutable(const fn : string;isdll:boolean):boolean;
       function  postprocessexecutable(const fn : string;isdll:boolean):boolean;
@@ -307,22 +314,80 @@ Begin
          end;
          end;
 End;
 End;
 
 
+{$ifdef has_internal_sysinit}      
+
+Procedure TLinkerLinux.InitSysInitUnitName;
+var
+  csysinitunit,
+  gsysinitunit : string[20];
+  hp           : tmodule;
+begin
+  hp:=tmodule(loaded_units.first);
+  while assigned(hp) do
+   begin
+     linklibc := hp.linkunitsharedlibs.find('c');
+     if linklibc then break;
+     hp:=tmodule(hp.next);
+   end;
+  reorder := linklibc and ReOrderEntries;
+  if islibrary then
+   begin
+     sysinitunit:='dll';
+     csysinitunit:='dll';
+     gsysinitunit:='dll';
+   end
+  else
+   begin
+     sysinitunit:='prc';
+     case libctype of
+       glibc21:
+         begin
+           csysinitunit:='c21';
+           gsysinitunit:='c21g';
+         end;
+       uclibc:
+         begin
+           csysinitunit:='uc';
+           gsysinitunit:='ucg';
+         end
+       else
+         csysinitunit:='c';
+         gsysinitunit:='g';
+     end;
+   end;
+  if cs_profile in current_settings.moduleswitches then
+   begin
+     sysinitunit:=gsysinitunit;
+     linklibc:=true;
+   end
+  else
+   begin
+     if linklibc then
+      sysinitunit:=csysinitunit;
+   end;
+end;
+
+{$endif}
+
 Function TLinkerLinux.WriteResponseFile(isdll:boolean) : Boolean;
 Function TLinkerLinux.WriteResponseFile(isdll:boolean) : Boolean;
 Var
 Var
   linkres      : TLinkRes;
   linkres      : TLinkRes;
   i            : longint;
   i            : longint;
+{$ifndef has_internal_sysinit}  
   cprtobj,
   cprtobj,
   gprtobj,
   gprtobj,
   prtobj       : string[80];
   prtobj       : string[80];
+  reorder,
+  linklibc     : boolean;
+{$endif}
   HPath        : TStringListItem;
   HPath        : TStringListItem;
   s,s1,s2      : string;
   s,s1,s2      : string;
   found1,
   found1,
-  found2,
-  Reorder,
-  linklibc     : boolean;
+  found2       : boolean;
 begin
 begin
   result:=False;
   result:=False;
 { set special options for some targets }
 { set special options for some targets }
+{$ifndef has_internal_sysinit}
   linklibc:=(SharedLibFiles.Find('c')<>nil);
   linklibc:=(SharedLibFiles.Find('c')<>nil);
   reorder := linklibc and ReOrderEntries;
   reorder := linklibc and ReOrderEntries;
   if isdll then
   if isdll then
@@ -350,9 +415,12 @@ begin
          gprtobj:='gprt0';
          gprtobj:='gprt0';
      end;
      end;
    end;
    end;
+{$endif}   
   if cs_profile in current_settings.moduleswitches then
   if cs_profile in current_settings.moduleswitches then
    begin
    begin
+{$ifndef has_internal_sysinit}
      prtobj:=gprtobj;
      prtobj:=gprtobj;
+{$endif}     
      if not(libctype in [glibc2,glibc21]) then
      if not(libctype in [glibc2,glibc21]) then
        AddSharedLibrary('gmon');
        AddSharedLibrary('gmon');
      AddSharedLibrary('c');
      AddSharedLibrary('c');
@@ -360,8 +428,10 @@ begin
    end
    end
   else
   else
    begin
    begin
+{$ifndef has_internal_sysinit}   
      if linklibc then
      if linklibc then
       prtobj:=cprtobj;
       prtobj:=cprtobj;
+{$endif}     
    end;
    end;
 
 
   { Open link.res file }
   { Open link.res file }
@@ -382,10 +452,12 @@ begin
          HPath:=TStringListItem(HPath.Next);
          HPath:=TStringListItem(HPath.Next);
        end;
        end;
 
 
-      Add('INPUT(');
+      StartSection('INPUT(');
+{$ifndef has_internal_sysinit}
       { add objectfiles, start with prt0 always }
       { add objectfiles, start with prt0 always }
       if prtobj<>'' then
       if prtobj<>'' then
        AddFileName(maybequoted(FindObjectFile(prtobj,'',false)));
        AddFileName(maybequoted(FindObjectFile(prtobj,'',false)));
+{$endif}
       { try to add crti and crtbegin if linking to C }
       { try to add crti and crtbegin if linking to C }
       if linklibc then
       if linklibc then
        begin
        begin
@@ -401,7 +473,7 @@ begin
          if s<>'' then
          if s<>'' then
           AddFileName(maybequoted(s));
           AddFileName(maybequoted(s));
        end;
        end;
-      Add(')');
+      EndSection(')');
 
 
       { Write staticlibraries }
       { Write staticlibraries }
       if not StaticLibFiles.Empty then
       if not StaticLibFiles.Empty then

+ 1 - 1
rtl/inc/systemh.inc

@@ -342,7 +342,7 @@ const
   InitProc : Pointer = nil;
   InitProc : Pointer = nil;
 
 
 var
 var
-  ExitCode    : Word; public name 'operatingsystem_result';
+  ExitCode    : Word; {$ifdef VER2_0} public name 'operatingsystem_result'; {$endif}
   RandSeed    : Cardinal;
   RandSeed    : Cardinal;
   { Delphi compatibility }
   { Delphi compatibility }
   IsLibrary : boolean = false;
   IsLibrary : boolean = false;

+ 1 - 1
rtl/linux/Makefile

@@ -251,7 +251,7 @@ override FPCOPT+=-Ur
 endif
 endif
 OBJPASDIR=$(RTL)/objpas
 OBJPASDIR=$(RTL)/objpas
 ifeq ($(FULL_TARGET),i386-linux)
 ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo termio unix linux initc cmem $(CPU_UNITS) crt printer linuxvcs sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst fmtbcd cthreads classes convutils stdconvs strutils rtlconsts dos objects cwstring fpcylix
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo termio unix linux initc cmem $(CPU_UNITS) crt printer linuxvcs sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst fmtbcd cthreads classes convutils stdconvs strutils rtlconsts dos objects cwstring fpcylix   si_prc si_c21g si_c21 si_c si_dll
 endif
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
 ifeq ($(FULL_TARGET),i386-go32v2)
 override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo termio unix linux initc cmem $(CPU_UNITS) crt printer linuxvcs sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst fmtbcd cthreads classes convutils stdconvs strutils rtlconsts dos objects cwstring fpcylix
 override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo termio unix linux initc cmem $(CPU_UNITS) crt printer linuxvcs sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst fmtbcd cthreads classes convutils stdconvs strutils rtlconsts dos objects cwstring fpcylix

+ 1 - 0
rtl/linux/Makefile.fpc

@@ -16,6 +16,7 @@ units=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixu
       errors sockets gpm ipc serial terminfo dl dynlibs \
       errors sockets gpm ipc serial terminfo dl dynlibs \
       video mouse keyboard variants types dateutils sysconst fmtbcd \
       video mouse keyboard variants types dateutils sysconst fmtbcd \
       cthreads classes convutils stdconvs strutils rtlconsts dos objects cwstring fpcylix
       cthreads classes convutils stdconvs strutils rtlconsts dos objects cwstring fpcylix
+units_i386_linux=si_prc si_c21g si_c21 si_c si_dll
 
 
 rsts=math varutils typinfo variants sysconst rtlconsts stdconvs
 rsts=math varutils typinfo variants sysconst rtlconsts stdconvs