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

* 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

Browse Source 
* 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
compiler/ncgrtti.pas
View File

@ -434,8 +434,15 @@ implementation
4 :
current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otULong));
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
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.max));
if (tf_requires_proper_alignment in target_info.flags) then
@ -960,11 +967,13 @@ implementation
end;
procedure TRTTIWriter.write_rtti_extrasyms(def:Tdef;rt:Trttitype;mainrtti:Tasmsymbol);
type Penumsym = ^Tenumsym;
function enumdef_rtti_calcstringtablestart(const def : Tenumdef) : integer;
begin
{ the alignment calls must correspond to the ones used during generating the
actual data structure created elsewhere in this file }
result:=1;
if assigned(def.typesym) then
inc(result,length(def.typesym.realname)+1)
@ -974,13 +983,16 @@ implementation
result:=align(result,sizeof(Tconstptruint));
inc(result);
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);
if (tf_requires_proper_alignment in target_info.flags) then
result:=align(result,sizeof(Tconstptruint));
inc(result, sizeof(pint));
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);
var rttilab:Tasmsymbol;
@ -1007,7 +1019,8 @@ implementation
if r>sym_count then
mode:=search; {Don't waste more than 50% space.}
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
begin
rttilab:=defineasmsymbol(Tstoreddef(def).rtti_mangledname(rt)+'_o2s',AB_GLOBAL,AT_DATA);
@ -1033,11 +1046,13 @@ implementation
end
else
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));
for i:=0 to sym_count-1 do
begin
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));
if (tf_requires_proper_alignment in target_info.flags) then
current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
@ -1048,6 +1063,9 @@ implementation
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);
var rttilab:Tasmsymbol;

88
rtl/inc/sstrings.inc
View File

@ -409,64 +409,58 @@ end;
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):
Tenum_rtti_header // variable sized; shortstring only contains minimum amount of data, e.g. length + string
(alignment) // if FPC_REQUIRES_PROPER_ALIGNMENT there is an alignment to pointer size
Tenum_rtti_body // more RTTI information
}
{ The following contains the TTypeInfo/TTypeData records from typinfo.pp
specialized for the tkEnumeration case (and stripped of unused things). }
type
PPstring=^Pstring;
Penum_rtti_header=^Tenum_rtti_header;
Tenum_rtti_header=record
kind:byte;
Penum_typeinfo=^Tenum_typeinfo;
Tenum_typeinfo={$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
kind:byte; { always tkEnumeration }
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;
Penum_rtti_body=^Tenum_rtti_body;
Tenum_rtti_body={$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
Penum_typedata=^Tenum_typedata;
Tenum_typedata={$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
ordtype:byte;
minvalue,maxvalue:longint;
basetype:pointer;
{ this seemingly extraneous inner record is here for alignment purposes, so
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 }
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;
Tsearch_data={$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
value:longint;
name:Pstring;
end;
Penum_ord_to_string_header=^Tenum_ord_to_string_header;
Tenum_ord_to_string_header={$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
Penum_ord_to_string=^Tenum_ord_to_string;
Tenum_ord_to_string={$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
o:(lookup,search);
end;
Penum_ord_to_string_lookup=^Tenum_ord_to_string_lookup;
Tenum_ord_to_string_lookup={$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
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);
case integer of
0: (lookup_data:array[0..0] of Pstring);
1: (num_entries:longint;
search_data:array[0..0] of Tsearch_data);
end;
var
p:Pstring;
enum_o2s : Penum_ord_to_string_header;
header:Penum_rtti_header;
body:Penum_rtti_body;
enum_o2s : Penum_ord_to_string;
header:Penum_typeinfo;
body:Penum_typedata;
res:Pshortstring;
sorted_data:Psearch_data;
spaces,i,m,h,l:longint;
@ -475,19 +469,19 @@ begin
{ set default return value }
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 }
if (enum_o2s^.o=lookup) then
begin
{ direct lookup table }
header:=Penum_rtti_header(typinfo);
header:=Penum_typeinfo(typinfo);
{ calculate address of enum rtti body: add the actual size of the
enum_rtti_header, and then align. Use an alignment of 1 (which
does nothing) in case FPC_REQUIRES_PROPER_ALIGNMENT is not set
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}));
with (body^) do
with (body^.inner) do
begin
{ Bounds check for the ordinal value for this enum }
if (ordinal<minvalue) or (ordinal>maxvalue) then
@ -495,7 +489,11 @@ begin
{ make the ordinal index for lookup zero-based }
dec(ordinal,minvalue);
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
exit;
s:=res^;
@ -503,10 +501,13 @@ begin
else
begin
{ 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 }
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
m:=(l+h) div 2;
if ordinal>sorted_data[m].value then
@ -518,6 +519,7 @@ begin
if l>h then
exit; { Ordinal value not found? Exit }
until false;
{$POP}
s:=sorted_data[m].name^;
end;

80
rtl/inc/text.inc
View File

@ -876,29 +876,7 @@ End;
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
p:Pstring;
l,h,m,offset:cardinal;
sorted_array:^Tsorted_array;
s:string;
begin
@ -910,62 +888,10 @@ begin
inoutres:=103;
exit;
end;
if Pcardinal(ord2strindex)^=0 then
begin
{The compiler did generate a lookup table.}
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;
inoutres := fpc_shortstr_enum_intern(ordinal, len, typinfo, ord2strindex, s);
if (inoutres <> 0) then
exit;
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;
{$ifdef FPC_HAS_STR_CURRENCY}