mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-06 09:52:33 +02:00
66f8276445
* support for case aware filesystems (Windows), they do now only
one lookup if a file exists
* add -WI option to generate import section for DLL imports or
let the linker handle it. Default is still import section until
the Makefiles are fixed, then the generation can be left to the
linker
git-svn-id: trunk@2274 -
1609 lines
51 KiB
ObjectPascal
1609 lines
51 KiB
ObjectPascal
{
|
|
Copyright (c) 1998-2002 by Florian Klaempfl
|
|
|
|
This unit implements the first loading and searching of the modules
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or
|
|
(at your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program; if not, write to the Free Software
|
|
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
|
****************************************************************************
|
|
}
|
|
unit fppu;
|
|
|
|
{$i fpcdefs.inc}
|
|
|
|
{ close ppufiles on system that are
|
|
short on file handles like DOS system PM }
|
|
{$ifdef GO32V2}
|
|
{$define SHORT_ON_FILE_HANDLES}
|
|
{$endif GO32V2}
|
|
{$ifdef WATCOM}
|
|
{$define SHORT_ON_FILE_HANDLES}
|
|
{$endif WATCOM}
|
|
|
|
interface
|
|
|
|
uses
|
|
cutils,cclasses,
|
|
globtype,globals,finput,fmodule,
|
|
symbase,ppu,symtype;
|
|
|
|
type
|
|
tppumodule = class(tmodule)
|
|
ppufile : tcompilerppufile; { the PPU file }
|
|
sourcefn : pstring; { Source specified with "uses .. in '..'" }
|
|
{$ifdef Test_Double_checksum}
|
|
crc_array : pointer;
|
|
crc_size : longint;
|
|
crc_array2 : pointer;
|
|
crc_size2 : longint;
|
|
{$endif def Test_Double_checksum}
|
|
constructor create(LoadedFrom:TModule;const s:string;const fn:string;_is_unit:boolean);
|
|
destructor destroy;override;
|
|
procedure reset;override;
|
|
function openppu:boolean;
|
|
procedure getppucrc;
|
|
procedure writeppu;
|
|
procedure loadppu;
|
|
function needrecompile:boolean;
|
|
private
|
|
function search_unit(onlysource,shortname:boolean):boolean;
|
|
procedure load_interface;
|
|
procedure load_implementation;
|
|
procedure load_symtable_refs;
|
|
procedure load_usedunits;
|
|
procedure writesourcefiles;
|
|
procedure writeusedunit(intf:boolean);
|
|
procedure writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
|
|
procedure writederefmap;
|
|
procedure writederefdata;
|
|
procedure putasmsymbol_in_idx(s:tnamedindexitem;arg:pointer);
|
|
procedure writeasmsymbols;
|
|
procedure readsourcefiles;
|
|
procedure readloadunit;
|
|
procedure readlinkcontainer(var p:tlinkcontainer);
|
|
procedure readderefmap;
|
|
procedure readderefdata;
|
|
procedure readasmsymbols;
|
|
{$IFDEF MACRO_DIFF_HINT}
|
|
procedure writeusedmacro(p:TNamedIndexItem;arg:pointer);
|
|
procedure writeusedmacros;
|
|
procedure readusedmacros;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure reload_flagged_units;
|
|
function registerunit(callermodule:tmodule;const s : stringid;const fn:string) : tppumodule;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
verbose,systems,version,
|
|
symtable, symsym,
|
|
scanner,
|
|
aasmbase,
|
|
parser;
|
|
|
|
{****************************************************************************
|
|
Helpers
|
|
****************************************************************************}
|
|
|
|
procedure reload_flagged_units;
|
|
var
|
|
hp : tmodule;
|
|
begin
|
|
{ now reload all dependent units }
|
|
hp:=tmodule(loaded_units.first);
|
|
while assigned(hp) do
|
|
begin
|
|
if hp.do_reload then
|
|
tppumodule(hp).loadppu;
|
|
hp:=tmodule(hp.next);
|
|
end;
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TPPUMODULE
|
|
****************************************************************************}
|
|
|
|
constructor tppumodule.create(LoadedFrom:TModule;const s:string;const fn:string;_is_unit:boolean);
|
|
begin
|
|
inherited create(LoadedFrom,s,_is_unit);
|
|
ppufile:=nil;
|
|
sourcefn:=stringdup(fn);
|
|
end;
|
|
|
|
|
|
destructor tppumodule.Destroy;
|
|
begin
|
|
if assigned(ppufile) then
|
|
ppufile.free;
|
|
ppufile:=nil;
|
|
stringdispose(sourcefn);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
|
|
procedure tppumodule.reset;
|
|
begin
|
|
if assigned(ppufile) then
|
|
begin
|
|
ppufile.free;
|
|
ppufile:=nil;
|
|
end;
|
|
inherited reset;
|
|
end;
|
|
|
|
|
|
function tppumodule.openppu:boolean;
|
|
var
|
|
ppufiletime : longint;
|
|
begin
|
|
openppu:=false;
|
|
Message1(unit_t_ppu_loading,ppufilename^);
|
|
{ Get ppufile time (also check if the file exists) }
|
|
ppufiletime:=getnamedfiletime(ppufilename^);
|
|
if ppufiletime=-1 then
|
|
exit;
|
|
{ Open the ppufile }
|
|
Message1(unit_u_ppu_name,ppufilename^);
|
|
ppufile:=tcompilerppufile.create(ppufilename^);
|
|
if not ppufile.openfile then
|
|
begin
|
|
ppufile.free;
|
|
ppufile:=nil;
|
|
Message(unit_u_ppu_file_too_short);
|
|
exit;
|
|
end;
|
|
{ check for a valid PPU file }
|
|
if not ppufile.CheckPPUId then
|
|
begin
|
|
ppufile.free;
|
|
ppufile:=nil;
|
|
Message(unit_u_ppu_invalid_header);
|
|
exit;
|
|
end;
|
|
{ check for allowed PPU versions }
|
|
if not (ppufile.GetPPUVersion = CurrentPPUVersion) then
|
|
begin
|
|
Message1(unit_u_ppu_invalid_version,tostr(ppufile.GetPPUVersion));
|
|
ppufile.free;
|
|
ppufile:=nil;
|
|
exit;
|
|
end;
|
|
{ check the target processor }
|
|
if tsystemcpu(ppufile.header.cpu)<>target_cpu then
|
|
begin
|
|
ppufile.free;
|
|
ppufile:=nil;
|
|
Message(unit_u_ppu_invalid_processor);
|
|
exit;
|
|
end;
|
|
{ check target }
|
|
if tsystem(ppufile.header.target)<>target_info.system then
|
|
begin
|
|
ppufile.free;
|
|
ppufile:=nil;
|
|
Message(unit_u_ppu_invalid_target);
|
|
exit;
|
|
end;
|
|
{$ifdef cpufpemu}
|
|
{ check if floating point emulation is on?}
|
|
{ fpu emulation isn't unit levelwise
|
|
if ((ppufile.header.flags and uf_fpu_emulation)<>0) and
|
|
(cs_fp_emulation in aktmoduleswitches) then
|
|
begin
|
|
ppufile.free;
|
|
ppufile:=nil;
|
|
Message(unit_u_ppu_invalid_fpumode);
|
|
exit;
|
|
end;
|
|
}
|
|
{$endif cpufpemu}
|
|
|
|
{ Load values to be access easier }
|
|
flags:=ppufile.header.flags;
|
|
crc:=ppufile.header.checksum;
|
|
interface_crc:=ppufile.header.interface_checksum;
|
|
{ Show Debug info }
|
|
Message1(unit_u_ppu_time,filetimestring(ppufiletime));
|
|
Message1(unit_u_ppu_flags,tostr(flags));
|
|
Message1(unit_u_ppu_crc,hexstr(ppufile.header.checksum,8));
|
|
Message1(unit_u_ppu_crc,hexstr(ppufile.header.interface_checksum,8)+' (intfc)');
|
|
do_compile:=false;
|
|
openppu:=true;
|
|
end;
|
|
|
|
|
|
function tppumodule.search_unit(onlysource,shortname:boolean):boolean;
|
|
var
|
|
singlepathstring,
|
|
filename : string;
|
|
|
|
Function UnitExists(const ext:string;var foundfile:string):boolean;
|
|
begin
|
|
Message1(unit_t_unitsearch,Singlepathstring+filename+ext);
|
|
UnitExists:=FindFile(FileName+ext,Singlepathstring,foundfile);
|
|
end;
|
|
|
|
Function PPUSearchPath(const s:string):boolean;
|
|
var
|
|
found : boolean;
|
|
hs : string;
|
|
begin
|
|
Found:=false;
|
|
singlepathstring:=FixPath(s,false);
|
|
{ Check for PPU file }
|
|
Found:=UnitExists(target_info.unitext,hs);
|
|
if Found then
|
|
Begin
|
|
SetFileName(hs,false);
|
|
Found:=OpenPPU;
|
|
End;
|
|
PPUSearchPath:=Found;
|
|
end;
|
|
|
|
Function SourceSearchPath(const s:string):boolean;
|
|
var
|
|
found : boolean;
|
|
hs : string;
|
|
begin
|
|
Found:=false;
|
|
singlepathstring:=FixPath(s,false);
|
|
{ Check for Sources }
|
|
ppufile:=nil;
|
|
do_compile:=true;
|
|
recompile_reason:=rr_noppu;
|
|
{Check for .pp file}
|
|
Found:=UnitExists(sourceext,hs);
|
|
if not Found then
|
|
begin
|
|
{ Check for .pas }
|
|
Found:=UnitExists(pasext,hs);
|
|
end;
|
|
if not Found and (m_mac in aktmodeswitches) then
|
|
begin
|
|
{ Check for .p, if mode is macpas}
|
|
Found:=UnitExists(pext,hs);
|
|
end;
|
|
stringdispose(mainsource);
|
|
if Found then
|
|
begin
|
|
sources_avail:=true;
|
|
{ Load Filenames when found }
|
|
mainsource:=StringDup(hs);
|
|
SetFileName(hs,false);
|
|
end
|
|
else
|
|
sources_avail:=false;
|
|
SourceSearchPath:=Found;
|
|
end;
|
|
|
|
Function SearchPath(const s:string):boolean;
|
|
var
|
|
found : boolean;
|
|
begin
|
|
{ First check for a ppu, then for the source }
|
|
found:=false;
|
|
if not onlysource then
|
|
found:=PPUSearchPath(s);
|
|
if not found then
|
|
found:=SourceSearchPath(s);
|
|
SearchPath:=found;
|
|
end;
|
|
|
|
Function SearchPathList(list:TSearchPathList):boolean;
|
|
var
|
|
hp : TStringListItem;
|
|
found : boolean;
|
|
begin
|
|
found:=false;
|
|
hp:=TStringListItem(list.First);
|
|
while assigned(hp) do
|
|
begin
|
|
found:=SearchPath(hp.Str);
|
|
if found then
|
|
break;
|
|
hp:=TStringListItem(hp.next);
|
|
end;
|
|
SearchPathList:=found;
|
|
end;
|
|
|
|
var
|
|
fnd : boolean;
|
|
hs : string;
|
|
begin
|
|
if shortname then
|
|
filename:=FixFileName(Copy(realmodulename^,1,8))
|
|
else
|
|
filename:=FixFileName(realmodulename^);
|
|
{ try to find unit
|
|
1. look for ppu in cwd
|
|
2. look for ppu in outputpath if set, this is tp7 compatible (PFV)
|
|
3. look for the specified source file (from the uses line)
|
|
4. look for source in cwd
|
|
5. look in same path as local unit
|
|
6. local unit pathlist
|
|
7. global unit pathlist }
|
|
fnd:=false;
|
|
if not onlysource then
|
|
begin
|
|
fnd:=PPUSearchPath('.');
|
|
if (not fnd) and (outputpath^<>'') then
|
|
fnd:=PPUSearchPath(outputpath^);
|
|
end;
|
|
if (not fnd) and (sourcefn^<>'') then
|
|
begin
|
|
{ the full filename is specified so we can't use here the
|
|
searchpath (PFV) }
|
|
Message1(unit_t_unitsearch,AddExtension(sourcefn^,sourceext));
|
|
fnd:=FindFile(AddExtension(sourcefn^,sourceext),'',hs);
|
|
if not fnd then
|
|
begin
|
|
Message1(unit_t_unitsearch,AddExtension(sourcefn^,pasext));
|
|
fnd:=FindFile(AddExtension(sourcefn^,pasext),'',hs);
|
|
end;
|
|
if not fnd and ((m_mac in aktmodeswitches) or (tf_p_ext_support in target_info.flags)) then
|
|
begin
|
|
Message1(unit_t_unitsearch,AddExtension(sourcefn^,pext));
|
|
fnd:=FindFile(AddExtension(sourcefn^,pext),'',hs);
|
|
end;
|
|
if fnd then
|
|
begin
|
|
sources_avail:=true;
|
|
do_compile:=true;
|
|
recompile_reason:=rr_noppu;
|
|
stringdispose(mainsource);
|
|
mainsource:=StringDup(hs);
|
|
SetFileName(hs,false);
|
|
end;
|
|
end;
|
|
if not fnd then
|
|
fnd:=SourceSearchPath('.');
|
|
if (not fnd) and Assigned(Loaded_From) then
|
|
begin
|
|
fnd:=PPUSearchPath(Loaded_From.Path^);
|
|
if not fnd then
|
|
fnd:=SourceSearchPath(Loaded_From.Path^);
|
|
if not fnd then
|
|
fnd:=SearchPathList(Loaded_From.LocalUnitSearchPath);
|
|
end;
|
|
if not fnd then
|
|
fnd:=SearchPathList(UnitSearchPath);
|
|
|
|
{ try to find a file with the first 8 chars of the modulename, like
|
|
dos }
|
|
if (not fnd) and (length(filename)>8) then
|
|
begin
|
|
filename:=copy(filename,1,8);
|
|
fnd:=SearchPath('.');
|
|
if (not fnd) then
|
|
fnd:=SearchPathList(LocalUnitSearchPath);
|
|
if not fnd then
|
|
fnd:=SearchPathList(UnitSearchPath);
|
|
end;
|
|
search_unit:=fnd;
|
|
end;
|
|
|
|
|
|
{**********************************
|
|
PPU Reading/Writing Helpers
|
|
***********************************}
|
|
|
|
{$IFDEF MACRO_DIFF_HINT}
|
|
var
|
|
is_initial: Boolean;
|
|
|
|
procedure tppumodule.writeusedmacro(p:TNamedIndexItem;arg:pointer);
|
|
begin
|
|
if tmacro(p).is_used or is_initial then
|
|
begin
|
|
ppufile.putstring(p.name);
|
|
ppufile.putbyte(byte(is_initial));
|
|
ppufile.putbyte(byte(tmacro(p).is_used));
|
|
end;
|
|
end;
|
|
|
|
procedure tppumodule.writeusedmacros;
|
|
begin
|
|
ppufile.do_crc:=false;
|
|
is_initial:= true;
|
|
initialmacrosymtable.foreach(@writeusedmacro,nil);
|
|
is_initial:= false;
|
|
if assigned(globalmacrosymtable) then
|
|
globalmacrosymtable.foreach(@writeusedmacro,nil);
|
|
localmacrosymtable.foreach(@writeusedmacro,nil);
|
|
ppufile.writeentry(ibusedmacros);
|
|
ppufile.do_crc:=true;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure tppumodule.writesourcefiles;
|
|
var
|
|
hp : tinputfile;
|
|
i,j : longint;
|
|
begin
|
|
{ second write the used source files }
|
|
ppufile.do_crc:=false;
|
|
hp:=sourcefiles.files;
|
|
{ write source files directly in good order }
|
|
j:=0;
|
|
while assigned(hp) do
|
|
begin
|
|
inc(j);
|
|
hp:=hp.ref_next;
|
|
end;
|
|
while j>0 do
|
|
begin
|
|
hp:=sourcefiles.files;
|
|
for i:=1 to j-1 do
|
|
hp:=hp.ref_next;
|
|
ppufile.putstring(hp.name^);
|
|
ppufile.putlongint(hp.getfiletime);
|
|
dec(j);
|
|
end;
|
|
ppufile.writeentry(ibsourcefiles);
|
|
ppufile.do_crc:=true;
|
|
end;
|
|
|
|
|
|
procedure tppumodule.writeusedunit(intf:boolean);
|
|
var
|
|
hp : tused_unit;
|
|
oldcrc : boolean;
|
|
begin
|
|
{ write a reference for each used unit }
|
|
hp:=tused_unit(used_units.first);
|
|
while assigned(hp) do
|
|
begin
|
|
if hp.in_interface=intf then
|
|
begin
|
|
ppufile.putstring(hp.u.realmodulename^);
|
|
{ the checksum should not affect the crc of this unit ! (PFV) }
|
|
oldcrc:=ppufile.do_crc;
|
|
ppufile.do_crc:=false;
|
|
ppufile.putlongint(longint(hp.checksum));
|
|
ppufile.putlongint(longint(hp.interface_checksum));
|
|
ppufile.do_crc:=oldcrc;
|
|
end;
|
|
hp:=tused_unit(hp.next);
|
|
end;
|
|
ppufile.do_interface_crc:=true;
|
|
ppufile.writeentry(ibloadunit);
|
|
end;
|
|
|
|
|
|
procedure tppumodule.writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
|
|
var
|
|
hcontainer : tlinkcontainer;
|
|
s : string;
|
|
mask : cardinal;
|
|
begin
|
|
hcontainer:=TLinkContainer.Create;
|
|
while not p.empty do
|
|
begin
|
|
s:=p.get(mask);
|
|
if strippath then
|
|
ppufile.putstring(SplitFileName(s))
|
|
else
|
|
ppufile.putstring(s);
|
|
ppufile.putlongint(mask);
|
|
hcontainer.add(s,mask);
|
|
end;
|
|
ppufile.writeentry(id);
|
|
p.Free;
|
|
p:=hcontainer;
|
|
end;
|
|
|
|
|
|
procedure tppumodule.writederefmap;
|
|
var
|
|
i : longint;
|
|
oldcrc : boolean;
|
|
begin
|
|
{ This does not influence crc }
|
|
oldcrc:=ppufile.do_crc;
|
|
ppufile.do_crc:=false;
|
|
{ The unit map used for resolving }
|
|
ppufile.putlongint(derefmapcnt);
|
|
for i:=0 to derefmapcnt-1 do
|
|
begin
|
|
if not assigned(derefmap[i].u) then
|
|
internalerror(2005011512);
|
|
ppufile.putstring(derefmap[i].u.modulename^)
|
|
end;
|
|
ppufile.writeentry(ibderefmap);
|
|
ppufile.do_crc:=oldcrc;
|
|
end;
|
|
|
|
|
|
procedure tppumodule.writederefdata;
|
|
var
|
|
oldcrc : boolean;
|
|
len,hlen : longint;
|
|
buf : array[0..1023] of byte;
|
|
begin
|
|
if derefdataintflen>derefdata.size then
|
|
internalerror(200310223);
|
|
derefdata.seek(0);
|
|
{ Write interface data }
|
|
len:=derefdataintflen;
|
|
while (len>0) do
|
|
begin
|
|
if len>1024 then
|
|
hlen:=1024
|
|
else
|
|
hlen:=len;
|
|
derefdata.read(buf,hlen);
|
|
ppufile.putdata(buf,hlen);
|
|
dec(len,hlen);
|
|
end;
|
|
{ Write implementation data, this does not influence crc }
|
|
oldcrc:=ppufile.do_crc;
|
|
ppufile.do_crc:=false;
|
|
len:=derefdata.size-derefdataintflen;
|
|
while (len>0) do
|
|
begin
|
|
if len>1024 then
|
|
hlen:=1024
|
|
else
|
|
hlen:=len;
|
|
derefdata.read(buf,hlen);
|
|
ppufile.putdata(buf,hlen);
|
|
dec(len,hlen);
|
|
end;
|
|
if derefdata.pos<>derefdata.size then
|
|
internalerror(200310224);
|
|
ppufile.do_crc:=oldcrc;
|
|
ppufile.writeentry(ibderefdata);
|
|
end;
|
|
|
|
|
|
procedure tppumodule.putasmsymbol_in_idx(s:tnamedindexitem;arg:pointer);
|
|
begin
|
|
if tasmsymbol(s).ppuidx<>-1 then
|
|
librarydata.asmsymbolidx^[tasmsymbol(s).ppuidx-1]:=tasmsymbol(s);
|
|
end;
|
|
|
|
|
|
procedure tppumodule.writeasmsymbols;
|
|
var
|
|
s : tasmsymbol;
|
|
i : longint;
|
|
asmsymtype : byte;
|
|
begin
|
|
{ get an ordered list of all symbols to put in the ppu }
|
|
getmem(librarydata.asmsymbolidx,librarydata.asmsymbolppuidx*sizeof(pointer));
|
|
fillchar(librarydata.asmsymbolidx^,librarydata.asmsymbolppuidx*sizeof(pointer),0);
|
|
librarydata.symbolsearch.foreach(@putasmsymbol_in_idx,nil);
|
|
{ write the number of symbols }
|
|
ppufile.putlongint(librarydata.asmsymbolppuidx);
|
|
{ write the symbols from the indexed list to the ppu }
|
|
for i:=1 to librarydata.asmsymbolppuidx do
|
|
begin
|
|
s:=librarydata.asmsymbolidx^[i-1];
|
|
if not assigned(s) then
|
|
internalerror(200208071);
|
|
if s.Classtype=tasmlabel then
|
|
asmsymtype:=2
|
|
else
|
|
asmsymtype:=1;
|
|
ppufile.putbyte(asmsymtype);
|
|
case asmsymtype of
|
|
1 :
|
|
ppufile.putstring(s.name);
|
|
2 :
|
|
begin
|
|
ppufile.putbyte(byte(tasmlabel(s).labeltype));
|
|
ppufile.putlongint(tasmlabel(s).labelnr);
|
|
end;
|
|
end;
|
|
ppufile.putbyte(byte(s.defbind));
|
|
ppufile.putbyte(byte(s.typ));
|
|
end;
|
|
ppufile.writeentry(ibasmsymbols);
|
|
end;
|
|
|
|
{$IFDEF MACRO_DIFF_HINT}
|
|
|
|
{
|
|
Define MACRO_DIFF_HINT for the whole compiler (and ppudump)
|
|
to turn this facility on. Also the hint messages defined
|
|
below must be commented in in the msg/errore.msg file.
|
|
|
|
There is some problems with this, thats why it is shut off:
|
|
|
|
At the first compilation, consider a macro which is not initially
|
|
defined, but it is used (e g the check that it is undefined is true).
|
|
Since it do not exist, there is no macro object where the is_used
|
|
flag can be set. Later on when the macro is defined, and the ppu
|
|
is opened, the check cannot detect this.
|
|
|
|
Also, in which macro object should this flag be set ? It cant be set
|
|
for macros in the initialmacrosymboltable since this table is shared
|
|
between different files.
|
|
}
|
|
|
|
procedure tppumodule.readusedmacros;
|
|
var
|
|
hs : string;
|
|
mac : tmacro;
|
|
was_initial,
|
|
was_used : boolean;
|
|
{Reads macros which was defined or used when the module was compiled.
|
|
This is done when a ppu file is open, before it possibly is parsed.}
|
|
begin
|
|
while not ppufile.endofentry do
|
|
begin
|
|
hs:=ppufile.getstring;
|
|
was_initial:=boolean(ppufile.getbyte);
|
|
was_used:=boolean(ppufile.getbyte);
|
|
mac:=tmacro(initialmacrosymtable.search(hs));
|
|
if assigned(mac) then
|
|
begin
|
|
{$ifndef EXTDEBUG}
|
|
{ if we don't have the sources why tell }
|
|
if sources_avail then
|
|
{$endif ndef EXTDEBUG}
|
|
if (not was_initial) and was_used then
|
|
Message2(unit_h_cond_not_set_in_last_compile,hs,mainsource^);
|
|
end
|
|
else { not assigned }
|
|
if was_initial and
|
|
was_used then
|
|
Message2(unit_h_cond_set_in_last_compile,hs,mainsource^);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure tppumodule.readsourcefiles;
|
|
var
|
|
temp,hs : string;
|
|
temp_dir : string;
|
|
main_dir : string;
|
|
found,
|
|
is_main : boolean;
|
|
orgfiletime,
|
|
source_time : longint;
|
|
hp : tinputfile;
|
|
begin
|
|
sources_avail:=true;
|
|
is_main:=true;
|
|
main_dir:='';
|
|
while not ppufile.endofentry do
|
|
begin
|
|
hs:=ppufile.getstring;
|
|
orgfiletime:=ppufile.getlongint;
|
|
temp_dir:='';
|
|
if (flags and uf_in_library)<>0 then
|
|
begin
|
|
sources_avail:=false;
|
|
temp:=' library';
|
|
end
|
|
else if pos('Macro ',hs)=1 then
|
|
begin
|
|
{ we don't want to find this file }
|
|
{ but there is a problem with file indexing !! }
|
|
temp:='';
|
|
end
|
|
else
|
|
begin
|
|
{ check the date of the source files:
|
|
1 path of ppu
|
|
2 path of main source
|
|
3 current dir
|
|
4 include/unit path }
|
|
Source_Time:=GetNamedFileTime(path^+hs);
|
|
found:=false;
|
|
if Source_Time<>-1 then
|
|
hs:=path^+hs
|
|
else
|
|
if not(is_main) then
|
|
begin
|
|
Source_Time:=GetNamedFileTime(main_dir+hs);
|
|
if Source_Time<>-1 then
|
|
hs:=main_dir+hs;
|
|
end;
|
|
if Source_Time=-1 then
|
|
Source_Time:=GetNamedFileTime(hs);
|
|
if (Source_Time=-1) then
|
|
begin
|
|
if is_main then
|
|
found:=unitsearchpath.FindFile(hs,temp_dir)
|
|
else
|
|
found:=includesearchpath.FindFile(hs,temp_dir);
|
|
if found then
|
|
begin
|
|
Source_Time:=GetNamedFileTime(temp_dir);
|
|
if Source_Time<>-1 then
|
|
hs:=temp_dir;
|
|
end;
|
|
end;
|
|
if Source_Time<>-1 then
|
|
begin
|
|
if is_main then
|
|
main_dir:=splitpath(hs);
|
|
temp:=' time '+filetimestring(source_time);
|
|
if (orgfiletime<>-1) and
|
|
(source_time<>orgfiletime) then
|
|
begin
|
|
if ((flags and uf_release)=0) then
|
|
begin
|
|
do_compile:=true;
|
|
recompile_reason:=rr_sourcenewer;
|
|
end
|
|
else
|
|
Message2(unit_h_source_modified,hs,ppufilename^);
|
|
temp:=temp+' *';
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
sources_avail:=false;
|
|
temp:=' not found';
|
|
end;
|
|
hp:=tinputfile.create(hs);
|
|
{ the indexing is wrong here PM }
|
|
sourcefiles.register_file(hp);
|
|
end;
|
|
if is_main then
|
|
begin
|
|
stringdispose(mainsource);
|
|
mainsource:=stringdup(hs);
|
|
end;
|
|
Message1(unit_u_ppu_source,hs+temp);
|
|
is_main:=false;
|
|
end;
|
|
{ check if we want to rebuild every unit, only if the sources are
|
|
available }
|
|
if do_build and sources_avail and
|
|
((flags and uf_release)=0) then
|
|
begin
|
|
do_compile:=true;
|
|
recompile_reason:=rr_build;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tppumodule.readloadunit;
|
|
var
|
|
hs : string;
|
|
pu : tused_unit;
|
|
hp : tppumodule;
|
|
intfchecksum,
|
|
checksum : cardinal;
|
|
begin
|
|
while not ppufile.endofentry do
|
|
begin
|
|
hs:=ppufile.getstring;
|
|
checksum:=cardinal(ppufile.getlongint);
|
|
intfchecksum:=cardinal(ppufile.getlongint);
|
|
{ set the state of this unit before registering, this is
|
|
needed for a correct circular dependency check }
|
|
hp:=registerunit(self,hs,'');
|
|
pu:=addusedunit(hp,false,nil);
|
|
pu.checksum:=checksum;
|
|
pu.interface_checksum:=intfchecksum;
|
|
end;
|
|
in_interface:=false;
|
|
end;
|
|
|
|
|
|
procedure tppumodule.readlinkcontainer(var p:tlinkcontainer);
|
|
var
|
|
s : string;
|
|
m : longint;
|
|
begin
|
|
while not ppufile.endofentry do
|
|
begin
|
|
s:=ppufile.getstring;
|
|
m:=ppufile.getlongint;
|
|
p.add(s,m);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tppumodule.readderefmap;
|
|
var
|
|
i : longint;
|
|
begin
|
|
{ Load unit map used for resolving }
|
|
derefmapsize:=ppufile.getlongint;
|
|
getmem(derefmap,derefmapsize*sizeof(tderefmaprec));
|
|
fillchar(derefmap^,derefmapsize*sizeof(tderefmaprec),0);
|
|
for i:=0 to derefmapsize-1 do
|
|
derefmap[i].modulename:=stringdup(ppufile.getstring);
|
|
end;
|
|
|
|
|
|
procedure tppumodule.readderefdata;
|
|
var
|
|
len,hlen : longint;
|
|
buf : array[0..1023] of byte;
|
|
begin
|
|
len:=ppufile.entrysize;
|
|
while (len>0) do
|
|
begin
|
|
if len>1024 then
|
|
hlen:=1024
|
|
else
|
|
hlen:=len;
|
|
ppufile.getdata(buf,hlen);
|
|
derefdata.write(buf,hlen);
|
|
dec(len,hlen);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tppumodule.readasmsymbols;
|
|
var
|
|
labelnr,
|
|
i : longint;
|
|
name : string;
|
|
labeltype : tasmlabeltype;
|
|
bind : TAsmSymBind;
|
|
typ : TAsmSymType;
|
|
asmsymtype : byte;
|
|
begin
|
|
librarydata.asmsymbolppuidx:=ppufile.getlongint;
|
|
if librarydata.asmsymbolppuidx>0 then
|
|
begin
|
|
getmem(librarydata.asmsymbolidx,librarydata.asmsymbolppuidx*sizeof(pointer));
|
|
fillchar(librarydata.asmsymbolidx^,librarydata.asmsymbolppuidx*sizeof(pointer),0);
|
|
for i:=1 to librarydata.asmsymbolppuidx do
|
|
begin
|
|
asmsymtype:=ppufile.getbyte;
|
|
case asmsymtype of
|
|
1 :
|
|
name:=ppufile.getstring;
|
|
2 :
|
|
begin
|
|
labeltype:=tasmlabeltype(ppufile.getbyte);
|
|
labelnr:=ppufile.getlongint;
|
|
end;
|
|
else
|
|
internalerror(200208192);
|
|
end;
|
|
bind:=tasmsymbind(ppufile.getbyte);
|
|
typ:=tasmsymtype(ppufile.getbyte);
|
|
case asmsymtype of
|
|
1 :
|
|
librarydata.asmsymbolidx^[i-1]:=librarydata.newasmsymbol(name,bind,typ);
|
|
2 :
|
|
librarydata.asmsymbolidx^[i-1]:=librarydata.newasmlabel(labelnr,labeltype,(typ=AT_DATA));
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tppumodule.load_interface;
|
|
var
|
|
b : byte;
|
|
newmodulename : string;
|
|
begin
|
|
{ read interface part }
|
|
repeat
|
|
b:=ppufile.readentry;
|
|
case b of
|
|
ibmodulename :
|
|
begin
|
|
newmodulename:=ppufile.getstring;
|
|
if (cs_check_unit_name in aktglobalswitches) and
|
|
(upper(newmodulename)<>modulename^) then
|
|
Message2(unit_f_unit_name_error,realmodulename^,newmodulename);
|
|
stringdispose(modulename);
|
|
stringdispose(realmodulename);
|
|
modulename:=stringdup(upper(newmodulename));
|
|
realmodulename:=stringdup(newmodulename);
|
|
end;
|
|
ibsourcefiles :
|
|
readsourcefiles;
|
|
{$IFDEF MACRO_DIFF_HINT}
|
|
ibusedmacros :
|
|
readusedmacros;
|
|
{$ENDIF}
|
|
ibloadunit :
|
|
readloadunit;
|
|
iblinkunitofiles :
|
|
readlinkcontainer(LinkUnitOFiles);
|
|
iblinkunitstaticlibs :
|
|
readlinkcontainer(LinkUnitStaticLibs);
|
|
iblinkunitsharedlibs :
|
|
readlinkcontainer(LinkUnitSharedLibs);
|
|
iblinkotherofiles :
|
|
readlinkcontainer(LinkotherOFiles);
|
|
iblinkotherstaticlibs :
|
|
readlinkcontainer(LinkotherStaticLibs);
|
|
iblinkothersharedlibs :
|
|
readlinkcontainer(LinkotherSharedLibs);
|
|
iblinkdlls :
|
|
readlinkcontainer(LinkDlls);
|
|
ibderefmap :
|
|
readderefmap;
|
|
ibderefdata :
|
|
readderefdata;
|
|
ibendinterface :
|
|
break;
|
|
else
|
|
Message1(unit_f_ppu_invalid_entry,tostr(b));
|
|
end;
|
|
{ we can already stop when we know that we must recompile }
|
|
if do_compile then
|
|
exit;
|
|
until false;
|
|
end;
|
|
|
|
|
|
procedure tppumodule.load_implementation;
|
|
var
|
|
b : byte;
|
|
begin
|
|
{ read implementation part }
|
|
repeat
|
|
b:=ppufile.readentry;
|
|
case b of
|
|
ibloadunit :
|
|
readloadunit;
|
|
ibasmsymbols :
|
|
readasmsymbols;
|
|
ibendimplementation :
|
|
break;
|
|
else
|
|
Message1(unit_f_ppu_invalid_entry,tostr(b));
|
|
end;
|
|
until false;
|
|
end;
|
|
|
|
|
|
procedure tppumodule.load_symtable_refs;
|
|
var
|
|
b : byte;
|
|
i : longint;
|
|
begin
|
|
if (flags and uf_has_browser)<>0 then
|
|
begin
|
|
tstoredsymtable(globalsymtable).load_references(ppufile,true);
|
|
for i:=0 to unitmapsize-1 do
|
|
tstoredsymtable(globalsymtable).load_references(ppufile,false);
|
|
b:=ppufile.readentry;
|
|
if b<>ibendbrowser then
|
|
Message1(unit_f_ppu_invalid_entry,tostr(b));
|
|
end;
|
|
if ((flags and uf_local_browser)<>0) then
|
|
tstaticsymtable(localsymtable).load_references(ppufile,true);
|
|
end;
|
|
|
|
|
|
procedure tppumodule.writeppu;
|
|
var
|
|
pu : tused_unit;
|
|
begin
|
|
Message1(unit_u_ppu_write,realmodulename^);
|
|
|
|
{ create unit flags }
|
|
if cs_browser in aktmoduleswitches then
|
|
flags:=flags or uf_has_browser;
|
|
if cs_local_browser in aktmoduleswitches then
|
|
flags:=flags or uf_local_browser;
|
|
if do_release then
|
|
flags:=flags or uf_release;
|
|
if assigned(localsymtable) then
|
|
flags:=flags or uf_local_symtable;
|
|
{$ifdef cpufpemu}
|
|
if (cs_fp_emulation in aktmoduleswitches) then
|
|
flags:=flags or uf_fpu_emulation;
|
|
{$endif cpufpemu}
|
|
{$ifdef Test_Double_checksum_write}
|
|
Assign(CRCFile,s+'.IMP');
|
|
Rewrite(CRCFile);
|
|
{$endif def Test_Double_checksum_write}
|
|
|
|
{ create new ppufile }
|
|
ppufile:=tcompilerppufile.create(ppufilename^);
|
|
if not ppufile.createfile then
|
|
Message(unit_f_ppu_cannot_write);
|
|
|
|
{ first the unitname }
|
|
ppufile.putstring(realmodulename^);
|
|
ppufile.writeentry(ibmodulename);
|
|
|
|
writesourcefiles;
|
|
{$IFDEF MACRO_DIFF_HINT}
|
|
writeusedmacros;
|
|
{$ENDIF}
|
|
|
|
{ write interface uses }
|
|
writeusedunit(true);
|
|
|
|
{ write the objectfiles and libraries that come for this unit,
|
|
preserve the containers becuase they are still needed to load
|
|
the link.res. All doesn't depend on the crc! It doesn't matter
|
|
if a unit is in a .o or .a file }
|
|
ppufile.do_crc:=false;
|
|
writelinkcontainer(linkunitofiles,iblinkunitofiles,true);
|
|
writelinkcontainer(linkunitstaticlibs,iblinkunitstaticlibs,true);
|
|
writelinkcontainer(linkunitsharedlibs,iblinkunitsharedlibs,true);
|
|
writelinkcontainer(linkotherofiles,iblinkotherofiles,false);
|
|
writelinkcontainer(linkotherstaticlibs,iblinkotherstaticlibs,true);
|
|
writelinkcontainer(linkothersharedlibs,iblinkothersharedlibs,true);
|
|
writelinkcontainer(linkdlls,iblinkdlls,true);
|
|
ppufile.do_crc:=true;
|
|
|
|
{ generate implementation deref data, the interface deref data is
|
|
already generated when calculating the interface crc }
|
|
if (cs_compilesystem in aktmoduleswitches) then
|
|
begin
|
|
tstoredsymtable(globalsymtable).buildderef;
|
|
derefdataintflen:=derefdata.size;
|
|
end;
|
|
tstoredsymtable(globalsymtable).buildderefimpl;
|
|
if (flags and uf_local_symtable)<>0 then
|
|
begin
|
|
tstoredsymtable(localsymtable).buildderef;
|
|
tstoredsymtable(localsymtable).buildderefimpl;
|
|
end;
|
|
writederefmap;
|
|
writederefdata;
|
|
|
|
ppufile.writeentry(ibendinterface);
|
|
|
|
{ write the symtable entries }
|
|
tstoredsymtable(globalsymtable).ppuwrite(ppufile);
|
|
|
|
if assigned(globalmacrosymtable) and (globalmacrosymtable.symindex.count > 0) then
|
|
begin
|
|
ppufile.putbyte(byte(true));
|
|
ppufile.writeentry(ibexportedmacros);
|
|
tstoredsymtable(globalmacrosymtable).ppuwrite(ppufile);
|
|
end
|
|
else
|
|
begin
|
|
ppufile.putbyte(byte(false));
|
|
ppufile.writeentry(ibexportedmacros);
|
|
end;
|
|
|
|
{ everything after this doesn't affect the crc }
|
|
ppufile.do_crc:=false;
|
|
|
|
{ write implementation uses }
|
|
writeusedunit(false);
|
|
|
|
{ write asmsymbols }
|
|
writeasmsymbols;
|
|
|
|
{ end of implementation }
|
|
ppufile.writeentry(ibendimplementation);
|
|
|
|
{ write static symtable
|
|
needed for local debugging of unit functions }
|
|
if (flags and uf_local_symtable)<>0 then
|
|
tstoredsymtable(localsymtable).ppuwrite(ppufile);
|
|
|
|
{ write all browser section }
|
|
if (flags and uf_has_browser)<>0 then
|
|
begin
|
|
tstoredsymtable(globalsymtable).write_references(ppufile,true);
|
|
pu:=tused_unit(used_units.first);
|
|
while assigned(pu) do
|
|
begin
|
|
tstoredsymtable(pu.u.globalsymtable).write_references(ppufile,false);
|
|
pu:=tused_unit(pu.next);
|
|
end;
|
|
ppufile.writeentry(ibendbrowser);
|
|
end;
|
|
if ((flags and uf_local_browser)<>0) then
|
|
begin
|
|
if not assigned(localsymtable) then
|
|
internalerror(200408271);
|
|
tstaticsymtable(localsymtable).write_references(ppufile,true);
|
|
end;
|
|
|
|
{ the last entry ibend is written automaticly }
|
|
|
|
{ flush to be sure }
|
|
ppufile.flush;
|
|
{ create and write header }
|
|
ppufile.header.size:=ppufile.size;
|
|
ppufile.header.checksum:=ppufile.crc;
|
|
ppufile.header.interface_checksum:=ppufile.interface_crc;
|
|
ppufile.header.compiler:=wordversion;
|
|
ppufile.header.cpu:=word(target_cpu);
|
|
ppufile.header.target:=word(target_info.system);
|
|
ppufile.header.flags:=flags;
|
|
ppufile.writeheader;
|
|
|
|
{ save crc in current module also }
|
|
crc:=ppufile.crc;
|
|
interface_crc:=ppufile.interface_crc;
|
|
|
|
{$ifdef Test_Double_checksum_write}
|
|
close(CRCFile);
|
|
{$endif Test_Double_checksum_write}
|
|
|
|
ppufile.closefile;
|
|
ppufile.free;
|
|
ppufile:=nil;
|
|
end;
|
|
|
|
|
|
procedure tppumodule.getppucrc;
|
|
begin
|
|
{$ifdef Test_Double_checksum_write}
|
|
Assign(CRCFile,s+'.INT')
|
|
Rewrite(CRCFile);
|
|
{$endif def Test_Double_checksum_write}
|
|
|
|
{ create new ppufile }
|
|
ppufile:=tcompilerppufile.create(ppufilename^);
|
|
ppufile.crc_only:=true;
|
|
if not ppufile.createfile then
|
|
Message(unit_f_ppu_cannot_write);
|
|
|
|
{ first the unitname }
|
|
ppufile.putstring(realmodulename^);
|
|
ppufile.writeentry(ibmodulename);
|
|
|
|
{ the interface units affect the crc }
|
|
writeusedunit(true);
|
|
|
|
{ deref data of interface that affect the crc }
|
|
derefdata.reset;
|
|
tstoredsymtable(globalsymtable).buildderef;
|
|
derefdataintflen:=derefdata.size;
|
|
writederefmap;
|
|
writederefdata;
|
|
|
|
ppufile.writeentry(ibendinterface);
|
|
|
|
{ write the symtable entries }
|
|
tstoredsymtable(globalsymtable).ppuwrite(ppufile);
|
|
|
|
if assigned(globalmacrosymtable) and (globalmacrosymtable.symindex.count > 0) then
|
|
begin
|
|
ppufile.putbyte(byte(true));
|
|
ppufile.writeentry(ibexportedmacros);
|
|
tstoredsymtable(globalmacrosymtable).ppuwrite(ppufile);
|
|
end
|
|
else
|
|
begin
|
|
ppufile.putbyte(byte(false));
|
|
ppufile.writeentry(ibexportedmacros);
|
|
end;
|
|
|
|
{ save crc }
|
|
crc:=ppufile.crc;
|
|
interface_crc:=ppufile.interface_crc;
|
|
|
|
{ end of implementation, to generate a correct ppufile
|
|
for ppudump when using INTFPPU define }
|
|
ppufile.writeentry(ibendimplementation);
|
|
|
|
{$ifdef Test_Double_checksum}
|
|
crc_array:=ppufile.crc_test;
|
|
ppufile.crc_test:=nil;
|
|
crc_size:=ppufile.crc_index2;
|
|
crc_array2:=ppufile.crc_test2;
|
|
ppufile.crc_test2:=nil;
|
|
crc_size2:=ppufile.crc_index2;
|
|
{$endif Test_Double_checksum}
|
|
|
|
{$ifdef Test_Double_checksum_write}
|
|
close(CRCFile);
|
|
{$endif Test_Double_checksum_write}
|
|
|
|
{ create and write header, this will only be used
|
|
for debugging purposes }
|
|
ppufile.header.size:=ppufile.size;
|
|
ppufile.header.checksum:=ppufile.crc;
|
|
ppufile.header.interface_checksum:=ppufile.interface_crc;
|
|
ppufile.header.compiler:=wordversion;
|
|
ppufile.header.cpu:=word(target_cpu);
|
|
ppufile.header.target:=word(target_info.system);
|
|
ppufile.header.flags:=flags;
|
|
ppufile.writeheader;
|
|
|
|
ppufile.closefile;
|
|
ppufile.free;
|
|
ppufile:=nil;
|
|
end;
|
|
|
|
|
|
procedure tppumodule.load_usedunits;
|
|
var
|
|
pu : tused_unit;
|
|
load_refs : boolean;
|
|
oldobjectlibrary : tasmlibrarydata;
|
|
begin
|
|
if current_module<>self then
|
|
internalerror(200212284);
|
|
load_refs:=true;
|
|
|
|
{ load the used units from interface }
|
|
in_interface:=true;
|
|
pu:=tused_unit(used_units.first);
|
|
while assigned(pu) do
|
|
begin
|
|
if pu.in_interface then
|
|
begin
|
|
tppumodule(pu.u).loadppu;
|
|
{ if this unit is compiled we can stop }
|
|
if state=ms_compiled then
|
|
exit;
|
|
{ add this unit to the dependencies }
|
|
pu.u.adddependency(self);
|
|
{ need to recompile the current unit, check the interface
|
|
crc. And when not compiled with -Ur then check the complete
|
|
crc }
|
|
if (pu.u.interface_crc<>pu.interface_checksum) or
|
|
(
|
|
((ppufile.header.flags and uf_release)=0) and
|
|
(pu.u.crc<>pu.checksum)
|
|
) then
|
|
begin
|
|
Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.realmodulename^);
|
|
recompile_reason:=rr_crcchanged;
|
|
do_compile:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
pu:=tused_unit(pu.next);
|
|
end;
|
|
|
|
{ ok, now load the interface of this unit }
|
|
if current_module<>self then
|
|
internalerror(200208187);
|
|
globalsymtable:=tglobalsymtable.create(modulename^,moduleid);
|
|
tstoredsymtable(globalsymtable).ppuload(ppufile);
|
|
|
|
if ppufile.readentry<>ibexportedmacros then
|
|
Message(unit_f_ppu_read_error);
|
|
if boolean(ppufile.getbyte) then
|
|
begin
|
|
globalmacrosymtable:=tmacrosymtable.Create(true);
|
|
tstoredsymtable(globalmacrosymtable).ppuload(ppufile)
|
|
end;
|
|
|
|
interface_compiled:=true;
|
|
|
|
{ read the implementation part, containing
|
|
the implementation uses and objectdata }
|
|
in_interface:=false;
|
|
load_implementation;
|
|
|
|
{ now only read the implementation uses }
|
|
pu:=tused_unit(used_units.first);
|
|
while assigned(pu) do
|
|
begin
|
|
if (not pu.in_interface) then
|
|
begin
|
|
tppumodule(pu.u).loadppu;
|
|
{ if this unit is compiled we can stop }
|
|
if state=ms_compiled then
|
|
exit;
|
|
{ add this unit to the dependencies }
|
|
pu.u.adddependency(self);
|
|
{ need to recompile the current unit ? }
|
|
if (pu.u.interface_crc<>pu.interface_checksum) then
|
|
begin
|
|
Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.realmodulename^+' {impl}');
|
|
recompile_reason:=rr_crcchanged;
|
|
do_compile:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
pu:=tused_unit(pu.next);
|
|
end;
|
|
|
|
{ load implementation symtable }
|
|
if (flags and uf_local_symtable)<>0 then
|
|
begin
|
|
localsymtable:=tstaticsymtable.create(modulename^,moduleid);
|
|
tstaticsymtable(localsymtable).ppuload(ppufile);
|
|
end;
|
|
|
|
{ we can now derefence all pointers to the implementation parts }
|
|
oldobjectlibrary:=objectlibrary;
|
|
objectlibrary:=librarydata;
|
|
tstoredsymtable(globalsymtable).derefimpl;
|
|
if assigned(localsymtable) then
|
|
tstoredsymtable(localsymtable).derefimpl;
|
|
objectlibrary:=oldobjectlibrary;
|
|
|
|
{ load browser info if stored }
|
|
if ((flags and uf_has_browser)<>0) and load_refs then
|
|
begin
|
|
if current_module<>self then
|
|
internalerror(200208188);
|
|
load_symtable_refs;
|
|
end;
|
|
end;
|
|
|
|
|
|
function tppumodule.needrecompile:boolean;
|
|
var
|
|
pu : tused_unit;
|
|
begin
|
|
result:=false;
|
|
pu:=tused_unit(used_units.first);
|
|
while assigned(pu) do
|
|
begin
|
|
{ need to recompile the current unit, check the interface
|
|
crc. And when not compiled with -Ur then check the complete
|
|
crc }
|
|
if (pu.u.interface_crc<>pu.interface_checksum) or
|
|
(
|
|
(pu.in_interface) and
|
|
(pu.u.crc<>pu.checksum)
|
|
) then
|
|
begin
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
pu:=tused_unit(pu.next);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tppumodule.loadppu;
|
|
const
|
|
ImplIntf : array[boolean] of string[15]=('implementation','interface');
|
|
var
|
|
do_load,
|
|
second_time : boolean;
|
|
old_current_module : tmodule;
|
|
begin
|
|
old_current_module:=current_module;
|
|
Message3(unit_u_load_unit,old_current_module.modulename^,
|
|
ImplIntf[old_current_module.in_interface],
|
|
modulename^);
|
|
|
|
{ Update loaded_from to detect cycles }
|
|
loaded_from:=old_current_module;
|
|
|
|
{ check if the globalsymtable is already available, but
|
|
we must reload when the do_reload flag is set }
|
|
if (not do_reload) and
|
|
assigned(globalsymtable) then
|
|
exit;
|
|
|
|
{ reset }
|
|
do_load:=true;
|
|
second_time:=false;
|
|
current_module:=self;
|
|
SetCompileModule(current_module);
|
|
Fillchar(aktfilepos,0,sizeof(aktfilepos));
|
|
|
|
{ A force reload }
|
|
if do_reload then
|
|
begin
|
|
Message(unit_u_forced_reload);
|
|
do_reload:=false;
|
|
{ When the unit is already loaded or being loaded
|
|
we can maybe skip a complete reload/recompile }
|
|
if assigned(globalsymtable) and
|
|
(not needrecompile) then
|
|
begin
|
|
{ When we don't have any data stored yet there
|
|
is nothing to resolve }
|
|
if interface_compiled then
|
|
begin
|
|
Message1(unit_u_reresolving_unit,modulename^);
|
|
tstoredsymtable(globalsymtable).deref;
|
|
tstoredsymtable(globalsymtable).derefimpl;
|
|
if assigned(localsymtable) then
|
|
begin
|
|
tstoredsymtable(localsymtable).deref;
|
|
tstoredsymtable(localsymtable).derefimpl;
|
|
end;
|
|
end
|
|
else
|
|
Message1(unit_u_skipping_reresolving_unit,modulename^);
|
|
do_load:=false;
|
|
end;
|
|
end;
|
|
|
|
if do_load then
|
|
begin
|
|
{ we are loading a new module, save the state of the scanner
|
|
and reset scanner+module }
|
|
if assigned(current_scanner) then
|
|
current_scanner.tempcloseinputfile;
|
|
current_scanner:=nil;
|
|
|
|
{ loading the unit for a second time? }
|
|
if state=ms_registered then
|
|
state:=ms_load
|
|
else
|
|
begin
|
|
{ try to load the unit a second time first }
|
|
Message1(unit_u_second_load_unit,modulename^);
|
|
Message2(unit_u_previous_state,modulename^,ModuleStateStr[state]);
|
|
{ Flag modules to reload }
|
|
flagdependent(old_current_module);
|
|
{ Reset the module }
|
|
reset;
|
|
if state in [ms_compile,ms_second_compile] then
|
|
begin
|
|
Message1(unit_u_second_compile_unit,modulename^);
|
|
state:=ms_second_compile;
|
|
do_compile:=true;
|
|
end
|
|
else
|
|
state:=ms_second_load;
|
|
second_time:=true;
|
|
end;
|
|
|
|
{ close old_current_ppu on system that are
|
|
short on file handles like DOS PM }
|
|
{$ifdef SHORT_ON_FILE_HANDLES}
|
|
if old_current_module.is_unit and
|
|
assigned(tppumodule(old_current_module).ppufile) then
|
|
tppumodule(old_current_module).ppufile.tempclose;
|
|
{$endif SHORT_ON_FILE_HANDLES}
|
|
|
|
{ try to opening ppu, skip this when we already
|
|
know that we need to compile the unit }
|
|
if not do_compile then
|
|
begin
|
|
Message1(unit_u_loading_unit,modulename^);
|
|
search_unit(false,false);
|
|
if not do_compile then
|
|
begin
|
|
load_interface;
|
|
if not do_compile then
|
|
begin
|
|
load_usedunits;
|
|
if not do_compile then
|
|
Message1(unit_u_finished_loading_unit,modulename^);
|
|
end;
|
|
end;
|
|
{ PPU is not needed anymore }
|
|
if assigned(ppufile) then
|
|
begin
|
|
ppufile.closefile;
|
|
ppufile.free;
|
|
ppufile:=nil;
|
|
end;
|
|
end;
|
|
|
|
{ Do we need to recompile the unit }
|
|
if do_compile then
|
|
begin
|
|
{ recompile the unit or give a fatal error if sources not available }
|
|
if not(sources_avail) then
|
|
begin
|
|
if (not search_unit(true,false)) and
|
|
(length(modulename^)>8) then
|
|
search_unit(true,true);
|
|
if not(sources_avail) then
|
|
begin
|
|
if recompile_reason=rr_noppu then
|
|
Message1(unit_f_cant_find_ppu,realmodulename^)
|
|
else
|
|
Message1(unit_f_cant_compile_unit,realmodulename^);
|
|
end;
|
|
end;
|
|
{ Flag modules to reload }
|
|
flagdependent(old_current_module);
|
|
{ Reset the module }
|
|
reset;
|
|
{ compile this module }
|
|
if not(state in [ms_compile,ms_second_compile]) then
|
|
state:=ms_compile;
|
|
compile(mainsource^);
|
|
end
|
|
else
|
|
state:=ms_compiled;
|
|
|
|
if current_module<>self then
|
|
internalerror(200212282);
|
|
|
|
if in_interface then
|
|
internalerror(200212283);
|
|
|
|
{ for a second_time recompile reload all dependent units,
|
|
for a first time compile register the unit _once_ }
|
|
if second_time then
|
|
reload_flagged_units
|
|
else
|
|
usedunits.concat(tused_unit.create(self,true,false,nil));
|
|
|
|
{ reopen the old module }
|
|
{$ifdef SHORT_ON_FILE_HANDLES}
|
|
if old_current_module.is_unit and
|
|
assigned(tppumodule(old_current_module).ppufile) then
|
|
tppumodule(old_current_module).ppufile.tempopen;
|
|
{$endif SHORT_ON_FILE_HANDLES}
|
|
|
|
{ reload old scanner }
|
|
current_scanner:=tscannerfile(old_current_module.scanner);
|
|
if assigned(current_scanner) then
|
|
begin
|
|
current_scanner.tempopeninputfile;
|
|
current_scanner.gettokenpos
|
|
end
|
|
else
|
|
fillchar(aktfilepos,sizeof(aktfilepos),0);
|
|
end;
|
|
|
|
{ we are back, restore current_module }
|
|
current_module:=old_current_module;
|
|
SetCompileModule(current_module);
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
RegisterUnit
|
|
*****************************************************************************}
|
|
|
|
|
|
function registerunit(callermodule:tmodule;const s : stringid;const fn:string) : tppumodule;
|
|
var
|
|
ups : stringid;
|
|
hp : tppumodule;
|
|
hp2 : tmodule;
|
|
begin
|
|
{ Info }
|
|
ups:=upper(s);
|
|
{ search all loaded units }
|
|
hp:=tppumodule(loaded_units.first);
|
|
while assigned(hp) do
|
|
begin
|
|
if hp.modulename^=ups then
|
|
begin
|
|
{ only check for units. The main program is also
|
|
as a unit in the loaded_units list. We simply need
|
|
to ignore this entry (PFV) }
|
|
if hp.is_unit then
|
|
begin
|
|
{ both units in interface ? }
|
|
if callermodule.in_interface and
|
|
hp.in_interface then
|
|
begin
|
|
{ check for a cycle }
|
|
hp2:=callermodule.loaded_from;
|
|
while assigned(hp2) and (hp2<>hp) do
|
|
begin
|
|
if hp2.in_interface then
|
|
hp2:=hp2.loaded_from
|
|
else
|
|
hp2:=nil;
|
|
end;
|
|
if assigned(hp2) then
|
|
Message2(unit_f_circular_unit_reference,callermodule.realmodulename^,hp.realmodulename^);
|
|
end;
|
|
break;
|
|
end;
|
|
end;
|
|
{ the next unit }
|
|
hp:=tppumodule(hp.next);
|
|
end;
|
|
{ the unit is not in the loaded units,
|
|
we create an entry and register the unit }
|
|
if not assigned(hp) then
|
|
begin
|
|
Message1(unit_u_registering_new_unit,Upper(s));
|
|
hp:=tppumodule.create(callermodule,s,fn,true);
|
|
hp.loaded_from:=callermodule;
|
|
addloadedunit(hp);
|
|
end;
|
|
{ return }
|
|
registerunit:=hp;
|
|
end;
|
|
|
|
end.
|