mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-14 21:19:29 +02:00
1824a945cf
Report a warning if a unit is used from an indirectly used package. We are doing this only for the units used in contained units though as in the "contains" section there can't be such units anyway (and just checking all loaded units would lead to false positives). pkgutil.pas: + new procedure check_for_indirect_package_usages() which walks a TLinkedList of used units and warns on every unit that is from an indirectly imported package pmodules.pas, proc_package: * when checking all loaded units whether they are from a package or not also check for indirect package usages using the new procedure ........ pkgutil.pas, exportprocsym: * use a temporary variable for the procdef * restructure the if-expression a bit to make it better readable ........ pmodules.pas, finish_unit: * also release the generated proc symbol if the init function isn't needed ........ pkgutil.pas, add_package_libs: * fix exit condition (on Linux it probably worked by accident :/ ) ........ git-svn-id: trunk@33518 -
2322 lines
86 KiB
ObjectPascal
2322 lines
86 KiB
ObjectPascal
{
|
|
Copyright (c) 1998-2008 by Florian Klaempfl
|
|
|
|
Handles the parsing and loading of the modules (ppufiles)
|
|
|
|
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 pmodules;
|
|
|
|
{$i fpcdefs.inc}
|
|
|
|
interface
|
|
|
|
function proc_unit:boolean;
|
|
procedure proc_package;
|
|
procedure proc_program(islibrary : boolean);
|
|
|
|
implementation
|
|
|
|
uses
|
|
SysUtils,
|
|
globtype,version,systems,tokens,
|
|
cutils,cfileutl,cclasses,comphook,
|
|
globals,verbose,fmodule,finput,fppu,globstat,fpcp,fpkg,
|
|
symconst,symbase,symtype,symdef,symsym,symtable,symcreat,
|
|
wpoinfo,
|
|
aasmtai,aasmdata,aasmcpu,aasmbase,
|
|
cgbase,cgobj,ngenutil,
|
|
nbas,nutils,ncgutil,
|
|
link,assemble,import,export,gendef,entfile,ppu,comprsrc,dbgbase,
|
|
cresstr,procinfo,
|
|
pexports,
|
|
objcgutl,
|
|
pkgutil,
|
|
wpobase,
|
|
scanner,pbase,pexpr,psystem,psub,pdecsub,ncgvmt,ncgrtti,
|
|
cpuinfo;
|
|
|
|
|
|
procedure create_objectfile;
|
|
var
|
|
DLLScanner : TDLLScanner;
|
|
s : string;
|
|
KeepShared : TCmdStrList;
|
|
begin
|
|
{ try to create import entries from system dlls }
|
|
if (tf_has_dllscanner in target_info.flags) and
|
|
(not current_module.linkOtherSharedLibs.Empty) then
|
|
begin
|
|
{ Init DLLScanner }
|
|
if assigned(CDLLScanner[target_info.system]) then
|
|
DLLScanner:=CDLLScanner[target_info.system].Create
|
|
else
|
|
internalerror(200104121);
|
|
KeepShared:=TCmdStrList.Create;
|
|
{ Walk all shared libs }
|
|
While not current_module.linkOtherSharedLibs.Empty do
|
|
begin
|
|
S:=current_module.linkOtherSharedLibs.Getusemask(link_always);
|
|
if not DLLScanner.scan(s) then
|
|
KeepShared.Concat(s);
|
|
end;
|
|
DLLscanner.Free;
|
|
{ Recreate import section }
|
|
if (target_info.system in [system_i386_win32,system_i386_wdosx]) then
|
|
begin
|
|
if assigned(current_asmdata.asmlists[al_imports]) then
|
|
current_asmdata.asmlists[al_imports].clear
|
|
else
|
|
current_asmdata.asmlists[al_imports]:=TAsmList.Create;
|
|
importlib.generatelib;
|
|
end;
|
|
{ Readd the not processed files }
|
|
while not KeepShared.Empty do
|
|
begin
|
|
s:=KeepShared.GetFirst;
|
|
current_module.linkOtherSharedLibs.add(s,link_always);
|
|
end;
|
|
KeepShared.Free;
|
|
end;
|
|
|
|
{ allow a target-specific pass over all assembler code (used by LLVM
|
|
to insert type definitions }
|
|
cnodeutils.InsertObjectInfo;
|
|
|
|
{ Start and end module debuginfo, at least required for stabs
|
|
to insert n_sourcefile lines }
|
|
if (cs_debuginfo in current_settings.moduleswitches) or
|
|
(cs_use_lineinfo in current_settings.globalswitches) then
|
|
current_debuginfo.insertmoduleinfo;
|
|
|
|
{ create the .s file and assemble it }
|
|
if not(create_smartlink_library) or not(tf_no_objectfiles_when_smartlinking in target_info.flags) then
|
|
GenerateAsm(false);
|
|
|
|
{ Also create a smartlinked version ? }
|
|
if create_smartlink_library then
|
|
begin
|
|
GenerateAsm(true);
|
|
if (af_needar in target_asm.flags) then
|
|
Linker.MakeStaticLibrary;
|
|
end;
|
|
|
|
{ resource files }
|
|
CompileResourceFiles;
|
|
end;
|
|
|
|
|
|
procedure insertobjectfile;
|
|
{ Insert the used object file for this unit in the used list for this unit }
|
|
begin
|
|
current_module.linkunitofiles.add(current_module.objfilename,link_static);
|
|
current_module.flags:=current_module.flags or uf_static_linked;
|
|
|
|
if create_smartlink_library then
|
|
begin
|
|
current_module.linkunitstaticlibs.add(current_module.staticlibfilename ,link_smart);
|
|
current_module.flags:=current_module.flags or uf_smart_linked;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure create_dwarf_frame;
|
|
begin
|
|
{ Dwarf conflicts with smartlinking in separate .a files }
|
|
if create_smartlink_library then
|
|
exit;
|
|
{ Call frame information }
|
|
{ MWE: we write our own info, so dwarf asm support is not really needed }
|
|
{ if (af_supports_dwarf in target_asm.flags) and }
|
|
{ CFI is currently broken for Darwin }
|
|
if not(target_info.system in systems_darwin) and
|
|
(
|
|
(tf_needs_dwarf_cfi in target_info.flags) or
|
|
(target_dbg.id in [dbg_dwarf2, dbg_dwarf3])
|
|
) then
|
|
begin
|
|
current_asmdata.asmlists[al_dwarf_frame].Free;
|
|
current_asmdata.asmlists[al_dwarf_frame] := TAsmList.create;
|
|
current_asmdata.asmcfi.generate_code(current_asmdata.asmlists[al_dwarf_frame]);
|
|
end;
|
|
end;
|
|
|
|
Function CheckResourcesUsed : boolean;
|
|
var
|
|
hp : tused_unit;
|
|
found : Boolean;
|
|
begin
|
|
CheckResourcesUsed:=tf_has_winlike_resources in target_info.flags;
|
|
if not CheckResourcesUsed then exit;
|
|
|
|
hp:=tused_unit(usedunits.first);
|
|
found:=((current_module.flags and uf_has_resourcefiles)=uf_has_resourcefiles);
|
|
If not found then
|
|
While Assigned(hp) and not found do
|
|
begin
|
|
Found:=((hp.u.flags and uf_has_resourcefiles)=uf_has_resourcefiles);
|
|
hp:=tused_unit(hp.next);
|
|
end;
|
|
CheckResourcesUsed:=found;
|
|
end;
|
|
|
|
function AddUnit(const s:string): tppumodule;
|
|
var
|
|
hp : tppumodule;
|
|
unitsym : tunitsym;
|
|
begin
|
|
{ load unit }
|
|
hp:=registerunit(current_module,s,'');
|
|
hp.loadppu;
|
|
hp.adddependency(current_module);
|
|
{ add to symtable stack }
|
|
symtablestack.push(hp.globalsymtable);
|
|
if (m_mac in current_settings.modeswitches) and
|
|
assigned(hp.globalmacrosymtable) then
|
|
macrosymtablestack.push(hp.globalmacrosymtable);
|
|
{ insert unitsym }
|
|
unitsym:=cunitsym.create(s,hp);
|
|
inc(unitsym.refs);
|
|
tabstractunitsymtable(current_module.localsymtable).insertunit(unitsym);
|
|
{ add to used units }
|
|
current_module.addusedunit(hp,false,unitsym);
|
|
result:=hp;
|
|
end;
|
|
|
|
|
|
procedure maybeloadvariantsunit;
|
|
var
|
|
hp : tmodule;
|
|
begin
|
|
{ Do we need the variants unit? Skip this
|
|
for VarUtils unit for bootstrapping }
|
|
if (current_module.flags and uf_uses_variants=0) or
|
|
(current_module.modulename^='VARUTILS') then
|
|
exit;
|
|
{ Variants unit already loaded? }
|
|
hp:=tmodule(loaded_units.first);
|
|
while assigned(hp) do
|
|
begin
|
|
if hp.modulename^='VARIANTS' then
|
|
exit;
|
|
hp:=tmodule(hp.next);
|
|
end;
|
|
{ Variants unit is not loaded yet, load it now }
|
|
Message(parser_w_implicit_uses_of_variants_unit);
|
|
AddUnit('variants');
|
|
end;
|
|
|
|
|
|
function MaybeRemoveResUnit : boolean;
|
|
var
|
|
resources_used : boolean;
|
|
hp : tmodule;
|
|
uu : tused_unit;
|
|
unitname : shortstring;
|
|
begin
|
|
{ We simply remove the unit from:
|
|
- usedunit list, so that things like init/finalization table won't
|
|
contain references to this unit
|
|
- loaded_units list, so that the unit object file doesn't get linked
|
|
with the executable. }
|
|
{ Note: on windows we always need resources! }
|
|
resources_used:=(target_info.system in systems_all_windows)
|
|
or CheckResourcesUsed;
|
|
if (not resources_used) and (tf_has_winlike_resources in target_info.flags) then
|
|
begin
|
|
{ resources aren't used, so we don't need this unit }
|
|
if target_res.id=res_ext then
|
|
unitname:='FPEXTRES'
|
|
else
|
|
unitname:='FPINTRES';
|
|
Message1(unit_u_unload_resunit,unitname);
|
|
{ find the module }
|
|
hp:=tmodule(loaded_units.first);
|
|
while assigned(hp) do
|
|
begin
|
|
if hp.is_unit and (hp.modulename^=unitname) then break;
|
|
hp:=tmodule(hp.next);
|
|
end;
|
|
if not assigned(hp) then
|
|
internalerror(200801071);
|
|
{ find its tused_unit in the global list }
|
|
uu:=tused_unit(usedunits.first);
|
|
while assigned(uu) do
|
|
begin
|
|
if uu.u=hp then break;
|
|
uu:=tused_unit(uu.next);
|
|
end;
|
|
if not assigned(uu) then
|
|
internalerror(200801072);
|
|
{ remove the tused_unit }
|
|
usedunits.Remove(uu);
|
|
uu.Free;
|
|
{ remove the module }
|
|
loaded_units.Remove(hp);
|
|
unloaded_units.Concat(hp);
|
|
end;
|
|
MaybeRemoveResUnit:=resources_used;
|
|
end;
|
|
|
|
|
|
procedure loaddefaultunits;
|
|
begin
|
|
{ we are going to rebuild the symtablestack, clear it first }
|
|
symtablestack.clear;
|
|
macrosymtablestack.clear;
|
|
|
|
{ macro symtable }
|
|
macrosymtablestack.push(initialmacrosymtable);
|
|
|
|
{ are we compiling the system unit? }
|
|
if (cs_compilesystem in current_settings.moduleswitches) then
|
|
begin
|
|
systemunit:=tglobalsymtable(current_module.localsymtable);
|
|
{ create system defines }
|
|
create_intern_types;
|
|
create_intern_symbols;
|
|
{ Set the owner of errorsym and errortype to symtable to
|
|
prevent crashes when accessing .owner }
|
|
generrorsym.owner:=systemunit;
|
|
generrordef.owner:=systemunit;
|
|
exit;
|
|
end;
|
|
|
|
{ insert the system unit, it is allways the first. Load also the
|
|
internal types from the system unit }
|
|
AddUnit('system');
|
|
systemunit:=tglobalsymtable(symtablestack.top);
|
|
load_intern_types;
|
|
|
|
{ Set the owner of errorsym and errortype to symtable to
|
|
prevent crashes when accessing .owner }
|
|
generrorsym.owner:=systemunit;
|
|
generrordef.owner:=systemunit;
|
|
|
|
{ Units only required for main module }
|
|
if not(current_module.is_unit) then
|
|
begin
|
|
{ Heaptrc unit, load heaptrace before any other units especially objpas }
|
|
if (cs_use_heaptrc in current_settings.globalswitches) then
|
|
AddUnit('heaptrc');
|
|
{ Lineinfo unit }
|
|
if (cs_use_lineinfo in current_settings.globalswitches) then begin
|
|
case target_dbg.id of
|
|
dbg_stabs:
|
|
AddUnit('lineinfo');
|
|
dbg_stabx:
|
|
AddUnit('lnfogdb');
|
|
else
|
|
AddUnit('lnfodwrf');
|
|
end;
|
|
end;
|
|
{ Valgrind requires c memory manager }
|
|
if (cs_gdb_valgrind in current_settings.globalswitches) then
|
|
AddUnit('cmem');
|
|
{$ifdef cpufpemu}
|
|
{ Floating point emulation unit?
|
|
softfpu must be in the system unit anyways (FK)
|
|
if (cs_fp_emulation in current_settings.moduleswitches) and not(target_info.system in system_wince) then
|
|
AddUnit('softfpu');
|
|
}
|
|
{$endif cpufpemu}
|
|
{ Which kind of resource support?
|
|
Note: if resources aren't used this unit will be removed later,
|
|
otherwise we need it here since it must be loaded quite early }
|
|
if (tf_has_winlike_resources in target_info.flags) then
|
|
if target_res.id=res_ext then
|
|
AddUnit('fpextres')
|
|
else
|
|
AddUnit('fpintres');
|
|
end;
|
|
{ Objpas unit? }
|
|
if m_objpas in current_settings.modeswitches then
|
|
AddUnit('objpas');
|
|
|
|
{ Macpas unit? }
|
|
if m_mac in current_settings.modeswitches then
|
|
AddUnit('macpas');
|
|
|
|
if m_iso in current_settings.modeswitches then
|
|
AddUnit('iso7185');
|
|
|
|
if m_extpas in current_settings.modeswitches then
|
|
begin
|
|
{ basic procedures for Extended Pascal are for now provided by the iso unit }
|
|
AddUnit('iso7185');
|
|
AddUnit('extpas');
|
|
end;
|
|
|
|
{ blocks support? }
|
|
if m_blocks in current_settings.modeswitches then
|
|
AddUnit('blockrtl');
|
|
|
|
{ default char=widechar? }
|
|
if m_default_unicodestring in current_settings.modeswitches then
|
|
AddUnit('uuchar');
|
|
|
|
{ Objective-C support unit? }
|
|
if (m_objectivec1 in current_settings.modeswitches) then
|
|
begin
|
|
{ interface to Objective-C run time }
|
|
AddUnit('objc');
|
|
loadobjctypes;
|
|
{ NSObject }
|
|
if not(current_module.is_unit) or
|
|
(current_module.modulename^<>'OBJCBASE') then
|
|
AddUnit('objcbase');
|
|
end;
|
|
{ Profile unit? Needed for go32v2 only }
|
|
if (cs_profile in current_settings.moduleswitches) and
|
|
(target_info.system in [system_i386_go32v2,system_i386_watcom]) then
|
|
AddUnit('profile');
|
|
if (cs_load_fpcylix_unit in current_settings.globalswitches) then
|
|
begin
|
|
AddUnit('fpcylix');
|
|
AddUnit('dynlibs');
|
|
end;
|
|
|
|
{ CPU targets with microcontroller support can add a controller specific unit }
|
|
if ControllerSupport and (target_info.system in systems_embedded) and
|
|
(current_settings.controllertype<>ct_none) and
|
|
(embedded_controllers[current_settings.controllertype].controllerunitstr<>'') then
|
|
AddUnit(embedded_controllers[current_settings.controllertype].controllerunitstr);
|
|
end;
|
|
|
|
|
|
procedure loadautounits;
|
|
var
|
|
hs,s : string;
|
|
begin
|
|
hs:=autoloadunits;
|
|
repeat
|
|
s:=GetToken(hs,',');
|
|
if s='' then
|
|
break;
|
|
AddUnit(s);
|
|
until false;
|
|
end;
|
|
|
|
|
|
procedure loadunits(preservest:tsymtable);
|
|
var
|
|
s,sorg : ansistring;
|
|
fn : string;
|
|
pu : tused_unit;
|
|
hp2 : tmodule;
|
|
unitsym : tunitsym;
|
|
filepos : tfileposinfo;
|
|
begin
|
|
consume(_USES);
|
|
repeat
|
|
s:=pattern;
|
|
sorg:=orgpattern;
|
|
filepos:=current_tokenpos;
|
|
consume(_ID);
|
|
while token=_POINT do
|
|
begin
|
|
consume(_POINT);
|
|
s:=s+'.'+pattern;
|
|
sorg:=sorg+'.'+orgpattern;
|
|
consume(_ID);
|
|
end;
|
|
{ support "<unit> in '<file>'" construct, but not for tp7 }
|
|
fn:='';
|
|
if not(m_tp7 in current_settings.modeswitches) and
|
|
try_to_consume(_OP_IN) then
|
|
fn:=FixFileName(get_stringconst);
|
|
{ Give a warning if lineinfo is loaded }
|
|
if s='LINEINFO' then
|
|
begin
|
|
Message(parser_w_no_lineinfo_use_switch);
|
|
if (target_dbg.id in [dbg_dwarf2, dbg_dwarf3]) then
|
|
s := 'LNFODWRF';
|
|
sorg := s;
|
|
end;
|
|
{ Give a warning if objpas is loaded }
|
|
if s='OBJPAS' then
|
|
Message(parser_w_no_objpas_use_mode);
|
|
{ Using the unit itself is not possible }
|
|
if (s<>current_module.modulename^) then
|
|
begin
|
|
{ check if the unit is already used }
|
|
hp2:=nil;
|
|
pu:=tused_unit(current_module.used_units.first);
|
|
while assigned(pu) do
|
|
begin
|
|
if (pu.u.modulename^=s) then
|
|
begin
|
|
hp2:=pu.u;
|
|
break;
|
|
end;
|
|
pu:=tused_unit(pu.next);
|
|
end;
|
|
if not assigned(hp2) then
|
|
hp2:=registerunit(current_module,sorg,fn)
|
|
else
|
|
Message1(sym_e_duplicate_id,s);
|
|
{ Create unitsym, we need to use the name as specified, we
|
|
can not use the modulename because that can be different
|
|
when -Un is used }
|
|
current_tokenpos:=filepos;
|
|
unitsym:=cunitsym.create(sorg,nil);
|
|
tabstractunitsymtable(current_module.localsymtable).insertunit(unitsym);
|
|
{ the current module uses the unit hp2 }
|
|
current_module.addusedunit(hp2,true,unitsym);
|
|
end
|
|
else
|
|
Message1(sym_e_duplicate_id,s);
|
|
if token=_COMMA then
|
|
begin
|
|
pattern:='';
|
|
consume(_COMMA);
|
|
end
|
|
else
|
|
break;
|
|
until false;
|
|
|
|
{ Load the units }
|
|
pu:=tused_unit(current_module.used_units.first);
|
|
while assigned(pu) do
|
|
begin
|
|
{ Only load the units that are in the current
|
|
(interface/implementation) uses clause }
|
|
if pu.in_uses and
|
|
(pu.in_interface=current_module.in_interface) then
|
|
begin
|
|
tppumodule(pu.u).loadppu;
|
|
{ is our module compiled? then we can stop }
|
|
if current_module.state=ms_compiled then
|
|
exit;
|
|
{ add this unit to the dependencies }
|
|
pu.u.adddependency(current_module);
|
|
{ save crc values }
|
|
pu.checksum:=pu.u.crc;
|
|
pu.interface_checksum:=pu.u.interface_crc;
|
|
pu.indirect_checksum:=pu.u.indirect_crc;
|
|
{ connect unitsym to the module }
|
|
pu.unitsym.module:=pu.u;
|
|
{ add to symtable stack }
|
|
if assigned(preservest) then
|
|
symtablestack.pushafter(pu.u.globalsymtable,preservest)
|
|
else
|
|
symtablestack.push(pu.u.globalsymtable);
|
|
if (m_mac in current_settings.modeswitches) and
|
|
assigned(pu.u.globalmacrosymtable) then
|
|
macrosymtablestack.push(pu.u.globalmacrosymtable);
|
|
{ check hints }
|
|
pu.check_hints;
|
|
end;
|
|
pu:=tused_unit(pu.next);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure reset_all_defs;
|
|
begin
|
|
if assigned(current_module.wpoinfo) then
|
|
current_module.wpoinfo.resetdefs;
|
|
end;
|
|
|
|
|
|
procedure free_localsymtables(st:TSymtable);
|
|
var
|
|
i : longint;
|
|
def : tstoreddef;
|
|
pd : tprocdef;
|
|
begin
|
|
for i:=0 to st.DefList.Count-1 do
|
|
begin
|
|
def:=tstoreddef(st.DefList[i]);
|
|
if def.typ=procdef then
|
|
begin
|
|
pd:=tprocdef(def);
|
|
if assigned(pd.localst) and
|
|
(pd.localst.symtabletype<>staticsymtable) and
|
|
not(po_inline in pd.procoptions) then
|
|
begin
|
|
free_localsymtables(pd.localst);
|
|
pd.localst.free;
|
|
pd.localst:=nil;
|
|
end;
|
|
pd.freeimplprocdefinfo;
|
|
pd.done_paraloc_info(calleeside);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure free_unregistered_localsymtable_elements;
|
|
var
|
|
i: longint;
|
|
def: tdef;
|
|
sym: tsym;
|
|
begin
|
|
{ from high to low so we hopefully have moves of less data }
|
|
for i:=current_module.localsymtable.symlist.count-1 downto 0 do
|
|
begin
|
|
sym:=tsym(current_module.localsymtable.symlist[i]);
|
|
{ this also frees sym, as the symbols are owned by the symtable }
|
|
if not sym.is_registered then
|
|
current_module.localsymtable.Delete(sym);
|
|
end;
|
|
for i:=current_module.localsymtable.deflist.count-1 downto 0 do
|
|
begin
|
|
def:=tdef(current_module.localsymtable.deflist[i]);
|
|
{ this also frees def, as the defs are owned by the symtable }
|
|
if not def.is_registered and
|
|
not(df_not_registered_no_free in def.defoptions) then
|
|
current_module.localsymtable.deletedef(def);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure setupglobalswitches;
|
|
begin
|
|
if (cs_create_pic in current_settings.moduleswitches) then
|
|
begin
|
|
def_system_macro('FPC_PIC');
|
|
def_system_macro('PIC');
|
|
end;
|
|
end;
|
|
|
|
|
|
function create_main_proc(const name:string;potype:tproctypeoption;st:TSymtable):tcgprocinfo;
|
|
var
|
|
ps : tprocsym;
|
|
pd : tprocdef;
|
|
begin
|
|
{ there should be no current_procinfo available }
|
|
if assigned(current_procinfo) then
|
|
internalerror(200304275);
|
|
{Generate a procsym for main}
|
|
ps:=cprocsym.create('$'+name);
|
|
{ always register the symbol }
|
|
ps.register_sym;
|
|
{ main are allways used }
|
|
inc(ps.refs);
|
|
st.insert(ps);
|
|
pd:=tprocdef(cnodeutils.create_main_procdef(target_info.cprefix+name,potype,ps));
|
|
{ We don't need is a local symtable. Change it into the static
|
|
symtable }
|
|
if potype<>potype_mainstub then
|
|
begin
|
|
pd.localst.free;
|
|
pd.localst:=st;
|
|
end
|
|
else
|
|
pd.proccalloption:=pocall_cdecl;
|
|
handle_calling_convention(pd);
|
|
{ set procinfo and current_procinfo.procdef }
|
|
result:=tcgprocinfo(cprocinfo.create(nil));
|
|
result.procdef:=pd;
|
|
{ main proc does always a call e.g. to init system unit }
|
|
include(result.flags,pi_do_call);
|
|
end;
|
|
|
|
|
|
procedure release_main_proc(pi:tcgprocinfo);
|
|
begin
|
|
{ remove localst as it was replaced by staticsymtable }
|
|
pi.procdef.localst:=nil;
|
|
{ remove procinfo }
|
|
current_module.procinfo:=nil;
|
|
pi.free;
|
|
pi:=nil;
|
|
end;
|
|
|
|
|
|
|
|
{ Insert _GLOBAL_OFFSET_TABLE_ symbol if system uses it }
|
|
|
|
procedure maybe_load_got;
|
|
{$if defined(i386) or defined (sparc)}
|
|
var
|
|
gotvarsym : tstaticvarsym;
|
|
{$endif i386 or sparc}
|
|
begin
|
|
{$if defined(i386) or defined(sparc)}
|
|
if (cs_create_pic in current_settings.moduleswitches) and
|
|
(tf_pic_uses_got in target_info.flags) then
|
|
begin
|
|
{ insert symbol for got access in assembler code}
|
|
gotvarsym:=cstaticvarsym.create('_GLOBAL_OFFSET_TABLE_',
|
|
vs_value,voidpointertype,[vo_is_external],true);
|
|
gotvarsym.set_mangledname('_GLOBAL_OFFSET_TABLE_');
|
|
current_module.localsymtable.insert(gotvarsym);
|
|
{ avoid unnecessary warnings }
|
|
gotvarsym.varstate:=vs_read;
|
|
gotvarsym.refs:=1;
|
|
end;
|
|
{$endif i386 or sparc}
|
|
end;
|
|
|
|
function gen_implicit_initfinal(flag:word;st:TSymtable):tcgprocinfo;
|
|
begin
|
|
{ create procdef }
|
|
case flag of
|
|
uf_init :
|
|
begin
|
|
result:=create_main_proc(make_mangledname('',current_module.localsymtable,'init_implicit'),potype_unitinit,st);
|
|
result.procdef.aliasnames.insert(make_mangledname('INIT$',current_module.localsymtable,''));
|
|
end;
|
|
uf_finalize :
|
|
begin
|
|
result:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize_implicit'),potype_unitfinalize,st);
|
|
result.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
|
|
if (not current_module.is_unit) then
|
|
result.procdef.aliasnames.insert('PASCALFINALIZE');
|
|
end;
|
|
else
|
|
internalerror(200304253);
|
|
end;
|
|
result.code:=cnothingnode.create;
|
|
end;
|
|
|
|
|
|
procedure copy_macro(p:TObject; arg:pointer);
|
|
begin
|
|
current_module.globalmacrosymtable.insert(tmacro(p).getcopy);
|
|
end;
|
|
|
|
function try_consume_hintdirective(var moduleopt:tmoduleoptions; var deprecatedmsg:pshortstring):boolean;
|
|
var
|
|
deprecated_seen,
|
|
last_is_deprecated:boolean;
|
|
begin
|
|
try_consume_hintdirective:=false;
|
|
deprecated_seen:=false;
|
|
repeat
|
|
last_is_deprecated:=false;
|
|
case idtoken of
|
|
_LIBRARY :
|
|
begin
|
|
include(moduleopt,mo_hint_library);
|
|
try_consume_hintdirective:=true;
|
|
end;
|
|
_DEPRECATED :
|
|
begin
|
|
{ allow deprecated only once }
|
|
if deprecated_seen then
|
|
break;
|
|
include(moduleopt,mo_hint_deprecated);
|
|
try_consume_hintdirective:=true;
|
|
last_is_deprecated:=true;
|
|
deprecated_seen:=true;
|
|
end;
|
|
_EXPERIMENTAL :
|
|
begin
|
|
include(moduleopt,mo_hint_experimental);
|
|
try_consume_hintdirective:=true;
|
|
end;
|
|
_PLATFORM :
|
|
begin
|
|
include(moduleopt,mo_hint_platform);
|
|
try_consume_hintdirective:=true;
|
|
end;
|
|
_UNIMPLEMENTED :
|
|
begin
|
|
include(moduleopt,mo_hint_unimplemented);
|
|
try_consume_hintdirective:=true;
|
|
end;
|
|
else
|
|
break;
|
|
end;
|
|
consume(Token);
|
|
{ handle deprecated message }
|
|
if ((token=_CSTRING) or (token=_CCHAR)) and last_is_deprecated then
|
|
begin
|
|
if deprecatedmsg<>nil then
|
|
internalerror(201001221);
|
|
if token=_CSTRING then
|
|
deprecatedmsg:=stringdup(cstringpattern)
|
|
else
|
|
deprecatedmsg:=stringdup(pattern);
|
|
consume(token);
|
|
include(moduleopt,mo_has_deprecated_msg);
|
|
end;
|
|
until false;
|
|
end;
|
|
|
|
|
|
{$ifdef jvm}
|
|
procedure addmoduleclass;
|
|
var
|
|
def: tobjectdef;
|
|
typesym: ttypesym;
|
|
begin
|
|
{ java_jlobject may not have been parsed yet (system unit); in any
|
|
case, we only use this to refer to the class type, so inheritance
|
|
does not matter }
|
|
def:=cobjectdef.create(odt_javaclass,'__FPC_JVM_Module_Class_Alias$',nil,true);
|
|
include(def.objectoptions,oo_is_external);
|
|
include(def.objectoptions,oo_is_sealed);
|
|
def.objextname:=stringdup(current_module.realmodulename^);
|
|
typesym:=ctypesym.create('__FPC_JVM_Module_Class_Alias$',def,true);
|
|
symtablestack.top.insert(typesym);
|
|
end;
|
|
{$endif jvm}
|
|
|
|
type
|
|
tfinishstate=record
|
|
init_procinfo:tcgprocinfo;
|
|
end;
|
|
pfinishstate=^tfinishstate;
|
|
|
|
procedure finish_unit(module:tmodule;immediate:boolean);forward;
|
|
|
|
function proc_unit:boolean;
|
|
var
|
|
main_file: tinputfile;
|
|
s1,s2 : ^string; {Saves stack space}
|
|
init_procinfo : tcgprocinfo;
|
|
unitname : ansistring;
|
|
unitname8 : string[8];
|
|
i,j : longint;
|
|
finishstate:pfinishstate;
|
|
globalstate:pglobalstate;
|
|
consume_semicolon_after_uses:boolean;
|
|
begin
|
|
result:=true;
|
|
|
|
init_procinfo:=nil;
|
|
|
|
if m_mac in current_settings.modeswitches then
|
|
current_module.mode_switch_allowed:= false;
|
|
|
|
consume(_UNIT);
|
|
if compile_level=1 then
|
|
Status.IsExe:=false;
|
|
|
|
unitname:=orgpattern;
|
|
consume(_ID);
|
|
while token=_POINT do
|
|
begin
|
|
consume(_POINT);
|
|
unitname:=unitname+'.'+orgpattern;
|
|
consume(_ID);
|
|
end;
|
|
|
|
{ create filenames and unit name }
|
|
main_file := current_scanner.inputfile;
|
|
while assigned(main_file.next) do
|
|
main_file := main_file.next;
|
|
|
|
new(s1);
|
|
s1^:=current_module.modulename^;
|
|
current_module.SetFileName(main_file.path+main_file.name,true);
|
|
current_module.SetModuleName(unitname);
|
|
|
|
{ check for system unit }
|
|
new(s2);
|
|
s2^:=upper(ChangeFileExt(ExtractFileName(main_file.name),''));
|
|
unitname8:=copy(current_module.modulename^,1,8);
|
|
if (cs_check_unit_name in current_settings.globalswitches) and
|
|
(
|
|
not(
|
|
(current_module.modulename^=s2^) or
|
|
(
|
|
(length(current_module.modulename^)>8) and
|
|
(unitname8=s2^)
|
|
)
|
|
)
|
|
or
|
|
(
|
|
(length(s1^)>8) and
|
|
(s1^<>current_module.modulename^)
|
|
)
|
|
) then
|
|
Message1(unit_e_illegal_unit_name,current_module.realmodulename^);
|
|
if (current_module.modulename^='SYSTEM') then
|
|
include(current_settings.moduleswitches,cs_compilesystem);
|
|
dispose(s2);
|
|
dispose(s1);
|
|
|
|
if (target_info.system in systems_unit_program_exports) then
|
|
exportlib.preparelib(current_module.realmodulename^);
|
|
|
|
{ parse hint directives }
|
|
try_consume_hintdirective(current_module.moduleoptions, current_module.deprecatedmsg);
|
|
|
|
consume(_SEMICOLON);
|
|
|
|
{ handle the global switches, do this before interface, because after interface has been
|
|
read, all following directives are parsed as well }
|
|
setupglobalswitches;
|
|
|
|
consume(_INTERFACE);
|
|
|
|
{ global switches are read, so further changes aren't allowed }
|
|
current_module.in_global:=false;
|
|
|
|
message1(unit_u_loading_interface_units,current_module.modulename^);
|
|
|
|
{ update status }
|
|
status.currentmodule:=current_module.realmodulename^;
|
|
|
|
{ maybe turn off m_objpas if we are compiling objpas }
|
|
if (current_module.modulename^='OBJPAS') then
|
|
exclude(current_settings.modeswitches,m_objpas);
|
|
|
|
{ maybe turn off m_mac if we are compiling macpas }
|
|
if (current_module.modulename^='MACPAS') then
|
|
exclude(current_settings.modeswitches,m_mac);
|
|
|
|
parse_only:=true;
|
|
|
|
{ generate now the global symboltable,
|
|
define first as local to overcome dependency conflicts }
|
|
current_module.localsymtable:=tglobalsymtable.create(current_module.modulename^,current_module.moduleid);
|
|
|
|
{ insert unitsym of this unit to prevent other units having
|
|
the same name }
|
|
tabstractunitsymtable(current_module.localsymtable).insertunit(cunitsym.create(current_module.realmodulename^,current_module));
|
|
|
|
{ load default units, like the system unit }
|
|
loaddefaultunits;
|
|
|
|
{ insert qualifier for the system unit (allows system.writeln) }
|
|
if not(cs_compilesystem in current_settings.moduleswitches) and
|
|
(token=_USES) then
|
|
begin
|
|
loadunits(nil);
|
|
{ has it been compiled at a higher level ?}
|
|
if current_module.state=ms_compiled then
|
|
begin
|
|
Message1(parser_u_already_compiled,current_module.realmodulename^);
|
|
exit;
|
|
end;
|
|
|
|
consume_semicolon_after_uses:=true;
|
|
end
|
|
else
|
|
consume_semicolon_after_uses:=false;
|
|
|
|
{ move the global symtable from the temporary local to global }
|
|
current_module.globalsymtable:=current_module.localsymtable;
|
|
current_module.localsymtable:=nil;
|
|
|
|
{ number all units, so we know if a unit is used by this unit or
|
|
needs to be added implicitly }
|
|
current_module.updatemaps;
|
|
|
|
{ consume the semicolon after maps have been updated else conditional compiling expressions
|
|
might cause internal errors, see tw8611 }
|
|
if consume_semicolon_after_uses then
|
|
consume(_SEMICOLON);
|
|
|
|
{ create whole program optimisation information (may already be
|
|
updated in the interface, e.g., in case of classrefdef typed
|
|
constants }
|
|
current_module.wpoinfo:=tunitwpoinfo.create;
|
|
|
|
{ ... parse the declarations }
|
|
Message1(parser_u_parsing_interface,current_module.realmodulename^);
|
|
symtablestack.push(current_module.globalsymtable);
|
|
{$ifdef jvm}
|
|
{ fake classdef to represent the class corresponding to the unit }
|
|
addmoduleclass;
|
|
{$endif}
|
|
read_interface_declarations;
|
|
|
|
{ Export macros defined in the interface for macpas. The macros
|
|
are put in the globalmacrosymtable that will only be used by other
|
|
units. The current unit continues to use the localmacrosymtable }
|
|
if (m_mac in current_settings.modeswitches) then
|
|
begin
|
|
current_module.globalmacrosymtable:=tmacrosymtable.create(true);
|
|
current_module.localmacrosymtable.SymList.ForEachCall(@copy_macro,nil);
|
|
end;
|
|
|
|
{ leave when we got an error }
|
|
if (Errorcount>0) and not status.skip_error then
|
|
begin
|
|
Message1(unit_f_errors_in_unit,tostr(Errorcount));
|
|
status.skip_error:=true;
|
|
symtablestack.pop(current_module.globalsymtable);
|
|
exit;
|
|
end;
|
|
|
|
{ Our interface is compiled, generate CRC and switch to implementation }
|
|
if not(cs_compilesystem in current_settings.moduleswitches) and
|
|
(Errorcount=0) then
|
|
tppumodule(current_module).getppucrc;
|
|
current_module.in_interface:=false;
|
|
current_module.interface_compiled:=true;
|
|
|
|
{ First reload all units depending on our interface, we need to do this
|
|
in the implementation part to prevent erroneous circular references }
|
|
tppumodule(current_module).setdefgeneration;
|
|
tppumodule(current_module).reload_flagged_units;
|
|
|
|
{ Parse the implementation section }
|
|
if (m_mac in current_settings.modeswitches) and try_to_consume(_END) then
|
|
current_module.interface_only:=true
|
|
else
|
|
current_module.interface_only:=false;
|
|
|
|
parse_only:=false;
|
|
|
|
{ create static symbol table }
|
|
current_module.localsymtable:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid);
|
|
|
|
{ Insert _GLOBAL_OFFSET_TABLE_ symbol if system uses it }
|
|
maybe_load_got;
|
|
|
|
if not current_module.interface_only then
|
|
begin
|
|
consume(_IMPLEMENTATION);
|
|
Message1(unit_u_loading_implementation_units,current_module.modulename^);
|
|
{ Read the implementation units }
|
|
if token=_USES then
|
|
begin
|
|
loadunits(current_module.globalsymtable);
|
|
consume(_SEMICOLON);
|
|
end;
|
|
end;
|
|
|
|
if current_module.state=ms_compiled then
|
|
begin
|
|
symtablestack.pop(current_module.globalsymtable);
|
|
exit;
|
|
end;
|
|
|
|
{ All units are read, now give them a number }
|
|
current_module.updatemaps;
|
|
|
|
{ further, changing the globalsymtable is not allowed anymore }
|
|
current_module.globalsymtable.sealed:=true;
|
|
symtablestack.push(current_module.localsymtable);
|
|
|
|
if not current_module.interface_only then
|
|
begin
|
|
Message1(parser_u_parsing_implementation,current_module.modulename^);
|
|
if current_module.in_interface then
|
|
internalerror(200212285);
|
|
|
|
{ Compile the unit }
|
|
init_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'init'),potype_unitinit,current_module.localsymtable);
|
|
init_procinfo.procdef.aliasnames.insert(make_mangledname('INIT$',current_module.localsymtable,''));
|
|
init_procinfo.parse_body;
|
|
{ save file pos for debuginfo }
|
|
current_module.mainfilepos:=init_procinfo.entrypos;
|
|
end;
|
|
|
|
{ remove all units that we are waiting for that are already waiting for
|
|
us => breaking up circles }
|
|
for i:=0 to current_module.waitingunits.count-1 do
|
|
for j:=current_module.waitingforunit.count-1 downto 0 do
|
|
if current_module.waitingunits[i]=current_module.waitingforunit[j] then
|
|
current_module.waitingforunit.delete(j);
|
|
|
|
{$ifdef DEBUG_UNITWAITING}
|
|
Writeln('Units waiting for ', current_module.modulename^, ': ',
|
|
current_module.waitingforunit.Count);
|
|
{$endif}
|
|
result:=current_module.waitingforunit.count=0;
|
|
|
|
{ save all information that is needed for finishing the unit }
|
|
New(finishstate);
|
|
finishstate^.init_procinfo:=init_procinfo;
|
|
current_module.finishstate:=finishstate;
|
|
|
|
if result then
|
|
finish_unit(current_module,true)
|
|
else
|
|
begin
|
|
{ save the current state, so the parsing can continue where we left
|
|
of here }
|
|
New(globalstate);
|
|
save_global_state(globalstate^,true);
|
|
current_module.globalstate:=globalstate;
|
|
end;
|
|
end;
|
|
|
|
procedure finish_unit(module:tmodule;immediate:boolean);
|
|
|
|
function is_assembler_generated:boolean;
|
|
var
|
|
hal : tasmlisttype;
|
|
begin
|
|
result:=false;
|
|
if Errorcount=0 then
|
|
begin
|
|
for hal:=low(TasmlistType) to high(TasmlistType) do
|
|
if not current_asmdata.asmlists[hal].empty then
|
|
begin
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure module_is_done;inline;
|
|
begin
|
|
dispose(pglobalstate(current_module.globalstate));
|
|
current_module.globalstate:=nil;
|
|
dispose(pfinishstate(current_module.finishstate));
|
|
current_module.finishstate:=nil;
|
|
end;
|
|
|
|
var
|
|
{$ifdef EXTDEBUG}
|
|
store_crc,
|
|
{$endif EXTDEBUG}
|
|
store_interface_crc,
|
|
store_indirect_crc: cardinal;
|
|
force_init_final : boolean;
|
|
init_procinfo,
|
|
finalize_procinfo : tcgprocinfo;
|
|
i : longint;
|
|
ag : boolean;
|
|
finishstate : tfinishstate;
|
|
globalstate : tglobalstate;
|
|
waitingmodule : tmodule;
|
|
begin
|
|
fillchar(globalstate,sizeof(tglobalstate),0);
|
|
if not immediate then
|
|
begin
|
|
{$ifdef DEBUG_UNITWAITING}
|
|
writeln('finishing waiting unit ''', module.modulename^, '''');
|
|
{$endif DEBUG_UNITWAITING}
|
|
{ restore the state when we stopped working on the unit }
|
|
save_global_state(globalstate,true);
|
|
if not assigned(module.globalstate) then
|
|
internalerror(2012091802);
|
|
restore_global_state(pglobalstate(module.globalstate)^,true);
|
|
end;
|
|
|
|
{ current_module is now module }
|
|
|
|
if not assigned(current_module.finishstate) then
|
|
internalerror(2012091801);
|
|
finishstate:=pfinishstate(current_module.finishstate)^;
|
|
|
|
finalize_procinfo:=nil;
|
|
|
|
init_procinfo:=finishstate.init_procinfo;
|
|
|
|
{ Generate specializations of objectdefs methods }
|
|
generate_specialization_procs;
|
|
|
|
{ Generate VMTs }
|
|
if Errorcount=0 then
|
|
begin
|
|
write_vmts(current_module.globalsymtable,true);
|
|
write_vmts(current_module.localsymtable,false);
|
|
end;
|
|
|
|
{ add implementations for synthetic method declarations added by
|
|
the compiler }
|
|
add_synthetic_method_implementations(current_module.globalsymtable);
|
|
add_synthetic_method_implementations(current_module.localsymtable);
|
|
|
|
{ if the unit contains ansi/widestrings, initialization and
|
|
finalization code must be forced }
|
|
force_init_final:=tglobalsymtable(current_module.globalsymtable).needs_init_final or
|
|
tstaticsymtable(current_module.localsymtable).needs_init_final;
|
|
|
|
{ should we force unit initialization? }
|
|
{ this is a hack, but how can it be done better ? }
|
|
{ Now the sole purpose of this is to change 'init' to 'init_implicit',
|
|
is it needed at all? (Sergei) }
|
|
{ it's needed in case cnodeutils.force_init = true }
|
|
if (force_init_final or cnodeutils.force_init) and
|
|
assigned(init_procinfo) and
|
|
has_no_code(init_procinfo.code) then
|
|
begin
|
|
{ first release the not used init procinfo }
|
|
if assigned(init_procinfo) then
|
|
begin
|
|
release_proc_symbol(init_procinfo.procdef);
|
|
release_main_proc(init_procinfo);
|
|
end;
|
|
init_procinfo:=gen_implicit_initfinal(uf_init,current_module.localsymtable);
|
|
end;
|
|
{ finalize? }
|
|
if not current_module.interface_only and (token=_FINALIZATION) then
|
|
begin
|
|
{ Compile the finalize }
|
|
finalize_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,current_module.localsymtable);
|
|
finalize_procinfo.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
|
|
finalize_procinfo.parse_body;
|
|
end
|
|
else if force_init_final or cnodeutils.force_final then
|
|
finalize_procinfo:=gen_implicit_initfinal(uf_finalize,current_module.localsymtable);
|
|
|
|
{ Now both init and finalize bodies are read and it is known
|
|
which variables are used in both init and finalize we can now
|
|
generate the code. This is required to prevent putting a variable in
|
|
a register that is also used in the finalize body (PFV) }
|
|
if assigned(init_procinfo) then
|
|
begin
|
|
if (force_init_final or cnodeutils.force_init) or
|
|
not(has_no_code(init_procinfo.code)) then
|
|
begin
|
|
init_procinfo.code:=cnodeutils.wrap_proc_body(init_procinfo.procdef,init_procinfo.code);
|
|
init_procinfo.generate_code;
|
|
current_module.flags:=current_module.flags or uf_init;
|
|
end
|
|
else
|
|
release_proc_symbol(init_procinfo.procdef);
|
|
init_procinfo.resetprocdef;
|
|
release_main_proc(init_procinfo);
|
|
end;
|
|
if assigned(finalize_procinfo) then
|
|
begin
|
|
if force_init_final or
|
|
cnodeutils.force_init or
|
|
not(has_no_code(finalize_procinfo.code)) then
|
|
begin
|
|
finalize_procinfo.code:=cnodeutils.wrap_proc_body(finalize_procinfo.procdef,finalize_procinfo.code);
|
|
finalize_procinfo.generate_code;
|
|
current_module.flags:=current_module.flags or uf_finalize;
|
|
end
|
|
else
|
|
release_proc_symbol(finalize_procinfo.procdef);
|
|
finalize_procinfo.resetprocdef;
|
|
release_main_proc(finalize_procinfo);
|
|
end;
|
|
|
|
symtablestack.pop(current_module.localsymtable);
|
|
symtablestack.pop(current_module.globalsymtable);
|
|
|
|
{ the last char should always be a point }
|
|
consume(_POINT);
|
|
|
|
{ reset wpo flags for all defs }
|
|
reset_all_defs;
|
|
|
|
if (Errorcount=0) then
|
|
begin
|
|
{ tests, if all (interface) forwards are resolved }
|
|
tstoredsymtable(current_module.globalsymtable).check_forwards;
|
|
{ check if all private fields are used }
|
|
tstoredsymtable(current_module.globalsymtable).allprivatesused;
|
|
|
|
{ test static symtable }
|
|
tstoredsymtable(current_module.localsymtable).allsymbolsused;
|
|
tstoredsymtable(current_module.localsymtable).allprivatesused;
|
|
tstoredsymtable(current_module.localsymtable).check_forwards;
|
|
tstoredsymtable(current_module.localsymtable).checklabels;
|
|
|
|
{ used units }
|
|
current_module.allunitsused;
|
|
end;
|
|
|
|
{ leave when we got an error }
|
|
if (Errorcount>0) and not status.skip_error then
|
|
begin
|
|
Message1(unit_f_errors_in_unit,tostr(Errorcount));
|
|
status.skip_error:=true;
|
|
module_is_done;
|
|
if not immediate then
|
|
restore_global_state(globalstate,true);
|
|
exit;
|
|
end;
|
|
|
|
{ if an Objective-C module, generate rtti and module info }
|
|
MaybeGenerateObjectiveCImageInfo(current_module.globalsymtable,current_module.localsymtable);
|
|
|
|
{ do we need to add the variants unit? }
|
|
maybeloadvariantsunit;
|
|
|
|
{ generate rtti/init tables }
|
|
write_persistent_type_info(current_module.globalsymtable,true);
|
|
write_persistent_type_info(current_module.localsymtable,false);
|
|
|
|
{ Tables }
|
|
cnodeutils.InsertThreadvars;
|
|
|
|
{ Resource strings }
|
|
GenerateResourceStrings;
|
|
|
|
{ Widestring typed constants }
|
|
cnodeutils.InsertWideInits;
|
|
|
|
{ Resourcestring references }
|
|
cnodeutils.InsertResStrInits;
|
|
|
|
{ generate debuginfo }
|
|
if (cs_debuginfo in current_settings.moduleswitches) then
|
|
current_debuginfo.inserttypeinfo;
|
|
|
|
{ generate imports }
|
|
if current_module.ImportLibraryList.Count>0 then
|
|
importlib.generatelib;
|
|
|
|
{ insert own objectfile, or say that it's in a library
|
|
(no check for an .o when loading) }
|
|
ag:=is_assembler_generated;
|
|
if ag then
|
|
insertobjectfile
|
|
else
|
|
begin
|
|
current_module.flags:=current_module.flags or uf_no_link;
|
|
current_module.flags:=current_module.flags and not (uf_has_stabs_debuginfo or uf_has_dwarf_debuginfo);
|
|
end;
|
|
|
|
if ag then
|
|
begin
|
|
{ create callframe info }
|
|
create_dwarf_frame;
|
|
{ assemble }
|
|
create_objectfile;
|
|
end;
|
|
|
|
{ Write out the ppufile after the object file has been created }
|
|
store_interface_crc:=current_module.interface_crc;
|
|
store_indirect_crc:=current_module.indirect_crc;
|
|
{$ifdef EXTDEBUG}
|
|
store_crc:=current_module.crc;
|
|
{$endif EXTDEBUG}
|
|
if (Errorcount=0) then
|
|
tppumodule(current_module).writeppu;
|
|
|
|
if not(cs_compilesystem in current_settings.moduleswitches) then
|
|
begin
|
|
if store_interface_crc<>current_module.interface_crc then
|
|
Message1(unit_u_interface_crc_changed,current_module.ppufilename);
|
|
if store_indirect_crc<>current_module.indirect_crc then
|
|
Message1(unit_u_indirect_crc_changed,current_module.ppufilename);
|
|
end;
|
|
{$ifdef EXTDEBUG}
|
|
if not(cs_compilesystem in current_settings.moduleswitches) then
|
|
if (store_crc<>current_module.crc) then
|
|
Message1(unit_u_implementation_crc_changed,current_module.ppufilename);
|
|
{$endif EXTDEBUG}
|
|
|
|
{ release unregistered defs/syms from the localsymtable }
|
|
free_unregistered_localsymtable_elements;
|
|
{ release local symtables that are not needed anymore }
|
|
free_localsymtables(current_module.globalsymtable);
|
|
free_localsymtables(current_module.localsymtable);
|
|
|
|
{ leave when we got an error }
|
|
if (Errorcount>0) and not status.skip_error then
|
|
begin
|
|
Message1(unit_f_errors_in_unit,tostr(Errorcount));
|
|
status.skip_error:=true;
|
|
module_is_done;
|
|
if not immediate then
|
|
restore_global_state(globalstate,true);
|
|
exit;
|
|
end;
|
|
|
|
{$ifdef debug_devirt}
|
|
{ print out all instantiated class/object types }
|
|
writeln('constructed object/class/classreftypes in ',current_module.realmodulename^);
|
|
for i := 0 to current_module.wpoinfo.createdobjtypes.count-1 do
|
|
begin
|
|
write(' ',tdef(current_module.wpoinfo.createdobjtypes[i]).GetTypeName);
|
|
case tdef(current_module.wpoinfo.createdobjtypes[i]).typ of
|
|
objectdef:
|
|
case tobjectdef(current_module.wpoinfo.createdobjtypes[i]).objecttype of
|
|
odt_object:
|
|
writeln(' (object)');
|
|
odt_class:
|
|
writeln(' (class)');
|
|
else
|
|
internalerror(2008101103);
|
|
end;
|
|
else
|
|
internalerror(2008101104);
|
|
end;
|
|
end;
|
|
|
|
for i := 0 to current_module.wpoinfo.createdclassrefobjtypes.count-1 do
|
|
begin
|
|
write(' Class Of ',tdef(current_module.wpoinfo.createdclassrefobjtypes[i]).GetTypeName);
|
|
case tdef(current_module.wpoinfo.createdclassrefobjtypes[i]).typ of
|
|
objectdef:
|
|
case tobjectdef(current_module.wpoinfo.createdclassrefobjtypes[i]).objecttype of
|
|
odt_class:
|
|
writeln(' (classrefdef)');
|
|
else
|
|
internalerror(2008101105);
|
|
end
|
|
else
|
|
internalerror(2008101102);
|
|
end;
|
|
end;
|
|
{$endif debug_devirt}
|
|
|
|
Message1(unit_u_finished_compiling,current_module.modulename^);
|
|
|
|
module_is_done;
|
|
if not immediate then
|
|
restore_global_state(globalstate,true);
|
|
|
|
for i:=0 to module.waitingunits.count-1 do
|
|
begin
|
|
waitingmodule:=tmodule(module.waitingunits[i]);
|
|
waitingmodule.waitingforunit.remove(module);
|
|
{ only finish the module if it isn't already finished }
|
|
if (waitingmodule.waitingforunit.count=0) and
|
|
assigned(waitingmodule.finishstate) then
|
|
begin
|
|
finish_unit(waitingmodule,false);
|
|
waitingmodule.end_of_parsing;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure proc_package;
|
|
var
|
|
main_file : tinputfile;
|
|
hp,hp2 : tmodule;
|
|
pkg : tpcppackage;
|
|
{finalize_procinfo,
|
|
init_procinfo,
|
|
main_procinfo : tcgprocinfo;}
|
|
force_init_final : boolean;
|
|
uu : tused_unit;
|
|
module_name: ansistring;
|
|
pentry: ppackageentry;
|
|
begin
|
|
Status.IsPackage:=true;
|
|
Status.IsExe:=true;
|
|
parse_only:=false;
|
|
{main_procinfo:=nil;
|
|
init_procinfo:=nil;
|
|
finalize_procinfo:=nil;}
|
|
|
|
if not (tf_supports_packages in target_info.flags) then
|
|
message1(parser_e_packages_not_supported,target_info.name);
|
|
|
|
if not RelocSectionSetExplicitly then
|
|
RelocSection:=true;
|
|
|
|
{ Relocation works only without stabs under Windows when }
|
|
{ external linker (LD) is used. LD generates relocs for }
|
|
{ stab sections which is not loaded in memory. It causes }
|
|
{ AV error when DLL is loaded and relocation is needed. }
|
|
{ Internal linker does not have this problem. }
|
|
if RelocSection and
|
|
(target_info.system in systems_all_windows+[system_i386_wdosx]) and
|
|
(cs_link_extern in current_settings.globalswitches) then
|
|
begin
|
|
include(current_settings.globalswitches,cs_link_strip);
|
|
{ Warning stabs info does not work with reloc section !! }
|
|
if (cs_debuginfo in current_settings.moduleswitches) and
|
|
(target_dbg.id=dbg_stabs) then
|
|
begin
|
|
Message1(parser_w_parser_reloc_no_debug,current_module.mainsource);
|
|
Message(parser_w_parser_win32_debug_needs_WN);
|
|
exclude(current_settings.moduleswitches,cs_debuginfo);
|
|
end;
|
|
end;
|
|
{ get correct output names }
|
|
main_file := current_scanner.inputfile;
|
|
while assigned(main_file.next) do
|
|
main_file := main_file.next;
|
|
|
|
current_module.SetFileName(main_file.path+main_file.name,true);
|
|
|
|
{ consume _PACKAGE word }
|
|
consume(_ID);
|
|
|
|
module_name:=orgpattern;
|
|
consume(_ID);
|
|
while token=_POINT do
|
|
begin
|
|
consume(_POINT);
|
|
module_name:=module_name+'.'+orgpattern;
|
|
consume(_ID);
|
|
end;
|
|
|
|
current_module.setmodulename(module_name);
|
|
current_module.ispackage:=true;
|
|
exportlib.preparelib(module_name);
|
|
pkg:=tpcppackage.create(module_name);
|
|
|
|
if tf_library_needs_pic in target_info.flags then
|
|
include(current_settings.moduleswitches,cs_create_pic);
|
|
|
|
{ setup things using the switches, do this before the semicolon, because after the semicolon has been
|
|
read, all following directives are parsed as well }
|
|
|
|
setupglobalswitches;
|
|
|
|
consume(_SEMICOLON);
|
|
|
|
{ global switches are read, so further changes aren't allowed }
|
|
current_module.in_global:=false;
|
|
|
|
{ set implementation flag }
|
|
current_module.in_interface:=false;
|
|
current_module.interface_compiled:=true;
|
|
|
|
{ insert after the unit symbol tables the static symbol table }
|
|
{ of the program }
|
|
current_module.localsymtable:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid);
|
|
|
|
{ ensure that no packages are picked up from the options }
|
|
packagelist.clear;
|
|
|
|
{Read the packages used by the package we compile.}
|
|
if (token=_ID) and (idtoken=_REQUIRES) then
|
|
begin
|
|
{ consume _REQUIRES word }
|
|
consume(_ID);
|
|
while true do
|
|
begin
|
|
if token=_ID then
|
|
begin
|
|
module_name:=orgpattern;
|
|
consume(_ID);
|
|
while token=_POINT do
|
|
begin
|
|
consume(_POINT);
|
|
module_name:=module_name+'.'+orgpattern;
|
|
consume(_ID);
|
|
end;
|
|
add_package(module_name,false,true);
|
|
end
|
|
else
|
|
consume(_ID);
|
|
if token=_COMMA then
|
|
consume(_COMMA)
|
|
else
|
|
break;
|
|
end;
|
|
consume(_SEMICOLON);
|
|
end;
|
|
|
|
{ now load all packages, so that we can determine whether a unit is
|
|
already provided by one of the loaded packages }
|
|
load_packages;
|
|
|
|
{Load the units used by the program we compile.}
|
|
if (token=_ID) and (idtoken=_CONTAINS) then
|
|
begin
|
|
{ consume _CONTAINS word }
|
|
consume(_ID);
|
|
while true do
|
|
begin
|
|
if token=_ID then
|
|
begin
|
|
module_name:=orgpattern;
|
|
consume(_ID);
|
|
while token=_POINT do
|
|
begin
|
|
consume(_POINT);
|
|
module_name:=module_name+'.'+orgpattern;
|
|
consume(_ID);
|
|
end;
|
|
hp:=AddUnit(module_name);
|
|
if (hp.modulename^='SYSTEM') and not assigned(systemunit) then
|
|
begin
|
|
systemunit:=tglobalsymtable(hp.globalsymtable);
|
|
load_intern_types;
|
|
end;
|
|
end
|
|
else
|
|
consume(_ID);
|
|
if token=_COMMA then
|
|
consume(_COMMA)
|
|
else break;
|
|
end;
|
|
consume(_SEMICOLON);
|
|
end;
|
|
|
|
{ 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;
|
|
{ was this unit listed as a contained unit? If so => error }
|
|
if (hp<>current_module) and assigned(hp.package) then
|
|
begin
|
|
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 assigned(uu) then
|
|
message2(package_e_unit_already_contained_in_package,hp.realmodulename^,hp.package.realpackagename^);
|
|
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));
|
|
|
|
Message1(parser_u_parsing_implementation,current_module.mainsource);
|
|
|
|
symtablestack.push(current_module.localsymtable);
|
|
|
|
{ create whole program optimisation information }
|
|
current_module.wpoinfo:=tunitwpoinfo.create;
|
|
|
|
{ should we force unit initialization? }
|
|
force_init_final:=tstaticsymtable(current_module.localsymtable).needs_init_final;
|
|
if force_init_final or cnodeutils.force_init then
|
|
{init_procinfo:=gen_implicit_initfinal(uf_init,current_module.localsymtable)};
|
|
|
|
{ Add symbol to the exports section for win32 so smartlinking a
|
|
DLL will include the edata section }
|
|
if assigned(exportlib) and
|
|
(target_info.system in [system_i386_win32,system_i386_wdosx]) and
|
|
((current_module.flags and uf_has_exports)<>0) then
|
|
current_asmdata.asmlists[al_procedures].concat(tai_const.createname(make_mangledname('EDATA',current_module.localsymtable,''),0));
|
|
|
|
{ all labels must be defined before generating code }
|
|
if Errorcount=0 then
|
|
tstoredsymtable(current_module.localsymtable).checklabels;
|
|
|
|
symtablestack.pop(current_module.localsymtable);
|
|
|
|
{ consume the last point }
|
|
consume(_END);
|
|
consume(_POINT);
|
|
|
|
if (Errorcount=0) then
|
|
begin
|
|
{ test static symtable }
|
|
tstoredsymtable(current_module.localsymtable).allsymbolsused;
|
|
tstoredsymtable(current_module.localsymtable).allprivatesused;
|
|
tstoredsymtable(current_module.localsymtable).check_forwards;
|
|
|
|
{ Note: all contained units are considered as used }
|
|
end;
|
|
|
|
if target_info.system in systems_windows then
|
|
begin
|
|
new_section(current_asmdata.asmlists[al_globals],sec_data,'_FPCDummy',4);
|
|
current_asmdata.asmlists[al_globals].concat(tai_symbol.createname_global('_FPCDummy',AT_DATA,0));
|
|
current_asmdata.asmlists[al_globals].concat(tai_const.create_32bit(0));
|
|
|
|
new_section(current_asmdata.asmlists[al_procedures],sec_code,'',0);
|
|
current_asmdata.asmlists[al_procedures].concat(tai_symbol.createname_global('_DLLMainCRTStartup',AT_FUNCTION,0));
|
|
gen_fpc_dummy(current_asmdata.asmlists[al_procedures]);
|
|
current_asmdata.asmlists[al_procedures].concat(tai_const.createname('_FPCDummy',0));
|
|
end;
|
|
|
|
{ leave when we got an error }
|
|
if (Errorcount>0) and not status.skip_error then
|
|
begin
|
|
Message1(unit_f_errors_in_unit,tostr(Errorcount));
|
|
status.skip_error:=true;
|
|
pkg.free;
|
|
exit;
|
|
end;
|
|
|
|
{ remove all unused units, this happends when units are removed
|
|
from the uses clause in the source and the ppu was already being loaded }
|
|
hp:=tmodule(loaded_units.first);
|
|
while assigned(hp) do
|
|
begin
|
|
hp2:=hp;
|
|
hp:=tmodule(hp.next);
|
|
if assigned(hp2.package) then
|
|
add_package_unit_ref(hp2.package);
|
|
if hp2.is_unit and
|
|
not assigned(hp2.globalsymtable) then
|
|
loaded_units.remove(hp2);
|
|
end;
|
|
|
|
exportlib.ignoreduplicates:=true;
|
|
|
|
{ force exports }
|
|
uu:=tused_unit(usedunits.first);
|
|
while assigned(uu) do
|
|
begin
|
|
if not assigned(systemunit) and (uu.u.modulename^='SYSTEM') then
|
|
begin
|
|
systemunit:=tglobalsymtable(uu.u.globalsymtable);
|
|
load_intern_types;
|
|
end;
|
|
if not assigned(uu.u.package) then
|
|
export_unit(uu.u);
|
|
|
|
uu:=tused_unit(uu.next);
|
|
end;
|
|
|
|
{$ifdef arm}
|
|
{ Insert .pdata section for arm-wince.
|
|
It is needed for exception handling. }
|
|
if target_info.system in [system_arm_wince] then
|
|
InsertPData;
|
|
{$endif arm}
|
|
|
|
{ generate debuginfo }
|
|
if (cs_debuginfo in current_settings.moduleswitches) then
|
|
current_debuginfo.inserttypeinfo;
|
|
|
|
exportlib.generatelib;
|
|
|
|
exportlib.ignoreduplicates:=false;
|
|
|
|
{ create import libraries for all packages }
|
|
if packagelist.count>0 then
|
|
createimportlibfromexternals;
|
|
|
|
{ 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]);
|
|
|
|
{ insert own objectfile }
|
|
insertobjectfile;
|
|
|
|
{ assemble and link }
|
|
create_objectfile;
|
|
|
|
{ We might need the symbols info if not using
|
|
the default do_extractsymbolinfo
|
|
which is a dummy function PM }
|
|
needsymbolinfo:=do_extractsymbolinfo<>@def_extractsymbolinfo;
|
|
{ release all local symtables that are not needed anymore }
|
|
if (not needsymbolinfo) then
|
|
free_localsymtables(current_module.localsymtable);
|
|
|
|
{ leave when we got an error }
|
|
if (Errorcount>0) and not status.skip_error then
|
|
begin
|
|
Message1(unit_f_errors_in_unit,tostr(Errorcount));
|
|
status.skip_error:=true;
|
|
pkg.free;
|
|
exit;
|
|
end;
|
|
|
|
if (not current_module.is_unit) then
|
|
begin
|
|
{ we add all loaded units that are not part of a package to the
|
|
package; this includes units in the "contains" section as well
|
|
as implicitely imported ones }
|
|
hp:=tmodule(loaded_units.first);
|
|
while assigned(hp) do
|
|
begin
|
|
if (hp<>current_module) then
|
|
begin
|
|
if not assigned(hp.package) then
|
|
begin
|
|
pkg.addunit(hp);
|
|
check_for_indirect_package_usages(hp.used_units);
|
|
end
|
|
else
|
|
begin
|
|
pentry:=ppackageentry(packagelist.find(hp.package.packagename^));
|
|
if not assigned(pentry) then
|
|
internalerror(2015112301);
|
|
pkg.add_required_package(hp.package);
|
|
end;
|
|
end;
|
|
hp:=tmodule(hp.next);
|
|
end;
|
|
|
|
pkg.initmoduleinfo(current_module);
|
|
|
|
{ create the executable when we are at level 1 }
|
|
if (compile_level=1) then
|
|
begin
|
|
{ create global resource file by collecting all resource files }
|
|
CollectResourceFiles;
|
|
{ write .def file }
|
|
if (cs_link_deffile in current_settings.globalswitches) then
|
|
deffile.writefile;
|
|
|
|
{ generate the pcp file }
|
|
pkg.savepcp;
|
|
|
|
{ insert all .o files from all loaded units and
|
|
unload the units, we don't need them anymore.
|
|
Keep the current_module because that is still needed }
|
|
hp:=tmodule(loaded_units.first);
|
|
while assigned(hp) do
|
|
begin
|
|
{ only link in those units which should become part of this
|
|
package }
|
|
if not assigned(hp.package) then
|
|
linker.AddModuleFiles(hp);
|
|
hp2:=tmodule(hp.next);
|
|
if (hp<>current_module) and
|
|
(not needsymbolinfo) then
|
|
begin
|
|
loaded_units.remove(hp);
|
|
hp.free;
|
|
end;
|
|
hp:=hp2;
|
|
end;
|
|
{ add the library of directly used packages }
|
|
add_package_libs(linker);
|
|
{ and now link the package library }
|
|
linker.MakeSharedLibrary
|
|
end;
|
|
|
|
{ Give Fatal with error count for linker errors }
|
|
if (Errorcount>0) and not status.skip_error then
|
|
begin
|
|
Message1(unit_f_errors_in_unit,tostr(Errorcount));
|
|
status.skip_error:=true;
|
|
end;
|
|
|
|
pkg.free;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure proc_program(islibrary : boolean);
|
|
type
|
|
TProgramParam = record
|
|
name : ansistring;
|
|
nr : dword;
|
|
end;
|
|
var
|
|
main_file : tinputfile;
|
|
hp,hp2 : tmodule;
|
|
finalize_procinfo,
|
|
init_procinfo,
|
|
main_procinfo : tcgprocinfo;
|
|
force_init_final : boolean;
|
|
resources_used : boolean;
|
|
program_name : ansistring;
|
|
consume_semicolon_after_uses : boolean;
|
|
ps : tprogramparasym;
|
|
paramnum : longint;
|
|
textsym : ttypesym;
|
|
sc : array of TProgramParam;
|
|
i : Longint;
|
|
sysinitmod: tmodule;
|
|
begin
|
|
Status.IsLibrary:=IsLibrary;
|
|
Status.IsPackage:=false;
|
|
Status.IsExe:=true;
|
|
parse_only:=false;
|
|
main_procinfo:=nil;
|
|
init_procinfo:=nil;
|
|
finalize_procinfo:=nil;
|
|
resources_used:=false;
|
|
{ make the compiler happy and avoid an uninitialized variable warning on Setlength(sc,length(sc)+1); }
|
|
sc:=nil;
|
|
|
|
{ DLL defaults to create reloc info }
|
|
if islibrary then
|
|
begin
|
|
if not RelocSectionSetExplicitly then
|
|
RelocSection:=true;
|
|
end;
|
|
|
|
{ Relocation works only without stabs under Windows when }
|
|
{ external linker (LD) is used. LD generates relocs for }
|
|
{ stab sections which is not loaded in memory. It causes }
|
|
{ AV error when DLL is loaded and relocation is needed. }
|
|
{ Internal linker does not have this problem. }
|
|
if RelocSection and
|
|
(target_info.system in systems_all_windows+[system_i386_wdosx]) and
|
|
(cs_link_extern in current_settings.globalswitches) then
|
|
begin
|
|
include(current_settings.globalswitches,cs_link_strip);
|
|
{ Warning stabs info does not work with reloc section !! }
|
|
if (cs_debuginfo in current_settings.moduleswitches) and
|
|
(target_dbg.id=dbg_stabs) then
|
|
begin
|
|
Message1(parser_w_parser_reloc_no_debug,current_module.mainsource);
|
|
Message(parser_w_parser_win32_debug_needs_WN);
|
|
exclude(current_settings.moduleswitches,cs_debuginfo);
|
|
end;
|
|
end;
|
|
{ get correct output names }
|
|
main_file := current_scanner.inputfile;
|
|
while assigned(main_file.next) do
|
|
main_file := main_file.next;
|
|
|
|
current_module.SetFileName(main_file.path+main_file.name,true);
|
|
|
|
if islibrary then
|
|
begin
|
|
consume(_LIBRARY);
|
|
program_name:=orgpattern;
|
|
consume(_ID);
|
|
while token=_POINT do
|
|
begin
|
|
consume(_POINT);
|
|
program_name:=program_name+'.'+orgpattern;
|
|
consume(_ID);
|
|
end;
|
|
current_module.setmodulename(program_name);
|
|
current_module.islibrary:=true;
|
|
exportlib.preparelib(program_name);
|
|
|
|
if tf_library_needs_pic in target_info.flags then
|
|
begin
|
|
include(current_settings.moduleswitches,cs_create_pic);
|
|
{ also set create_pic for all unit compilation }
|
|
include(init_settings.moduleswitches,cs_create_pic);
|
|
end;
|
|
|
|
{ setup things using the switches, do this before the semicolon, because after the semicolon has been
|
|
read, all following directives are parsed as well }
|
|
setupglobalswitches;
|
|
|
|
consume(_SEMICOLON);
|
|
end
|
|
else
|
|
{ is there an program head ? }
|
|
if token=_PROGRAM then
|
|
begin
|
|
consume(_PROGRAM);
|
|
program_name:=orgpattern;
|
|
consume(_ID);
|
|
while token=_POINT do
|
|
begin
|
|
consume(_POINT);
|
|
program_name:=program_name+'.'+orgpattern;
|
|
consume(_ID);
|
|
end;
|
|
current_module.setmodulename(program_name);
|
|
if (target_info.system in systems_unit_program_exports) then
|
|
exportlib.preparelib(program_name);
|
|
if token=_LKLAMMER then
|
|
begin
|
|
consume(_LKLAMMER);
|
|
paramnum:=1;
|
|
repeat
|
|
if m_isolike_program_para in current_settings.modeswitches then
|
|
begin
|
|
if (pattern<>'INPUT') and (pattern<>'OUTPUT') then
|
|
begin
|
|
{ the symtablestack is not setup here, so text must be created later on }
|
|
Setlength(sc,length(sc)+1);
|
|
with sc[high(sc)] do
|
|
begin
|
|
name:=pattern;
|
|
nr:=paramnum;
|
|
end;
|
|
inc(paramnum);
|
|
end;
|
|
end;
|
|
consume(_ID);
|
|
until not try_to_consume(_COMMA);
|
|
consume(_RKLAMMER);
|
|
end;
|
|
|
|
{ setup things using the switches, do this before the semicolon, because after the semicolon has been
|
|
read, all following directives are parsed as well }
|
|
setupglobalswitches;
|
|
|
|
consume(_SEMICOLON);
|
|
end
|
|
else
|
|
begin
|
|
if (target_info.system in systems_unit_program_exports) then
|
|
exportlib.preparelib(current_module.realmodulename^);
|
|
|
|
{ setup things using the switches }
|
|
setupglobalswitches;
|
|
end;
|
|
|
|
{ load all packages, so we know whether a unit is contained inside a
|
|
package or not }
|
|
load_packages;
|
|
|
|
{ global switches are read, so further changes aren't allowed }
|
|
current_module.in_global:=false;
|
|
|
|
{ set implementation flag }
|
|
current_module.in_interface:=false;
|
|
current_module.interface_compiled:=true;
|
|
|
|
{ insert after the unit symbol tables the static symbol table
|
|
of the program }
|
|
current_module.localsymtable:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid);
|
|
|
|
{ load standard units (system,objpas,profile unit) }
|
|
loaddefaultunits;
|
|
|
|
{ Load units provided on the command line }
|
|
loadautounits;
|
|
|
|
{ insert iso program parameters }
|
|
if length(sc)>0 then
|
|
begin
|
|
textsym:=search_system_type('TEXT');
|
|
if not(assigned(textsym)) then
|
|
internalerror(2013011201);
|
|
for i:=0 to high(sc) do
|
|
begin
|
|
ps:=cprogramparasym.create(sc[i].name,sc[i].nr);
|
|
current_module.localsymtable.insert(ps,true);
|
|
end;
|
|
end;
|
|
|
|
{ Load the units used by the program we compile. }
|
|
if token=_USES then
|
|
begin
|
|
loadunits(nil);
|
|
consume_semicolon_after_uses:=true;
|
|
end
|
|
else
|
|
consume_semicolon_after_uses:=false;
|
|
|
|
{ All units are read, now give them a number }
|
|
current_module.updatemaps;
|
|
|
|
{ consume the semicolon after maps have been updated else conditional compiling expressions
|
|
might cause internal errors, see tw8611 }
|
|
if consume_semicolon_after_uses then
|
|
consume(_SEMICOLON);
|
|
|
|
{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));
|
|
|
|
Message1(parser_u_parsing_implementation,current_module.mainsource);
|
|
|
|
symtablestack.push(current_module.localsymtable);
|
|
|
|
{$ifdef jvm}
|
|
{ fake classdef to represent the class corresponding to the unit }
|
|
addmoduleclass;
|
|
{$endif}
|
|
|
|
{ Insert _GLOBAL_OFFSET_TABLE_ symbol if system uses it }
|
|
maybe_load_got;
|
|
|
|
{ create whole program optimisation information }
|
|
current_module.wpoinfo:=tunitwpoinfo.create;
|
|
|
|
{ The program intialization needs an alias, so it can be called
|
|
from the bootstrap code.}
|
|
if islibrary then
|
|
begin
|
|
main_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,mainaliasname),potype_proginit,current_module.localsymtable);
|
|
{ Win32 startup code needs a single name }
|
|
if not(target_info.system in (systems_darwin+systems_aix)) then
|
|
main_procinfo.procdef.aliasnames.insert('PASCALMAIN')
|
|
else
|
|
main_procinfo.procdef.aliasnames.insert(target_info.Cprefix+'PASCALMAIN')
|
|
end
|
|
else if (target_info.system in ([system_i386_netware,system_i386_netwlibc,system_powerpc_macos]+systems_darwin+systems_aix)) then
|
|
begin
|
|
{ create a stub with the name of the desired main routine, with
|
|
the same signature as the C "main" function, and call through to
|
|
FPC_SYSTEMMAIN, which will initialise everything based on its
|
|
parameters. This function cannot be in the system unit, because
|
|
its name can be configured on the command line (for use with e.g.
|
|
SDL, where the main function should be called SDL_main) }
|
|
main_procinfo:=create_main_proc(mainaliasname,potype_mainstub,current_module.localsymtable);
|
|
call_through_new_name(main_procinfo.procdef,target_info.cprefix+'FPC_SYSTEMMAIN');
|
|
main_procinfo.free;
|
|
{ now create the PASCALMAIN routine (which will be called from
|
|
FPC_SYSTEMMAIN) }
|
|
main_procinfo:=create_main_proc('PASCALMAIN',potype_proginit,current_module.localsymtable);
|
|
end
|
|
else
|
|
begin
|
|
main_procinfo:=create_main_proc(mainaliasname,potype_proginit,current_module.localsymtable);
|
|
main_procinfo.procdef.aliasnames.insert('PASCALMAIN');
|
|
end;
|
|
main_procinfo.parse_body;
|
|
{ save file pos for debuginfo }
|
|
current_module.mainfilepos:=main_procinfo.entrypos;
|
|
|
|
{ Generate specializations of objectdefs methods }
|
|
generate_specialization_procs;
|
|
|
|
{ Generate VMTs }
|
|
if Errorcount=0 then
|
|
write_vmts(current_module.localsymtable,false);
|
|
|
|
{ add implementations for synthetic method declarations added by
|
|
the compiler }
|
|
add_synthetic_method_implementations(current_module.localsymtable);
|
|
|
|
{ should we force unit initialization? }
|
|
force_init_final:=tstaticsymtable(current_module.localsymtable).needs_init_final;
|
|
if force_init_final or cnodeutils.force_init then
|
|
init_procinfo:=gen_implicit_initfinal(uf_init,current_module.localsymtable);
|
|
|
|
{ Add symbol to the exports section for win32 so smartlinking a
|
|
DLL will include the edata section }
|
|
if assigned(exportlib) and
|
|
(target_info.system in [system_i386_win32,system_i386_wdosx]) and
|
|
((current_module.flags and uf_has_exports)<>0) then
|
|
current_asmdata.asmlists[al_procedures].concat(tai_const.createname(make_mangledname('EDATA',current_module.localsymtable,''),0));
|
|
|
|
{ finalize? }
|
|
if token=_FINALIZATION then
|
|
begin
|
|
{ Parse the finalize }
|
|
finalize_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,current_module.localsymtable);
|
|
finalize_procinfo.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
|
|
finalize_procinfo.procdef.aliasnames.insert('PASCALFINALIZE');
|
|
finalize_procinfo.parse_body;
|
|
end
|
|
else
|
|
if force_init_final or cnodeutils.force_final then
|
|
finalize_procinfo:=gen_implicit_initfinal(uf_finalize,current_module.localsymtable);
|
|
|
|
{ the finalization routine of libraries is generic (and all libraries need to }
|
|
{ be finalized, so they can finalize any units they use }
|
|
if (islibrary) then
|
|
exportlib.setfininame(current_asmdata.asmlists[al_procedures],'FPC_LIB_EXIT');
|
|
|
|
{ all labels must be defined before generating code }
|
|
if Errorcount=0 then
|
|
tstoredsymtable(current_module.localsymtable).checklabels;
|
|
|
|
{ See remark in unit init/final }
|
|
main_procinfo.generate_code;
|
|
main_procinfo.resetprocdef;
|
|
release_main_proc(main_procinfo);
|
|
if assigned(init_procinfo) then
|
|
begin
|
|
{ initialization can be implicit only }
|
|
current_module.flags:=current_module.flags or uf_init;
|
|
init_procinfo.code:=cnodeutils.wrap_proc_body(init_procinfo.procdef,init_procinfo.code);
|
|
init_procinfo.generate_code;
|
|
init_procinfo.resetprocdef;
|
|
release_main_proc(init_procinfo);
|
|
end;
|
|
if assigned(finalize_procinfo) then
|
|
begin
|
|
if force_init_final or
|
|
cnodeutils.force_init or
|
|
not(has_no_code(finalize_procinfo.code)) then
|
|
begin
|
|
finalize_procinfo.code:=cnodeutils.wrap_proc_body(finalize_procinfo.procdef,finalize_procinfo.code);
|
|
finalize_procinfo.generate_code;
|
|
current_module.flags:=current_module.flags or uf_finalize;
|
|
end;
|
|
finalize_procinfo.resetprocdef;
|
|
release_main_proc(finalize_procinfo);
|
|
end;
|
|
|
|
symtablestack.pop(current_module.localsymtable);
|
|
|
|
{ consume the last point }
|
|
consume(_POINT);
|
|
|
|
{ reset wpo flags for all defs }
|
|
reset_all_defs;
|
|
|
|
if (Errorcount=0) then
|
|
begin
|
|
{ test static symtable }
|
|
tstoredsymtable(current_module.localsymtable).allsymbolsused;
|
|
tstoredsymtable(current_module.localsymtable).allprivatesused;
|
|
tstoredsymtable(current_module.localsymtable).check_forwards;
|
|
|
|
current_module.allunitsused;
|
|
end;
|
|
|
|
{ leave when we got an error }
|
|
if (Errorcount>0) and not status.skip_error then
|
|
begin
|
|
Message1(unit_f_errors_in_unit,tostr(Errorcount));
|
|
status.skip_error:=true;
|
|
exit;
|
|
end;
|
|
|
|
{ remove all unused units, this happens when units are removed
|
|
from the uses clause in the source and the ppu was already being loaded }
|
|
hp:=tmodule(loaded_units.first);
|
|
while assigned(hp) do
|
|
begin
|
|
hp2:=hp;
|
|
hp:=tmodule(hp.next);
|
|
if hp2.is_unit and
|
|
not assigned(hp2.globalsymtable) then
|
|
begin
|
|
loaded_units.remove(hp2);
|
|
unloaded_units.concat(hp2);
|
|
end;
|
|
end;
|
|
|
|
{ do we need to add the variants unit? }
|
|
maybeloadvariantsunit;
|
|
|
|
{ Now that everything has been compiled we know if we need resource
|
|
support. If not, remove the unit. }
|
|
resources_used:=MaybeRemoveResUnit;
|
|
|
|
linker.initsysinitunitname;
|
|
if target_info.system in systems_internal_sysinit then
|
|
begin
|
|
{ add start/halt unit }
|
|
sysinitmod:=AddUnit(linker.sysinitunit);
|
|
end
|
|
else
|
|
sysinitmod:=nil;
|
|
|
|
{$ifdef arm}
|
|
{ Insert .pdata section for arm-wince.
|
|
It is needed for exception handling. }
|
|
if target_info.system in [system_arm_wince] then
|
|
InsertPData;
|
|
{$endif arm}
|
|
|
|
cnodeutils.InsertThreadvars;
|
|
|
|
{ generate rtti/init tables }
|
|
write_persistent_type_info(current_module.localsymtable,false);
|
|
|
|
{ if an Objective-C module, generate rtti and module info }
|
|
MaybeGenerateObjectiveCImageInfo(nil,current_module.localsymtable);
|
|
|
|
{ generate debuginfo }
|
|
if (cs_debuginfo in current_settings.moduleswitches) then
|
|
current_debuginfo.inserttypeinfo;
|
|
|
|
if islibrary or (target_info.system in systems_unit_program_exports) then
|
|
exportlib.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]);
|
|
|
|
{ Resource strings }
|
|
GenerateResourceStrings;
|
|
|
|
{ Windows widestring needing initialization }
|
|
cnodeutils.InsertWideInits;
|
|
|
|
{ Resourcestring references (const foo:string=someresourcestring) }
|
|
cnodeutils.InsertResStrInits;
|
|
|
|
{ insert Tables and StackLength }
|
|
cnodeutils.InsertInitFinalTable;
|
|
cnodeutils.InsertThreadvarTablesTable;
|
|
cnodeutils.InsertResourceTablesTable;
|
|
cnodeutils.InsertWideInitsTablesTable;
|
|
cnodeutils.InsertResStrTablesTable;
|
|
cnodeutils.InsertMemorySizes;
|
|
|
|
{ Insert symbol to resource info }
|
|
cnodeutils.InsertResourceInfo(resources_used);
|
|
|
|
{ create callframe info }
|
|
create_dwarf_frame;
|
|
|
|
{ create import library for all packages }
|
|
if packagelist.count>0 then
|
|
createimportlibfromexternals;
|
|
|
|
{ generate imports }
|
|
if current_module.ImportLibraryList.Count>0 then
|
|
importlib.generatelib;
|
|
|
|
{ insert own objectfile }
|
|
insertobjectfile;
|
|
|
|
{ assemble and link }
|
|
create_objectfile;
|
|
|
|
{ We might need the symbols info if not using
|
|
the default do_extractsymbolinfo
|
|
which is a dummy function PM }
|
|
needsymbolinfo:=
|
|
(do_extractsymbolinfo<>@def_extractsymbolinfo) or
|
|
((current_settings.genwpoptimizerswitches*WPOptimizationsNeedingAllUnitInfo)<>[]);
|
|
|
|
{ release all local symtables that are not needed anymore }
|
|
if (not needsymbolinfo) then
|
|
free_localsymtables(current_module.localsymtable);
|
|
|
|
{ leave when we got an error }
|
|
if (Errorcount>0) and not status.skip_error then
|
|
begin
|
|
Message1(unit_f_errors_in_unit,tostr(Errorcount));
|
|
status.skip_error:=true;
|
|
exit;
|
|
end;
|
|
|
|
if (not current_module.is_unit) then
|
|
begin
|
|
{ create the executable when we are at level 1 }
|
|
if (compile_level=1) then
|
|
begin
|
|
{ create global resource file by collecting all resource files }
|
|
CollectResourceFiles;
|
|
{ write .def file }
|
|
if (cs_link_deffile in current_settings.globalswitches) then
|
|
deffile.writefile;
|
|
{ link SysInit (if any) first, to have behavior consistent with
|
|
assembler startup files }
|
|
if assigned(sysinitmod) then
|
|
linker.AddModuleFiles(sysinitmod);
|
|
{ insert all .o files from all loaded units and
|
|
unload the units, we don't need them anymore.
|
|
Keep the current_module because that is still needed }
|
|
hp:=tmodule(loaded_units.first);
|
|
while assigned(hp) do
|
|
begin
|
|
if (hp<>sysinitmod) and (hp.flags and uf_in_library=0) then
|
|
linker.AddModuleFiles(hp);
|
|
hp2:=tmodule(hp.next);
|
|
if assigned(hp.package) then
|
|
add_package_unit_ref(hp.package);
|
|
if (hp<>current_module) and
|
|
(not needsymbolinfo) then
|
|
begin
|
|
loaded_units.remove(hp);
|
|
hp.free;
|
|
end;
|
|
hp:=hp2;
|
|
end;
|
|
{ free also unneeded units we didn't free before }
|
|
if not needsymbolinfo then
|
|
unloaded_units.Clear;
|
|
{ add all directly used packages as libraries }
|
|
add_package_libs(linker);
|
|
{ finally we can create a executable }
|
|
if current_module.islibrary then
|
|
linker.MakeSharedLibrary
|
|
else
|
|
linker.MakeExecutable;
|
|
|
|
{ collect all necessary information for whole-program optimization }
|
|
wpoinfomanager.extractwpoinfofromprogram;
|
|
end;
|
|
|
|
|
|
{ Give Fatal with error count for linker errors }
|
|
if (Errorcount>0) and not status.skip_error then
|
|
begin
|
|
Message1(unit_f_errors_in_unit,tostr(Errorcount));
|
|
status.skip_error:=true;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end.
|