Browse Source

* generic support for setting islibrary to true for libraries (+ changed
tlibrary1 to test this)

git-svn-id: trunk@12377 -

Jonas Maebe 16 years ago
parent
commit
d3923b315a
3 changed files with 15 additions and 10 deletions
  1. 4 10
      compiler/ncgutil.pas
  2. 9 0
      rtl/inc/system.inc
  3. 2 0
      tests/test/tlibrary1.pp

+ 4 - 10
compiler/ncgutil.pas

@@ -1960,13 +1960,7 @@ implementation
 
 
 
 
     procedure gen_entry_code(list:TAsmList);
     procedure gen_entry_code(list:TAsmList);
-      var
-        paraloc1,
-        paraloc2 : tcgpara;
       begin
       begin
-        paraloc1.init;
-        paraloc2.init;
-
         { the actual profile code can clobber some registers,
         { the actual profile code can clobber some registers,
           therefore if the context must be saved, do it before
           therefore if the context must be saved, do it before
           the actual call to the profile code
           the actual call to the profile code
@@ -1987,7 +1981,10 @@ implementation
          begin
          begin
            { initialize units }
            { initialize units }
            cg.allocallcpuregisters(list);
            cg.allocallcpuregisters(list);
-           cg.a_call_name(list,'FPC_INITIALIZEUNITS',false);
+           if not(current_module.islibrary) then
+             cg.a_call_name(list,'FPC_INITIALIZEUNITS',false)
+           else
+             cg.a_call_name(list,'FPC_LIBINITIALIZEUNITS',false);
            cg.deallocallcpuregisters(list);
            cg.deallocallcpuregisters(list);
          end;
          end;
 
 
@@ -1996,9 +1993,6 @@ implementation
 {$ifdef OLDREGVARS}
 {$ifdef OLDREGVARS}
         load_regvars(list,nil);
         load_regvars(list,nil);
 {$endif OLDREGVARS}
 {$endif OLDREGVARS}
-
-        paraloc1.done;
-        paraloc2.done;
       end;
       end;
 
 
 
 

+ 9 - 0
rtl/inc/system.inc

@@ -769,6 +769,15 @@ begin
 end;
 end;
 
 
 
 
+procedure internal_initializeunits; external name 'FPC_INITIALIZEUNITS';
+
+procedure fpc_LibInitializeUnits;[public,alias:'FPC_LIBINITIALIZEUNITS'];
+begin
+  IsLibrary:=true;
+  internal_initializeunits;
+end;
+
+
 procedure FinalizeUnits;[public,alias:'FPC_FINALIZEUNITS'];
 procedure FinalizeUnits;[public,alias:'FPC_FINALIZEUNITS'];
 begin
 begin
   with {$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}PInitFinalTable(EntryInformation.{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
   with {$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}PInitFinalTable(EntryInformation.{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}

+ 2 - 0
tests/test/tlibrary1.pp

@@ -36,6 +36,8 @@ const
 procedure Test;export;
 procedure Test;export;
 
 
  begin
  begin
+   if not islibrary then
+     halt(1);
    writeln('Hoi');
    writeln('Hoi');
  end;
  end;