mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-14 02:39:27 +02:00
40cf2cefa0
JVM platform (normally it's not necessary because all types are
automatically initialized)
git-svn-id: branches/jvmbackend@18672 -
763 lines
29 KiB
ObjectPascal
763 lines
29 KiB
ObjectPascal
{
|
|
Copyright (c) 1998-2011 by Florian Klaempfl
|
|
|
|
Generic version of some node tree helper routines that can be overridden
|
|
by cpu-specific versions
|
|
|
|
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 ngenutil;
|
|
|
|
{$i fpcdefs.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
node,symtype,symsym,symconst,symdef;
|
|
|
|
|
|
type
|
|
tnodeutils = class
|
|
class function call_fail_node:tnode; virtual;
|
|
class function initialize_data_node(p:tnode; force: boolean):tnode; virtual;
|
|
class function finalize_data_node(p:tnode):tnode; virtual;
|
|
{ returns true if the unit requires an initialisation section (e.g.,
|
|
to force class constructors for the JVM target to initialise global
|
|
records/arrays) }
|
|
class function force_init: boolean; virtual;
|
|
{ idem for finalization }
|
|
class function force_final: boolean; virtual;
|
|
|
|
{ called after parsing a routine with the code of the entire routine
|
|
as argument; can be used to modify the node tree. By default handles
|
|
insertion of code for systems that perform the typed constant
|
|
initialisation via the node tree }
|
|
class function wrap_proc_body(pd: tprocdef; n: tnode): tnode; virtual;
|
|
|
|
class procedure insertbssdata(sym : tstaticvarsym); virtual;
|
|
|
|
class function create_main_procdef(const name: string; potype:tproctypeoption; ps: tprocsym):tdef; virtual;
|
|
class procedure InsertInitFinalTable; virtual;
|
|
public
|
|
class procedure InsertThreadvarTablesTable; virtual;
|
|
class procedure InsertThreadvars; virtual;
|
|
class procedure InsertWideInitsTablesTable; virtual;
|
|
class procedure InsertWideInits; virtual;
|
|
class procedure InsertResourceTablesTable; virtual;
|
|
class procedure InsertResourceInfo(ResourcesUsed : boolean); virtual;
|
|
|
|
class procedure InsertMemorySizes; virtual;
|
|
|
|
strict protected
|
|
class procedure add_main_procdef_paras(pd: tdef); virtual;
|
|
end;
|
|
tnodeutilsclass = class of tnodeutils;
|
|
|
|
const
|
|
cnodeutils: tnodeutilsclass = tnodeutils;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
verbose,version,globtype,globals,cclasses,cutils,constexp,
|
|
scanner,systems,procinfo,fmodule,
|
|
aasmbase,aasmdata,aasmtai,
|
|
symbase,symtable,defutil,
|
|
nadd,nbas,ncal,ncnv,ncon,nflw,nld,nmem,nobj,nutils,
|
|
ppu,
|
|
pass_1;
|
|
|
|
class function tnodeutils.call_fail_node:tnode;
|
|
var
|
|
para : tcallparanode;
|
|
newstatement : tstatementnode;
|
|
srsym : tsym;
|
|
begin
|
|
result:=internalstatements(newstatement);
|
|
|
|
{ call fail helper and exit normal }
|
|
if is_class(current_structdef) then
|
|
begin
|
|
srsym:=search_struct_member(current_structdef,'FREEINSTANCE');
|
|
if assigned(srsym) and
|
|
(srsym.typ=procsym) then
|
|
begin
|
|
{ if self<>0 and vmt<>0 then freeinstance }
|
|
addstatement(newstatement,cifnode.create(
|
|
caddnode.create(andn,
|
|
caddnode.create(unequaln,
|
|
load_self_pointer_node,
|
|
cnilnode.create),
|
|
caddnode.create(unequaln,
|
|
load_vmt_pointer_node,
|
|
cnilnode.create)),
|
|
ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node,[]),
|
|
nil));
|
|
end
|
|
else
|
|
internalerror(200305108);
|
|
end
|
|
else
|
|
if is_object(current_structdef) then
|
|
begin
|
|
{ parameter 3 : vmt_offset }
|
|
{ parameter 2 : pointer to vmt }
|
|
{ parameter 1 : self pointer }
|
|
para:=ccallparanode.create(
|
|
cordconstnode.create(tobjectdef(current_structdef).vmt_offset,s32inttype,false),
|
|
ccallparanode.create(
|
|
ctypeconvnode.create_internal(
|
|
load_vmt_pointer_node,
|
|
voidpointertype),
|
|
ccallparanode.create(
|
|
ctypeconvnode.create_internal(
|
|
load_self_pointer_node,
|
|
voidpointertype),
|
|
nil)));
|
|
addstatement(newstatement,
|
|
ccallnode.createintern('fpc_help_fail',para));
|
|
end
|
|
else
|
|
internalerror(200305132);
|
|
{ self:=nil }
|
|
addstatement(newstatement,cassignmentnode.create(
|
|
load_self_pointer_node,
|
|
cnilnode.create));
|
|
{ exit }
|
|
addstatement(newstatement,cexitnode.create(nil));
|
|
end;
|
|
|
|
|
|
class function tnodeutils.initialize_data_node(p:tnode; force: boolean):tnode;
|
|
begin
|
|
if not assigned(p.resultdef) then
|
|
typecheckpass(p);
|
|
if is_ansistring(p.resultdef) or
|
|
is_wide_or_unicode_string(p.resultdef) or
|
|
is_interfacecom_or_dispinterface(p.resultdef) or
|
|
is_dynamic_array(p.resultdef) then
|
|
begin
|
|
result:=cassignmentnode.create(
|
|
ctypeconvnode.create_internal(p,voidpointertype),
|
|
cnilnode.create
|
|
);
|
|
end
|
|
else
|
|
begin
|
|
result:=ccallnode.createintern('fpc_initialize',
|
|
ccallparanode.create(
|
|
caddrnode.create_internal(
|
|
crttinode.create(
|
|
tstoreddef(p.resultdef),initrtti,rdt_normal)),
|
|
ccallparanode.create(
|
|
caddrnode.create_internal(p),
|
|
nil)));
|
|
end;
|
|
end;
|
|
|
|
|
|
class function tnodeutils.finalize_data_node(p:tnode):tnode;
|
|
var
|
|
newstatement : tstatementnode;
|
|
begin
|
|
if not assigned(p.resultdef) then
|
|
typecheckpass(p);
|
|
if is_ansistring(p.resultdef) then
|
|
begin
|
|
result:=internalstatements(newstatement);
|
|
addstatement(newstatement,ccallnode.createintern('fpc_ansistr_decr_ref',
|
|
ccallparanode.create(
|
|
ctypeconvnode.create_internal(p,voidpointertype),
|
|
nil)));
|
|
addstatement(newstatement,cassignmentnode.create(
|
|
ctypeconvnode.create_internal(p.getcopy,voidpointertype),
|
|
cnilnode.create
|
|
));
|
|
end
|
|
else if is_widestring(p.resultdef) then
|
|
begin
|
|
result:=internalstatements(newstatement);
|
|
addstatement(newstatement,ccallnode.createintern('fpc_widestr_decr_ref',
|
|
ccallparanode.create(
|
|
ctypeconvnode.create_internal(p,voidpointertype),
|
|
nil)));
|
|
addstatement(newstatement,cassignmentnode.create(
|
|
ctypeconvnode.create_internal(p.getcopy,voidpointertype),
|
|
cnilnode.create
|
|
));
|
|
end
|
|
else if is_unicodestring(p.resultdef) then
|
|
begin
|
|
result:=internalstatements(newstatement);
|
|
addstatement(newstatement,ccallnode.createintern('fpc_unicodestr_decr_ref',
|
|
ccallparanode.create(
|
|
ctypeconvnode.create_internal(p,voidpointertype),
|
|
nil)));
|
|
addstatement(newstatement,cassignmentnode.create(
|
|
ctypeconvnode.create_internal(p.getcopy,voidpointertype),
|
|
cnilnode.create
|
|
));
|
|
end
|
|
else if is_interfacecom_or_dispinterface(p.resultdef) then
|
|
begin
|
|
result:=internalstatements(newstatement);
|
|
addstatement(newstatement,ccallnode.createintern('fpc_intf_decr_ref',
|
|
ccallparanode.create(
|
|
ctypeconvnode.create_internal(p,voidpointertype),
|
|
nil)));
|
|
addstatement(newstatement,cassignmentnode.create(
|
|
ctypeconvnode.create_internal(p.getcopy,voidpointertype),
|
|
cnilnode.create
|
|
));
|
|
end
|
|
else
|
|
result:=ccallnode.createintern('fpc_finalize',
|
|
ccallparanode.create(
|
|
caddrnode.create_internal(
|
|
crttinode.create(
|
|
tstoreddef(p.resultdef),initrtti,rdt_normal)),
|
|
ccallparanode.create(
|
|
caddrnode.create_internal(p),
|
|
nil)));
|
|
end;
|
|
|
|
|
|
class function tnodeutils.force_init: boolean;
|
|
begin
|
|
result:=
|
|
(target_info.system in systems_typed_constants_node_init) and
|
|
assigned(current_module.tcinitcode);
|
|
end;
|
|
|
|
|
|
class function tnodeutils.force_final: boolean;
|
|
begin
|
|
result:=false;
|
|
end;
|
|
|
|
|
|
class function tnodeutils.wrap_proc_body(pd: tprocdef; n: tnode): tnode;
|
|
var
|
|
stat: tstatementnode;
|
|
block: tnode;
|
|
psym: tsym;
|
|
tcinitproc: tprocdef;
|
|
begin
|
|
result:=n;
|
|
if target_info.system in systems_typed_constants_node_init then
|
|
begin
|
|
case pd.proctypeoption of
|
|
potype_class_constructor:
|
|
begin
|
|
{ even though the initialisation code for typed constants may
|
|
not yet be complete at this point (there may be more inside
|
|
method definitions coming after this class constructor), the
|
|
ones from inside the class definition have already been parsed.
|
|
in case of {$j-}, these are marked "final" in Java and such
|
|
static fields must be initialsed in the class constructor
|
|
itself -> add them here }
|
|
block:=internalstatements(stat);
|
|
if assigned(pd.struct.tcinitcode) then
|
|
begin
|
|
addstatement(stat,pd.struct.tcinitcode);
|
|
pd.struct.tcinitcode:=nil;
|
|
end;
|
|
psym:=tsym(pd.struct.symtable.find('FPC_INIT_TYPED_CONSTS_HELPER'));
|
|
if assigned(psym) then
|
|
begin
|
|
if (psym.typ<>procsym) or
|
|
(tprocsym(psym).procdeflist.count<>1) then
|
|
internalerror(2011040301);
|
|
tcinitproc:=tprocdef(tprocsym(psym).procdeflist[0]);
|
|
addstatement(stat,ccallnode.create(nil,tprocsym(psym),
|
|
pd.struct.symtable,nil,[]));
|
|
end;
|
|
addstatement(stat,result);
|
|
result:=block
|
|
end;
|
|
potype_unitinit:
|
|
begin
|
|
if assigned(current_module.tcinitcode) then
|
|
begin
|
|
block:=internalstatements(stat);
|
|
addstatement(stat,tnode(current_module.tcinitcode));
|
|
current_module.tcinitcode:=nil;
|
|
addstatement(stat,result);
|
|
result:=block;
|
|
end;
|
|
end;
|
|
else case pd.synthetickind of
|
|
tsk_tcinit:
|
|
begin
|
|
if assigned(pd.struct.tcinitcode) then
|
|
begin
|
|
block:=internalstatements(stat);
|
|
addstatement(stat,pd.struct.tcinitcode);
|
|
pd.struct.tcinitcode:=nil;
|
|
addstatement(stat,result);
|
|
result:=block
|
|
end
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
class procedure tnodeutils.insertbssdata(sym: tstaticvarsym);
|
|
var
|
|
l : asizeint;
|
|
varalign : shortint;
|
|
storefilepos : tfileposinfo;
|
|
list : TAsmList;
|
|
sectype : TAsmSectiontype;
|
|
begin
|
|
storefilepos:=current_filepos;
|
|
current_filepos:=sym.fileinfo;
|
|
l:=sym.getsize;
|
|
varalign:=sym.vardef.alignment;
|
|
if (varalign=0) then
|
|
varalign:=var_align_size(l)
|
|
else
|
|
varalign:=var_align(varalign);
|
|
if tf_section_threadvars in target_info.flags then
|
|
begin
|
|
if (vo_is_thread_var in sym.varoptions) then
|
|
begin
|
|
list:=current_asmdata.asmlists[al_threadvars];
|
|
sectype:=sec_threadvar;
|
|
end
|
|
else
|
|
begin
|
|
list:=current_asmdata.asmlists[al_globals];
|
|
sectype:=sec_bss;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if (vo_is_thread_var in sym.varoptions) then
|
|
begin
|
|
inc(l,sizeof(pint));
|
|
{ it doesn't help to set a higher alignment, as }
|
|
{ the first sizeof(pint) bytes field will offset }
|
|
{ everything anyway }
|
|
varalign:=sizeof(pint);
|
|
end;
|
|
list:=current_asmdata.asmlists[al_globals];
|
|
sectype:=sec_bss;
|
|
end;
|
|
maybe_new_object_file(list);
|
|
if vo_has_section in sym.varoptions then
|
|
new_section(list,sec_user,sym.section,varalign)
|
|
else
|
|
new_section(list,sectype,lower(sym.mangledname),varalign);
|
|
if (sym.owner.symtabletype=globalsymtable) or
|
|
create_smartlink or
|
|
DLLSource or
|
|
(assigned(current_procinfo) and
|
|
(po_inline in current_procinfo.procdef.procoptions)) or
|
|
(vo_is_public in sym.varoptions) then
|
|
list.concat(Tai_datablock.create_global(sym.mangledname,l))
|
|
else
|
|
list.concat(Tai_datablock.create(sym.mangledname,l));
|
|
current_filepos:=storefilepos;
|
|
end;
|
|
|
|
|
|
class function tnodeutils.create_main_procdef(const name: string; potype: tproctypeoption; ps: tprocsym): tdef;
|
|
var
|
|
pd: tprocdef;
|
|
begin
|
|
pd:=tprocdef.create(main_program_level);
|
|
pd.procsym:=ps;
|
|
ps.ProcdefList.Add(pd);
|
|
include(pd.procoptions,po_global);
|
|
{ set procdef options }
|
|
pd.proctypeoption:=potype;
|
|
pd.proccalloption:=pocall_default;
|
|
include(pd.procoptions,po_hascallingconvention);
|
|
pd.forwarddef:=false;
|
|
{ may be required to calculate the mangled name }
|
|
add_main_procdef_paras(pd);
|
|
pd.setmangledname(name);
|
|
pd.aliasnames.insert(pd.mangledname);
|
|
result:=pd;
|
|
end;
|
|
|
|
|
|
procedure AddToStructInits(p:TObject;arg:pointer);
|
|
var
|
|
StructList: TFPList absolute arg;
|
|
begin
|
|
if (tdef(p).typ in [objectdef,recorddef]) and
|
|
([oo_has_class_constructor,oo_has_class_destructor] * tabstractrecorddef(p).objectoptions <> []) then
|
|
StructList.Add(p);
|
|
end;
|
|
|
|
|
|
class procedure tnodeutils.InsertInitFinalTable;
|
|
var
|
|
hp : tused_unit;
|
|
unitinits : TAsmList;
|
|
count : longint;
|
|
|
|
procedure write_struct_inits(u: tmodule);
|
|
var
|
|
i: integer;
|
|
structlist: TFPList;
|
|
pd: tprocdef;
|
|
begin
|
|
structlist := TFPList.Create;
|
|
if assigned(u.globalsymtable) then
|
|
u.globalsymtable.DefList.ForEachCall(@AddToStructInits,structlist);
|
|
u.localsymtable.DefList.ForEachCall(@AddToStructInits,structlist);
|
|
{ write structures }
|
|
for i := 0 to structlist.Count - 1 do
|
|
begin
|
|
pd := tabstractrecorddef(structlist[i]).find_procdef_bytype(potype_class_constructor);
|
|
if assigned(pd) then
|
|
unitinits.concat(Tai_const.Createname(pd.mangledname,0))
|
|
else
|
|
unitinits.concat(Tai_const.Create_pint(0));
|
|
pd := tabstractrecorddef(structlist[i]).find_procdef_bytype(potype_class_destructor);
|
|
if assigned(pd) then
|
|
unitinits.concat(Tai_const.Createname(pd.mangledname,0))
|
|
else
|
|
unitinits.concat(Tai_const.Create_pint(0));
|
|
inc(count);
|
|
end;
|
|
structlist.free;
|
|
end;
|
|
|
|
begin
|
|
unitinits:=TAsmList.Create;
|
|
count:=0;
|
|
hp:=tused_unit(usedunits.first);
|
|
while assigned(hp) do
|
|
begin
|
|
{ insert class constructors/destructors of the unit }
|
|
if (hp.u.flags and uf_classinits) <> 0 then
|
|
write_struct_inits(hp.u);
|
|
{ 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,''),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,''),0))
|
|
else
|
|
unitinits.concat(Tai_const.Create_sym(nil));
|
|
inc(count);
|
|
end;
|
|
hp:=tused_unit(hp.next);
|
|
end;
|
|
{ insert class constructors/destructor of the program }
|
|
if (current_module.flags and uf_classinits) <> 0 then
|
|
write_struct_inits(current_module);
|
|
{ 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,''),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,''),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(current_asmdata.asmlists[al_globals]);
|
|
new_section(current_asmdata.asmlists[al_globals],sec_data,'INITFINAL',sizeof(pint));
|
|
current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('INITFINAL',AT_DATA,0));
|
|
current_asmdata.asmlists[al_globals].concatlist(unitinits);
|
|
current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname('INITFINAL'));
|
|
unitinits.free;
|
|
end;
|
|
|
|
|
|
class procedure tnodeutils.InsertThreadvarTablesTable;
|
|
var
|
|
hp : tused_unit;
|
|
ltvTables : TAsmList;
|
|
count : longint;
|
|
begin
|
|
if (tf_section_threadvars in target_info.flags) then
|
|
exit;
|
|
ltvTables:=TAsmList.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,''),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,''),0));
|
|
inc(count);
|
|
end;
|
|
{ Insert TableCount at start }
|
|
ltvTables.insert(Tai_const.Create_32bit(count));
|
|
{ insert in data segment }
|
|
maybe_new_object_file(current_asmdata.asmlists[al_globals]);
|
|
new_section(current_asmdata.asmlists[al_globals],sec_data,'FPC_THREADVARTABLES',sizeof(pint));
|
|
current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('FPC_THREADVARTABLES',AT_DATA,0));
|
|
current_asmdata.asmlists[al_globals].concatlist(ltvTables);
|
|
current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname('FPC_THREADVARTABLES'));
|
|
ltvTables.free;
|
|
end;
|
|
|
|
|
|
|
|
procedure AddToThreadvarList(p:TObject;arg:pointer);
|
|
var
|
|
ltvTable : TAsmList;
|
|
begin
|
|
ltvTable:=TAsmList(arg);
|
|
if (tsym(p).typ=staticvarsym) and
|
|
(vo_is_thread_var in tstaticvarsym(p).varoptions) then
|
|
begin
|
|
{ address of threadvar }
|
|
ltvTable.concat(tai_const.Createname(tstaticvarsym(p).mangledname,0));
|
|
{ size of threadvar }
|
|
ltvTable.concat(tai_const.create_32bit(tstaticvarsym(p).getsize));
|
|
end;
|
|
end;
|
|
|
|
|
|
class procedure tnodeutils.InsertThreadvars;
|
|
var
|
|
s : string;
|
|
ltvTable : TAsmList;
|
|
begin
|
|
if (tf_section_threadvars in target_info.flags) then
|
|
exit;
|
|
ltvTable:=TAsmList.create;
|
|
if assigned(current_module.globalsymtable) then
|
|
current_module.globalsymtable.SymList.ForEachCall(@AddToThreadvarList,ltvTable);
|
|
current_module.localsymtable.SymList.ForEachCall(@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(current_asmdata.asmlists[al_globals]);
|
|
new_section(current_asmdata.asmlists[al_globals],sec_data,s,sizeof(pint));
|
|
current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global(s,AT_DATA,0));
|
|
current_asmdata.asmlists[al_globals].concatlist(ltvTable);
|
|
current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname(s));
|
|
current_module.flags:=current_module.flags or uf_threadvars;
|
|
end;
|
|
ltvTable.Free;
|
|
end;
|
|
|
|
|
|
class procedure tnodeutils.InsertWideInitsTablesTable;
|
|
var
|
|
hp: tused_unit;
|
|
lwiTables: TAsmList;
|
|
count: longint;
|
|
begin
|
|
lwiTables:=TAsmList.Create;
|
|
count:=0;
|
|
hp:=tused_unit(usedunits.first);
|
|
while assigned(hp) do
|
|
begin
|
|
if (hp.u.flags and uf_wideinits)=uf_wideinits then
|
|
begin
|
|
lwiTables.concat(Tai_const.Createname(make_mangledname('WIDEINITS',hp.u.globalsymtable,''),0));
|
|
inc(count);
|
|
end;
|
|
hp:=tused_unit(hp.next);
|
|
end;
|
|
{ Add program widestring consts, if any }
|
|
if (current_module.flags and uf_wideinits)=uf_wideinits then
|
|
begin
|
|
lwiTables.concat(Tai_const.Createname(make_mangledname('WIDEINITS',current_module.localsymtable,''),0));
|
|
inc(count);
|
|
end;
|
|
{ Insert TableCount at start }
|
|
lwiTables.insert(Tai_const.Create_32bit(count));
|
|
{ insert in data segment }
|
|
maybe_new_object_file(current_asmdata.asmlists[al_globals]);
|
|
new_section(current_asmdata.asmlists[al_globals],sec_data,'FPC_WIDEINITTABLES',sizeof(pint));
|
|
current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('FPC_WIDEINITTABLES',AT_DATA,0));
|
|
current_asmdata.asmlists[al_globals].concatlist(lwiTables);
|
|
current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname('FPC_WIDEINITTABLES'));
|
|
lwiTables.free;
|
|
end;
|
|
|
|
|
|
class procedure tnodeutils.InsertWideInits;
|
|
var
|
|
s: string;
|
|
item: TTCInitItem;
|
|
begin
|
|
item:=TTCInitItem(current_asmdata.WideInits.First);
|
|
if item=nil then
|
|
exit;
|
|
s:=make_mangledname('WIDEINITS',current_module.localsymtable,'');
|
|
maybe_new_object_file(current_asmdata.asmlists[al_globals]);
|
|
new_section(current_asmdata.asmlists[al_globals],sec_data,s,sizeof(pint));
|
|
current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global(s,AT_DATA,0));
|
|
repeat
|
|
{ optimize away unused local/static symbols }
|
|
if (item.sym.refs>0) or (item.sym.owner.symtabletype=globalsymtable) then
|
|
begin
|
|
{ address to initialize }
|
|
current_asmdata.asmlists[al_globals].concat(Tai_const.createname(item.sym.mangledname, item.offset));
|
|
{ value with which to initialize }
|
|
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(item.datalabel));
|
|
end;
|
|
item:=TTCInitItem(item.Next);
|
|
until item=nil;
|
|
{ end-of-list marker }
|
|
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(nil));
|
|
current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname(s));
|
|
current_module.flags:=current_module.flags or uf_wideinits;
|
|
end;
|
|
|
|
|
|
class procedure tnodeutils.InsertResourceTablesTable;
|
|
var
|
|
hp : tmodule;
|
|
ResourceStringTables : tasmlist;
|
|
count : longint;
|
|
begin
|
|
ResourceStringTables:=tasmlist.Create;
|
|
count:=0;
|
|
hp:=tmodule(loaded_units.first);
|
|
while assigned(hp) do
|
|
begin
|
|
If (hp.flags and uf_has_resourcestrings)=uf_has_resourcestrings then
|
|
begin
|
|
ResourceStringTables.concat(Tai_const.Createname(make_mangledname('RESSTR',hp.localsymtable,'START'),0));
|
|
ResourceStringTables.concat(Tai_const.Createname(make_mangledname('RESSTR',hp.localsymtable,'END'),0));
|
|
inc(count);
|
|
end;
|
|
hp:=tmodule(hp.next);
|
|
end;
|
|
{ Insert TableCount at start }
|
|
ResourceStringTables.insert(Tai_const.Create_pint(count));
|
|
{ Add to data segment }
|
|
maybe_new_object_file(current_asmdata.AsmLists[al_globals]);
|
|
new_section(current_asmdata.AsmLists[al_globals],sec_data,'FPC_RESOURCESTRINGTABLES',sizeof(pint));
|
|
current_asmdata.AsmLists[al_globals].concat(Tai_symbol.Createname_global('FPC_RESOURCESTRINGTABLES',AT_DATA,0));
|
|
current_asmdata.AsmLists[al_globals].concatlist(ResourceStringTables);
|
|
current_asmdata.AsmLists[al_globals].concat(Tai_symbol_end.Createname('FPC_RESOURCESTRINGTABLES'));
|
|
ResourceStringTables.free;
|
|
end;
|
|
|
|
|
|
class procedure tnodeutils.InsertResourceInfo(ResourcesUsed: boolean);
|
|
var
|
|
ResourceInfo : TAsmList;
|
|
begin
|
|
if (target_res.id in [res_elf,res_macho]) then
|
|
begin
|
|
ResourceInfo:=TAsmList.Create;
|
|
|
|
maybe_new_object_file(ResourceInfo);
|
|
new_section(ResourceInfo,sec_data,'FPC_RESLOCATION',sizeof(aint));
|
|
ResourceInfo.concat(Tai_symbol.Createname_global('FPC_RESLOCATION',AT_DATA,0));
|
|
if ResourcesUsed then
|
|
{ Valid pointer to resource information }
|
|
ResourceInfo.concat(Tai_const.Createname('FPC_RESSYMBOL',0))
|
|
else
|
|
{ Nil pointer to resource information }
|
|
{$IFDEF CPU32}
|
|
ResourceInfo.Concat(Tai_const.Create_32bit(0));
|
|
{$ELSE}
|
|
ResourceInfo.Concat(Tai_const.Create_64bit(0));
|
|
{$ENDIF}
|
|
maybe_new_object_file(current_asmdata.asmlists[al_globals]);
|
|
current_asmdata.asmlists[al_globals].concatlist(ResourceInfo);
|
|
ResourceInfo.free;
|
|
end;
|
|
end;
|
|
|
|
|
|
class procedure tnodeutils.InsertMemorySizes;
|
|
{$IFDEF POWERPC}
|
|
var
|
|
stkcookie: string;
|
|
{$ENDIF POWERPC}
|
|
begin
|
|
maybe_new_object_file(current_asmdata.asmlists[al_globals]);
|
|
{ Insert Ident of the compiler in the .fpc.version section }
|
|
new_section(current_asmdata.asmlists[al_globals],sec_fpc,'version',const_align(32));
|
|
current_asmdata.asmlists[al_globals].concat(Tai_string.Create('FPC '+full_version_string+
|
|
' ['+date_string+'] for '+target_cpu_string+' - '+target_info.shortname));
|
|
if not(tf_no_generic_stackcheck in target_info.flags) then
|
|
begin
|
|
{ stacksize can be specified and is now simulated }
|
|
new_section(current_asmdata.asmlists[al_globals],sec_data,'__stklen', sizeof(pint));
|
|
current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('__stklen',AT_DATA,sizeof(pint)));
|
|
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_pint(stacksize));
|
|
end;
|
|
{$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(current_asmdata.asmlists[al_globals]);
|
|
new_section(current_asmdata.asmlists[al_globals],sec_data,'__stack_cookie',length(stkcookie));
|
|
current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('__stack_cookie',AT_DATA,length(stkcookie)));
|
|
current_asmdata.asmlists[al_globals].concat(Tai_string.Create(stkcookie));
|
|
end;
|
|
{$ENDIF POWERPC}
|
|
{ Initial heapsize }
|
|
maybe_new_object_file(current_asmdata.asmlists[al_globals]);
|
|
new_section(current_asmdata.asmlists[al_globals],sec_data,'__heapsize',sizeof(pint));
|
|
current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('__heapsize',AT_DATA,sizeof(pint)));
|
|
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_pint(heapsize));
|
|
{ Initial heapsize }
|
|
maybe_new_object_file(current_asmdata.asmlists[al_globals]);
|
|
new_section(current_asmdata.asmlists[al_globals],sec_data,'__fpc_valgrind',sizeof(boolean));
|
|
current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('__fpc_valgrind',AT_DATA,sizeof(boolean)));
|
|
current_asmdata.asmlists[al_globals].concat(Tai_const.create_8bit(byte(cs_gdb_valgrind in current_settings.globalswitches)));
|
|
end;
|
|
|
|
|
|
|
|
|
|
class procedure tnodeutils.add_main_procdef_paras(pd: tdef);
|
|
begin
|
|
{ no parameters by default }
|
|
end;
|
|
|
|
|
|
end.
|