mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-12 22:10:38 +02:00
f8e9b33f99
Merged revision(s) 28796, 28837-28845, 28847-28850, 28852, 32135 from branches/svenbarth/packages:
Provide possibility to pass packages and search paths for packages as parameters.
fpkg.pas:
+ new unit which contains the base types related to package files (most importantly "tpackage")
globals.pas:
+ new variable "packagesearchpath" which contains all paths in which package files should be looked for
+ new variable "packagelist" which contains a list of all packages that should be used in a program or library
* InitGlobals & DoneGlobals: initialize/finalize "packagesearchpath" accordingly ("packagelist" is handled in unit fpkg using a init/done-callback)
options.pas:
+ TOption: new fields "parapackagepath" and "parapackages" to keep track of package search paths and package files passed as parameters
* TOption.interpret_option: use '-Fp' for package search paths and '-FP' for package files
* read_arguments: apply the passed package search paths and packages to their respective containers
........
+ add a new unit which will contain basic functions related to handling packages
........
Move package related functions from pmodules to pkgutil.
pmodules.pas => pkgutil.pas:
* createimportlibfromexports
* varexport
* procexport
* insert_export
* RewritePPU
........
* adjust indentation
........
Extract the code to export the symbols of a unit to its own function in pkgutil so that less functions need to be exported.
pmodules.pas, proc_package:
* move code to export the symbols of a unit to new function export_unit
pkgutil.pas:
+ new function export_unit
- remove exports of procexport, varexport and insert_export
........
Some small fixes for package parsing.
pmodules.pas, proc_package:
* use orgpattern instead of pattern to build the module name (like is done in uses sections)
* ignore duplicates when generating exports
- no need to generate an import library for the package; that is done by the program/library that uses the package
........
+ new unit fpcp of which the class tpcppackage handles the reading and writing of package metadata from/to pcp files (equivalant to tppumodule).
........
+ add unit which contains representation of a PCP file (tpcpfile) like tppufile is for units.
........
Improve export generation.
pkgutil.pas:
+ new function exportprocsym to correctly export a procedure with all its aliases
+ new function exportabstractrecordsymproc to export the members of structured types
* insert_export: handle also namespacesym and propertsym (by ignoring them)
* insert_export: correctly export classes, record and objects
* insert_export: use new exportprocsym function to export a procsym
* insert_export: only export public variables of a static symtable
........
+ add entry constants for the name of the package and the package file names, both used by a PCP file
........
* use messages to get rid of most writelns related to package loading
........
Add additional entry types for PCP files
entfile.pas:
+ new entries ibstartrequireds and ibendrequireds to store the list of required packages
+ new entries ibstartcontained and ibendcontained to store the list of contained units
+ new entries ibstartppus and ibendppus to store the list of contained PPU files
........
Generate the PCP file once the package file and the used units were compiled correctly.
pmodules.pas:
* proc_package: generate the PCP file upon successful compilation
........
Add the possibility to load all packages supplied as parameters.
pkgutil.pas:
+ new function load_packages to load all packages supplied as parameters
pmodules.pas, proc_program:
* use load_packages to load all packages before any unit is loaded
........
Add code which tries to load a unit from a package first and only then as usual.
fppu.pas, tppumodule:
+ new method loadfrompackage which searches all available packages for the unit and loads it from there if found
* loadppu: first try to load the unit from a package if any are available
........
Don't link objects files of a unit that is provided by a package.
pmodules.pas, proc_program:
* if a unit has uf_in_library set we must not include it in the units we link against
........
git-svn-id: trunk@33452 -
2209 lines
81 KiB
ObjectPascal
2209 lines
81 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,
|
|
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,fpcp,
|
|
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);
|
|
{ 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
|
|
release_main_proc(init_procinfo);
|
|
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;
|
|
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);
|
|
|
|
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);
|
|
|
|
{Load the units used by the program we compile.}
|
|
if token=_REQUIRES then
|
|
begin
|
|
end;
|
|
|
|
{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;
|
|
AddUnit(module_name);
|
|
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;
|
|
|
|
{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;
|
|
|
|
current_module.allunitsused;
|
|
end;
|
|
|
|
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));
|
|
|
|
{ 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 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 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
|
|
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;
|
|
|
|
{ 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;
|
|
exit;
|
|
end;
|
|
|
|
if (not current_module.is_unit) then
|
|
begin
|
|
{ add all contained units to the package }
|
|
{ TODO : handle implicitly imported units }
|
|
pkg:=tpcppackage.create(module_name);
|
|
uu:=tused_unit(current_module.used_units.first);
|
|
while assigned(uu) do
|
|
begin
|
|
pkg.addunit(uu.u);
|
|
uu:=tused_unit(uu.next);
|
|
end;
|
|
|
|
pkg.initmoduleinfo(current_module);
|
|
|
|
{ finally rewrite all units included into the package }
|
|
uu:=tused_unit(usedunits.first);
|
|
while assigned(uu) do
|
|
begin
|
|
RewritePPU(uu.u.ppufilename,uu.u.ppufilename);
|
|
uu:=tused_unit(uu.next);
|
|
end;
|
|
|
|
{ create the executable when we are at level 1 }
|
|
if (compile_level=1) then
|
|
begin
|
|
{ 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
|
|
{ the package itself contains no code so far }
|
|
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;
|
|
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 imports }
|
|
if current_module.ImportLibraryList.Count>0 then
|
|
importlib.generatelib;
|
|
|
|
{ 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;
|
|
|
|
{ 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 (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;
|
|
{ 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.
|