Browse Source

* qword,int64 rtti support basics

peter 25 years ago
parent
commit
2260192c30
1 changed files with 30 additions and 23 deletions
  1. 30 23
      rtl/objpas/typinfo.pp

+ 30 - 23
rtl/objpas/typinfo.pp

@@ -52,7 +52,7 @@ unit typinfo;
        TTypeKind = (tkUnknown,tkInteger,tkChar,tkEnumeration,
        TTypeKind = (tkUnknown,tkInteger,tkChar,tkEnumeration,
                    tkFloat,tkSet,tkMethod,tkSString,tkLString,tkAString,
                    tkFloat,tkSet,tkMethod,tkSString,tkLString,tkAString,
                    tkWString,tkVariant,tkArray,tkRecord,tkInterface,
                    tkWString,tkVariant,tkArray,tkRecord,tkInterface,
-                   tkClass,tkObject,tkWChar,tkBool);
+                   tkClass,tkObject,tkWChar,tkBool,tkInt64,tkQWord);
 
 
        TTOrdType = (otSByte,otUByte,otSWord,otUWord,otSLong,otULong);
        TTOrdType = (otSByte,otUByte,otSWord,otUWord,otSLong,otULong);
 
 
@@ -129,6 +129,10 @@ unit typinfo;
               followed by
               followed by
                   ResultType : ShortString}
                   ResultType : ShortString}
               );
               );
+            tkInt64:
+              (MinInt64Value, MaxInt64Value: Int64);
+            tkQWord:
+              (MinQWordValue, MaxQWordValue: QWord);
             tkInterface:
             tkInterface:
               ({!!!!!!!}
               ({!!!!!!!}
               );
               );
@@ -204,9 +208,9 @@ unit typinfo;
     procedure SetMethodProp(Instance : TObject;PropInfo : PPropInfo;
     procedure SetMethodProp(Instance : TObject;PropInfo : PPropInfo;
       const Value : TMethod);
       const Value : TMethod);
 
 
-    function GetInt64Prop(Instance: TObject; PropInfo: PPropInfo): Int64;
-    procedure SetInt64Prop(Instance: TObject; PropInfo: PPropInfo;
-      const Value: Int64);
+    function GetInt64Prop(Instance: TObject; PropInfo: PPropInfo): Int64;
+    procedure SetInt64Prop(Instance: TObject; PropInfo: PPropInfo;
+      const Value: Int64);
 
 
     { misc. stuff }
     { misc. stuff }
     function GetEnumName(TypeInfo : PTypeInfo;Value : Integer) : string;
     function GetEnumName(TypeInfo : PTypeInfo;Value : Integer) : string;
@@ -214,8 +218,8 @@ unit typinfo;
 
 
 
 
   const
   const
-    BooleanIdents: array[Boolean] of String = ('False', 'True');
-    DotSep: String = '.';
+    BooleanIdents: array[Boolean] of String = ('False', 'True');
+    DotSep: String = '.';
 
 
 
 
   implementation
   implementation
@@ -364,7 +368,7 @@ unit typinfo;
          hp : PTypeData;
          hp : PTypeData;
          i : longint;
          i : longint;
          p : string;
          p : string;
-         
+
       begin
       begin
          P:=UpCase(PropName);
          P:=UpCase(PropName);
          while Assigned(TypeInfo) do
          while Assigned(TypeInfo) do
@@ -499,7 +503,7 @@ unit typinfo;
 
 
       var
       var
          value,Index,Ivalue : longint;
          value,Index,Ivalue : longint;
-	 TypeInfo: PTypeInfo;
+         TypeInfo: PTypeInfo;
 
 
       begin
       begin
          SetIndexValues(PropInfo,Index,Ivalue);
          SetIndexValues(PropInfo,Index,Ivalue);
@@ -512,20 +516,20 @@ unit typinfo;
               Value:=CallIntegerFunc(Instance,PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.GetProc))^,Index,IValue);
               Value:=CallIntegerFunc(Instance,PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.GetProc))^,Index,IValue);
          end;
          end;
          { cut off unnecessary stuff }
          { cut off unnecessary stuff }
-	 TypeInfo := PropInfo^.PropType;
-	 case TypeInfo^.Kind of
-	   tkChar, tkBool:
-	     Value:=Value and $ff;
-	   tkWChar:
-	     Value:=Value and $ffff;
-	   tkInteger:
-	     case GetTypeData(TypeInfo)^.OrdType of
-        	otSWord,otUWord:
+         TypeInfo := PropInfo^.PropType;
+         case TypeInfo^.Kind of
+           tkChar, tkBool:
+             Value:=Value and $ff;
+           tkWChar:
+             Value:=Value and $ffff;
+           tkInteger:
+             case GetTypeData(TypeInfo)^.OrdType of
+                otSWord,otUWord:
                   Value:=Value and $ffff;
                   Value:=Value and $ffff;
-        	otSByte,otUByte:
+                otSByte,otUByte:
                   Value:=Value and $ff;
                   Value:=Value and $ff;
              end;
              end;
-	 end;
+         end;
          GetOrdProp:=Value;
          GetOrdProp:=Value;
       end;
       end;
 
 
@@ -787,14 +791,14 @@ unit typinfo;
          end;
          end;
       end;
       end;
 
 
-    function GetInt64Prop(Instance: TObject; PropInfo: PPropInfo): Int64;
+    function GetInt64Prop(Instance: TObject; PropInfo: PPropInfo): Int64;
     begin
     begin
       // !!!: Implement me!
       // !!!: Implement me!
       Result := 0;
       Result := 0;
     end;
     end;
 
 
-    procedure SetInt64Prop(Instance: TObject; PropInfo: PPropInfo;
-      const Value: Int64);
+    procedure SetInt64Prop(Instance: TObject; PropInfo: PPropInfo;
+      const Value: Int64);
     begin
     begin
       // !!!: Implement me!
       // !!!: Implement me!
     end;
     end;
@@ -842,7 +846,10 @@ end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.41  2000-06-22 15:31:09  sg
+  Revision 1.42  2000-06-22 20:02:51  peter
+    * qword,int64 rtti support basics
+
+  Revision 1.41  2000/06/22 15:31:09  sg
   * Fixed a small typo in my previous update
   * Fixed a small typo in my previous update
 
 
   Revision 1.40  2000/06/22 15:29:31  sg
   Revision 1.40  2000/06/22 15:29:31  sg