Przeglądaj źródła

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

git-svn-id: trunk@12377 -

Jonas Maebe 16 lat temu
rodzic
commit
d3923b315a
3 zmienionych plików z 15 dodań i 10 usunięć
  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);
-      var
-        paraloc1,
-        paraloc2 : tcgpara;
       begin
-        paraloc1.init;
-        paraloc2.init;
-
         { the actual profile code can clobber some registers,
           therefore if the context must be saved, do it before
           the actual call to the profile code
@@ -1987,7 +1981,10 @@ implementation
          begin
            { initialize units }
            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);
          end;
 
@@ -1996,9 +1993,6 @@ implementation
 {$ifdef OLDREGVARS}
         load_regvars(list,nil);
 {$endif OLDREGVARS}
-
-        paraloc1.done;
-        paraloc2.done;
       end;
 
 

+ 9 - 0
rtl/inc/system.inc

@@ -769,6 +769,15 @@ begin
 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'];
 begin
   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;
 
  begin
+   if not islibrary then
+     halt(1);
    writeln('Hoi');
  end;