* changes to alignment for enumeration rtti record members: we need a Tconstptrint alignment before the MinValue/MaxValue members because the entire record needs that alignment due to some pointers inside

* changes to alignment for ordinal enumeration value to string accelerator tables so that we can define a single Pascal record to describe them for cleaner code
* some warnings in enumeration rtti generation indicating that if you change the code, you also have to change that in the RTL
* call fpc_shortstr_enum_intern in fpc_write_text_enum instead of copy&paste
* clean up code in fpc_shortstr_enum_intern:
  * unify data structures for lookup/search accelerator tables made possible by alignment changes in ncgrtti.pas
  * make clear that this is a partial copy&paste of the typinfo unit, also fix some alignment issues by introducing a fake inner record of Tenum_typedata
  * temporarily disable range checking for accesses to array[0..0] members of internal data structures
  * some documentation

git-svn-id: trunk@16229 -
This commit is contained in:
tom_at_work 2010-10-26 22:00:15 +00:00
parent c1df466f6d
commit 19baf7d3e0
3 changed files with 71 additions and 125 deletions

View File

@ -434,8 +434,15 @@ implementation
4 : 4 :
current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otULong)); current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otULong));
end; end;
{ we need to align by Tconstptruint here to satisfy the alignment rules set by
records: in the typinfo unit we overlay a TTypeData record on this data, which at
the innermost variant record needs an alignment of TConstPtrUint due to e.g.
the "CompType" member for tkSet (also the "BaseType" member for tkEnumeration).
We need to adhere to this, otherwise things will break.
Note that other code (e.g. enumdef_rtti_calcstringtablestart()) relies on the
exact sequence too. }
if (tf_requires_proper_alignment in target_info.flags) then if (tf_requires_proper_alignment in target_info.flags) then
current_asmdata.asmlists[al_rtti].concat(Cai_align.Create(longint(def.size))); current_asmdata.asmlists[al_rtti].concat(Cai_align.Create(sizeof(TConstPtrUint)));
current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.min)); current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.min));
current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.max)); current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.max));
if (tf_requires_proper_alignment in target_info.flags) then if (tf_requires_proper_alignment in target_info.flags) then
@ -960,11 +967,13 @@ implementation
end; end;
procedure TRTTIWriter.write_rtti_extrasyms(def:Tdef;rt:Trttitype;mainrtti:Tasmsymbol); procedure TRTTIWriter.write_rtti_extrasyms(def:Tdef;rt:Trttitype;mainrtti:Tasmsymbol);
type Penumsym = ^Tenumsym; type Penumsym = ^Tenumsym;
function enumdef_rtti_calcstringtablestart(const def : Tenumdef) : integer; function enumdef_rtti_calcstringtablestart(const def : Tenumdef) : integer;
begin begin
{ the alignment calls must correspond to the ones used during generating the
actual data structure created elsewhere in this file }
result:=1; result:=1;
if assigned(def.typesym) then if assigned(def.typesym) then
inc(result,length(def.typesym.realname)+1) inc(result,length(def.typesym.realname)+1)
@ -974,13 +983,16 @@ implementation
result:=align(result,sizeof(Tconstptruint)); result:=align(result,sizeof(Tconstptruint));
inc(result); inc(result);
if (tf_requires_proper_alignment in target_info.flags) then if (tf_requires_proper_alignment in target_info.flags) then
result:=align(result,longint(def.size)); result:=align(result,sizeof(Tconstptruint));
inc(result, sizeof(longint) * 2); inc(result, sizeof(longint) * 2);
if (tf_requires_proper_alignment in target_info.flags) then if (tf_requires_proper_alignment in target_info.flags) then
result:=align(result,sizeof(Tconstptruint)); result:=align(result,sizeof(Tconstptruint));
inc(result, sizeof(pint)); inc(result, sizeof(pint));
end; end;
{ Writes a helper table for accelerated conversion of ordinal enum values to strings.
If you change something in this method, make sure to adapt the corresponding code
in sstrings.inc. }
procedure enumdef_rtti_ord2stringindex(const sym_count:longint; const offsets:plongint; const syms:Penumsym; const st:longint); procedure enumdef_rtti_ord2stringindex(const sym_count:longint; const offsets:plongint; const syms:Penumsym; const st:longint);
var rttilab:Tasmsymbol; var rttilab:Tasmsymbol;
@ -1007,7 +1019,8 @@ implementation
if r>sym_count then if r>sym_count then
mode:=search; {Don't waste more than 50% space.} mode:=search; {Don't waste more than 50% space.}
end; end;
{ write rtti data } { write rtti data; make sure that the alignment matches the corresponding data structure
in the code that uses it (if alignment is required). }
with current_asmdata do with current_asmdata do
begin begin
rttilab:=defineasmsymbol(Tstoreddef(def).rtti_mangledname(rt)+'_o2s',AB_GLOBAL,AT_DATA); rttilab:=defineasmsymbol(Tstoreddef(def).rtti_mangledname(rt)+'_o2s',AB_GLOBAL,AT_DATA);
@ -1033,11 +1046,13 @@ implementation
end end
else else
begin begin
if (tf_requires_proper_alignment in target_info.flags) then
current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
asmlists[al_rtti].concat(Tai_const.create_32bit(sym_count)); asmlists[al_rtti].concat(Tai_const.create_32bit(sym_count));
for i:=0 to sym_count-1 do for i:=0 to sym_count-1 do
begin begin
if (tf_requires_proper_alignment in target_info.flags) then if (tf_requires_proper_alignment in target_info.flags) then
current_asmdata.asmlists[al_rtti].concat(cai_align.Create(4)); current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
asmlists[al_rtti].concat(Tai_const.create_32bit(syms[i].value)); asmlists[al_rtti].concat(Tai_const.create_32bit(syms[i].value));
if (tf_requires_proper_alignment in target_info.flags) then if (tf_requires_proper_alignment in target_info.flags) then
current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt))); current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
@ -1048,6 +1063,9 @@ implementation
end; end;
end; end;
{ Writes a helper table for accelerated conversion of string to ordinal enum values.
If you change something in this method, make sure to adapt the corresponding code
in sstrings.inc. }
procedure enumdef_rtti_string2ordindex(const sym_count:longint; const offsets:plongint; const syms:Penumsym; const st:longint); procedure enumdef_rtti_string2ordindex(const sym_count:longint; const offsets:plongint; const syms:Penumsym; const st:longint);
var rttilab:Tasmsymbol; var rttilab:Tasmsymbol;

View File

@ -409,64 +409,58 @@ end;
function fpc_shortstr_enum_intern(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:shortstring): longint; function fpc_shortstr_enum_intern(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:shortstring): longint;
{ Enumeration RTTI has the following format (given by typinfo parameter): { The following contains the TTypeInfo/TTypeData records from typinfo.pp
Tenum_rtti_header // variable sized; shortstring only contains minimum amount of data, e.g. length + string specialized for the tkEnumeration case (and stripped of unused things). }
(alignment) // if FPC_REQUIRES_PROPER_ALIGNMENT there is an alignment to pointer size
Tenum_rtti_body // more RTTI information
}
type type
PPstring=^Pstring; PPstring=^Pstring;
Penum_rtti_header=^Tenum_rtti_header; Penum_typeinfo=^Tenum_typeinfo;
Tenum_rtti_header=record Tenum_typeinfo={$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
kind:byte; kind:byte; { always tkEnumeration }
num_chars:byte; num_chars:byte;
chars:array[0..0] of char; // variable length with size of num_chars; chars:array[0..0] of char; { variable length with size of num_chars }
end; end;
Penum_rtti_body=^Tenum_rtti_body; Penum_typedata=^Tenum_typedata;
Tenum_rtti_body={$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record Tenum_typedata={$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
ordtype:byte; ordtype:byte;
minvalue,maxvalue:longint; { this seemingly extraneous inner record is here for alignment purposes, so
basetype:pointer; that its data gets aligned properly (if FPC_REQUIRES_PROPER_ALIGNMENT is
set }
inner: {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
minvalue,maxvalue:longint;
basetype:pointer; { required for alignment }
end;
{ more data here, but not needed } { more data here, but not needed }
end; end;
{ Pascal data types for the ordinal enum value to string table. It consists of a header
that indicates what type of data the table stores, either a direct lookup table (when
o = lookup) or a set of ordered (ordinal value, string) tuples (when o = search). }
{ A single entry in the set of ordered tuples }
Psearch_data=^Tsearch_data; Psearch_data=^Tsearch_data;
Tsearch_data={$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record Tsearch_data={$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
value:longint; value:longint;
name:Pstring; name:Pstring;
end; end;
Penum_ord_to_string_header=^Tenum_ord_to_string_header; Penum_ord_to_string=^Tenum_ord_to_string;
Tenum_ord_to_string_header={$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record Tenum_ord_to_string={$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
o:(lookup,search); o:(lookup,search);
end; case integer of
0: (lookup_data:array[0..0] of Pstring);
Penum_ord_to_string_lookup=^Tenum_ord_to_string_lookup; 1: (num_entries:longint;
Tenum_ord_to_string_lookup={$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record search_data:array[0..0] of Tsearch_data);
header:Tenum_ord_to_string_header;
lookup_data:array[0..0] of Pstring;
end;
Penum_ord_to_string_search=^Tenum_ord_to_string_search;
Tenum_ord_to_string_search={$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
header:Tenum_ord_to_string_header;
num_entries:longint; // only if o == 0
search_data:array[0..0] of Tsearch_data;
end;
function align_up(value:ptruint; alignment:sizeint) : ptruint;
begin
align_up:=(value + (alignment - 1)) and not (alignment - 1);
end; end;
var var
p:Pstring; p:Pstring;
enum_o2s : Penum_ord_to_string_header; enum_o2s : Penum_ord_to_string;
header:Penum_rtti_header; header:Penum_typeinfo;
body:Penum_rtti_body; body:Penum_typedata;
res:Pshortstring; res:Pshortstring;
sorted_data:Psearch_data; sorted_data:Psearch_data;
spaces,i,m,h,l:longint; spaces,i,m,h,l:longint;
@ -475,19 +469,19 @@ begin
{ set default return value } { set default return value }
fpc_shortstr_enum_intern:=107; fpc_shortstr_enum_intern:=107;
enum_o2s:=Penum_ord_to_string_header(ord2strindex); enum_o2s:=Penum_ord_to_string(ord2strindex);
{ depending on the type of table in ord2strindex retrieve the data } { depending on the type of table in ord2strindex retrieve the data }
if (enum_o2s^.o=lookup) then if (enum_o2s^.o=lookup) then
begin begin
{ direct lookup table } { direct lookup table }
header:=Penum_rtti_header(typinfo); header:=Penum_typeinfo(typinfo);
{ calculate address of enum rtti body: add the actual size of the { calculate address of enum rtti body: add the actual size of the
enum_rtti_header, and then align. Use an alignment of 1 (which enum_rtti_header, and then align. Use an alignment of 1 (which
does nothing) in case FPC_REQUIRES_PROPER_ALIGNMENT is not set does nothing) in case FPC_REQUIRES_PROPER_ALIGNMENT is not set
to avoid the need for an if in this situation } to avoid the need for an if in this situation }
body:=Penum_rtti_body(align_up(ptruint(header) + 2 * sizeof(byte) { kind, num_chars } + header^.num_chars, body:=Penum_typedata(align(ptruint(header) + 2 * sizeof(byte) { kind, num_chars } + header^.num_chars,
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT} 1 {$else} sizeof(pointer) {$endif})); {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT} 1 {$else} sizeof(pointer) {$endif}));
with (body^) do with (body^.inner) do
begin begin
{ Bounds check for the ordinal value for this enum } { Bounds check for the ordinal value for this enum }
if (ordinal<minvalue) or (ordinal>maxvalue) then if (ordinal<minvalue) or (ordinal>maxvalue) then
@ -495,7 +489,11 @@ begin
{ make the ordinal index for lookup zero-based } { make the ordinal index for lookup zero-based }
dec(ordinal,minvalue); dec(ordinal,minvalue);
end; end;
res:=Penum_ord_to_string_lookup(enum_o2s)^.lookup_data[ordinal]; { temporarily disable range checking because of the access to the array[0..0]
member of Tenum_ord_to_string_lookup }
{$PUSH}{$R-}
res:=enum_o2s^.lookup_data[ordinal];
{$POP}
if (not assigned(res)) then if (not assigned(res)) then
exit; exit;
s:=res^; s:=res^;
@ -503,10 +501,13 @@ begin
else else
begin begin
{ The compiler did generate a sorted array of (ordvalue,Pstring) tuples } { The compiler did generate a sorted array of (ordvalue,Pstring) tuples }
sorted_data:=Penum_ord_to_string_search(enum_o2s)^.search_data; sorted_data:=@enum_o2s^.search_data;
{ Use a binary search to get the string } { Use a binary search to get the string }
l:=0; l:=0;
h:=Penum_ord_to_string_search(enum_o2s)^.num_entries-1; { temporarily disable range checking because of the access to the array[0..0]
member of Tenum_ord_to_string_search }
{$PUSH}{$R-}
h:=enum_o2s^.num_entries-1;
repeat repeat
m:=(l+h) div 2; m:=(l+h) div 2;
if ordinal>sorted_data[m].value then if ordinal>sorted_data[m].value then
@ -518,6 +519,7 @@ begin
if l>h then if l>h then
exit; { Ordinal value not found? Exit } exit; { Ordinal value not found? Exit }
until false; until false;
{$POP}
s:=sorted_data[m].name^; s:=sorted_data[m].name^;
end; end;

View File

@ -876,29 +876,7 @@ End;
procedure fpc_write_text_enum(typinfo,ord2strindex:pointer;len:sizeint;var t:text;ordinal:longint); iocheck; compilerproc; procedure fpc_write_text_enum(typinfo,ord2strindex:pointer;len:sizeint;var t:text;ordinal:longint); iocheck; compilerproc;
type Ptypeinfo=^Ttypeinfo;
Ttypeinfo=packed record
kind:byte;
name:shortstring;
end;
Penuminfo=^Tenuminfo;
Tenuminfo={$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
ordtype:byte;
minvalue, maxvalue:longint;
basetype:pointer;
namelist:shortstring;
end;
Tsorted_array={$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
o:longint;
s:Pstring;
end;
var var
p:Pstring;
l,h,m,offset:cardinal;
sorted_array:^Tsorted_array;
s:string; s:string;
begin begin
@ -910,62 +888,10 @@ begin
inoutres:=103; inoutres:=103;
exit; exit;
end; end;
if Pcardinal(ord2strindex)^=0 then inoutres := fpc_shortstr_enum_intern(ordinal, len, typinfo, ord2strindex, s);
begin if (inoutres <> 0) then
{The compiler did generate a lookup table.} exit;
offset:=2+length(Ptypeinfo(typinfo)^.name);
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
offset:=align(offset, sizeof(ptrint));
{$endif}
with Penuminfo(Pbyte(typinfo)+offset)^ do
begin
if (ordinal<minvalue) or (ordinal>maxvalue) then
begin
inoutres:=107; {Invalid ordinal value for this enum.}
exit;
end;
dec(ordinal,minvalue);
end;
{Get the address of the string.}
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
p:=Pshortstring((PPpointer(ord2strindex+align(sizeof(longint), sizeof(ptrint)))+ordinal)^);
{$else}
p:=Pshortstring((PPpointer(ord2strindex+sizeof(longint))+ordinal)^);
{$endif}
if p=nil then
begin
inoutres:=107; {Invalid ordinal value for this enum.}
exit;
end;
s:=p^;
end
else
begin
{The compiler did generate a sorted array of (ordvalue,Pstring) tuples.}
sorted_array:=pointer(Pcardinal(ord2strindex)+2);
{Use a binary search to get the string.}
l:=0;
h:=(Pcardinal(ord2strindex)+1)^-1;
repeat
m:=(l+h) div 2;
if ordinal>sorted_array[m].o then
l:=m+1
else if ordinal<sorted_array[m].o then
h:=m-1
else
break;
if l>h then
begin
inoutres:=107; {Invalid ordinal value for this enum.}
exit;
end;
until false;
s:=sorted_array[m].s^;
end;
fpc_writeBuffer(t,s[1],length(s)); fpc_writeBuffer(t,s[1],length(s));
{Pad the string with spaces if necessary.}
if len>length(s) then
fpc_writeblanks(t,len-length(s));
end; end;
{$ifdef FPC_HAS_STR_CURRENCY} {$ifdef FPC_HAS_STR_CURRENCY}