mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-31 03:31:36 +01:00
1645 lines
58 KiB
ObjectPascal
1645 lines
58 KiB
ObjectPascal
{
|
|
$Id$
|
|
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,
|
|
link,assemble,import,export,gendef,ppu,comprsrc,
|
|
cresstr,procinfo,
|
|
dwarf,
|
|
{$ifdef GDB}
|
|
gdb,
|
|
{$endif GDB}
|
|
scanner,pbase,pexpr,psystem,psub,pdecsub;
|
|
|
|
procedure fixseg(p:TAAsmoutput; sec:TAsmSectionType; secname: string);
|
|
begin
|
|
maybe_new_object_file(p);
|
|
if target_info.system <> system_powerpc_macos then
|
|
p.insert(Tai_section.Create(sec,'',0))
|
|
else
|
|
p.insert(Tai_section.Create(sec,secname,0));
|
|
end;
|
|
|
|
|
|
procedure create_objectfile;
|
|
var
|
|
DLLScanner : TDLLScanner;
|
|
s : string;
|
|
KeepShared : TStringList;
|
|
begin
|
|
{ try to create import entries from system dlls }
|
|
if target_info.DllScanSupported 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(importssection)then
|
|
importssection.clear
|
|
else
|
|
importssection:=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;
|
|
|
|
{ create the .s file and assemble it }
|
|
GenerateAsm(false);
|
|
|
|
{ Also create a smartlinked version ? }
|
|
if (cs_create_smart in aktmoduleswitches) then
|
|
begin
|
|
{ regenerate the importssection for win32 }
|
|
if assigned(importssection) and
|
|
(target_info.system in [system_i386_win32,system_i386_wdosx]) then
|
|
begin
|
|
importsSection.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) 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
|
|
dwarflist:=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(dwarflist);
|
|
end;
|
|
|
|
|
|
procedure insertsegment;
|
|
var
|
|
oldaktfilepos : tfileposinfo;
|
|
{Note: Sections get names in macos only.}
|
|
begin
|
|
{ Insert Ident of the compiler }
|
|
if (not (cs_create_smart in aktmoduleswitches))
|
|
{$ifndef EXTDEBUG}
|
|
and (not current_module.is_unit)
|
|
{$endif}
|
|
then
|
|
begin
|
|
{ align the first data }
|
|
dataSegment.insert(Tai_align.Create(const_align(32)));
|
|
dataSegment.insert(Tai_string.Create('FPC '+full_version_string+
|
|
' ['+date_string+'] for '+target_cpu_string+' - '+target_info.shortname));
|
|
end;
|
|
{ align code segment }
|
|
codeSegment.concat(Tai_align.Create(aktalignment.procalign));
|
|
{ Insert start and end of sections }
|
|
fixseg(codesegment,sec_code,'____seg_code');
|
|
fixseg(datasegment,sec_data,'____seg_data');
|
|
fixseg(bsssegment,sec_bss,'____seg_bss');
|
|
{ we should use .rdata section for these two no ?
|
|
.rdata is a read only data section (PM) }
|
|
fixseg(rttilist,sec_data,'____seg_rtti');
|
|
fixseg(consts,sec_data,'____seg_consts');
|
|
fixseg(picdata,sec_data,'____seg_picdata');
|
|
if assigned(resourcestringlist) then
|
|
fixseg(resourcestringlist,sec_data,'____seg_resstrings');
|
|
{$ifdef GDB}
|
|
if assigned(debuglist) then
|
|
begin
|
|
oldaktfilepos:=aktfilepos;
|
|
aktfilepos.line:=0;
|
|
debugList.insert(Tai_symbol.Createname('gcc2_compiled',AT_DATA,0));
|
|
debugList.insert(Tai_symbol.Createname('fpc_compiled',AT_DATA,0));
|
|
fixseg(debuglist,sec_code,'____seg_debug');
|
|
aktfilepos:=oldaktfilepos;
|
|
end;
|
|
{$endif GDB}
|
|
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;
|
|
{ TableCount }
|
|
ltvTables.insert(Tai_const.Create_32bit(count));
|
|
ltvTables.insert(Tai_symbol.Createname_global('FPC_THREADVARTABLES',AT_DATA,0));
|
|
ltvTables.insert(Tai_align.Create(const_align(sizeof(aint))));
|
|
ltvTables.concat(Tai_symbol_end.Createname('FPC_THREADVARTABLES'));
|
|
{ insert in data segment }
|
|
maybe_new_object_file(dataSegment);
|
|
dataSegment.concatlist(ltvTables);
|
|
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,'');
|
|
{ add begin and end of the list }
|
|
ltvTable.insert(tai_symbol.Createname_global(s,AT_DATA,0));
|
|
ltvTable.insert(Tai_align.Create(const_align(32)));
|
|
ltvTable.concat(tai_const.create_sym(nil)); { end of list marker }
|
|
ltvTable.concat(tai_symbol_end.createname(s));
|
|
maybe_new_object_file(dataSegment);
|
|
dataSegment.concatlist(ltvTable);
|
|
current_module.flags:=current_module.flags or uf_threadvars;
|
|
end;
|
|
ltvTable.Free;
|
|
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 ResourceStringList<>Nil then
|
|
begin
|
|
ResourceStringTables.concat(Tai_const.Createname(make_mangledname('RESOURCESTRINGLIST',current_module.localsymtable,''),AT_DATA,0));
|
|
Inc(Count);
|
|
end;
|
|
{ TableCount }
|
|
ResourceStringTables.insert(Tai_const.Create_32bit(count));
|
|
ResourceStringTables.insert(Tai_symbol.Createname_global('FPC_RESOURCESTRINGTABLES',AT_DATA,0));
|
|
ResourceStringTables.insert(Tai_align.Create(const_align(4)));
|
|
ResourceStringTables.concat(Tai_symbol_end.Createname('FPC_RESOURCESTRINGTABLES'));
|
|
{ insert in data segment }
|
|
maybe_new_object_file(dataSegment);
|
|
dataSegment.concatlist(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;
|
|
{ TableCount,InitCount }
|
|
unitinits.insert(Tai_const.Create_32bit(0));
|
|
unitinits.insert(Tai_const.Create_32bit(count));
|
|
unitinits.insert(Tai_symbol.Createname_global('INITFINAL',AT_DATA,0));
|
|
unitinits.insert(Tai_align.Create(const_align(4)));
|
|
unitinits.concat(Tai_symbol_end.Createname('INITFINAL'));
|
|
{ insert in data segment }
|
|
maybe_new_object_file(dataSegment);
|
|
dataSegment.concatlist(unitinits);
|
|
unitinits.free;
|
|
end;
|
|
|
|
|
|
procedure insertmemorysizes;
|
|
begin
|
|
{ stacksize can be specified and is now simulated }
|
|
dataSegment.concat(Tai_align.Create(const_align(4)));
|
|
dataSegment.concat(Tai_symbol.Createname_global('__stklen',AT_DATA,4));
|
|
dataSegment.concat(Tai_const.Create_32bit(stacksize));
|
|
dataSegment.concat(Tai_symbol.Createname_global('__heapsize',AT_DATA,4));
|
|
dataSegment.concat(Tai_const.Create_32bit(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;
|
|
{ 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;
|
|
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;
|
|
{$ifdef cpufpemu}
|
|
{ Floating point emulation unit? }
|
|
if (cs_fp_emulation in aktmoduleswitches) then
|
|
AddUnit('SoftFpu');
|
|
{$endif cpufpemu}
|
|
{ Thread support unit? }
|
|
if (cs_threading in aktmoduleswitches) then
|
|
AddUnit('SysThrds');
|
|
{ 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');
|
|
{ Units only required for main module }
|
|
if not(current_module.is_unit) then
|
|
begin
|
|
{ Heaptrc unit }
|
|
if (cs_gdb_heaptrc in aktglobalswitches) then
|
|
AddUnit('HeapTrc');
|
|
{ Lineinfo unit }
|
|
if (cs_gdb_lineinfo in aktglobalswitches) then
|
|
AddUnit('LineInfo');
|
|
{ Lineinfo unit }
|
|
if (cs_gdb_valgrind in aktglobalswitches) then
|
|
AddUnit('CMem');
|
|
end;
|
|
{ save default symtablestack }
|
|
defaultsymtablestack:=symtablestack;
|
|
end;
|
|
|
|
|
|
procedure loadunits;
|
|
var
|
|
s,sorg : stringid;
|
|
fn : string;
|
|
pu : tused_unit;
|
|
hp2 : tmodule;
|
|
hp3 : tsymtable;
|
|
unitsym : tunitsym;
|
|
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;
|
|
consume(_SEMICOLON);
|
|
|
|
{ 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;
|
|
{ connect unitsym to the globalsymtable of the unit }
|
|
pu.unitsym.unitsymtable:=pu.u.globalsymtable;
|
|
{ increase refs of the unitsym when the unit contains
|
|
initialization/finalization code so it doesn't trigger
|
|
the unit not used hint }
|
|
if (pu.u.flags and (uf_init or uf_finalize))<>0 then
|
|
inc(pu.unitsym.refs);
|
|
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;
|
|
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);
|
|
{$ifdef DEBUG}
|
|
test_symtablestack;
|
|
{$endif DEBUG}
|
|
end;
|
|
end;
|
|
end;
|
|
pu:=tused_unit(pu.next);
|
|
end;
|
|
end;
|
|
|
|
|
|
{$IfDef GDB}
|
|
procedure write_gdb_info;
|
|
|
|
procedure reset_unit_type_info;
|
|
var
|
|
hp : tmodule;
|
|
begin
|
|
hp:=tmodule(loaded_units.first);
|
|
while assigned(hp) do
|
|
begin
|
|
hp.is_stab_written:=false;
|
|
hp:=tmodule(hp.next);
|
|
end;
|
|
end;
|
|
|
|
procedure write_used_unit_type_info(hp:tmodule);
|
|
var
|
|
pu : tused_unit;
|
|
begin
|
|
pu:=tused_unit(hp.used_units.first);
|
|
while assigned(pu) do
|
|
begin
|
|
if not pu.u.is_stab_written then
|
|
begin
|
|
{ prevent infinte loop for circular dependencies }
|
|
pu.u.is_stab_written:=true;
|
|
{ write type info from used units, use a depth first
|
|
strategy to reduce the recursion in writing all
|
|
dependent stabs }
|
|
write_used_unit_type_info(pu.u);
|
|
if assigned(pu.u.globalsymtable) then
|
|
tglobalsymtable(pu.u.globalsymtable).concattypestabto(debuglist);
|
|
end;
|
|
pu:=tused_unit(pu.next);
|
|
end;
|
|
end;
|
|
|
|
var
|
|
vardebuglist : taasmoutput;
|
|
storefilepos : tfileposinfo;
|
|
begin
|
|
if not (cs_debuginfo in aktmoduleswitches) then
|
|
exit;
|
|
storefilepos:=aktfilepos;
|
|
aktfilepos:=current_module.mainfilepos;
|
|
{ include symbol that will be referenced from the program to be sure to
|
|
include this debuginfo .o file }
|
|
if current_module.is_unit then
|
|
begin
|
|
current_module.flags:=current_module.flags or uf_has_debuginfo;
|
|
debugList.concat(tai_symbol.Createname_global(make_mangledname('DEBUGINFO',current_module.globalsymtable,''),AT_DATA,0));
|
|
end
|
|
else
|
|
debugList.concat(tai_symbol.Createname_global(make_mangledname('DEBUGINFO',current_module.localsymtable,''),AT_DATA,0));
|
|
{ first write all global/local symbols again to a temp list. This will flag
|
|
all required tdefs. After that the temp list can be removed since the debuginfo is already
|
|
written to the stabs when the variables/consts were written }
|
|
{$warning Hack to get all needed types}
|
|
vardebuglist:=taasmoutput.create;
|
|
new_section(vardebuglist,sec_data,'',0);
|
|
if assigned(current_module.globalsymtable) then
|
|
tglobalsymtable(current_module.globalsymtable).concatstabto(vardebuglist);
|
|
if assigned(current_module.localsymtable) then
|
|
tstaticsymtable(current_module.localsymtable).concatstabto(vardebuglist);
|
|
vardebuglist.free;
|
|
{ reset unit type info flag }
|
|
reset_unit_type_info;
|
|
{ write used types from the used units }
|
|
write_used_unit_type_info(current_module);
|
|
{ last write the types from this unit }
|
|
if assigned(current_module.globalsymtable) then
|
|
tglobalsymtable(current_module.globalsymtable).concattypestabto(debuglist);
|
|
if assigned(current_module.localsymtable) then
|
|
tstaticsymtable(current_module.localsymtable).concattypestabto(debuglist);
|
|
{ include files }
|
|
if (cs_gdb_dbx in aktglobalswitches) then
|
|
begin
|
|
debugList.concat(tai_comment.Create(strpnew('EINCL of global '+
|
|
tglobalsymtable(current_module.globalsymtable).name^+' has index '+
|
|
tostr(tglobalsymtable(current_module.globalsymtable).unitid))));
|
|
debugList.concat(Tai_stabs.Create(strpnew('"'+
|
|
tglobalsymtable(current_module.globalsymtable).name^+'",'+
|
|
tostr(N_EINCL)+',0,0,0')));
|
|
tglobalsymtable(current_module.globalsymtable).dbx_count_ok:={true}false;
|
|
dbx_counter:=tglobalsymtable(current_module.globalsymtable).prev_dbx_counter;
|
|
do_count_dbx:=false;
|
|
end;
|
|
aktfilepos:=storefilepos;
|
|
end;
|
|
{$EndIf GDB}
|
|
|
|
|
|
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((pd.proccalloption=pocall_inline) 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);
|
|
|
|
{ define a symbol in delphi,objfpc,tp,gpc mode }
|
|
if (m_delphi in aktmodeswitches) then
|
|
current_scanner.def_macro('FPC_DELPHI')
|
|
else
|
|
if (m_tp7 in aktmodeswitches) then
|
|
current_scanner.def_macro('FPC_TP')
|
|
else
|
|
if (m_objfpc in aktmodeswitches) then
|
|
current_scanner.def_macro('FPC_OBJFPC')
|
|
else
|
|
if (m_gpc in aktmodeswitches) then
|
|
current_scanner.def_macro('FPC_GPC')
|
|
else
|
|
if (m_mac in aktmodeswitches) then
|
|
current_scanner.def_macro('FPC_MACPAS');
|
|
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 proc_unit;
|
|
|
|
function is_assembler_generated:boolean;
|
|
begin
|
|
is_assembler_generated:=(Errorcount=0) and
|
|
not(
|
|
codeSegment.empty and
|
|
dataSegment.empty and
|
|
bssSegment.empty and
|
|
((importssection=nil) or importsSection.empty) and
|
|
((resourcesection=nil) or resourceSection.empty) and
|
|
((resourcestringlist=nil) or resourcestringList.empty)
|
|
);
|
|
end;
|
|
|
|
var
|
|
main_file: tinputfile;
|
|
st : tsymtable;
|
|
unitst : tglobalsymtable;
|
|
store_crc,store_interface_crc : cardinal;
|
|
s1,s2 : ^string; {Saves stack space}
|
|
force_init_final : boolean;
|
|
pd : tprocdef;
|
|
unitname8 : string[8];
|
|
has_impl: boolean;
|
|
begin
|
|
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;
|
|
|
|
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 }
|
|
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^);
|
|
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));
|
|
|
|
{ load default units, like the system unit }
|
|
loaddefaultunits;
|
|
|
|
{ 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.numberunits;
|
|
|
|
{ ... 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
|
|
begin
|
|
consume(_IMPLEMENTATION);
|
|
has_impl:= true;
|
|
end;
|
|
|
|
if has_impl then
|
|
Message1(unit_u_loading_implementation_units,current_module.modulename^);
|
|
|
|
parse_only:=false;
|
|
|
|
{ generates static symbol table }
|
|
st:=tstaticsymtable.create(current_module.modulename^);
|
|
current_module.localsymtable:=st;
|
|
|
|
{ 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;
|
|
|
|
{ Read the implementation units }
|
|
if has_impl then
|
|
parse_implementation_uses;
|
|
|
|
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.numberunits;
|
|
|
|
{ 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;
|
|
|
|
{ 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 }
|
|
{$ifdef GDB}
|
|
write_gdb_info;
|
|
{$endif GDB}
|
|
|
|
{ generate a list of threadvars }
|
|
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) }
|
|
if is_assembler_generated then
|
|
insertobjectfile
|
|
else
|
|
current_module.flags:=current_module.flags or uf_no_link;
|
|
|
|
if cs_local_browser in aktmoduleswitches then
|
|
current_module.localsymtable:=refsymtable;
|
|
|
|
if is_assembler_generated 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;
|
|
store_crc:=current_module.crc;
|
|
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 local symtables that are not needed anymore }
|
|
free_localsymtables(current_module.globalsymtable);
|
|
free_localsymtables(current_module.localsymtable);
|
|
|
|
{ remove static symtable (=refsymtable) here to save some mem }
|
|
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);
|
|
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_i386_WIN32,system_i386_wdosx]) 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_i386_WIN32,system_i386_wdosx]) 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 global switches }
|
|
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.localsymtable:=st;
|
|
refsymtable:=st;
|
|
|
|
{ load standard units (system,objpas,profile unit) }
|
|
loaddefaultunits;
|
|
|
|
{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.numberunits;
|
|
|
|
{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 or
|
|
(target_info.system in [system_powerpc_macos,system_powerpc_darwin]) then
|
|
begin
|
|
pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'main'),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
|
|
begin
|
|
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('main',potype_proginit,st);
|
|
pd.aliasnames.insert('PASCALMAIN');
|
|
end;
|
|
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);
|
|
|
|
{ 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
|
|
assigned(current_module._exports.first) then
|
|
codesegment.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 }
|
|
{$ifdef GDB}
|
|
write_gdb_info;
|
|
{$endif GDB}
|
|
|
|
{ generate a list of threadvars }
|
|
InsertThreadvars;
|
|
|
|
{ generate imports }
|
|
if current_module.uses_imports then
|
|
importlib.generatelib;
|
|
|
|
if islibrary or
|
|
(target_info.system in [system_i386_WIN32,system_i386_wdosx]) or
|
|
(target_info.system=system_i386_NETWARE) then
|
|
exportlib.generatelib;
|
|
|
|
{ insert Tables and StackLength }
|
|
insertThreadVarTablesTable;
|
|
insertResourceTablesTable;
|
|
insertinitfinaltable;
|
|
insertmemorysizes;
|
|
|
|
{ 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.
|
|
{
|
|
$Log$
|
|
Revision 1.178 2004-12-06 19:23:05 peter
|
|
implicit load of variants unit
|
|
|
|
Revision 1.177 2004/11/29 18:50:15 peter
|
|
* os2 fixes for import
|
|
* asmsymtype support for intel reader
|
|
|
|
Revision 1.176 2004/11/19 08:17:02 michael
|
|
* Split po_public into po_public and po_global (Peter)
|
|
|
|
Revision 1.175 2004/11/16 20:32:40 peter
|
|
* fixes for win32 mangledname
|
|
|
|
Revision 1.174 2004/11/15 23:35:31 peter
|
|
* tparaitem removed, use tparavarsym instead
|
|
* parameter order is now calculated from paranr value in tparavarsym
|
|
|
|
Revision 1.173 2004/11/08 22:09:59 peter
|
|
* tvarsym splitted
|
|
|
|
Revision 1.172 2004/11/05 20:04:49 florian
|
|
* THREADVARLIST is now aligned
|
|
|
|
Revision 1.171 2004/11/04 23:59:13 peter
|
|
use filepos of main when generating the module stabs
|
|
|
|
Revision 1.170 2004/11/04 17:09:54 peter
|
|
fixed debuginfo for variables in staticsymtable
|
|
|
|
Revision 1.169 2004/10/31 15:29:39 olle
|
|
+ All sections get names in macos
|
|
|
|
Revision 1.168 2004/10/26 15:11:01 peter
|
|
* -Ch for heapsize added again
|
|
* __heapsize contains the heapsize
|
|
|
|
Revision 1.167 2004/10/25 15:38:41 peter
|
|
* heap and heapsize removed
|
|
* checkpointer fixes
|
|
|
|
Revision 1.166 2004/10/15 09:14:17 mazen
|
|
- remove $IFDEF DELPHI and related code
|
|
- remove $IFDEF FPCPROCVAR and related code
|
|
|
|
Revision 1.165 2004/10/04 18:26:51 peter
|
|
* debuginfo fixes
|
|
|
|
Revision 1.164 2004/09/14 16:33:46 peter
|
|
* release localsymtables when module is compiled
|
|
|
|
Revision 1.163 2004/09/04 21:18:47 armin
|
|
* target netwlibc added (libc is preferred for newer netware versions)
|
|
|
|
Revision 1.162 2004/09/03 16:12:32 armin
|
|
* dont create main for netware (only PASCALMAIN)
|
|
|
|
Revision 1.161 2004/08/16 22:52:35 olle
|
|
+ Added automatic use of unit macpas under mode macpas
|
|
|
|
Revision 1.160 2004/07/06 20:23:25 peter
|
|
* remove unused and not loaded units before linking
|
|
|
|
Revision 1.159 2004/06/29 21:00:08 peter
|
|
* only enable dwarf for supported platforms
|
|
|
|
Revision 1.158 2004/06/20 08:55:30 florian
|
|
* logs truncated
|
|
|
|
Revision 1.157 2004/06/18 15:16:27 peter
|
|
* fixed debuginfo symbol
|
|
|
|
Revision 1.156 2004/06/16 20:07:09 florian
|
|
* dwarf branch merged
|
|
|
|
Revision 1.155 2004/05/23 20:56:42 peter
|
|
* initialize errorsym/errortype.def.owner to prevent crashes
|
|
|
|
Revision 1.154 2004/05/23 15:06:21 peter
|
|
* implicit_finally flag must be set in pass1
|
|
* add check whether the implicit frame is generated when expected
|
|
|
|
Revision 1.153 2004/05/19 21:16:13 peter
|
|
* add DEBUGINFO symbol to reference the .o file that includes the
|
|
stabs info for types and global/static variables
|
|
* debuginfo flag added to ppu to indicate whether debuginfo is
|
|
generated or not
|
|
|
|
}
|