Sfoglia il codice sorgente

* 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 -

tom_at_work 14 anni fa
parent
commit
19baf7d3e0
3 ha cambiato i file con 71 aggiunte e 125 eliminazioni
  1. 23 5
      compiler/ncgrtti.pas
  2. 45 43
      rtl/inc/sstrings.inc
  3. 3 77
      rtl/inc/text.inc

+ 23 - 5
compiler/ncgrtti.pas

@@ -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;

+ 45 - 43
rtl/inc/sstrings.inc

@@ -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;
 

+ 3 - 77
rtl/inc/text.inc

@@ -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}