浏览代码

Allow system unit to be compiled without RTTI feature

git-svn-id: trunk@45351 -
pierre 5 年之前
父节点
当前提交
3aa253c11d
共有 5 个文件被更改,包括 22 次插入6 次删除
  1. 12 0
      rtl/inc/objpas.inc
  2. 2 0
      rtl/inc/rttih.inc
  3. 8 2
      rtl/inc/sstrings.inc
  4. 0 2
      rtl/inc/systemh.inc
  5. 0 2
      rtl/java/jsystemh.inc

+ 12 - 0
rtl/inc/objpas.inc

@@ -383,7 +383,9 @@
         var
            vmt  : PVmt;
            inittable : pointer;
+{$ifdef FPC_HAS_FEATURE_RTTI}
            mopinittable : PRTTIRecordOpOffsetTable;
+{$endif def FPC_HAS_FEATURE_RTTI}
            i : longint;
 {$endif VER3_0}
         begin
@@ -396,6 +398,7 @@
              InitInterfacePointers(self,instance);
 
 {$ifndef VER3_0}
+{$ifdef FPC_HAS_FEATURE_RTTI}
            { for management operators like initialize call int_initialize }
            vmt := PVmt(self);
            if assigned(vmt) then
@@ -415,6 +418,7 @@
                      end;
                  end;
              end;
+{$endif def FPC_HAS_FEATURE_RTTI}
 {$endif VER3_0}
 
            InitInstance:=TObject(Instance);
@@ -749,10 +753,12 @@
            while vmt<>nil do
              begin
                Temp:= vmt^.vInitTable;
+{$ifdef FPC_HAS_FEATURE_RTTI}
                { The RTTI format matches one for records, except the type is tkClass.
                  Since RecordRTTI does not check the type, calling it yields the desired result. }
                if Assigned(Temp) then
                  RecordRTTI(Self,Temp,@int_finalize);
+{$endif def FPC_HAS_FEATURE_RTTI}
                vmt:= vmt^.vParent;
              end;
         end;
@@ -977,6 +983,7 @@
         end;
 
       class function TObject.UnitName : {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}ansistring{$else FPC_HAS_FEATURE_ANSISTRINGS}shortstring{$endif FPC_HAS_FEATURE_ANSISTRINGS};
+{$ifdef FPC_HAS_FEATURE_RTTI}
         type
           TClassTypeInfo = {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
             Attributes: Pointer;
@@ -1009,6 +1016,11 @@
           else
             result:='';
         end;
+{$else not FPC_HAS_FEATURE_RTTI}
+        begin
+          result:='';
+        end;
+{$endif ndef FPC_HAS_FEATURE_RTTI}
 
       class function TObject.QualifiedClassName: {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}ansistring{$else FPC_HAS_FEATURE_ANSISTRINGS}shortstring{$endif FPC_HAS_FEATURE_ANSISTRINGS};
         var

+ 2 - 0
rtl/inc/rttih.inc

@@ -37,8 +37,10 @@ const
   tkWideString = tkWString;
   tkUnicodeString = tkUString;
 
+{$ifdef FPC_HAS_FEATURE_RTTI}
 procedure InitializeArray(p, typeInfo: Pointer; count: SizeInt);
 procedure FinalizeArray(p, typeInfo: Pointer; count: SizeInt);
 procedure CopyArray(dest, source, typeInfo: Pointer; count: SizeInt);
+{$endif FPC_HAS_FEATURE_RTTI}
 
 

+ 8 - 2
rtl/inc/sstrings.inc

@@ -506,7 +506,13 @@ end;
 
 {$ifndef FPC_STR_ENUM_INTERN}
 function fpc_shortstr_enum_intern(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:shortstring): longint;
-
+{$ifndef FPC_HAS_FEATURE_RTTI}
+begin
+  int_str(ordinal,s);
+  if length(s)<len then
+    s:=space(len-length(s))+s;
+end;
+{$else with RTTI feature}
 { The following contains the TTypeInfo/TTypeData records from typinfo.pp
   specialized for the tkEnumeration case (and stripped of unused things). }
 type
@@ -654,7 +660,7 @@ begin
     end;
   fpc_shortstr_enum_intern:=0;
 end;
-
+{$endif with RTTI feature}
 
 procedure fpc_shortstr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:shortstring);[public,alias:'FPC_SHORTSTR_ENUM'];compilerproc;
 var

+ 0 - 2
rtl/inc/systemh.inc

@@ -1672,9 +1672,7 @@ const
                            RTTI support
 *****************************************************************************}
 
-{$ifdef FPC_HAS_FEATURE_RTTI}
 {$i rttih.inc}
-{$endif FPC_HAS_FEATURE_RTTI}
 
 {*****************************************************************************
                        Object Pascal support

+ 0 - 2
rtl/java/jsystemh.inc

@@ -894,9 +894,7 @@ const
                            RTTI support
 *****************************************************************************}
 
-{$ifdef FPC_HAS_FEATURE_RTTI}
 {$i rttih.inc}
-{$endif FPC_HAS_FEATURE_RTTI}
 
 {*****************************************************************************
                    Internal helper routines support