Explorar o código

* fixed sets in rtti for big endian systems
* changed set sizes in rtti to 1 byte for Delphi compatibility
* fixed tests/webtbs/tw12038 for the new set sizes
* documented at http://wiki.freepascal.org/User_Changes_Trunk#Sets_in_RTTI_.28run-time_type_information.29

git-svn-id: trunk@12894 -

Jonas Maebe %!s(int64=16) %!d(string=hai) anos
pai
achega
f2ce99029b
Modificáronse 4 ficheiros con 32 adicións e 20 borrados
  1. 19 12
      compiler/ncgrtti.pas
  2. 8 3
      compiler/options.pas
  3. 4 0
      rtl/objpas/typinfo.pp
  4. 1 5
      tests/webtbs/tw12038.pp

+ 19 - 12
compiler/ncgrtti.pas

@@ -630,6 +630,11 @@ implementation
                  }
                  }
                  if is_open_array(parasym.vardef) then
                  if is_open_array(parasym.vardef) then
                    paraspec:=paraspec or pfArray or pfReference;
                    paraspec:=paraspec or pfArray or pfReference;
+                 { set bits run from the highest to the lowest bit on
+                   big endian systems
+                 }
+                 if (target_info.endian = endian_big) then
+                   paraspec:=reverse_byte(paraspec);
                  { write flags for current parameter }
                  { write flags for current parameter }
                  current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(paraspec));
                  current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(paraspec));
                  { write name of current parameter }
                  { write name of current parameter }
@@ -742,6 +747,10 @@ implementation
           var
           var
             i : longint;
             i : longint;
             propnamelist : TFPHashObjectList;
             propnamelist : TFPHashObjectList;
+            { if changed to a set, make sure it's still a byte large, and
+              swap appropriately when cross-compiling
+            }
+            IntfFlags: byte;
           begin
           begin
             { Collect unique property names with nameindex }
             { Collect unique property names with nameindex }
             propnamelist:=TFPHashObjectList.Create;
             propnamelist:=TFPHashObjectList.Create;
@@ -754,20 +763,18 @@ implementation
               current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil));
               current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil));
 
 
             { interface: write flags, iid and iidstr }
             { interface: write flags, iid and iidstr }
-            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(
-              { ugly, but working }
-{$ifdef USE_PACKSET1}
-              byte([
-{$else USE_PACKSET1}
-              longint([
-{$endif USE_PACKSET1}
-                TCompilerIntfFlag(ord(ifHasGuid)*ord(assigned(def.iidguid))),
-                TCompilerIntfFlag(ord(ifHasStrGUID)*ord(assigned(def.iidstr))),
-                TCompilerIntfFlag(ord(ifDispInterface)*ord(def.objecttype=odt_dispinterface))
-              ])
+            IntfFlags:=0;
+            if assigned(def.iidguid) then
+              IntfFlags:=IntfFlags or (1 shl ord(ifHasGuid));
+            if assigned(def.iidstr) then
+              IntfFlags:=IntfFlags or (1 shl ord(ifHasStrGUID));
+            if (def.objecttype=odt_dispinterface) then
+              IntfFlags:=IntfFlags or (1 shl ord(ifDispInterface));
+            if (target_info.endian=endian_big) then
+              IntfFlags:=reverse_byte(IntfFlags);
               {
               {
               ifDispatch, }
               ifDispatch, }
-              ));
+            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(IntfFlags));
             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)));
             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(longint(def.iidguid^.D1)));
             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(longint(def.iidguid^.D1)));

+ 8 - 3
compiler/options.pas

@@ -2209,10 +2209,14 @@ begin
       set_target_asm(target_info.assemextern);
       set_target_asm(target_info.assemextern);
     end;
     end;
 
 
-  { smart linking does not yet work with DWARF debug info }
+  { smart linking does not yet work with DWARF debug info on most targets }
   if (paratargetdbg in [dbg_dwarf2,dbg_dwarf3]) and
   if (paratargetdbg in [dbg_dwarf2,dbg_dwarf3]) and
-     (cs_link_smart in init_settings.globalswitches) then
-    ForceStaticLinking;
+     (cs_link_smart in init_settings.globalswitches) and
+     not(target_info.system in systems_darwin) then
+    begin
+      Message(option_dwarf_smart_linking);
+      ForceStaticLinking;
+    end;
 end;
 end;
 
 
 
 
@@ -2372,6 +2376,7 @@ begin
   def_system_macro('FPC_HAS_INTERNAL_ABS_LONG');
   def_system_macro('FPC_HAS_INTERNAL_ABS_LONG');
 {$endif}
 {$endif}
   def_system_macro('FPC_HAS_UNICODESTRING');
   def_system_macro('FPC_HAS_UNICODESTRING');
+  def_system_macro('FPC_RTTI_PACKSET1');
 
 
 { these cpus have an inline rol/ror implementaion }
 { these cpus have an inline rol/ror implementaion }
 {$if defined(x86) or defined(arm) or defined(powerpc) or defined(powerpc64)}
 {$if defined(x86) or defined(arm) or defined(powerpc) or defined(powerpc64)}

+ 4 - 0
rtl/objpas/typinfo.pp

@@ -32,6 +32,10 @@ unit typinfo;
     type
     type
 
 
 {$MINENUMSIZE 1   this saves a lot of memory }
 {$MINENUMSIZE 1   this saves a lot of memory }
+{$ifdef FPC_RTTI_PACKSET1}
+{ for Delphi compatibility }
+{$packset 1}
+{$endif}
        // if you change one of the following enumeration types
        // if you change one of the following enumeration types
        // you have also to change the compiler in an appropriate way !
        // you have also to change the compiler in an appropriate way !
        TTypeKind = (tkUnknown,tkInteger,tkChar,tkEnumeration,tkFloat,
        TTypeKind = (tkUnknown,tkInteger,tkChar,tkEnumeration,tkFloat,

+ 1 - 5
tests/webtbs/tw12038.pp

@@ -167,11 +167,7 @@ var
    ProcessThisProperty : boolean;
    ProcessThisProperty : boolean;
    Fu_ResultType: String;
    Fu_ResultType: String;
    Flags: TParamFlags;
    Flags: TParamFlags;
-{$ifdef fpc}
-   Flag:integer;
-{$else}
    Flag:byte;
    Flag:byte;
-{$endif}
    Definition: String;
    Definition: String;
 begin
 begin
   // Finding property type 
   // Finding property type 
@@ -236,7 +232,7 @@ begin
           for i:= 1 to DTypeData^.ParamCount do
           for i:= 1 to DTypeData^.ParamCount do
           begin
           begin
            { First Handle the ParamFlag }
            { First Handle the ParamFlag }
-           Flag:=integer(DTypeData^.ParamList[CurrentParamPosition]);
+           Flag:=byte(DTypeData^.ParamList[CurrentParamPosition]);
 					 Flags:=TParamFlags(Flag);
 					 Flags:=TParamFlags(Flag);
 					 writeln('ord(Flags):',ord(DTypeData^.ParamList[CurrentParamPosition]));
 					 writeln('ord(Flags):',ord(DTypeData^.ParamList[CurrentParamPosition]));
 //				 For i:= 1 to NumI do
 //				 For i:= 1 to NumI do