mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-14 00:19:32 +02:00
13b0ac91d9
o these classes get an "enum" flag in the class files
o these classes get a class field (whose type is that same enum
class) per enum in the type, which also gets the "enum" flag
o those class fields are initialised in the class constructor
with the name of the enum and their order in the declaration
o if the enum has jumps in FPC (lowest value is not 0, or not
all values are contiguous), then we add an extra field
to hold the FPC ordinal value of the enum
o these classes get a class field valled $VALUES that contains
a reference to the aforementioned class fields in order of
declaration (= ordinal->instance mapping, JDK-mandated)
o apart from the JDK-mandated instance methods (values, valueOf),
also add FPCOrdinal (returns FPC ordinal value; same as order
of declaration in case of no jumps) instance method and FPCValueOf
(returns enum corresponding to FPC ordinal value) static class
method
o the mapping between FPC ordinals and enum instances in case of
jumps is stored in a hashmap whose size is the next prime number
greater or equal than the number of enum elements
o moved several extra JDK types to the system unit for the enum
support, and for future boxing and Java set support
o several new synthetic method identifiers to generate the enum class
methods/constructor/class constructor
o enums with jumps are ordered by FPC ordinal value in the JVM
$VALUES array so that the java.lang.Enum.doCompare() method
will properly compare them
git-svn-id: branches/jvmbackend@18616 -
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):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):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.
|