Bläddra i källkod

* continued to play around with package support

git-svn-id: trunk@9075 -
florian 18 år sedan
förälder
incheckning
d9e0f078e1
4 ändrade filer med 296 tillägg och 19 borttagningar
  1. 1 1
      compiler/link.pas
  2. 290 17
      compiler/pmodules.pas
  3. 1 1
      compiler/scanner.pas
  4. 4 0
      compiler/systems/t_win.pas

+ 1 - 1
compiler/link.pas

@@ -27,7 +27,7 @@ unit link;
 interface
 
     uses
-	  sysutils,
+      sysutils,
       cclasses,
       systems,
       fmodule,

+ 290 - 17
compiler/pmodules.pas

@@ -44,7 +44,12 @@ implementation
        link,assemble,import,export,gendef,ppu,comprsrc,dbgbase,
        cresstr,procinfo,
        pexports,
-       scanner,pbase,pexpr,psystem,psub,pdecsub,ptype;
+       scanner,pbase,pexpr,psystem,psub,pdecsub,ptype
+{$ifdef i386}
+       { fix me! }
+       ,cpubase
+{$endif i386}
+       ;
 
 
     procedure create_objectfile;
@@ -1188,10 +1193,33 @@ implementation
       end;
 
 
+    procedure procexport(const s : string);
+      var
+        hp : texported_item;
+      begin
+        hp:=texported_item.create;
+        hp.name:=stringdup(s);
+        hp.options:=hp.options or eo_name;
+        exportlib.exportprocedure(hp);
+      end;
+
+
+    procedure varexport(const s : string);
+      var
+        hp : texported_item;
+      begin
+        hp:=texported_item.create;
+        hp.name:=stringdup(s);
+        hp.options:=hp.options or eo_name;
+        exportlib.exportvar(hp);
+      end;
+
+
     procedure insert_export(sym : TObject;arg:pointer);
       var
         hp : texported_item;
         i : longint;
+        item : TCmdStrListItem;
       begin
         case TSym(sym).typ of
           { ignore: }
@@ -1205,23 +1233,28 @@ implementation
             begin
               for i:=0 to tprocsym(sym).ProcdefList.Count-1 do
                 begin
-                  if not(tprocdef(tprocsym(sym).ProcdefList[i]).proccalloption in [pocall_internproc]) then
+                  if not(tprocdef(tprocsym(sym).ProcdefList[i]).proccalloption in [pocall_internproc]) and
+                    ((tprocdef(tprocsym(sym).ProcdefList[i]).procoptions*[po_external])=[]) and
+                    ((tsymtable(arg).symtabletype=globalsymtable) or
+                     ((tsymtable(arg).symtabletype=staticsymtable) and (po_public in tprocdef(tprocsym(sym).ProcdefList[i]).procoptions))
+                    ) then
                     begin
-                      hp:=texported_item.create;
-                      // hp.sym:=tsym(sym);
-                      hp.name:=stringdup(tprocdef(tprocsym(sym).ProcdefList[i]).mangledname);
-                      hp.options:=hp.options or eo_name;
-                      exportlib.exportprocedure(hp)
+                      procexport(tprocdef(tprocsym(sym).ProcdefList[i]).mangledname);
+                      { walk through all aliases }
+                      item:=TCmdStrListItem(tprocdef(tprocsym(sym).ProcdefList[i]).aliasnames.first);
+                      while assigned(item) do
+                        begin
+                          { avoid duplicate entries, sometimes aliasnames contains the mangledname }
+                          if item.str<>tprocdef(tprocsym(sym).ProcdefList[i]).mangledname then
+                            procexport(item.str);
+                          item:=TCmdStrListItem(item.next);
+                        end;
                     end;
                 end;
             end;
           staticvarsym:
             begin
-              hp:=texported_item.create;
-              // hp.sym:=tsym(sym);
-              hp.name:=stringdup(tsym(sym).mangledname);
-              hp.options:=hp.options or eo_name;
-              exportlib.exportvar(hp);
+              varexport(tsym(sym).mangledname);
             end;
           else
             begin
@@ -1231,6 +1264,218 @@ implementation
       end;
 
 
+    Function RewritePPU(const PPUFn,PPLFn:String):Boolean;
+      Var
+        MakeStatic : Boolean;
+      Var
+        buffer : array[0..$1fff] of byte;
+        inppu,
+        outppu : tppufile;
+        b,
+        untilb : byte;
+        l,m    : longint;
+        f      : file;
+        ext,
+        s      : string;
+        ppuversion : dword;
+      begin
+        Result:=false;
+        MakeStatic:=False;
+        inppu:=tppufile.create(PPUFn);
+        if not inppu.openfile then
+         begin
+           inppu.free;
+           Comment(V_Error,'Could not open : '+PPUFn);
+           Exit;
+         end;
+      { Check the ppufile }
+        if not inppu.CheckPPUId then
+         begin
+           inppu.free;
+           Comment(V_Error,'Not a PPU File : '+PPUFn);
+           Exit;
+         end;
+        ppuversion:=inppu.GetPPUVersion;
+        if ppuversion<CurrentPPUVersion then
+         begin
+           inppu.free;
+           Comment(V_Error,'Wrong PPU Version '+tostr(ppuversion)+' in '+PPUFn);
+           Exit;
+         end;
+      { No .o file generated for this ppu, just skip }
+        if (inppu.header.flags and uf_no_link)<>0 then
+         begin
+           inppu.free;
+           Result:=true;
+           Exit;
+         end;
+      { Already a lib? }
+        if (inppu.header.flags and uf_in_library)<>0 then
+         begin
+           inppu.free;
+           Comment(V_Error,'PPU is already in a library : '+PPUFn);
+           Exit;
+         end;
+      { We need a static linked unit }
+        if (inppu.header.flags and uf_static_linked)=0 then
+         begin
+           inppu.free;
+           Comment(V_Error,'PPU is not static linked : '+PPUFn);
+           Exit;
+         end;
+      { Check if shared is allowed }
+        if tsystem(inppu.header.target) in [system_i386_go32v2] then
+         begin
+           Comment(V_Error,'Shared library not supported for ppu target, switching to static library');
+           MakeStatic:=true;
+         end;
+      { Create the new ppu }
+        if PPUFn=PPLFn then
+         outppu:=tppufile.create('ppumove.$$$')
+        else
+         outppu:=tppufile.create(PPLFn);
+        outppu.createfile;
+      { Create new header, with the new flags }
+        outppu.header:=inppu.header;
+        outppu.header.flags:=outppu.header.flags or uf_in_library;
+        if MakeStatic then
+         outppu.header.flags:=outppu.header.flags or uf_static_linked
+        else
+         outppu.header.flags:=outppu.header.flags or uf_shared_linked;
+      { read until the object files are found }
+        untilb:=iblinkunitofiles;
+        repeat
+          b:=inppu.readentry;
+          if b in [ibendinterface,ibend] then
+           begin
+             inppu.free;
+             outppu.free;
+             Comment(V_Error,'No files to be linked found : '+PPUFn);
+             Exit;
+           end;
+          if b<>untilb then
+           begin
+             repeat
+               inppu.getdatabuf(buffer,sizeof(buffer),l);
+               outppu.putdata(buffer,l);
+             until l<sizeof(buffer);
+             outppu.writeentry(b);
+           end;
+        until (b=untilb);
+      { we have now reached the section for the files which need to be added,
+        now add them to the list }
+        case b of
+          iblinkunitofiles :
+            begin
+              { add all o files, and save the entry when not creating a static
+                library to keep staticlinking possible }
+              while not inppu.endofentry do
+               begin
+                 s:=inppu.getstring;
+                 m:=inppu.getlongint;
+                 if not MakeStatic then
+                  begin
+                    outppu.putstring(s);
+                    outppu.putlongint(m);
+                  end;
+                 current_module.linkotherofiles.add(s,link_always);;
+               end;
+              if not MakeStatic then
+               outppu.writeentry(b);
+            end;
+      {    iblinkunitstaticlibs :
+            begin
+              AddToLinkFiles(ExtractLib(inppu.getstring));
+              if not inppu.endofentry then
+               begin
+                 repeat
+                   inppu.getdatabuf(buffer^,bufsize,l);
+                   outppu.putdata(buffer^,l);
+                 until l<bufsize;
+                 outppu.writeentry(b);
+               end;
+             end; }
+        end;
+      { just add a new entry with the new lib }
+        if MakeStatic then
+         begin
+           outppu.putstring('imp'+current_module.realmodulename^);
+           outppu.putlongint(link_static);
+           outppu.writeentry(iblinkunitstaticlibs)
+         end
+        else
+         begin
+           outppu.putstring('imp'+current_module.realmodulename^);
+           outppu.putlongint(link_shared);
+           outppu.writeentry(iblinkunitsharedlibs);
+         end;
+      { read all entries until the end and write them also to the new ppu }
+        repeat
+          b:=inppu.readentry;
+        { don't write ibend, that's written automaticly }
+          if b<>ibend then
+           begin
+             if b=iblinkothersharedlibs then
+               begin
+                 while not inppu.endofentry do
+                   begin
+                     s:=inppu.getstring;
+                     m:=inppu.getlongint;
+
+                     outppu.putstring(s);
+                     outppu.putlongint(m);
+
+                     { strip lib prefix }
+                     if copy(s,1,3)='lib' then
+                       delete(s,1,3);
+                     ext:=ExtractFileExt(s);
+                     if ext<>'' then
+                       delete(s,length(s)-length(ext)+1,length(ext));
+
+                     current_module.linkOtherSharedLibs.add(s,link_always);
+                   end;
+               end
+             else
+               repeat
+                 inppu.getdatabuf(buffer,sizeof(buffer),l);
+                 outppu.putdata(buffer,l);
+               until l<sizeof(buffer);
+             outppu.writeentry(b);
+           end;
+        until b=ibend;
+      { write the last stuff and close }
+        outppu.flush;
+        outppu.writeheader;
+        outppu.free;
+        inppu.free;
+      { rename }
+        if PPUFn=PPLFn then
+         begin
+           {$I-}
+            assign(f,PPUFn);
+            erase(f);
+            assign(f,'ppumove.$$$');
+            rename(f,PPUFn);
+           {$I+}
+           if ioresult<>0 then;
+         end;
+        Result:=True;
+      end;
+
+
+    procedure createimportlibfromexports;
+      var
+        hp : texported_item;
+      begin
+        hp:=texported_item(current_module._exports.first);
+        while assigned(hp) do
+          begin
+            current_module.AddExternalImport(current_module.realmodulename^,hp.name^,hp.index,hp.is_var);
+            hp:=texported_item(hp.next);
+          end;
+      end;
+
+
     procedure proc_package;
       var
         main_file : tinputfile;
@@ -1375,6 +1620,11 @@ implementation
 
          new_section(current_asmdata.asmlists[al_procedures],sec_code,'',0);
          current_asmdata.asmlists[al_procedures].concat(tai_symbol.createname_global('_DLLMainCRTStartup',AT_FUNCTION,0));
+{$ifdef i386}
+         { fix me! }
+         current_asmdata.asmlists[al_procedures].concat(Taicpu.Op_const_reg(A_MOV,S_L,1,NR_EAX));
+         current_asmdata.asmlists[al_procedures].concat(Taicpu.Op_const(A_RET,S_W,12));
+{$endif i386}
          current_asmdata.asmlists[al_procedures].concat(tai_const.createname('_FPCDummy',0));
 
          { leave when we got an error }
@@ -1401,7 +1651,18 @@ implementation
          uu:=tused_unit(usedunits.first);
          while assigned(uu) do
            begin
-             uu.u.globalsymtable.symlist.ForEachCall(@insert_export,nil);
+             uu.u.globalsymtable.symlist.ForEachCall(@insert_export,uu.u.globalsymtable);
+             { check localsymtable for exports too to get public symbols }
+             uu.u.localsymtable.symlist.ForEachCall(@insert_export,uu.u.localsymtable);
+
+             { create special exports }
+             if (uu.u.flags and uf_init)<>0 then
+               procexport(make_mangledname('INIT$',uu.u.globalsymtable,''));
+             if (uu.u.flags and uf_finalize)<>0 then
+               procexport(make_mangledname('FINALIZE$',uu.u.globalsymtable,''));
+             if (uu.u.flags and uf_threadvars)=uf_threadvars then
+               varexport(make_mangledname('THREADVARLIST',uu.u.globalsymtable,''));
+
              uu:=tused_unit(uu.next);
            end;
 
@@ -1412,16 +1673,20 @@ implementation
            InsertPData;
 {$endif arm}
 
-         { generate imports }
-         if current_module.ImportLibraryList.Count>0 then
-           importlib.generatelib;
-
          { generate debuginfo }
          if (cs_debuginfo in current_settings.moduleswitches) then
            current_debuginfo.inserttypeinfo;
 
          exportlib.generatelib;
 
+         { write all our exports to the import library,
+           needs to be done after exportlib.generatelib; }
+         createimportlibfromexports;
+
+         { generate imports }
+         if current_module.ImportLibraryList.Count>0 then
+           importlib.generatelib;
+
          { Reference all DEBUGINFO sections from the main .fpc section }
          if (cs_debuginfo in current_settings.moduleswitches) then
            current_debuginfo.referencesections(current_asmdata.asmlists[al_procedures]);
@@ -1450,6 +1715,14 @@ implementation
 
          if (not current_module.is_unit) then
            begin
+             { finally rewrite all units included into the package }
+             uu:=tused_unit(usedunits.first);
+             while assigned(uu) do
+               begin
+                 RewritePPU(uu.u.ppufilename^,uu.u.ppufilename^);
+                 uu:=tused_unit(uu.next);
+               end;
+
              { create the executable when we are at level 1 }
              if (compile_level=1) then
                begin

+ 1 - 1
compiler/scanner.pas

@@ -1598,7 +1598,7 @@ In case not, the value returned can be arbitrary.
 
 
 {*****************************************************************************
-                            Preprocessor writting
+                            Preprocessor writing
 *****************************************************************************}
 
 {$ifdef PREPROCWRITE}

+ 4 - 0
compiler/systems/t_win.pas

@@ -882,6 +882,10 @@ implementation
          name_table_pointers.free;
          ordinal_table.free;
          name_table.free;
+
+         { the package support needs this data later on
+           to create the import library }
+         current_module._exports.concatlist(temtexport);
          temtexport.free;
       end;