paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-27 00:30:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

* converted emitting method message string tables to the typed constant

Browse Source 
builder

git-svn-id: branches/hlcgllvm@28768 -
This commit is contained in:
Jonas Maebe 2014-10-06 20:53:59 +00:00
parent f8d4d20f5a
commit 67647d4ee0
1 changed files with 85 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

106
compiler/ncgvmt.pas
View File

@ -27,7 +27,7 @@ interface
uses uses
aasmdata,aasmbase,aasmcnst, aasmdata,aasmbase,aasmcnst,
symbase,symdef; symbase,symtype,symdef;
type type
pprocdeftree = ^tprocdeftree; pprocdeftree = ^tprocdeftree;
@ -42,6 +42,7 @@ interface
_Class : tobjectdef; _Class : tobjectdef;
{ message tables } { message tables }
root : pprocdeftree; root : pprocdeftree;
procedure disposeprocdeftree(p : pprocdeftree); procedure disposeprocdeftree(p : pprocdeftree);
procedure insertmsgint(p:TObject;arg:pointer); procedure insertmsgint(p:TObject;arg:pointer);
procedure insertmsgstr(p:TObject;arg:pointer); procedure insertmsgstr(p:TObject;arg:pointer);
@ -50,7 +51,7 @@ interface
function RedirectToEmpty(procdef: tprocdef): boolean; function RedirectToEmpty(procdef: tprocdef): boolean;
procedure writenames(list : TAsmList;p : pprocdeftree); procedure writenames(list : TAsmList;p : pprocdeftree);
procedure writeintentry(list : TAsmList;p : pprocdeftree); procedure writeintentry(list : TAsmList;p : pprocdeftree);
procedure writestrentry(list : TAsmList;p : pprocdeftree); procedure writestrentry(tcb: ttai_typedconstbuilder; p: pprocdeftree; entrydef: tdef);
{$ifdef WITHDMT} {$ifdef WITHDMT}
{ dmt } { dmt }
procedure insertdmtentry(p:TObject;arg:pointer); procedure insertdmtentry(p:TObject;arg:pointer);
@ -67,6 +68,14 @@ interface
procedure intf_create_vtbl(rawdata: TAsmList;AImplIntf:TImplementedInterface); procedure intf_create_vtbl(rawdata: TAsmList;AImplIntf:TImplementedInterface);
procedure intf_gen_intf_ref(rawdata: TAsmList;AImplIntf:TImplementedInterface); procedure intf_gen_intf_ref(rawdata: TAsmList;AImplIntf:TImplementedInterface);
function intf_write_table(list : TAsmList):TAsmLabel; function intf_write_table(list : TAsmList):TAsmLabel;
{ get a table def of the form
record
count: countdef;
elements: array[0..count-1] of elementdef
end;
Returns both the outer record and the inner arraydef
}
procedure gettabledef(const basename: string; countdef, elementdef: tdef; count: longint; packrecords: shortint; out recdef: trecorddef; out arrdef: tarraydef);
{ generates the message tables for a class } { generates the message tables for a class }
function genstrmsgtab(list : TAsmList) : tasmlabel; function genstrmsgtab(list : TAsmList) : tasmlabel;
function genintmsgtab(list : TAsmList) : tasmlabel; function genintmsgtab(list : TAsmList) : tasmlabel;
@ -99,7 +108,7 @@ implementation
cutils,cclasses, cutils,cclasses,
globtype,globals,verbose,constexp, globtype,globals,verbose,constexp,
systems,fmodule, systems,fmodule,
symconst,symtype,symsym,symtable,defutil, symconst,symsym,symtable,defutil,
aasmtai, aasmtai,
wpobase, wpobase,
nobj, nobj,
@ -223,64 +232,87 @@ implementation
var var
ca : pchar; ca : pchar;
len : byte; len : byte;
tcb : ttai_typedconstbuilder;
begin begin
current_asmdata.getdatalabel(p^.nl); current_asmdata.getdatalabel(p^.nl);
if assigned(p^.l) then if assigned(p^.l) then
writenames(list,p^.l); writenames(list,p^.l);
list.concat(cai_align.create(const_align(sizeof(pint)))); tcb:=ctai_typedconstbuilder.create;
list.concat(Tai_label.Create(p^.nl));
len:=length(p^.data.messageinf.str^); len:=length(p^.data.messageinf.str^);
list.concat(tai_const.create_8bit(len)); tcb.maybe_begin_aggregate(getarraydef(cansichartype,len+1));
tcb.emit_tai(tai_const.create_8bit(len),cansichartype);
getmem(ca,len+1); getmem(ca,len+1);
move(p^.data.messageinf.str^[1],ca^,len); move(p^.data.messageinf.str^[1],ca^,len);
ca[len]:=#0; ca[len]:=#0;
list.concat(Tai_string.Create_pchar(ca,len)); tcb.emit_tai(Tai_string.Create_pchar(ca,len),getarraydef(cansichartype,len));
tcb.maybe_end_aggregate(getarraydef(cansichartype,len+1));
list.concatList(tcb.get_final_asmlist(p^.nl,getarraydef(cansichartype,len+1),sec_rodata_norel,'',sizeof(pint),[tcalo_is_lab]));
tcb.free;
if assigned(p^.r) then if assigned(p^.r) then
writenames(list,p^.r); writenames(list,p^.r);
end; end;
procedure TVMTWriter.writestrentry(list : TAsmList;p : pprocdeftree); procedure TVMTWriter.writestrentry(tcb: ttai_typedconstbuilder; p: pprocdeftree; entrydef: tdef);
begin begin
if assigned(p^.l) then if assigned(p^.l) then
writestrentry(list,p^.l); writestrentry(tcb,p^.l,entrydef);
{ write name label } { write name label }
list.concat(cai_align.create(const_align(sizeof(pint)))); tcb.maybe_begin_aggregate(entrydef);
list.concat(Tai_const.Create_sym(p^.nl)); tcb.emit_tai(Tai_const.Create_sym(p^.nl),getpointerdef(getarraydef(cansichartype,length(p^.data.messageinf.str^)+1)));
list.concat(cai_align.create(const_align(sizeof(pint)))); tcb.queue_init(voidcodepointertype);
list.concat(Tai_const.Createname(p^.data.mangledname,AT_FUNCTION,0)); tcb.queue_emit_proc(p^.data);
tcb.maybe_end_aggregate(entrydef);
if assigned(p^.r) then if assigned(p^.r) then
writestrentry(list,p^.r); writestrentry(tcb,p^.r,entrydef);
end; end;
function TVMTWriter.genstrmsgtab(list : TAsmList) : tasmlabel; function TVMTWriter.genstrmsgtab(list : TAsmList) : tasmlabel;
var var
count : longint; count : longint;
tcb: ttai_typedconstbuilder;
msgstrtabdef: trecorddef;
msgstrentry: tdef;
msgarraydef: tarraydef;
begin begin
root:=nil; root:=nil;
count:=0; count:=0;
{ insert all message handlers into a tree, sorted by name } { insert all message handlers into a tree, sorted by name }
_class.symtable.SymList.ForEachCall(@insertmsgstr,@count); _class.symtable.SymList.ForEachCall(@insertmsgstr,@count);
tcb:=ctai_typedconstbuilder.create;
{ write all names } { write all names }
if assigned(root) then if assigned(root) then
writenames(list,root); writenames(list,root);
{ now start writing of the message string table } { now start writing of the message string table }
current_asmdata.getlabel(result,alt_data); current_asmdata.getlabel(result,alt_data);
list.concat(cai_align.create(const_align(sizeof(pint)))); {
list.concat(Tai_label.Create(result)); TStringMessageTable = record
list.concat(cai_align.create(const_align(sizeof(longint)))); count : longint;
list.concat(Tai_const.Create_32bit(count)); msgstrtable : array[0..0] of tmsgstrtable;
list.concat(cai_align.create(const_align(sizeof(pint)))); end;
Instead of 0 as the upper bound, use the actual upper bound
}
msgstrentry:=search_system_type('TMSGSTRTABLE').typedef;
gettabledef('fpc_intern_TStringMessageTable_',s32inttype,msgstrentry,count,0,msgstrtabdef,msgarraydef);
{ outer record (TStringMessageTable) }
tcb.maybe_begin_aggregate(msgstrtabdef);
tcb.emit_tai(Tai_const.Create_32bit(count),s32inttype);
if assigned(root) then if assigned(root) then
begin begin
writestrentry(list,root); { array of TMsgStrTable }
tcb.maybe_begin_aggregate(msgarraydef);
writestrentry(tcb,root,msgstrentry);
tcb.maybe_end_aggregate(msgarraydef);
disposeprocdeftree(root); disposeprocdeftree(root);
end; end;
tcb.maybe_end_aggregate(msgstrtabdef);
list.concatList(tcb.get_final_asmlist(result,msgstrtabdef,sec_rodata,'',sizeof(pint),[tcalo_is_lab]));
tcb.free;
end; end;
@ -666,6 +698,38 @@ implementation
end; end;
procedure TVMTWriter.gettabledef(const basename: string; countdef, elementdef: tdef; count: longint; packrecords: shortint; out recdef: trecorddef; out arrdef: tarraydef);
var
fields: tfplist;
name: TIDString;
srsym: tsym;
srsymtable: tsymtable;
begin
{ already created a message string table with this number of elements
in this unit -> reuse the def }
name:=basename+tostr(count);
if searchsym_type(name,srsym,srsymtable) then
begin
recdef:=trecorddef(ttypesym(srsym).typedef);
arrdef:=tarraydef(trecordsymtable(recdef.symtable).findfieldbyoffset(countdef.size).vardef);
exit
end;
recdef:=crecorddef.create_global_internal('$'+basename+tostr(count),0);
fields:=tfplist.create;
fields.add(countdef);
if count>0 then
begin
arrdef:=carraydef.create(0,count-1,ptruinttype);
arrdef.elementdef:=elementdef;
fields.add(arrdef);
end
else
arrdef:=nil;
recdef.add_fields_from_deflist(fields);
fields.free;
end;
{ Write interface identifiers to the data section } { Write interface identifiers to the data section }
procedure TVMTWriter.writeinterfaceids(list: TAsmList); procedure TVMTWriter.writeinterfaceids(list: TAsmList);
var var