diff --git a/compiler/ncgvmt.pas b/compiler/ncgvmt.pas
index 74d3f1dc75..ab93c7fe07 100644
--- a/compiler/ncgvmt.pas
+++ b/compiler/ncgvmt.pas
@@ -69,15 +69,6 @@ interface
procedure intf_create_vtbl(tcb: ttai_typedconstbuilder; AImplIntf: TImplementedInterface; intfindex: longint);
procedure intf_gen_intf_ref(tcb: ttai_typedconstbuilder; AImplIntf: TImplementedInterface; intfindex: longint; interfaceentrydef, interfaceentrytypedef: tdef);
procedure intf_write_table(tcb: ttai_typedconstbuilder; out lab: TAsmLabel; out intftabledef: trecorddef);
- { 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(prefix: tinternaltypeprefix; countdef, elementdef: tdef; count: longint; packrecords: shortint; out recdef: trecorddef; out arrdef: tarraydef);
- function getrecorddef(prefix: tinternaltypeprefix; const fields: array of tdef; packrecords: shortint): trecorddef;
{ generates the message tables for a class }
procedure genstrmsgtab(tcb: ttai_typedconstbuilder; out lab: tasmlabel; out msgstrtabledef: trecorddef);
procedure genintmsgtab(tcb: ttai_typedconstbuilder; out lab: tasmlabel; out msginttabledef: trecorddef);
@@ -302,7 +293,7 @@ implementation
Instead of 0 as the upper bound, use the actual upper bound
}
msgstrentry:=search_system_type('TMSGSTRTABLE').typedef;
- gettabledef(itp_vmt_tstringmesssagetable,s32inttype,msgstrentry,count,0,msgstrtabledef,msgarraydef);
+ get_tabledef(itp_vmt_tstringmesssagetable,s32inttype,msgstrentry,count,0,msgstrtabledef,msgarraydef);
{ outer record (TStringMessageTable) }
datatcb.maybe_begin_aggregate(msgstrtabledef);
datatcb.emit_tai(Tai_const.Create_32bit(count),s32inttype);
@@ -356,7 +347,7 @@ implementation
method : codepointer;
end;
}
- msginttabledef:=getrecorddef(itp_vmt_intern_msgint_table,[u32inttype,voidcodepointertype],0);
+ msginttabledef:=get_recorddef(itp_vmt_intern_msgint_table,[u32inttype,voidcodepointertype],0);
{ from objpas.inc:
TMsgInt = record
count : longint;
@@ -364,7 +355,7 @@ implementation
end;
}
tcb.start_internal_data_builder(current_asmdata.AsmLists[al_const],sec_rodata,_class.vmt_mangledname,datatcb,lab);
- gettabledef(itp_vmt_msgint_table_entries,s32inttype,msginttabledef,count,0,msgintdef,msgintarrdef);
+ get_tabledef(itp_vmt_msgint_table_entries,s32inttype,msginttabledef,count,0,msgintdef,msgintarrdef);
datatcb.maybe_begin_aggregate(msgintdef);
datatcb.emit_tai(Tai_const.Create_32bit(count),s32inttype);
if assigned(root) then
@@ -549,7 +540,7 @@ implementation
addr : codepointer;
end;
}
- lists.methodnamerec:=getrecorddef(itp_vmt_intern_tmethodnamerec,[cpointerdef.getreusable(cshortstringtype),voidcodepointertype],1);
+ lists.methodnamerec:=get_recorddef(itp_vmt_intern_tmethodnamerec,[cpointerdef.getreusable(cshortstringtype),voidcodepointertype],1);
{ from objpas.inc:
tmethodnametable = packed record
count : dword;
@@ -557,7 +548,7 @@ implementation
end;
}
tcb.start_internal_data_builder(current_asmdata.AsmLists[al_const],sec_rodata,_class.vmt_mangledname,lists.pubmethodstcb,lab);
- gettabledef(itp_vmt_intern_tmethodnametable,u32inttype,lists.methodnamerec,count,1,pubmethodsdef,pubmethodsarraydef);
+ get_tabledef(itp_vmt_intern_tmethodnametable,u32inttype,lists.methodnamerec,count,1,pubmethodsdef,pubmethodsarraydef);
{ begin tmethodnametable }
lists.pubmethodstcb.maybe_begin_aggregate(pubmethodsdef);
{ emit count field }
@@ -881,63 +872,6 @@ implementation
end;
- procedure TVMTWriter.gettabledef(prefix: tinternaltypeprefix; 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:=internaltypeprefixName[prefix]+tostr(count);
- if searchsym_type(copy(name,2,length(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(name,packrecords,
- targetinfos[target_info.system]^.alignment.recordalignmin,
- targetinfos[target_info.system]^.alignment.maxCrecordalign);
- fields:=tfplist.create;
- fields.add(countdef);
- if count>0 then
- begin
- arrdef:=carraydef.create(0,count-1,sizeuinttype);
- arrdef.elementdef:=elementdef;
- fields.add(arrdef);
- end
- else
- arrdef:=nil;
- recdef.add_fields_from_deflist(fields);
- fields.free;
- end;
-
-
- function TVMTWriter.getrecorddef(prefix: tinternaltypeprefix; const fields: array of tdef; packrecords: shortint): trecorddef;
- var
- fieldlist: tfplist;
- srsym: tsym;
- srsymtable: tsymtable;
- i: longint;
- begin
- if searchsym_type(copy(internaltypeprefixName[prefix],2,length(internaltypeprefixName[prefix])),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(internaltypeprefixName[prefix],packrecords,
- targetinfos[target_info.system]^.alignment.recordalignmin,
- targetinfos[target_info.system]^.alignment.maxCrecordalign);
- result.add_fields_from_deflist(fieldlist);
- fieldlist.free;
- end;
-
-
{ Write interface identifiers to the data section }
procedure TVMTWriter.writeinterfaceids(list: TAsmList);
var
diff --git a/compiler/symdef.pas b/compiler/symdef.pas
index 4a260c46b9..0c2019f101 100644
--- a/compiler/symdef.pas
+++ b/compiler/symdef.pas
@@ -1206,6 +1206,15 @@ interface
function getparaencoding(def:tdef):tstringencoding; inline;
function get_threadvar_record(def: tdef; out index_field, non_mt_data_field: tsym): trecorddef;
+ function get_recorddef(prefix:tinternaltypeprefix;const fields:array of tdef; packrecords:shortint): trecorddef;
+ { 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 get_tabledef(prefix:tinternaltypeprefix;countdef,elementdef:tdef;count:longint;packrecords:shortint;out recdef:trecorddef;out arrdef:tarraydef);
implementation
@@ -1320,6 +1329,62 @@ implementation
end;
+ function get_recorddef(prefix:tinternaltypeprefix; const fields:array of tdef; packrecords:shortint): trecorddef;
+ var
+ fieldlist: tfplist;
+ srsym: tsym;
+ srsymtable: tsymtable;
+ i: longint;
+ begin
+ if searchsym_type(copy(internaltypeprefixName[prefix],2,length(internaltypeprefixName[prefix])),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(internaltypeprefixName[prefix],packrecords,
+ targetinfos[target_info.system]^.alignment.recordalignmin,
+ targetinfos[target_info.system]^.alignment.maxCrecordalign);
+ result.add_fields_from_deflist(fieldlist);
+ fieldlist.free;
+ end;
+
+
+ procedure get_tabledef(prefix:tinternaltypeprefix;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:=internaltypeprefixName[prefix]+tostr(count);
+ if searchsym_type(copy(name,2,length(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(name,packrecords,
+ targetinfos[target_info.system]^.alignment.recordalignmin,
+ targetinfos[target_info.system]^.alignment.maxCrecordalign);
+ fields:=tfplist.create;
+ fields.add(countdef);
+ if count>0 then
+ begin
+ arrdef:=carraydef.create(0,count-1,sizeuinttype);
+ arrdef.elementdef:=elementdef;
+ fields.add(arrdef);
+ end
+ else
+ arrdef:=nil;
+ recdef.add_fields_from_deflist(fields);
+ fields.free;
+ end;
+
function make_mangledname(const typeprefix:TSymStr;st:TSymtable;const suffix:TSymStr):TSymStr;
var
s,