mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-02 08:53:42 +02:00
66f8276445
* support for case aware filesystems (Windows), they do now only
one lookup if a file exists
* add -WI option to generate import section for DLL imports or
let the linker handle it. Default is still import section until
the Makefiles are fixed, then the generation can be left to the
linker
git-svn-id: trunk@2274 -
1603 lines
57 KiB
ObjectPascal
1603 lines
57 KiB
ObjectPascal
{
|
|
Copyright (c) 1998-2002 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
|
|
|
|
procedure proc_unit;
|
|
procedure proc_program(islibrary : boolean);
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
globtype,version,systems,tokens,
|
|
cutils,cclasses,comphook,
|
|
globals,verbose,fmodule,finput,fppu,
|
|
symconst,symbase,symtype,symdef,symsym,symtable,
|
|
aasmtai,aasmcpu,aasmbase,
|
|
cgbase,cgobj,
|
|
nbas,ncgutil,
|
|
link,assemble,import,export,gendef,ppu,comprsrc,dbgbase,
|
|
cresstr,procinfo,
|
|
dwarf,pexports,
|
|
scanner,pbase,pexpr,psystem,psub,pdecsub;
|
|
|
|
|
|
procedure create_objectfile;
|
|
var
|
|
DLLScanner : TDLLScanner;
|
|
s : string;
|
|
KeepShared : TStringList;
|
|
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:=TStringList.Create;
|
|
{ Walk all shared libs }
|
|
While not current_module.linkOtherSharedLibs.Empty do
|
|
begin
|
|
S:=current_module.linkOtherSharedLibs.Getusemask(link_allways);
|
|
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(asmlist[al_imports]) then
|
|
asmlist[al_imports].clear
|
|
else
|
|
asmlist[al_imports]:=taasmoutput.Create;
|
|
importlib.generatelib;
|
|
end;
|
|
{ Readd the not processed files }
|
|
while not KeepShared.Empty do
|
|
begin
|
|
s:=KeepShared.GetFirst;
|
|
current_module.linkOtherSharedLibs.add(s,link_allways);
|
|
end;
|
|
KeepShared.Free;
|
|
end;
|
|
|
|
{ Start and end module debuginfo, at least required for stabs
|
|
to insert n_sourcefile lines }
|
|
if (cs_debuginfo in aktmoduleswitches) or
|
|
(cs_use_lineinfo in aktglobalswitches) then
|
|
debuginfo.insertmoduleinfo;
|
|
|
|
{ create the .s file and assemble it }
|
|
GenerateAsm(false);
|
|
|
|
{ Also create a smartlinked version ? }
|
|
if (cs_create_smart in aktmoduleswitches) and
|
|
not(af_smartlink_sections in target_asm.flags) then
|
|
begin
|
|
{ regenerate the importssection for win32 }
|
|
if assigned(asmlist[al_imports]) and
|
|
(target_info.system in [system_i386_win32,system_i386_wdosx, system_arm_wince,system_i386_wince]) then
|
|
begin
|
|
asmlist[al_imports].clear;
|
|
importlib.generatesmartlib;
|
|
end;
|
|
|
|
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 (cs_create_smart in aktmoduleswitches) and
|
|
not(af_smartlink_sections in target_asm.flags) 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;
|
|
begin
|
|
asmlist[al_dwarf]:=taasmoutput.create;
|
|
{ Call frame information }
|
|
if (tf_needs_dwarf_cfi in target_info.flags) and
|
|
(af_supports_dwarf in target_asm.flags) then
|
|
dwarfcfi.generate_code(asmlist[al_dwarf]);
|
|
end;
|
|
|
|
|
|
procedure InsertThreadvarTablesTable;
|
|
var
|
|
hp : tused_unit;
|
|
ltvTables : taasmoutput;
|
|
count : longint;
|
|
begin
|
|
ltvTables:=TAAsmOutput.Create;
|
|
count:=0;
|
|
hp:=tused_unit(usedunits.first);
|
|
while assigned(hp) do
|
|
begin
|
|
If (hp.u.flags and uf_threadvars)=uf_threadvars then
|
|
begin
|
|
ltvTables.concat(Tai_const.Createname(make_mangledname('THREADVARLIST',hp.u.globalsymtable,''),AT_DATA,0));
|
|
inc(count);
|
|
end;
|
|
hp:=tused_unit(hp.next);
|
|
end;
|
|
{ Add program threadvars, if any }
|
|
If (current_module.flags and uf_threadvars)=uf_threadvars then
|
|
begin
|
|
ltvTables.concat(Tai_const.Createname(make_mangledname('THREADVARLIST',current_module.localsymtable,''),AT_DATA,0));
|
|
inc(count);
|
|
end;
|
|
{ Insert TableCount at start }
|
|
ltvTables.insert(Tai_const.Create_32bit(count));
|
|
{ insert in data segment }
|
|
maybe_new_object_file(asmlist[al_globals]);
|
|
new_section(asmlist[al_globals],sec_data,'FPC_THREADVARTABLES',sizeof(aint));
|
|
asmlist[al_globals].concat(Tai_symbol.Createname_global('FPC_THREADVARTABLES',AT_DATA,0));
|
|
asmlist[al_globals].concatlist(ltvTables);
|
|
asmlist[al_globals].concat(Tai_symbol_end.Createname('FPC_THREADVARTABLES'));
|
|
ltvTables.free;
|
|
end;
|
|
|
|
procedure AddToThreadvarList(p:tnamedindexitem;arg:pointer);
|
|
var
|
|
ltvTable : taasmoutput;
|
|
begin
|
|
ltvTable:=taasmoutput(arg);
|
|
if (tsym(p).typ=globalvarsym) and
|
|
(vo_is_thread_var in tglobalvarsym(p).varoptions) then
|
|
begin
|
|
{ address of threadvar }
|
|
ltvTable.concat(tai_const.Createname(tglobalvarsym(p).mangledname,AT_DATA,0));
|
|
{ size of threadvar }
|
|
ltvTable.concat(tai_const.create_32bit(tglobalvarsym(p).getsize));
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure InsertThreadvars;
|
|
var
|
|
s : string;
|
|
ltvTable : TAAsmoutput;
|
|
begin
|
|
ltvTable:=TAAsmoutput.create;
|
|
if assigned(current_module.globalsymtable) then
|
|
current_module.globalsymtable.foreach_static(@AddToThreadvarList,ltvTable);
|
|
current_module.localsymtable.foreach_static(@AddToThreadvarList,ltvTable);
|
|
if ltvTable.first<>nil then
|
|
begin
|
|
s:=make_mangledname('THREADVARLIST',current_module.localsymtable,'');
|
|
{ end of the list marker }
|
|
ltvTable.concat(tai_const.create_sym(nil));
|
|
{ add to datasegment }
|
|
maybe_new_object_file(asmlist[al_globals]);
|
|
new_section(asmlist[al_globals],sec_data,s,sizeof(aint));
|
|
asmlist[al_globals].concat(Tai_symbol.Createname_global(s,AT_DATA,0));
|
|
asmlist[al_globals].concatlist(ltvTable);
|
|
asmlist[al_globals].concat(Tai_symbol_end.Createname(s));
|
|
current_module.flags:=current_module.flags or uf_threadvars;
|
|
end;
|
|
ltvTable.Free;
|
|
end;
|
|
|
|
|
|
Procedure InsertResourceInfo;
|
|
|
|
var
|
|
hp : tused_unit;
|
|
found : Boolean;
|
|
I : Integer;
|
|
ResourceInfo : taasmoutput;
|
|
|
|
begin
|
|
if target_res.id=res_elf then
|
|
begin
|
|
hp:=tused_unit(usedunits.first);
|
|
found:=false;
|
|
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;
|
|
ResourceInfo:=TAAsmOutput.Create;
|
|
if found then
|
|
begin
|
|
{ Valid pointer to resource information }
|
|
ResourceInfo.concat(Tai_symbol.Createname_global('FPC_RESLOCATION',AT_DATA,0));
|
|
ResourceInfo.concat(Tai_const.Createname('FPC_RESSYMBOL',AT_DATA,0));
|
|
{$ifdef EXTERNALRESPTRS}
|
|
current_module.linkotherofiles.add('resptrs.o',link_allways);
|
|
{$else EXTERNALRESPTRS}
|
|
new_section(ResourceInfo,sec_fpc,'resptrs',4);
|
|
ResourceInfo.concat(Tai_symbol.Createname_global('FPC_RESSYMBOL',AT_DATA,0));
|
|
For I:=1 to 32 do
|
|
ResourceInfo.Concat(Tai_const.Create_32bit(0));
|
|
{$endif EXTERNALRESPTRS}
|
|
end
|
|
else
|
|
begin
|
|
{ Nil pointer to resource information }
|
|
ResourceInfo.concat(Tai_symbol.Createname_global('FPC_RESLOCATION',AT_DATA,0));
|
|
ResourceInfo.Concat(Tai_const.Create_32bit(0));
|
|
end;
|
|
maybe_new_object_file(asmlist[al_globals]);
|
|
asmlist[al_globals].concatlist(ResourceInfo);
|
|
ResourceInfo.free;
|
|
end;
|
|
end;
|
|
|
|
Procedure InsertResourceTablesTable;
|
|
var
|
|
hp : tused_unit;
|
|
ResourceStringTables : taasmoutput;
|
|
count : longint;
|
|
begin
|
|
ResourceStringTables:=TAAsmOutput.Create;
|
|
count:=0;
|
|
hp:=tused_unit(usedunits.first);
|
|
while assigned(hp) do
|
|
begin
|
|
If (hp.u.flags and uf_has_resources)=uf_has_resources then
|
|
begin
|
|
ResourceStringTables.concat(Tai_const.Createname(make_mangledname('RESOURCESTRINGLIST',hp.u.globalsymtable,''),AT_DATA,0));
|
|
inc(count);
|
|
end;
|
|
hp:=tused_unit(hp.next);
|
|
end;
|
|
{ Add program resources, if any }
|
|
If resourcestrings.ResStrCount>0 then
|
|
begin
|
|
ResourceStringTables.concat(Tai_const.Createname(make_mangledname('RESOURCESTRINGLIST',current_module.localsymtable,''),AT_DATA,0));
|
|
Inc(Count);
|
|
end;
|
|
{ Insert TableCount at start }
|
|
ResourceStringTables.insert(Tai_const.Create_32bit(count));
|
|
{ Add to data segment }
|
|
maybe_new_object_file(asmlist[al_globals]);
|
|
new_section(asmlist[al_globals],sec_data,'FPC_RESOURCESTRINGTABLES',sizeof(aint));
|
|
asmlist[al_globals].concat(Tai_symbol.Createname_global('FPC_RESOURCESTRINGTABLES',AT_DATA,0));
|
|
asmlist[al_globals].concatlist(ResourceStringTables);
|
|
asmlist[al_globals].concat(Tai_symbol_end.Createname('FPC_RESOURCESTRINGTABLES'));
|
|
ResourceStringTables.free;
|
|
end;
|
|
|
|
|
|
procedure InsertInitFinalTable;
|
|
var
|
|
hp : tused_unit;
|
|
unitinits : taasmoutput;
|
|
count : longint;
|
|
begin
|
|
unitinits:=TAAsmOutput.Create;
|
|
count:=0;
|
|
hp:=tused_unit(usedunits.first);
|
|
while assigned(hp) do
|
|
begin
|
|
{ call the unit init code and make it external }
|
|
if (hp.u.flags and (uf_init or uf_finalize))<>0 then
|
|
begin
|
|
if (hp.u.flags and uf_init)<>0 then
|
|
unitinits.concat(Tai_const.Createname(make_mangledname('INIT$',hp.u.globalsymtable,''),AT_FUNCTION,0))
|
|
else
|
|
unitinits.concat(Tai_const.Create_sym(nil));
|
|
if (hp.u.flags and uf_finalize)<>0 then
|
|
unitinits.concat(Tai_const.Createname(make_mangledname('FINALIZE$',hp.u.globalsymtable,''),AT_FUNCTION,0))
|
|
else
|
|
unitinits.concat(Tai_const.Create_sym(nil));
|
|
inc(count);
|
|
end;
|
|
hp:=tused_unit(hp.next);
|
|
end;
|
|
{ Insert initialization/finalization of the program }
|
|
if (current_module.flags and (uf_init or uf_finalize))<>0 then
|
|
begin
|
|
if (current_module.flags and uf_init)<>0 then
|
|
unitinits.concat(Tai_const.Createname(make_mangledname('INIT$',current_module.localsymtable,''),AT_FUNCTION,0))
|
|
else
|
|
unitinits.concat(Tai_const.Create_sym(nil));
|
|
if (current_module.flags and uf_finalize)<>0 then
|
|
unitinits.concat(Tai_const.Createname(make_mangledname('FINALIZE$',current_module.localsymtable,''),AT_FUNCTION,0))
|
|
else
|
|
unitinits.concat(Tai_const.Create_sym(nil));
|
|
inc(count);
|
|
end;
|
|
{ Insert TableCount,InitCount at start }
|
|
unitinits.insert(Tai_const.Create_32bit(0));
|
|
unitinits.insert(Tai_const.Create_32bit(count));
|
|
{ Add to data segment }
|
|
maybe_new_object_file(asmlist[al_globals]);
|
|
new_section(asmlist[al_globals],sec_data,'INITFINAL',sizeof(aint));
|
|
asmlist[al_globals].concat(Tai_symbol.Createname_global('INITFINAL',AT_DATA,0));
|
|
asmlist[al_globals].concatlist(unitinits);
|
|
asmlist[al_globals].concat(Tai_symbol_end.Createname('INITFINAL'));
|
|
unitinits.free;
|
|
end;
|
|
|
|
|
|
procedure insertmemorysizes;
|
|
{$IFDEF POWERPC}
|
|
var
|
|
stkcookie: string;
|
|
{$ENDIF POWERPC}
|
|
begin
|
|
{ stacksize can be specified and is now simulated }
|
|
maybe_new_object_file(asmlist[al_globals]);
|
|
new_section(asmlist[al_globals],sec_data,'__stklen', sizeof(aint));
|
|
asmlist[al_globals].concat(Tai_symbol.Createname_global('__stklen',AT_DATA,sizeof(aint)));
|
|
asmlist[al_globals].concat(Tai_const.Create_aint(stacksize));
|
|
{$IFDEF POWERPC}
|
|
{ AmigaOS4 "stack cookie" support }
|
|
if ( target_info.system = system_powerpc_amiga ) then
|
|
begin
|
|
{ this symbol is needed to ignite powerpc amigaos' }
|
|
{ stack allocation magic for us with the given stack size. }
|
|
{ note: won't work for m68k amigaos or morphos. (KB) }
|
|
str(stacksize,stkcookie);
|
|
stkcookie:='$STACK: '+stkcookie+#0;
|
|
maybe_new_object_file(asmlist[al_globals]);
|
|
new_section(asmlist[al_globals],sec_data,'__stack_cookie',length(stkcookie));
|
|
asmlist[al_globals].concat(Tai_symbol.Createname_global('__stack_cookie',AT_DATA,length(stkcookie)));
|
|
asmlist[al_globals].concat(Tai_string.Create(stkcookie));
|
|
end;
|
|
{$ENDIF POWERPC}
|
|
{ Initial heapsize }
|
|
maybe_new_object_file(asmlist[al_globals]);
|
|
new_section(asmlist[al_globals],sec_data,'__heapsize',sizeof(aint));
|
|
asmlist[al_globals].concat(Tai_symbol.Createname_global('__heapsize',AT_DATA,sizeof(aint)));
|
|
asmlist[al_globals].concat(Tai_const.Create_aint(heapsize));
|
|
end;
|
|
|
|
|
|
procedure AddUnit(const s:string);
|
|
var
|
|
hp : tppumodule;
|
|
unitsym : tunitsym;
|
|
begin
|
|
{ load unit }
|
|
hp:=registerunit(current_module,s,'');
|
|
hp.loadppu;
|
|
hp.adddependency(current_module);
|
|
{ add to symtable stack }
|
|
tsymtable(hp.globalsymtable).next:=symtablestack;
|
|
symtablestack:=hp.globalsymtable;
|
|
if (m_mac in aktmodeswitches) and assigned(hp.globalmacrosymtable) then
|
|
begin
|
|
tsymtable(hp.globalmacrosymtable).next:=macrosymtablestack;
|
|
macrosymtablestack:=hp.globalmacrosymtable;
|
|
end;
|
|
{ insert unitsym }
|
|
unitsym:=tunitsym.create(s,hp.globalsymtable);
|
|
inc(unitsym.refs);
|
|
refsymtable.insert(unitsym);
|
|
{ add to used units }
|
|
current_module.addusedunit(hp,false,unitsym);
|
|
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;
|
|
|
|
|
|
procedure loaddefaultunits;
|
|
begin
|
|
{ are we compiling the system unit? }
|
|
if (cs_compilesystem in aktmoduleswitches) then
|
|
begin
|
|
{ create system defines }
|
|
createconstdefs;
|
|
{ we don't need to reset anything, it's already done in parser.pas }
|
|
exit;
|
|
end;
|
|
{ insert the system unit, it is allways the first }
|
|
symtablestack:=nil;
|
|
macrosymtablestack:=initialmacrosymtable;
|
|
AddUnit('System');
|
|
SystemUnit:=TGlobalSymtable(Symtablestack);
|
|
{ read default constant definitions }
|
|
make_ref:=false;
|
|
readconstdefs;
|
|
make_ref:=true;
|
|
{ Set the owner of errorsym and errortype to symtable to
|
|
prevent crashes when accessing .owner }
|
|
generrorsym.owner:=systemunit;
|
|
generrortype.def.owner:=systemunit;
|
|
{ Units only required for main module }
|
|
{ load heaptrace before any other units especially objpas }
|
|
if not(current_module.is_unit) then
|
|
begin
|
|
{ Heaptrc unit }
|
|
if (cs_use_heaptrc in aktglobalswitches) then
|
|
AddUnit('HeapTrc');
|
|
{ Lineinfo unit }
|
|
if (cs_use_lineinfo in aktglobalswitches) then
|
|
AddUnit('LineInfo');
|
|
{ Lineinfo unit }
|
|
if (cs_gdb_valgrind in aktglobalswitches) then
|
|
AddUnit('CMem');
|
|
{$ifdef cpufpemu}
|
|
{ Floating point emulation unit? }
|
|
if (cs_fp_emulation in aktmoduleswitches) and not(target_info.system in system_wince) then
|
|
AddUnit('SoftFpu');
|
|
{$endif cpufpemu}
|
|
end;
|
|
{ Objpas unit? }
|
|
if m_objpas in aktmodeswitches then
|
|
AddUnit('ObjPas');
|
|
{ Macpas unit? }
|
|
if m_mac in aktmodeswitches then
|
|
AddUnit('MacPas');
|
|
{ Profile unit? Needed for go32v2 only }
|
|
if (cs_profile in aktmoduleswitches) and
|
|
(target_info.system in [system_i386_go32v2,system_i386_watcom]) then
|
|
AddUnit('Profile');
|
|
if (cs_load_fpcylix_unit in aktglobalswitches) then
|
|
begin
|
|
AddUnit('FPCylix');
|
|
AddUnit('DynLibs');
|
|
end;
|
|
{ save default symtablestack }
|
|
defaultsymtablestack:=symtablestack;
|
|
defaultmacrosymtablestack:=macrosymtablestack;
|
|
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;
|
|
var
|
|
s,sorg : stringid;
|
|
fn : string;
|
|
pu : tused_unit;
|
|
hp2 : tmodule;
|
|
hp3 : tsymtable;
|
|
unitsym : tunitsym;
|
|
top_of_macrosymtable : tsymtable;
|
|
|
|
begin
|
|
consume(_USES);
|
|
{$ifdef DEBUG}
|
|
test_symtablestack;
|
|
{$endif DEBUG}
|
|
repeat
|
|
s:=pattern;
|
|
sorg:=orgpattern;
|
|
consume(_ID);
|
|
{ support "<unit> in '<file>'" construct, but not for tp7 }
|
|
if not(m_tp7 in aktmodeswitches) then
|
|
begin
|
|
if try_to_consume(_OP_IN) then
|
|
fn:=FixFileName(get_stringconst)
|
|
else
|
|
fn:='';
|
|
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 }
|
|
unitsym:=tunitsym.create(sorg,nil);
|
|
refsymtable.insert(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 }
|
|
top_of_macrosymtable:= macrosymtablestack;
|
|
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;
|
|
{ connect unitsym to the globalsymtable of the unit }
|
|
pu.unitsym.unitsymtable:=pu.u.globalsymtable;
|
|
end;
|
|
pu:=tused_unit(pu.next);
|
|
end;
|
|
|
|
{ set the symtable to systemunit so it gets reorderd correctly,
|
|
then insert the units in the symtablestack }
|
|
pu:=tused_unit(current_module.used_units.first);
|
|
symtablestack:=defaultsymtablestack;
|
|
macrosymtablestack:=defaultmacrosymtablestack;
|
|
while assigned(pu) do
|
|
begin
|
|
if pu.in_uses then
|
|
begin
|
|
{ Reinsert in symtablestack }
|
|
hp3:=symtablestack;
|
|
while assigned(hp3) do
|
|
begin
|
|
{ insert units only once ! }
|
|
if pu.u.globalsymtable=hp3 then
|
|
break;
|
|
hp3:=hp3.next;
|
|
{ unit isn't inserted }
|
|
if hp3=nil then
|
|
begin
|
|
tsymtable(pu.u.globalsymtable).next:=symtablestack;
|
|
symtablestack:=tsymtable(pu.u.globalsymtable);
|
|
if (m_mac in aktmodeswitches) and assigned(pu.u.globalmacrosymtable) then
|
|
begin
|
|
tsymtable(pu.u.globalmacrosymtable).next:=macrosymtablestack;
|
|
macrosymtablestack:=tsymtable(pu.u.globalmacrosymtable);
|
|
end;
|
|
{$ifdef DEBUG}
|
|
test_symtablestack;
|
|
{$endif DEBUG}
|
|
end;
|
|
end;
|
|
end;
|
|
pu:=tused_unit(pu.next);
|
|
end;
|
|
|
|
if assigned (current_module.globalmacrosymtable) then
|
|
top_of_macrosymtable.next.next:= macrosymtablestack
|
|
else
|
|
top_of_macrosymtable.next:= macrosymtablestack;
|
|
macrosymtablestack:= top_of_macrosymtable;
|
|
consume(_SEMICOLON);
|
|
end;
|
|
|
|
|
|
procedure reset_all_defs;
|
|
|
|
procedure reset_used_unit_defs(hp:tmodule);
|
|
var
|
|
pu : tused_unit;
|
|
begin
|
|
pu:=tused_unit(hp.used_units.first);
|
|
while assigned(pu) do
|
|
begin
|
|
if not pu.u.is_reset then
|
|
begin
|
|
{ prevent infinte loop for circular dependencies }
|
|
pu.u.is_reset:=true;
|
|
if assigned(pu.u.globalsymtable) then
|
|
begin
|
|
tglobalsymtable(pu.u.globalsymtable).reset_all_defs;
|
|
reset_used_unit_defs(pu.u);
|
|
end;
|
|
end;
|
|
pu:=tused_unit(pu.next);
|
|
end;
|
|
end;
|
|
|
|
var
|
|
hp2 : tmodule;
|
|
begin
|
|
hp2:=tmodule(loaded_units.first);
|
|
while assigned(hp2) do
|
|
begin
|
|
hp2.is_reset:=false;
|
|
hp2:=tmodule(hp2.next);
|
|
end;
|
|
reset_used_unit_defs(current_module);
|
|
end;
|
|
|
|
|
|
procedure free_localsymtables(st:tsymtable);
|
|
var
|
|
def : tstoreddef;
|
|
pd : tprocdef;
|
|
begin
|
|
def:=tstoreddef(st.defindex.first);
|
|
while assigned(def) do
|
|
begin
|
|
if def.deftype=procdef then
|
|
begin
|
|
pd:=tprocdef(def);
|
|
if assigned(pd.localst) and
|
|
(pd.localst.symtabletype<>staticsymtable) and
|
|
not((po_inline in pd.procoptions) or
|
|
((current_module.flags and uf_local_browser)<>0)) then
|
|
begin
|
|
free_localsymtables(pd.localst);
|
|
pd.localst.free;
|
|
pd.localst:=nil;
|
|
end;
|
|
end;
|
|
def:=tstoreddef(def.indexnext);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure parse_implementation_uses;
|
|
begin
|
|
if token=_USES then
|
|
begin
|
|
loadunits;
|
|
{$ifdef DEBUG}
|
|
test_symtablestack;
|
|
{$endif DEBUG}
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure setupglobalswitches;
|
|
begin
|
|
{ can't have local browser when no global browser }
|
|
if (cs_local_browser in aktmoduleswitches) and
|
|
not(cs_browser in aktmoduleswitches) then
|
|
exclude(aktmoduleswitches,cs_local_browser);
|
|
if (cs_create_pic in aktmoduleswitches) then
|
|
def_system_macro('FPC_PIC');
|
|
end;
|
|
|
|
|
|
function create_main_proc(const name:string;potype:tproctypeoption;st:tsymtable):tprocdef;
|
|
var
|
|
stt : tsymtable;
|
|
ps : tprocsym;
|
|
pd : tprocdef;
|
|
begin
|
|
{ there should be no current_procinfo available }
|
|
if assigned(current_procinfo) then
|
|
internalerror(200304275);
|
|
{Generate a procsym for main}
|
|
make_ref:=false;
|
|
{ try to insert in in static symtable ! }
|
|
stt:=symtablestack;
|
|
symtablestack:=st;
|
|
{ generate procsym }
|
|
ps:=tprocsym.create('$'+name);
|
|
{ main are allways used }
|
|
inc(ps.refs);
|
|
symtablestack.insert(ps);
|
|
pd:=tprocdef.create(main_program_level);
|
|
include(pd.procoptions,po_global);
|
|
pd.procsym:=ps;
|
|
ps.addprocdef(pd);
|
|
{ restore symtable }
|
|
make_ref:=true;
|
|
symtablestack:=stt;
|
|
{ set procdef options }
|
|
pd.proctypeoption:=potype;
|
|
pd.proccalloption:=pocall_default;
|
|
pd.forwarddef:=false;
|
|
pd.setmangledname(target_info.cprefix+name);
|
|
pd.aliasnames.insert(pd.mangledname);
|
|
handle_calling_convention(pd);
|
|
{ We don't need is a local symtable. Change it into the static
|
|
symtable }
|
|
pd.localst.free;
|
|
pd.localst:=st;
|
|
{ set procinfo and current_procinfo.procdef }
|
|
current_procinfo:=cprocinfo.create(nil);
|
|
current_module.procinfo:=current_procinfo;
|
|
current_procinfo.procdef:=pd;
|
|
{ return procdef }
|
|
create_main_proc:=pd;
|
|
{ main proc does always a call e.g. to init system unit }
|
|
include(current_procinfo.flags,pi_do_call);
|
|
end;
|
|
|
|
|
|
procedure release_main_proc(pd:tprocdef);
|
|
begin
|
|
{ this is a main proc, so there should be no parent }
|
|
if not(assigned(current_procinfo)) or
|
|
assigned(current_procinfo.parent) or
|
|
not(current_procinfo.procdef=pd) then
|
|
internalerror(200304276);
|
|
{ remove procinfo }
|
|
current_module.procinfo:=nil;
|
|
current_procinfo.free;
|
|
current_procinfo:=nil;
|
|
{ remove localst as it was replaced by staticsymtable }
|
|
pd.localst:=nil;
|
|
end;
|
|
|
|
|
|
procedure gen_implicit_initfinal(flag:word;st:tsymtable);
|
|
var
|
|
pd : tprocdef;
|
|
begin
|
|
{ update module flags }
|
|
current_module.flags:=current_module.flags or flag;
|
|
{ create procdef }
|
|
case flag of
|
|
uf_init :
|
|
begin
|
|
pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'init_implicit'),potype_unitinit,st);
|
|
pd.aliasnames.insert(make_mangledname('INIT$',current_module.localsymtable,''));
|
|
end;
|
|
uf_finalize :
|
|
begin
|
|
pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize_implicit'),potype_unitfinalize,st);
|
|
pd.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
|
|
end;
|
|
else
|
|
internalerror(200304253);
|
|
end;
|
|
tcgprocinfo(current_procinfo).code:=cnothingnode.create;
|
|
tcgprocinfo(current_procinfo).generate_code;
|
|
release_main_proc(pd);
|
|
end;
|
|
|
|
procedure delete_duplicate_macros(p:TNamedIndexItem; arg:pointer);
|
|
var
|
|
hp: tsymentry;
|
|
begin
|
|
hp:= current_module.localmacrosymtable.search(p.name);
|
|
if assigned(hp) then
|
|
current_module.localmacrosymtable.delete(hp);
|
|
end;
|
|
|
|
procedure proc_unit;
|
|
|
|
function is_assembler_generated:boolean;
|
|
var
|
|
hal : tasmlist;
|
|
begin
|
|
result:=false;
|
|
if Errorcount=0 then
|
|
begin
|
|
for hal:=low(Tasmlist) to high(Tasmlist) do
|
|
if not asmlist[hal].empty then
|
|
begin
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
main_file: tinputfile;
|
|
st : tsymtable;
|
|
unitst : tglobalsymtable;
|
|
{$ifdef EXTDEBUG}
|
|
store_crc,
|
|
{$endif EXTDEBUG}
|
|
store_interface_crc : cardinal;
|
|
s1,s2 : ^string; {Saves stack space}
|
|
force_init_final : boolean;
|
|
pd : tprocdef;
|
|
unitname8 : string[8];
|
|
has_impl,ag: boolean;
|
|
globalvarsym : tglobalvarsym;
|
|
begin
|
|
if m_mac in aktmodeswitches then
|
|
begin
|
|
ConsolidateMode;
|
|
current_module.mode_switch_allowed:= false;
|
|
end;
|
|
|
|
consume(_UNIT);
|
|
if compile_level=1 then
|
|
Status.IsExe:=false;
|
|
|
|
if token=_ID then
|
|
begin
|
|
{ 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(orgpattern);
|
|
|
|
{ check for system unit }
|
|
new(s2);
|
|
s2^:=upper(SplitName(main_file.name^));
|
|
unitname8:=copy(current_module.modulename^,1,8);
|
|
if (cs_check_unit_name in aktglobalswitches) 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(aktmoduleswitches,cs_compilesystem);
|
|
dispose(s2);
|
|
dispose(s1);
|
|
end;
|
|
|
|
if (target_info.system in system_unit_program_exports) then
|
|
exportlib.preparelib(current_module.realmodulename^);
|
|
|
|
consume(_ID);
|
|
consume(_SEMICOLON);
|
|
consume(_INTERFACE);
|
|
{ global switches are read, so further changes aren't allowed }
|
|
current_module.in_global:=false;
|
|
|
|
{ handle the global switches }
|
|
ConsolidateMode;
|
|
setupglobalswitches;
|
|
|
|
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(aktmodeswitches,m_objpas);
|
|
|
|
{ maybe turn off m_mac if we are compiling macpas }
|
|
if (current_module.modulename^='MACPAS') then
|
|
exclude(aktmodeswitches,m_mac);
|
|
|
|
parse_only:=true;
|
|
|
|
{ generate now the global symboltable }
|
|
st:=tglobalsymtable.create(current_module.modulename^,current_module.moduleid);
|
|
refsymtable:=st;
|
|
unitst:=tglobalsymtable(st);
|
|
{ define first as local to overcome dependency conflicts }
|
|
current_module.localsymtable:=st;
|
|
|
|
{ the unit name must be usable as a unit specifier }
|
|
{ inside the unit itself (PM) }
|
|
{ this also forbids to have another symbol }
|
|
{ with the same name as the unit }
|
|
refsymtable.insert(tunitsym.create(current_module.realmodulename^,unitst));
|
|
|
|
macrosymtablestack:= initialmacrosymtable;
|
|
|
|
{ load default units, like the system unit }
|
|
loaddefaultunits;
|
|
|
|
current_module.localmacrosymtable.next:=macrosymtablestack;
|
|
if assigned(current_module.globalmacrosymtable) then
|
|
begin
|
|
current_module.globalmacrosymtable.next:= current_module.localmacrosymtable;
|
|
macrosymtablestack:=current_module.globalmacrosymtable;
|
|
end
|
|
else
|
|
macrosymtablestack:=current_module.localmacrosymtable;
|
|
|
|
{ reset }
|
|
make_ref:=true;
|
|
|
|
{ insert qualifier for the system unit (allows system.writeln) }
|
|
if not(cs_compilesystem in aktmoduleswitches) then
|
|
begin
|
|
if token=_USES then
|
|
begin
|
|
loadunits;
|
|
{ has it been compiled at a higher level ?}
|
|
if current_module.state=ms_compiled then
|
|
exit;
|
|
end;
|
|
{ ... but insert the symbol table later }
|
|
st.next:=symtablestack;
|
|
symtablestack:=st;
|
|
end
|
|
else
|
|
{ while compiling a system unit, some types are directly inserted }
|
|
begin
|
|
st.next:=symtablestack;
|
|
symtablestack:=st;
|
|
insert_intern_types(st);
|
|
end;
|
|
|
|
{ now we know the place to insert the constants }
|
|
constsymtable:=symtablestack;
|
|
|
|
{ move the global symtab from the temporary local to global }
|
|
current_module.globalsymtable:=current_module.localsymtable;
|
|
current_module.localsymtable:=nil;
|
|
|
|
reset_all_defs;
|
|
|
|
{ number all units, so we know if a unit is used by this unit or
|
|
needs to be added implicitly }
|
|
current_module.updatemaps;
|
|
|
|
{ ... parse the declarations }
|
|
Message1(parser_u_parsing_interface,current_module.realmodulename^);
|
|
read_interface_declarations;
|
|
|
|
{ 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;
|
|
|
|
{ Our interface is compiled, generate CRC and switch to implementation }
|
|
if not(cs_compilesystem in aktmoduleswitches) 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 errorneous circular references }
|
|
reload_flagged_units;
|
|
|
|
{ Parse the implementation section }
|
|
if (m_mac in aktmodeswitches) and try_to_consume(_END) then
|
|
has_impl:= false
|
|
else
|
|
has_impl:= true;
|
|
|
|
parse_only:=false;
|
|
|
|
{ generates static symbol table }
|
|
st:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid);
|
|
current_module.localsymtable:=st;
|
|
|
|
{$ifdef i386}
|
|
if cs_create_pic in aktmoduleswitches then
|
|
begin
|
|
{ insert symbol for got access in assembler code}
|
|
globalvarsym:=tglobalvarsym.create('_GLOBAL_OFFSET_TABLE_',vs_value,voidpointertype,[vo_is_external,vo_is_C_var]);
|
|
globalvarsym.set_mangledname('_GLOBAL_OFFSET_TABLE_');
|
|
current_module.localsymtable.insert(globalvarsym);
|
|
{ avoid unnecessary warnings }
|
|
globalvarsym.varstate:=vs_read;
|
|
globalvarsym.refs:=1;
|
|
end;
|
|
{$endif i386}
|
|
|
|
{ Swap the positions of the local and global macro sym table}
|
|
if assigned(current_module.globalmacrosymtable) then
|
|
begin
|
|
macrosymtablestack:=current_module.localmacrosymtable;
|
|
current_module.globalmacrosymtable.next:= current_module.localmacrosymtable.next;
|
|
current_module.localmacrosymtable.next:=current_module.globalmacrosymtable;
|
|
|
|
current_module.globalmacrosymtable.foreach_static(@delete_duplicate_macros, nil);
|
|
end;
|
|
|
|
{ remove the globalsymtable from the symtable stack }
|
|
{ to reinsert it after loading the implementation units }
|
|
symtablestack:=unitst.next;
|
|
|
|
{ we don't want implementation units symbols in unitsymtable !! PM }
|
|
refsymtable:=st;
|
|
|
|
if has_impl then
|
|
begin
|
|
consume(_IMPLEMENTATION);
|
|
Message1(unit_u_loading_implementation_units,current_module.modulename^);
|
|
{ Read the implementation units }
|
|
parse_implementation_uses;
|
|
end;
|
|
|
|
if current_module.state=ms_compiled then
|
|
exit;
|
|
|
|
{ reset ranges/stabs in exported definitions }
|
|
reset_all_defs;
|
|
|
|
{ All units are read, now give them a number }
|
|
current_module.updatemaps;
|
|
|
|
{ now we can change refsymtable }
|
|
refsymtable:=st;
|
|
|
|
{ but reinsert the global symtable as lasts }
|
|
unitst.next:=symtablestack;
|
|
symtablestack:=unitst;
|
|
|
|
{$ifdef DEBUG}
|
|
test_symtablestack;
|
|
{$endif DEBUG}
|
|
constsymtable:=symtablestack;
|
|
|
|
if has_impl then
|
|
begin
|
|
Message1(parser_u_parsing_implementation,current_module.modulename^);
|
|
if current_module.in_interface then
|
|
internalerror(200212285);
|
|
|
|
{ Compile the unit }
|
|
pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'init'),potype_unitinit,st);
|
|
pd.aliasnames.insert(make_mangledname('INIT$',current_module.localsymtable,''));
|
|
tcgprocinfo(current_procinfo).parse_body;
|
|
tcgprocinfo(current_procinfo).generate_code;
|
|
tcgprocinfo(current_procinfo).resetprocdef;
|
|
{ save file pos for debuginfo }
|
|
current_module.mainfilepos:=current_procinfo.entrypos;
|
|
release_main_proc(pd);
|
|
end;
|
|
|
|
{ Generate specializations of objectdefs methods }
|
|
generate_specialization_procs;
|
|
|
|
{ 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 ? }
|
|
if force_init_final and ((current_module.flags and uf_init)=0) then
|
|
gen_implicit_initfinal(uf_init,st);
|
|
{ finalize? }
|
|
if has_impl and (token=_FINALIZATION) then
|
|
begin
|
|
{ set module options }
|
|
current_module.flags:=current_module.flags or uf_finalize;
|
|
|
|
{ Compile the finalize }
|
|
pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,st);
|
|
pd.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
|
|
tcgprocinfo(current_procinfo).parse_body;
|
|
tcgprocinfo(current_procinfo).generate_code;
|
|
tcgprocinfo(current_procinfo).resetprocdef;
|
|
release_main_proc(pd);
|
|
end
|
|
else if force_init_final then
|
|
gen_implicit_initfinal(uf_finalize,st);
|
|
|
|
{ the last char should always be a point }
|
|
consume(_POINT);
|
|
|
|
{ Generate resoucestrings }
|
|
If resourcestrings.ResStrCount>0 then
|
|
begin
|
|
resourcestrings.CreateResourceStringList;
|
|
current_module.flags:=current_module.flags or uf_has_resources;
|
|
{ only write if no errors found }
|
|
if (Errorcount=0) then
|
|
resourcestrings.WriteResourceFile(ForceExtension(current_module.ppufilename^,'.rst'));
|
|
end;
|
|
|
|
if (Errorcount=0) then
|
|
begin
|
|
{ tests, if all (interface) forwards are resolved }
|
|
tstoredsymtable(symtablestack).check_forwards;
|
|
{ check if all private fields are used }
|
|
tstoredsymtable(symtablestack).allprivatesused;
|
|
{ remove cross unit overloads }
|
|
tstoredsymtable(symtablestack).unchain_overloaded;
|
|
|
|
{ test static symtable }
|
|
tstoredsymtable(st).allsymbolsused;
|
|
tstoredsymtable(st).allprivatesused;
|
|
tstoredsymtable(st).check_forwards;
|
|
tstoredsymtable(st).checklabels;
|
|
tstoredsymtable(st).unchain_overloaded;
|
|
|
|
{ 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;
|
|
exit;
|
|
end;
|
|
|
|
{ do we need to add the variants unit? }
|
|
maybeloadvariantsunit;
|
|
|
|
{ generate debuginfo }
|
|
if (cs_debuginfo in aktmoduleswitches) then
|
|
debuginfo.inserttypeinfo;
|
|
|
|
{ generate wrappers for interfaces }
|
|
gen_intf_wrappers(asmlist[al_procedures],current_module.globalsymtable);
|
|
gen_intf_wrappers(asmlist[al_procedures],current_module.localsymtable);
|
|
|
|
{ generate pic helpers to load eip if necessary }
|
|
gen_pic_helpers(asmlist[al_procedures]);
|
|
|
|
{ generate a list of threadvars }
|
|
if not(tf_section_threadvars in target_info.flags) then
|
|
InsertThreadvars;
|
|
|
|
{ generate imports }
|
|
if current_module.uses_imports 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_debuginfo;
|
|
end;
|
|
|
|
if cs_local_browser in aktmoduleswitches then
|
|
current_module.localsymtable:=refsymtable;
|
|
|
|
if ag then
|
|
begin
|
|
{ create dwarf debuginfo }
|
|
create_dwarf;
|
|
{ finish asmlist by adding segment starts }
|
|
// insertsegment;
|
|
{ assemble }
|
|
create_objectfile;
|
|
end;
|
|
|
|
{ Write out the ppufile after the object file has been created }
|
|
store_interface_crc:=current_module.interface_crc;
|
|
{$ifdef EXTDEBUG}
|
|
store_crc:=current_module.crc;
|
|
{$endif EXTDEBUG}
|
|
if (Errorcount=0) then
|
|
tppumodule(current_module).writeppu;
|
|
|
|
if not(cs_compilesystem in aktmoduleswitches) then
|
|
if store_interface_crc<>current_module.interface_crc then
|
|
Message1(unit_u_interface_crc_changed,current_module.ppufilename^);
|
|
{$ifdef EXTDEBUG}
|
|
if not(cs_compilesystem in aktmoduleswitches) then
|
|
if (store_crc<>current_module.crc) and simplify_ppu then
|
|
Message1(unit_u_implementation_crc_changed,current_module.ppufilename^);
|
|
{$endif EXTDEBUG}
|
|
|
|
{ release all overload references and local symtables that
|
|
are not needed anymore }
|
|
tstoredsymtable(current_module.localsymtable).unchain_overloaded;
|
|
tstoredsymtable(current_module.globalsymtable).unchain_overloaded;
|
|
free_localsymtables(current_module.globalsymtable);
|
|
free_localsymtables(current_module.localsymtable);
|
|
|
|
{ remove static symtable (=refsymtable) here to save some mem, possible references
|
|
(like procsym overloads) should already have been freed above }
|
|
if not (cs_local_browser in aktmoduleswitches) then
|
|
begin
|
|
st.free;
|
|
current_module.localsymtable:=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;
|
|
exit;
|
|
end;
|
|
|
|
Message1(unit_u_finished_compiling,current_module.modulename^);
|
|
end;
|
|
|
|
|
|
procedure proc_program(islibrary : boolean);
|
|
var
|
|
main_file : tinputfile;
|
|
st : tsymtable;
|
|
hp,hp2 : tmodule;
|
|
pd : tprocdef;
|
|
begin
|
|
DLLsource:=islibrary;
|
|
Status.IsLibrary:=IsLibrary;
|
|
Status.IsExe:=true;
|
|
parse_only:=false;
|
|
|
|
{ DLL defaults to create reloc info }
|
|
if islibrary then
|
|
begin
|
|
if not RelocSectionSetExplicitly then
|
|
RelocSection:=true;
|
|
end;
|
|
|
|
{ relocation works only without stabs under win32 !! PM }
|
|
{ internal assembler uses rva for stabs info
|
|
so it should work with relocated DLLs }
|
|
if RelocSection and
|
|
(target_info.system in [system_i386_win32,system_i386_wdosx]) and
|
|
(target_info.assem<>as_i386_pecoff) then
|
|
begin
|
|
include(aktglobalswitches,cs_link_strip);
|
|
{ Warning stabs info does not work with reloc section !! }
|
|
if cs_debuginfo in aktmoduleswitches then
|
|
begin
|
|
Message1(parser_w_parser_reloc_no_debug,current_module.mainsource^);
|
|
Message(parser_w_parser_win32_debug_needs_WN);
|
|
exclude(aktmoduleswitches,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);
|
|
stringdispose(current_module.modulename);
|
|
stringdispose(current_module.realmodulename);
|
|
current_module.modulename:=stringdup(pattern);
|
|
current_module.realmodulename:=stringdup(orgpattern);
|
|
current_module.islibrary:=true;
|
|
exportlib.preparelib(orgpattern);
|
|
|
|
if tf_library_needs_pic in target_info.flags then
|
|
include(aktmoduleswitches,cs_create_pic);
|
|
|
|
consume(_ID);
|
|
consume(_SEMICOLON);
|
|
end
|
|
else
|
|
{ is there an program head ? }
|
|
if token=_PROGRAM then
|
|
begin
|
|
consume(_PROGRAM);
|
|
stringdispose(current_module.modulename);
|
|
stringdispose(current_module.realmodulename);
|
|
current_module.modulename:=stringdup(pattern);
|
|
current_module.realmodulename:=stringdup(orgpattern);
|
|
if (target_info.system in system_unit_program_exports) then
|
|
exportlib.preparelib(orgpattern);
|
|
consume(_ID);
|
|
if token=_LKLAMMER then
|
|
begin
|
|
consume(_LKLAMMER);
|
|
repeat
|
|
consume(_ID);
|
|
until not try_to_consume(_COMMA);
|
|
consume(_RKLAMMER);
|
|
end;
|
|
consume(_SEMICOLON);
|
|
end
|
|
else if (target_info.system in system_unit_program_exports) then
|
|
exportlib.preparelib(current_module.realmodulename^);
|
|
|
|
{ global switches are read, so further changes aren't allowed }
|
|
current_module.in_global:=false;
|
|
|
|
{ setup things using the switches }
|
|
ConsolidateMode;
|
|
setupglobalswitches;
|
|
|
|
{ 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 }
|
|
st:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid);
|
|
current_module.localsymtable:=st;
|
|
refsymtable:=st;
|
|
|
|
macrosymtablestack:= nil;
|
|
|
|
{ load standard units (system,objpas,profile unit) }
|
|
loaddefaultunits;
|
|
|
|
current_module.localmacrosymtable.next:=macrosymtablestack;
|
|
macrosymtablestack:=current_module.localmacrosymtable;
|
|
|
|
{ Load units provided on the command line }
|
|
loadautounits;
|
|
|
|
{Load the units used by the program we compile.}
|
|
if token=_USES then
|
|
loadunits;
|
|
|
|
{ reset ranges/stabs in exported definitions }
|
|
reset_all_defs;
|
|
|
|
{ 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
|
|
st.insert(tunitsym.create(current_module.realmodulename^,st));
|
|
|
|
{ ...is also constsymtable, this is the symtable where }
|
|
{ the elements of enumeration types are inserted }
|
|
constsymtable:=st;
|
|
|
|
Message1(parser_u_parsing_implementation,current_module.mainsource^);
|
|
|
|
{ The program intialization needs an alias, so it can be called
|
|
from the bootstrap code.}
|
|
|
|
if islibrary then
|
|
begin
|
|
pd:=create_main_proc(make_mangledname('',current_module.localsymtable,mainaliasname),potype_proginit,st);
|
|
{ Win32 startup code needs a single name }
|
|
// if (target_info.system in [system_i386_win32,system_i386_wdosx]) then
|
|
pd.aliasnames.insert('PASCALMAIN');
|
|
end
|
|
else if (target_info.system = system_i386_netware) or
|
|
(target_info.system = system_i386_netwlibc) then
|
|
begin
|
|
pd:=create_main_proc('PASCALMAIN',potype_proginit,st); { main is need by the netware rtl }
|
|
end
|
|
else
|
|
begin
|
|
pd:=create_main_proc(mainaliasname,potype_proginit,st);
|
|
pd.aliasnames.insert('PASCALMAIN');
|
|
end;
|
|
tcgprocinfo(current_procinfo).parse_body;
|
|
tcgprocinfo(current_procinfo).generate_code;
|
|
tcgprocinfo(current_procinfo).resetprocdef;
|
|
{ save file pos for debuginfo }
|
|
current_module.mainfilepos:=current_procinfo.entrypos;
|
|
release_main_proc(pd);
|
|
|
|
{ Generate specializations of objectdefs methods }
|
|
generate_specialization_procs;
|
|
|
|
{ should we force unit initialization? }
|
|
if tstaticsymtable(current_module.localsymtable).needs_init_final then
|
|
begin
|
|
{ initialize section }
|
|
gen_implicit_initfinal(uf_init,st);
|
|
{ finalize section }
|
|
gen_implicit_initfinal(uf_finalize,st);
|
|
end;
|
|
|
|
{ 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
|
|
asmlist[al_procedures].concat(tai_const.create_sym(exportlib.edatalabel));
|
|
|
|
If resourcestrings.ResStrCount>0 then
|
|
begin
|
|
resourcestrings.CreateResourceStringList;
|
|
{ only write if no errors found }
|
|
if (Errorcount=0) then
|
|
resourcestrings.WriteResourceFile(ForceExtension(current_module.ppufilename^,'.rst'));
|
|
end;
|
|
|
|
{ finalize? }
|
|
if token=_FINALIZATION then
|
|
begin
|
|
{ set module options }
|
|
current_module.flags:=current_module.flags or uf_finalize;
|
|
|
|
{ Compile the finalize }
|
|
pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,st);
|
|
pd.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
|
|
tcgprocinfo(current_procinfo).parse_body;
|
|
tcgprocinfo(current_procinfo).generate_code;
|
|
tcgprocinfo(current_procinfo).resetprocdef;
|
|
release_main_proc(pd);
|
|
end;
|
|
|
|
{ consume the last point }
|
|
consume(_POINT);
|
|
|
|
if (Errorcount=0) then
|
|
begin
|
|
{ test static symtable }
|
|
tstoredsymtable(st).allsymbolsused;
|
|
tstoredsymtable(st).allprivatesused;
|
|
tstoredsymtable(st).check_forwards;
|
|
tstoredsymtable(st).checklabels;
|
|
tstoredsymtable(st).unchain_overloaded;
|
|
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 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;
|
|
|
|
{ do we need to add the variants unit? }
|
|
maybeloadvariantsunit;
|
|
|
|
{ generate debuginfo }
|
|
if (cs_debuginfo in aktmoduleswitches) then
|
|
debuginfo.inserttypeinfo;
|
|
|
|
{ generate wrappers for interfaces }
|
|
gen_intf_wrappers(asmlist[al_procedures],current_module.localsymtable);
|
|
|
|
{ generate pic helpers to load eip if necessary }
|
|
gen_pic_helpers(asmlist[al_procedures]);
|
|
|
|
{ generate a list of threadvars }
|
|
if not(tf_section_threadvars in target_info.flags) then
|
|
InsertThreadvars;
|
|
|
|
{ generate imports }
|
|
if current_module.uses_imports then
|
|
importlib.generatelib;
|
|
|
|
if islibrary or (target_info.system in system_unit_program_exports) then
|
|
exportlib.generatelib;
|
|
|
|
{ insert Tables and StackLength }
|
|
if not(tf_section_threadvars in target_info.flags) then
|
|
insertThreadVarTablesTable;
|
|
|
|
insertResourceTablesTable;
|
|
insertinitfinaltable;
|
|
insertmemorysizes;
|
|
{ Insert symbol to resource info }
|
|
|
|
InsertResourceInfo;
|
|
|
|
{ create dwarf debuginfo }
|
|
create_dwarf;
|
|
|
|
{ finish asmlist by adding segment starts }
|
|
// insertsegment;
|
|
|
|
{ insert own objectfile }
|
|
insertobjectfile;
|
|
|
|
{ assemble and link }
|
|
create_objectfile;
|
|
|
|
{ release all local symtables that are not needed anymore }
|
|
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;
|
|
|
|
{ create the executable when we are at level 1 }
|
|
if (compile_level=1) then
|
|
begin
|
|
{ insert all .o files from all loaded units }
|
|
hp:=tmodule(loaded_units.first);
|
|
while assigned(hp) do
|
|
begin
|
|
linker.AddModuleFiles(hp);
|
|
hp:=tmodule(hp.next);
|
|
end;
|
|
{ write .def file }
|
|
if (cs_link_deffile in aktglobalswitches) then
|
|
deffile.writefile;
|
|
{ finally we can create a executable }
|
|
if (not current_module.is_unit) then
|
|
begin
|
|
if DLLSource then
|
|
linker.MakeSharedLibrary
|
|
else
|
|
linker.MakeExecutable;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end.
|