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

* converted generting method message integer dispatch tables to the typed

Browse Source 
constant builder

git-svn-id: branches/hlcgllvm@28769 -
This commit is contained in:
Jonas Maebe 2014-10-06 20:54:02 +00:00
parent 67647d4ee0
commit 5ecb2faf93
1 changed files with 60 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
compiler/ncgvmt.pas
View File

@ -50,7 +50,7 @@ interface
procedure insertstr(p : pprocdeftree;var at : pprocdeftree;var count:longint); procedure insertstr(p : pprocdeftree;var at : pprocdeftree;var count:longint);
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(tcb: ttai_typedconstbuilder; p: pprocdeftree; entrydef: tdef);
procedure writestrentry(tcb: ttai_typedconstbuilder; p: pprocdeftree; entrydef: tdef); procedure writestrentry(tcb: ttai_typedconstbuilder; p: pprocdeftree; entrydef: tdef);
{$ifdef WITHDMT} {$ifdef WITHDMT}
{ dmt } { dmt }
@ -76,6 +76,7 @@ interface
Returns both the outer record and the inner arraydef 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); procedure gettabledef(const basename: string; countdef, elementdef: tdef; count: longint; packrecords: shortint; out recdef: trecorddef; out arrdef: tarraydef);
function getrecorddef(const name: string; const fields: array of tdef; packrecords: shortint): trecorddef;
{ 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;
@ -316,19 +317,20 @@ implementation
end; end;
procedure TVMTWriter.writeintentry(list : TAsmList;p : pprocdeftree); procedure TVMTWriter.writeintentry(tcb: ttai_typedconstbuilder; p: pprocdeftree; entrydef: tdef);
begin begin
if assigned(p^.l) then if assigned(p^.l) then
writeintentry(list,p^.l); writeintentry(tcb,p^.l,entrydef);
{ write name label } tcb.maybe_begin_aggregate(entrydef);
list.concat(cai_align.create(const_align(sizeof(longint)))); { write integer dispatch number }
list.concat(Tai_const.Create_32bit(p^.data.messageinf.i)); tcb.emit_tai(Tai_const.Create_32bit(p^.data.messageinf.i),u32inttype);
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
writeintentry(list,p^.r); writeintentry(tcb,p^.r,entrydef);
end; end;
@ -336,6 +338,10 @@ implementation
var var
r : tasmlabel; r : tasmlabel;
count : longint; count : longint;
tcb: ttai_typedconstbuilder;
msgintdef: trecorddef;
msginttabledef: trecorddef;
msgintarrdef: tarraydef;
begin begin
root:=nil; root:=nil;
count:=0; count:=0;
@ -343,18 +349,36 @@ implementation
_class.symtable.SymList.ForEachCall(@insertmsgint,@count); _class.symtable.SymList.ForEachCall(@insertmsgint,@count);
{ now start writing of the message string table } { now start writing of the message string table }
{ from objpas.inc:
TMsgIntTable = record
index : dword;
method : codepointer;
end;
}
msginttabledef:=getrecorddef('fpc_intern_msgint_table',[u32inttype,voidcodepointertype],0);
{ from objpas.inc:
TMsgInt = record
count : longint;
msgs : array[0..0] of TMsgIntTable;
end;
}
current_asmdata.getlabel(r,alt_data); current_asmdata.getlabel(r,alt_data);
list.concat(cai_align.create(const_align(sizeof(pint)))); tcb:=ctai_typedconstbuilder.create;
list.concat(Tai_label.Create(r));
genintmsgtab:=r; genintmsgtab:=r;
list.concat(cai_align.create(const_align(sizeof(longint)))); gettabledef('fpc_msgint_table_entries_',s32inttype,msginttabledef,count,0,msgintdef,msgintarrdef);
list.concat(Tai_const.Create_32bit(count)); tcb.maybe_begin_aggregate(msgintdef);
list.concat(cai_align.create(const_align(sizeof(pint)))); tcb.emit_tai(Tai_const.Create_32bit(count),s32inttype);
if assigned(root) then if assigned(root) then
begin begin
writeintentry(list,root); tcb.maybe_begin_aggregate(msgintarrdef);
writeintentry(tcb,root,msginttabledef);
tcb.maybe_end_aggregate(msgintarrdef);
disposeprocdeftree(root); disposeprocdeftree(root);
end; end;
tcb.maybe_end_aggregate(msgintdef);
list.concatList(tcb.get_final_asmlist(result,msgintdef,sec_rodata,'',sizeof(pint),[tcalo_is_lab]));
tcb.free;
end; end;
{$ifdef WITHDMT} {$ifdef WITHDMT}
@ -730,6 +754,27 @@ implementation
end; end;
function TVMTWriter.getrecorddef(const name: string; const fields: array of tdef; packrecords: shortint): trecorddef;
var
fieldlist: tfplist;
srsym: tsym;
srsymtable: tsymtable;
i: longint;
begin
if searchsym_type(name,srsym,srsymtable) then
begin
result:=trecorddef(ttypesym(srsym).typedef);
exit
end;
fieldlist:=tfplist.create;
for i:=low(fields) to high(fields) do
fieldlist.add(fields[i]);
result:=crecorddef.create_global_internal('$'+name,packrecords);
result.add_fields_from_deflist(fieldlist);
fieldlist.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