Merged revision(s) 31988, 31991-31993, 32136, 32308-32309, 32312, 32318 from branches/svenbarth/packages:

Correctly parse the directives DenyPackageUnit and WeakPackageUnit

ppu.pas:
  + add flags uf_packagedeny and uf_packageweak
scandir.pas:
  + new procedure do_moduleflagswitch() which parses a ON/OFF/+/- argument and sets or clears a flag in the current module
  + new procedure dir_denypackageunit which handles DenyPackageUnit
  * implement dir_weakpackageunit (and move to the correct location ;) )
  * InitScannerDirectives: add dir_denypackageunit handler
........
Respect DenyPackageUnit flag.

pmodules.pas, proc_package:
  * check all contained units that are not already part of a package for their uf_package_deny flag and report an error for each that has it set
........
Do not check whether all units are used as by definition all units of a package are considered as used.

pmodules.pas, proc_package:
  - remove call to current_module.allunitsused
........
Check whether a unit has been implicitely imported in a package. A unit is considered as implicitely imported if it is not part of a required package nor part of the units listed in the contains section. This note is useful (Delphi even provides a dialog in that case) as a package with implicitely imported units /might/ become incompatible with other packages (e.g. if another package includes that unit uses that package and includes that unit explicitely; of course that is the same as if both package included it explicitely, but with the hint one knows where to look).

pmodules.pas, proc_package:
  * while walking the loaded units also check whether any of them not contained in a package was part of the contained units which are the same as the current module's used units
........
Generate CRC for package files

pcp.pas, tpcpfile:
  + new field do_crc which controls CRC generation
  + override putdata() method to generate CRC when data is written
  * resetfile: enable do_crc by default
........fppu.pas, tppumodule:
  * loadfrompackage: mention if a unit is loaded from a package
........
fpkg.pas, tcontainedunit:
  + new fields offset and size for the PPU data stored inside the PCP
fpcp.pas, tpcppackage:
  * readcontainedunits & addunit: correctly initialize offset and size to 0
........
Store the modified PPU files directly inside the PCP and thus get finally rid of the .ppl.ppu files.

entfile.pas:
  + new entry type ibpputable
pkgutil.pas:
  * adjust RewritePPU to work on a stream as output instead of a filename
fpcp.pas, tpcppackage:
  + new method writepputable() which writes the offsets and sizes of all contained units (not part of CRC!)
  + new method writeppudata() which rewrites all contained PPUs directly into the PCP after the ibend entry (Note: the data is written 16 Byte aligned to ease viewing of the PCP and its contained PPUs in a hex editor)
  + new method readpputable() which reads the offsets and sizes of all contained units
  + new method getmodulestream() which returns a substream for a contained module
  * loadpcp: also call readpputable()
  * writepcp: first write an empty pputable, then finish writing all data that requires the put*/write* methods of the pcpfile, then use writeppudata() to write all PPUs and finally write the correct pputable at the original location
fppu.pas, tppumodule:
  * loadfrompackage: don't read the PPU from a file if it is contained in a package, but using the new tpcppackage.getmodulestream() and tppumodule.openppustream() methods
pmodules.pas, proc_package:
  * don't rewrite the PPUs here
pcp.pas:
  * increase CurrentPCPVersion
........
Fix cycling

........

git-svn-id: trunk@33514 -

compiler/entfile.pas

@@ -38,6 +38,7 @@ const
   subentryid          = 2;
   {special}
   iberror             = 0;
+  ibpputable          = 243;
   ibstartrequireds    = 244;
   ibendrequireds      = 245;
   ibstartcontained    = 246;

compiler/fpcp.pas

@@ -26,7 +26,7 @@ unit fpcp;
 interface
 
   uses
-    cclasses,
+    cclasses,cstreams,
     globtype,
     pcp,finput,fpkg;
 
@@ -43,14 +43,18 @@ interface
       procedure writecontainernames;
       procedure writecontainedunits;
       procedure writerequiredpackages;
+      procedure writepputable;
+      procedure writeppudata;
       procedure readcontainernames;
       procedure readcontainedunits;
       procedure readrequiredpackages;
+      procedure readpputable;
     public
       constructor create(const pn:string);
       destructor destroy; override;
       procedure loadpcp;
       procedure savepcp;
+      function getmodulestream(module:tmodulebase):tcstream;
       procedure initmoduleinfo(module:tmodulebase);
       procedure addunit(module:tmodulebase);
     end;
@@ -62,7 +66,7 @@ implementation
     cfileutl,cutils,
     systems,globals,version,
     verbose,
-    entfile,fppu,ppu;
+    entfile,fppu,ppu,pkgutil;
 
 { tpcppackage }
 
@@ -265,6 +269,59 @@ implementation
       pcpfile.writeentry(ibendrequireds);
     end;
 
+  procedure tpcppackage.writepputable;
+    var
+      module : pcontainedunit;
+      i : longint;
+    begin
+      { no need to write the count again; it's the same as for the contained units }
+      for i:=0 to containedmodules.count-1 do
+        begin
+          module:=pcontainedunit(containedmodules[i]);
+          pcpfile.putlongint(module^.offset);
+          pcpfile.putlongint(module^.size);
+        end;
+      pcpfile.writeentry(ibpputable);
+    end;
+
+  procedure tpcppackage.writeppudata;
+    const
+      align: array[0..15] of byte = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
+    var
+      i,j,
+      pos,
+      rem : longint;
+      module : pcontainedunit;
+      stream : TCStream;
+    begin
+      pcpfile.flush;
+
+      for i:=0 to containedmodules.count-1 do
+        begin
+          module:=pcontainedunit(containedmodules[i]);
+
+          pos:=pcpfile.position;
+          { align to 16 byte so that it can be nicely viewed in hex editors;
+            maybe we could also use 512 byte alignment instead }
+          rem:=$f-(pos and $f);
+          pcpfile.stream.write(align[0],rem+1);
+          pcpfile.flush;
+          module^.offset:=pcpfile.position;
+
+          { retrieve substream for the current position }
+          stream:=pcpfile.substream(module^.offset,-1);
+          rewriteppu(module^.module.ppufilename,stream);
+          module^.size:=stream.position;
+          stream.free;
+        end;
+
+      pos:=pcpfile.position;
+      { align to 16 byte so that it can be nicely viewed in hex editors;
+        maybe we could also use 512 byte alignment instead }
+      rem:=$f-(pos and $f);
+      pcpfile.stream.write(align[0],rem+1);
+    end;
+
   procedure tpcppackage.readcontainernames;
     begin
       if pcpfile.readentry<>ibpackagefiles then
@@ -297,10 +354,12 @@ implementation
       for i:=0 to cnt-1 do
         begin
           name:=pcpfile.getstring;
-          path:=ChangeFileExt(pcpfile.getstring,'.ppl.ppu');
+          path:=pcpfile.getstring;
           new(p);
           p^.module:=nil;
           p^.ppufile:=path;
+          p^.offset:=0;
+          p^.size:=0;
           containedmodules.add(name,p);
           message1(package_u_contained_unit,name);
         end;
@@ -330,6 +389,24 @@ implementation
         end;
     end;
 
+  procedure tpcppackage.readpputable;
+    var
+      module : pcontainedunit;
+      i : longint;
+    begin
+      if pcpfile.readentry<>ibpputable then
+        begin
+          message(package_f_pcp_read_error);
+          internalerror(2015103001);
+        end;
+      for i:=0 to containedmodules.count-1 do
+        begin
+          module:=pcontainedunit(containedmodules[i]);
+          module^.offset:=pcpfile.getlongint;
+          module^.size:=pcpfile.getlongint;
+        end;
+    end;
+
     constructor tpcppackage.create(const pn: string);
     begin
       inherited create(pn);
@@ -371,9 +448,14 @@ implementation
       readrequiredpackages;
 
       readcontainedunits;
+
+      readpputable;
     end;
 
   procedure tpcppackage.savepcp;
+    var
+      tablepos,
+      oldpos : longint;
     begin
       { create new ppufile }
       pcpfile:=tpcpfile.create(pcpfilename);
@@ -389,7 +471,16 @@ implementation
 
       writecontainedunits;
 
-      //writeppus;
+      { the offsets and the contents of the ppus are not crc'd }
+      pcpfile.do_crc:=false;
+
+      pcpfile.flush;
+      tablepos:=pcpfile.position;
+
+      { this will write a table with empty entries }
+      writepputable;
+
+      pcpfile.do_crc:=true;
 
       { the last entry ibend is written automatically }
 
@@ -406,6 +497,18 @@ implementation
       pcpfile.header.requiredlistsize:=requiredpackages.count;
       pcpfile.writeheader;
 
+      { write the ppu table which will also fill the offsets/sizes }
+      writeppudata;
+
+      pcpfile.flush;
+      oldpos:=pcpfile.position;
+
+      { now write the filled PPU table at the previously stored position }
+      pcpfile.position:=tablepos;
+      writepputable;
+
+      pcpfile.position:=oldpos;
+
       { save crc in current module also }
       //crc:=pcpfile.crc;
 
@@ -414,6 +517,23 @@ implementation
       pcpfile:=nil;
     end;
 
+  function tpcppackage.getmodulestream(module:tmodulebase):tcstream;
+    var
+      i : longint;
+      contained : pcontainedunit;
+    begin
+      for i:=0 to containedmodules.count-1 do
+        begin
+          contained:=pcontainedunit(containedmodules[i]);
+          if contained^.module=module then
+            begin
+              result:=pcpfile.substream(contained^.offset,contained^.size);
+              exit;
+            end;
+        end;
+      result:=nil;
+    end;
+
   procedure tpcppackage.initmoduleinfo(module: tmodulebase);
     begin
       pplfilename:=extractfilename(module.sharedlibfilename);
@@ -426,6 +546,8 @@ implementation
       new(containedunit);
       containedunit^.module:=module;
       containedunit^.ppufile:=extractfilename(module.ppufilename);
+      containedunit^.offset:=0;
+      containedunit^.size:=0;
       containedmodules.add(module.modulename^,containedunit);
     end;
 

compiler/fpkg.pas

@@ -34,6 +34,8 @@ interface
     tcontainedunit=record
       module:tmodulebase;
       ppufile:tpathstr;
+      offset:longint;
+      size:longint;
     end;
     pcontainedunit=^tcontainedunit;
 

compiler/fppu.pas

@@ -127,7 +127,7 @@ uses
   aasmbase,ogbase,
   parser,
   comphook,
-  entfile,fpkg;
+  entfile,fpkg,fpcp;
 
 
 var
@@ -517,7 +517,7 @@ var
       end;
 
     function tppumodule.loadfrompackage: boolean;
-      var
+      (*var
         singlepathstring,
         filename : TCmdStr;
 
@@ -540,7 +540,7 @@ var
             if Found then
              Begin
                SetFileName(hs,false);
-               Found:=openppufile;
+               //Found:=OpenPPU;
              End;
             PPUSearchPath:=Found;
           end;
@@ -560,12 +560,13 @@ var
                hp:=TCmdStrListItem(hp.next);
              end;
             SearchPathList:=found;
-          end;
+          end;*)
 
       var
         pkg : ppackageentry;
         pkgunit : pcontainedunit;
         i,idx : longint;
+        strm : TCStream;
       begin
         result:=false;
         for i:=0 to packagelist.count-1 do
@@ -580,10 +581,17 @@ var
                 pkgunit:=pcontainedunit(pkg^.package.containedmodules[idx]);
                 if not assigned(pkgunit^.module) then
                   pkgunit^.module:=self;
-                filename:=pkgunit^.ppufile;
+                { ToDo: check whether we really don't need this anymore }
+                {filename:=pkgunit^.ppufile;
                 if not SearchPathList(unitsearchpath) then
+                  exit};
+                strm:=tpcppackage(pkg^.package).getmodulestream(self);
+                if not assigned(strm) then
+                  internalerror(2015103002);
+                if not openppustream(strm) then
                   exit;
                 package:=pkg^.package;
+                Message2(unit_u_loading_from_package,modulename^,pkg^.package.packagename^);
 
                 { now load the unit and all used units }
                 load_interface;

compiler/pcp.pas

@@ -29,7 +29,7 @@ interface
     cstreams,entfile;
 
   const
-    CurrentPCPVersion=2;
+    CurrentPCPVersion=3;
 
   { unit flags }
     //uf_init                = $000001; { unit has initialization section }
@@ -59,6 +59,7 @@ interface
       header : tpcpheader;
       { crc for the entire package }
       crc : cardinal;
+      do_crc : boolean;
     protected
       function getheadersize:longint;override;
       function getheaderaddr:pentryheader;override;
@@ -68,10 +69,14 @@ interface
     public
       procedure writeheader;override;
       function checkpcpid:boolean;
+      procedure putdata(const b;len:integer);override;
     end;
 
 implementation
 
+uses
+  fpccrc;
+
   { tpcpfile }
 
   function tpcpfile.getheadersize: longint;
@@ -142,6 +147,7 @@ implementation
   procedure tpcpfile.resetfile;
     begin
       crc:=0;
+      do_crc:=true;
     end;
 
 
@@ -184,5 +190,15 @@ implementation
     end;
 
 
+  procedure tpcpfile.putdata(const b;len:integer);
+    begin
+      if do_crc then
+        begin
+          crc:=UpdateCrc32(crc,b,len);
+        end;
+      inherited putdata(b, len);
+    end;
+
+
 end.
 

compiler/pkgutil.pas

@@ -27,10 +27,10 @@ unit pkgutil;
 interface
 
   uses
-    fmodule,fpkg,link;
+    fmodule,fpkg,link,cstreams;
 
   procedure createimportlibfromexternals;
-  Function RewritePPU(const PPUFn,PPLFn:String):Boolean;
+  Function RewritePPU(const PPUFn:String;OutStream:TCStream):Boolean;
   procedure export_unit(u:tmodule);
   procedure load_packages;
   procedure add_package(const name:string;ignoreduplicates:boolean);
@@ -195,7 +195,7 @@ implementation
         varexport(make_mangledname('THREADVARLIST',u.globalsymtable,''));
     end;
 
-  Function RewritePPU(const PPUFn,PPLFn:String):Boolean;
+  Function RewritePPU(const PPUFn:String;OutStream:TCStream):Boolean;
     Var
       MakeStatic : Boolean;
     Var
@@ -261,11 +261,8 @@ implementation
          MakeStatic:=true;
        end;
     { Create the new ppu }
-      if PPUFn=PPLFn then
+      outppu:=tppufile.create(PPUFn);
-       outppu:=tppufile.create('ppumove.$$$')
+      outppu.createstream(OutStream);
-      else
-       outppu:=tppufile.create(PPLFn);
-      outppu.createfile;
     { Create new header, with the new flags }
       outppu.header:=inppu.header;
       outppu.header.common.flags:=outppu.header.common.flags or uf_in_library;
@@ -379,17 +376,6 @@ implementation
       outppu.writeheader;
       outppu.free;
       inppu.free;
-    { rename }
-      if PPUFn=PPLFn then
-       begin
-         {$push}{$I-}
-          assign(f,PPUFn);
-          erase(f);
-          assign(f,'ppumove.$$$');
-          rename(f,PPUFn);
-         {$pop}
-         if ioresult<>0 then;
-       end;
       Result:=True;
     end;
 

compiler/pmodules.pas

@@ -1534,6 +1534,27 @@ type
          { All units are read, now give them a number }
          current_module.updatemaps;
 
+         hp:=tmodule(loaded_units.first);
+         while assigned(hp) do
+           begin
+             if (hp<>current_module) and not assigned(hp.package) then
+               begin
+                 if (hp.flags and uf_package_deny) <> 0 then
+                   message1(package_e_unit_deny_package,hp.realmodulename^);
+                 { part of the package's used, aka contained units? }
+                 uu:=tused_unit(current_module.used_units.first);
+                 while assigned(uu) do
+                   begin
+                     if uu.u=hp then
+                       break;
+                     uu:=tused_unit(uu.next);
+                   end;
+                 if not assigned(uu) then
+                   message2(package_n_implicit_unit_import,hp.realmodulename^,current_module.realmodulename^);
+               end;
+             hp:=tmodule(hp.next);
+           end;
+
          {Insert the name of the main program into the symbol table.}
          if current_module.realmodulename^<>'' then
            tabstractunitsymtable(current_module.localsymtable).insertunit(cunitsym.create(current_module.realmodulename^,current_module));
@@ -1574,7 +1595,7 @@ type
              tstoredsymtable(current_module.localsymtable).allprivatesused;
              tstoredsymtable(current_module.localsymtable).check_forwards;
 
-             current_module.allunitsused;
+             { Note: all contained units are considered as used }
            end;
 
          if target_info.system in systems_windows then
@@ -1693,15 +1714,6 @@ type
 
              pkg.initmoduleinfo(current_module);
 
-             { finally rewrite all units included into the package }
-             uu:=tused_unit(usedunits.first);
-             while assigned(uu) do
-               begin
-                 if not assigned(uu.u.package) then
-                   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

compiler/ppu.pas

@@ -76,6 +76,8 @@ const
   uf_i8086_far_data     = $4000000; { this unit uses an i8086 memory model with far data (i.e. compact or large) }
   uf_i8086_huge_data    = $8000000; { this unit uses an i8086 memory model with huge data (i.e. huge) }
   uf_i8086_cs_equals_ds = $10000000; { this unit uses an i8086 memory model with CS=DS (i.e. tiny) }
+  uf_package_deny       = $20000000; { this unit must not be part of a package }
+  uf_package_weak       = $40000000; { this unit may be completely contained in a package }
 
 type
   { bestreal is defined based on the target architecture }

compiler/scandir.pas

@@ -118,6 +118,18 @@ unit scandir;
       end;
 
 
+    procedure do_moduleflagswitch(flag:cardinal);
+      var
+        state : char;
+      begin
+        state:=current_scanner.readstate;
+        if state='-' then
+          current_module.flags:=current_module.flags and not flag
+        else
+          current_module.flags:=current_module.flags or flag;
+      end;
+
+
     procedure do_message(w:integer);
       begin
         current_scanner.skipspace;
@@ -367,6 +379,11 @@ unit scandir;
         do_delphiswitch('D');
       end;
 
+    procedure dir_denypackageunit;
+      begin
+        do_moduleflagswitch(uf_package_deny);
+      end;
+
     procedure dir_description;
       begin
         if not (target_info.system in systems_all_windows+[system_i386_os2,system_i386_emx,
@@ -1565,6 +1582,11 @@ unit scandir;
         do_setverbose('W');
       end;
 
+    procedure dir_weakpackageunit;
+      begin
+        do_moduleflagswitch(uf_package_weak);
+      end;
+
     procedure dir_writeableconst;
       begin
         do_delphiswitch('J');
@@ -1663,10 +1685,6 @@ unit scandir;
         do_localswitch(cs_hugeptr_comparison_normalization);
       end;
 
-    procedure dir_weakpackageunit;
-      begin
-      end;
-
     procedure dir_codealign;
       var
         s : string;
@@ -1755,6 +1773,7 @@ unit scandir;
         AddDirective('COPYRIGHT',directive_all, @dir_copyright);
         AddDirective('D',directive_all, @dir_description);
         AddDirective('DEBUGINFO',directive_all, @dir_debuginfo);
+        AddDirective('DENYPACKAGEUNIT',directive_all,@dir_denypackageunit);
         AddDirective('DESCRIPTION',directive_all, @dir_description);
         AddDirective('ENDREGION',directive_all, @dir_endregion);
         AddDirective('ERROR',directive_all, @dir_error);