ソースを参照

* move TTypeKind from TypInfo unit to System unit as it's necessary for the future GetTypeKind() intrinsic
* also adjust (P)Byte usages to (P/T)TypeKind where necessary/approbiate

git-svn-id: trunk@36873 -

svenbarth 8 年 前
コミット
8b5461367b
9 ファイル変更109 行追加100 行削除
  1. 2 2
      rtl/inc/dynarr.inc
  2. 1 1
      rtl/inc/dynarrh.inc
  3. 5 7
      rtl/inc/rtti.inc
  4. 17 0
      rtl/inc/rttih.inc
  5. 2 2
      rtl/inc/sstrings.inc
  6. 12 40
      rtl/inc/system.inc
  7. 14 40
      rtl/java/jsystem.inc
  8. 17 0
      rtl/java/rttih.inc
  9. 39 8
      rtl/objpas/typinfo.pp

+ 2 - 2
rtl/inc/dynarr.inc

@@ -195,7 +195,7 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
           fillchar(newp^,size,0);
 {$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
           { call int_InitializeArray for management operators }
-          if assigned(eletypemngd) and (PByte(eletype)^ in [tkRecord, tkObject]) then
+          if assigned(eletypemngd) and (PTypeKind(eletype)^ in [tkRecord, tkObject]) then
             int_InitializeArray(pointer(newp)+sizeof(tdynarray), eletype, dims[0]);
 {$endif FPC_HAS_MANAGEMENT_OPERATORS}
           updatep := true;
@@ -272,7 +272,7 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
                            (dims[0]-realp^.high-1)*elesize,0);
 {$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
                          { call int_InitializeArray for management operators }
-                         if assigned(eletypemngd) and (PByte(eletype)^ in [tkRecord, tkObject]) then
+                         if assigned(eletypemngd) and (PTypeKind(eletype)^ in [tkRecord, tkObject]) then
                            int_InitializeArray(pointer(realp)+sizeof(tdynarray)+elesize*(realp^.high+1),
                              eletype, dims[0]-realp^.high-1);
 {$endif FPC_HAS_MANAGEMENT_OPERATORS}

+ 1 - 1
rtl/inc/dynarrh.inc

@@ -22,7 +22,7 @@ type
   pdynarraytypeinfo = ^tdynarraytypeinfo;
   ppdynarraytypeinfo = ^pdynarraytypeinfo;
   tdynarraytypeinfo = packed record
-    kind : byte;
+    kind : TTypeKind;
     namelen : byte;
     { here the chars follow, we've to skip them }
     elesize : sizeint;

+ 5 - 7
rtl/inc/rtti.inc

@@ -14,8 +14,6 @@
 
 { Run-Time type information routines }
 
-{ the tk* constants are now declared in system.inc }
-
 {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
   {$define USE_PACKED}
 {$endif}
@@ -175,7 +173,7 @@ begin
 function RTTISize(typeInfo: Pointer): SizeInt;
 begin
 {$endif FPC_HAS_MANAGEMENT_OPERATORS}
-  case PByte(typeinfo)^ of
+  case PTypeKind(typeinfo)^ of
     tkAString,tkWString,tkUString,
     tkInterface,tkDynarray:
       result:=sizeof(Pointer);
@@ -272,7 +270,7 @@ end;
 
 Procedure fpc_Initialize (Data,TypeInfo : pointer);[Public,Alias : 'FPC_INITIALIZE'];  compilerproc;
 begin
-  case PByte(TypeInfo)^ of
+  case PTypeKind(TypeInfo)^ of
 {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
     tkDynArray,
 {$endif FPC_HAS_FEATURE_DYNARRAYS}
@@ -314,7 +312,7 @@ end;
 
 Procedure fpc_finalize (Data,TypeInfo: Pointer);[Public,Alias : 'FPC_FINALIZE'];  compilerproc;
 begin
-  case PByte(TypeInfo)^ of
+  case PTypeKind(TypeInfo)^ of
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
     tkAstring :
       fpc_AnsiStr_Decr_Ref(PPointer(Data)^);
@@ -363,7 +361,7 @@ end;
 
 Procedure fpc_Addref (Data,TypeInfo : Pointer); [Public,alias : 'FPC_ADDREF'];  compilerproc;
 begin
-  case PByte(TypeInfo)^ of
+  case PTypeKind(TypeInfo)^ of
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
     tkAstring :
       fpc_AnsiStr_Incr_Ref(PPointer(Data)^);
@@ -424,7 +422,7 @@ var
   info: pointer;
 begin
   result:=sizeof(pointer);
-  case PByte(TypeInfo)^ of
+  case PTypeKind(TypeInfo)^ of
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
     tkAstring:
       fpc_AnsiStr_Assign(PPointer(Dest)^,PPointer(Src)^);

+ 17 - 0
rtl/inc/rttih.inc

@@ -11,6 +11,23 @@
 
  **********************************************************************}
 
+{ sadly MinEnumSize is not handled by Push/Pop :'( }
+{$MINENUMSIZE 1   this saves a lot of memory }
+
+type
+  { If you change one of the following enumeration types you have also to
+    change the compiler and unit typeinfo in an appropriate way!
+    Also if you add managed types you'll need to update tkManagedTypes in
+    rtti.inc }
+  TTypeKind = (tkUnknown,tkInteger,tkChar,tkEnumeration,tkFloat,
+              tkSet,tkMethod,tkSString,tkLString,tkAString,
+              tkWString,tkVariant,tkArray,tkRecord,tkInterface,
+              tkClass,tkObject,tkWChar,tkBool,tkInt64,tkQWord,
+              tkDynArray,tkInterfaceRaw,tkProcVar,tkUString,tkUChar,
+              tkHelper,tkFile,tkClassRef,tkPointer);
+
+{$MINENUMSIZE DEFAULT}
+
 procedure InitializeArray(p, typeInfo: Pointer; count: SizeInt);
 procedure FinalizeArray(p, typeInfo: Pointer; count: SizeInt);
 procedure CopyArray(dest, source, typeInfo: Pointer; count: SizeInt);

+ 2 - 2
rtl/inc/sstrings.inc

@@ -514,7 +514,7 @@ type
 
   Penum_typeinfo=^Tenum_typeinfo;
   Tenum_typeinfo={$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
-    kind:byte; { always tkEnumeration }
+    kind:TTypeKind; { always tkEnumeration }
     num_chars:byte;
     chars:array[0..0] of char; { variable length with size of num_chars }
   end;
@@ -524,7 +524,7 @@ type
   Penum_typedata=^Tenum_typedata;
   Tenum_typedata={$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
     ordtype:byte;
-    case byte of
+    case TTypeKind of
       tkInteger,tkChar,tkEnumeration,tkBool,tkWChar,tkSet: (
         MinValue,MaxValue : Longint;
         case byte of

+ 12 - 40
rtl/inc/system.inc

@@ -23,46 +23,6 @@ type
   ObjpasInt = LongInt;
 {$endif CPU16}
 
-{ The RTTI is implemented through a series of constants : }
-
-Const
-   // please update tkManagedTypes below if you add new
-   // values
-   tkUnknown        = 0;
-   tkInteger        = 1;
-   tkChar           = 2;
-   tkEnumeration    = 3;
-   tkFloat          = 4;
-   tkSet            = 5;
-   tkMethod         = 6;
-   tkSString        = 7;
-   tkString         = tkSString;
-   tkLString        = 8;
-   tkAString        = 9;
-   tkWString        = 10;
-   tkVariant        = 11;
-   tkArray          = 12;
-   tkRecord         = 13;
-   tkInterface      = 14;
-   tkClass          = 15;
-   tkObject         = 16;
-   tkWChar          = 17;
-   tkBool           = 18;
-   tkInt64          = 19;
-   tkQWord          = 20;
-   tkDynArray       = 21;
-   tkInterfaceCorba = 22;
-   tkProcVar        = 23;
-   tkUString        = 24;
-   tkHelper         = 26;
-   tkFile           = 27;
-   tkClassRef       = 28;
-   tkPointer        = 29;
-
-  // all potentially managed types
-  tkManagedTypes   = [tkAstring,tkWstring,tkUstring,tkArray,
-                     tkObject,tkRecord,tkDynArray,tkInterface,tkVariant];
-
 {****************************************************************************
                                 Local types
 ****************************************************************************}
@@ -496,6 +456,18 @@ function aligntoqword(p : pointer) : pointer;inline;
 
 {$i aliases.inc}
 
+{****************************************************************************
+                  Run-Time Type Information (RTTI) declarations
+****************************************************************************}
+
+type
+  PTypeKind = ^TTypeKind;
+
+const
+  // all potentially managed types
+  tkManagedTypes   = [tkAstring,tkWstring,tkUstring,tkArray,
+                     tkObject,tkRecord,tkDynArray,tkInterface,tkVariant];
+
 {*****************************************************************************
                         Dynamic Array support
 *****************************************************************************}

+ 14 - 40
rtl/java/jsystem.inc

@@ -23,46 +23,6 @@ type
   ObjpasInt = LongInt;
 {$endif CPU16}
 
-{ The RTTI is implemented through a series of constants : }
-
-Const
-   // please update tkManagedTypes below if you add new
-   // values
-   tkUnknown        = 0;
-   tkInteger        = 1;
-   tkChar           = 2;
-   tkEnumeration    = 3;
-   tkFloat          = 4;
-   tkSet            = 5;
-   tkMethod         = 6;
-   tkSString        = 7;
-   tkString         = tkSString;
-   tkLString        = 8;
-   tkAString        = 9;
-   tkWString        = 10;
-   tkVariant        = 11;
-   tkArray          = 12;
-   tkRecord         = 13;
-   tkInterface      = 14;
-   tkClass          = 15;
-   tkObject         = 16;
-   tkWChar          = 17;
-   tkBool           = 18;
-   tkInt64          = 19;
-   tkQWord          = 20;
-   tkDynArray       = 21;
-   tkInterfaceCorba = 22;
-   tkProcVar        = 23;
-   tkUString        = 24;
-   tkHelper         = 26;
-   tkFile           = 27;
-   tkClassRef       = 28;
-   tkPointer        = 29;
-
-  // all potentially managed types
-  tkManagedTypes   = [tkAstring,tkWstring,tkUstring,tkArray,
-                     tkObject,tkRecord,tkDynArray,tkInterface,tkVariant];
-
 {****************************************************************************
                                 Local types
 ****************************************************************************}
@@ -449,6 +409,20 @@ function aligntoptr(p : pointer) : pointer;inline;
 
 {$i aliases.inc}
 
+{****************************************************************************
+                  Run-Time Type Information (RTTI) declarations
+****************************************************************************}
+
+(*
+type
+  PTypeKind = ^TTypeKind;
+*)
+
+const
+  // all potentially managed types
+  tkManagedTypes   = [tkAstring,tkWstring,tkUstring,tkArray,
+                     tkObject,tkRecord,tkDynArray,tkInterface,tkVariant];
+
 {*****************************************************************************
                         Dynamic Array support
 *****************************************************************************}

+ 17 - 0
rtl/java/rttih.inc

@@ -11,6 +11,23 @@
 
  **********************************************************************}
 
+{ sadly MinEnumSize is not handled by Push/Pop :'( }
+{$MINENUMSIZE 1   this saves a lot of memory }
+
+type
+  { If you change one of the following enumeration types you have also to
+    change the compiler and unit typeinfo in an appropriate way!
+    Also if you add managed types you'll need to update tkManagedTypes in
+    rtti.inc }
+  TTypeKind = (tkUnknown,tkInteger,tkChar,tkEnumeration,tkFloat,
+              tkSet,tkMethod,tkSString,tkLString,tkAString,
+              tkWString,tkVariant,tkArray,tkRecord,tkInterface,
+              tkClass,tkObject,tkWChar,tkBool,tkInt64,tkQWord,
+              tkDynArray,tkInterfaceRaw,tkProcVar,tkUString,tkUChar,
+              tkHelper,tkFile,tkClassRef,tkPointer);
+
+{$MINENUMSIZE DEFAULT}
+
 (*
 procedure InitializeArray(p, typeInfo: Pointer; count: SizeInt);
 procedure FinalizeArray(p, typeInfo: Pointer; count: SizeInt);

+ 39 - 8
rtl/objpas/typinfo.pp

@@ -38,14 +38,45 @@ unit typinfo;
 { for Delphi compatibility }
 {$packset 1}
 {$endif}
-       // if you change one of the following enumeration types
-       // you have also to change the compiler in an appropriate way !
-       TTypeKind = (tkUnknown,tkInteger,tkChar,tkEnumeration,tkFloat,
-                   tkSet,tkMethod,tkSString,tkLString,tkAString,
-                   tkWString,tkVariant,tkArray,tkRecord,tkInterface,
-                   tkClass,tkObject,tkWChar,tkBool,tkInt64,tkQWord,
-                   tkDynArray,tkInterfaceRaw,tkProcVar,tkUString,tkUChar,
-                   tkHelper,tkFile,tkClassRef,tkPointer);
+
+       { this alias and the following constant aliases are for backwards
+         compatibility before TTypeKind was moved to System unit }
+       TTypeKind = System.TTypeKind;
+
+    const
+
+       tkUnknown = System.tkUnknown;
+       tkInteger = System.tkInteger;
+       tkChar = System.tkChar;
+       tkEnumeration = System.tkEnumeration;
+       tkFloat = System.tkFloat;
+       tkSet = System.tkSet;
+       tkMethod = System.tkMethod;
+       tkSString = System.tkSString;
+       tkLString = System.tkLString;
+       tkAString = System.tkAString;
+       tkWString = System.tkWString;
+       tkVariant = System.tkVariant;
+       tkArray = System.tkArray;
+       tkRecord = System.tkRecord;
+       tkInterface = System.tkInterface;
+       tkClass = System.tkClass;
+       tkObject = System.tkObject;
+       tkWChar = System.tkWChar;
+       tkBool = System.tkBool;
+       tkInt64 = System.tkInt64;
+       tkQWord = System.tkQWord;
+       tkDynArray = System.tkDynArray;
+       tkInterfaceRaw = System.tkInterfaceRaw;
+       tkProcVar = System.tkProcVar;
+       tkUString = System.tkUString;
+       tkUChar = System.tkUChar;
+       tkHelper = System.tkHelper;
+       tkFile = System.tkFile;
+       tkClassRef = System.tkClassRef;
+       tkPointer = System.tkPointer;
+
+    type
 
        TOrdType  = (otSByte,otUByte,otSWord,otUWord,otSLong,otULong,otSQWord,otUQWord);