From 7d8d0340b97ac17913f2332b56e0b915b63e9c18 Mon Sep 17 00:00:00 2001 From: svenbarth Date: Fri, 15 Apr 2016 13:39:41 +0000 Subject: [PATCH] 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 | 1 + compiler/fpcp.pas | 130 ++++++++++++++++++++++++++++++++++++++++-- compiler/fpkg.pas | 2 + compiler/fppu.pas | 18 ++++-- compiler/pcp.pas | 18 +++++- compiler/pkgutil.pas | 24 ++------ compiler/pmodules.pas | 32 +++++++---- compiler/ppu.pas | 2 + compiler/scandir.pas | 27 +++++++-- 9 files changed, 211 insertions(+), 43 deletions(-) diff --git a/compiler/entfile.pas b/compiler/entfile.pas index 5bef81b14b..aab1047981 100644 --- a/compiler/entfile.pas +++ b/compiler/entfile.pas @@ -38,6 +38,7 @@ const subentryid = 2; {special} iberror = 0; + ibpputable = 243; ibstartrequireds = 244; ibendrequireds = 245; ibstartcontained = 246; diff --git a/compiler/fpcp.pas b/compiler/fpcp.pas index a415ee6da8..59dcfb99e5 100644 --- a/compiler/fpcp.pas +++ b/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; diff --git a/compiler/fpkg.pas b/compiler/fpkg.pas index 18a399fef1..8638faeff6 100644 --- a/compiler/fpkg.pas +++ b/compiler/fpkg.pas @@ -34,6 +34,8 @@ interface tcontainedunit=record module:tmodulebase; ppufile:tpathstr; + offset:longint; + size:longint; end; pcontainedunit=^tcontainedunit; diff --git a/compiler/fppu.pas b/compiler/fppu.pas index 6361bf2f07..b8066c289d 100644 --- a/compiler/fppu.pas +++ b/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; diff --git a/compiler/pcp.pas b/compiler/pcp.pas index a35107921f..b1f96cde07 100644 --- a/compiler/pcp.pas +++ b/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. diff --git a/compiler/pkgutil.pas b/compiler/pkgutil.pas index 2ee4de2714..e791bbb605 100644 --- a/compiler/pkgutil.pas +++ b/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('ppumove.$$$') - else - outppu:=tppufile.create(PPLFn); - outppu.createfile; + outppu:=tppufile.create(PPUFn); + outppu.createstream(OutStream); { 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; diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index f6353505ec..41faa33222 100644 --- a/compiler/pmodules.pas +++ b/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 diff --git a/compiler/ppu.pas b/compiler/ppu.pas index 19567b46c9..91a04b35d2 100644 --- a/compiler/ppu.pas +++ b/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 } diff --git a/compiler/scandir.pas b/compiler/scandir.pas index 6f6ea8e2c1..03e5091e4f 100644 --- a/compiler/scandir.pas +++ b/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);