Browse Source

* make cycle for win32 fixed

florian 24 years ago
parent
commit
92b842342c
4 changed files with 134 additions and 197 deletions
  1. 9 2
      rtl/inc/genrtti.inc
  2. 115 1
      rtl/objpas/cvarutil.inc
  3. 6 80
      rtl/objpas/varutilh.inc
  4. 4 114
      rtl/objpas/varutils.inc

+ 9 - 2
rtl/inc/genrtti.inc

@@ -55,8 +55,10 @@ begin
         With PRecRec(Temp)^.elements[I] do
           int_Initialize (Data+Offset,Info);
       end;
+{$ifdef HASVARIANTS}
     tkVariant:
       variant_init(Variant(PVarData(Data)^))
+{$endif HASVARIANTS}
   end;
 end;
 {$endif}
@@ -100,8 +102,10 @@ begin
         With PRecRec(Temp)^.elements[I] do
           int_Finalize (Data+Offset,Info);
       end;
+{$ifdef HASVARIANTS}
     tkVariant:
       variant_clear(Variant(PVarData(Data)^))
+{$endif HASVARIANTS}
   end;
 end;
 {$endif}
@@ -212,8 +216,11 @@ procedure fpc_FinalizeArray(data,typeinfo : pointer;count,size : longint); [Publ
 
 {
  $Log$
- Revision 1.6  2001-11-14 22:59:11  michael
- + Initial variant support
+ Revision 1.7  2001-11-17 10:29:48  florian
+   * make cycle for win32 fixed
+
+ Revision 1.6  2001/11/14 22:59:11  michael
+   + Initial variant support
 
  Revision 1.5  2001/08/01 15:00:10  jonas
    + "compproc" helpers

+ 115 - 1
rtl/objpas/cvarutil.inc

@@ -425,10 +425,124 @@ Function VariantToShortString(Const VargSrc : TVarData) : ShortString;
 begin
 end;
 
+{ ---------------------------------------------------------------------
+    Some debug routines
+  ---------------------------------------------------------------------}
+
+
+Procedure DumpVariant(Const VArgSrc : TVarData);
+
+begin
+  DumpVariant(Output,VArgSrc);
+end;
+
+(*
+   tvardata = packed record
+      vtype : tvartype;
+      case integer of
+         0:(res1 : word;
+            case integer of
+               0:
+                 (res2,res3 : word;
+                  case word of
+                     varsmallint : (vsmallint : smallint);
+                     varinteger : (vinteger : longint);
+                     varsingle : (vsingle : single);
+                     vardouble : (vdouble : double);
+                     varcurrency : (vcurrency : currency);
+                     vardate : (vdate : tdatetime);
+                     varolestr : (volestr : pwidechar);
+                     vardispatch : (vdispatch : pointer);
+                     varerror : (verror : dword);
+                     varboolean : (vboolean : wordbool);
+                     varunknown : (vunknown : pointer);
+                     // vardecimal : ( : );
+                     varshortint : (vshortint : shortint);
+                     varbyte : (vbyte : byte);
+                     varword : (vword : word);
+                     varlongword : (vlongword : dword);
+                     varint64 : (vint64 : int64);
+                     varqword : (vqword : qword);
+                     varword64 : (vword64 : qword);
+                     varstring : (vstring : pointer);
+                     varany :  (vany : pointer);
+                     vararray : (varray : pvararray);
+                     varbyref : (vpointer : pointer);
+                 );
+               1:
+                 (vlongs : array[0..2] of longint);
+           );
+         1:(vwords : array[0..6] of word);
+         2:(vbytes : array[0..13] of byte);
+      end;
+
+*)
+
+Const
+  VarTypeStrings : Array [varEmpty..varqword] of string = (
+    'empty',  'null',  'smallint',  'integer',  'single',  'double',
+    'currency',  'date',  'olestr',  'dispatch',  'error',  'boolean',
+    'variant',  'unknown',  'unknown','decimal',  'shortint',  'byte',  'word',
+    'longword',  'int64',  'qword');
+
+Procedure DumpVariant(Var F : Text; Const VArgSrc : TVarData);
+
+begin
+  If VArgSrc.vType in [varEmpty..varqword] then
+    Writeln(F,'Variant has type : ',VarTypeStrings[VArgSrc.vType])
+  else if (VArgSrc.vType=VarArray) Then
+    begin
+    Write(F,'Variant is array.');
+    exit;
+    end
+  else if (VargSrc.vType=VarByRef) then
+    begin
+    Writeln(F,'Variant is by reference.');
+    exit;
+    end
+  else
+    begin
+    Writeln(F,'Variant has unknown type: ', VargSrc.vType);
+    Exit;
+    end;
+  If VArgSrc.vType<>varEmpty then
+    With VArgSrc do
+      begin
+      Write(F,'Value is: ') ;
+      Case vtype of
+        varnull : Write(F,'Null');
+        varsmallint : Write(F,vsmallint);
+        varinteger : Write(F,vinteger);
+        varsingle : Write(F,vsingle);
+        vardouble : Write(F,vdouble);
+        varcurrency : Write(F,vcurrency) ;
+        vardate : Write(F,vdate) ;
+        varolestr : Write(F,'Not supported') ;
+        vardispatch : Write(F,'Not suppordted') ;
+        varerror : Write(F,'Error') ;
+        varboolean : Write(F,vboolean) ;
+        varvariant : Write(F,'Unsupported') ;
+        varunknown : Write(F,'Unsupported') ;
+        vardecimal : Write(F,'Unsupported') ;
+        varshortint : Write(F,vshortint) ;
+        varbyte : Write(F,vbyte) ;
+        varword : Write(F,vword) ;
+        varlongword : Write(F,vlongword) ;
+        varint64 : Write(F,vint64) ;
+        varqword : Write(F,vqword) ;
+      end;
+      Writeln(f);
+      end;
+end;
+
 {$endif HASVARIANT}
+
 {
   $Log$
-  Revision 1.4  2001-11-15 22:33:14  michael
+  Revision 1.5  2001-11-17 10:29:48  florian
+    * make cycle for win32 fixed
+
+  Revision 1.4  2001/11/15 22:33:14  michael
   + Real/Boolean support added, Start of string support
 
   Revision 1.3  2001/11/14 23:00:17  michael

+ 6 - 80
rtl/objpas/varutilh.inc

@@ -17,90 +17,14 @@
  **********************************************************************}
 
 
+{$ifdef HASVARIANT}
 Type
-
   EVarianterror = Class(Exception)
     ErrCode : longint;
     Constructor CreateCode(Code : Longint);
   end;
 
-{$ifndef HASVARIANT}
-
-  // Types needed to make this work. These should be moved to the system unit.
-
-  currency            = int64;
-  HRESULT             = Longint;
-  PSmallInt           = ^Smallint;
-  PLongint            = ^Longint;
-  PSingle             = ^Single;
-  PDouble             = ^Double;
-  PCurrency           = ^Currency;
-  TDateTime           = Double;
-  PDate               = ^TDateTime;
-  PPWideChar          = ^PWideChar;
-  Error               = Longint;
-  PError              = ^Error;
-  PWordBool           = ^WordBool;
-  PByte               = ^Byte;
-
-
-  TVarArrayBound = packed record
-    ElementCount: Longint;
-    LowBound: Longint;
-  end;
-  TVarArrayBoundArray = Array [0..0] of TVarArrayBound;
-  PVarArrayBoundArray = ^TVarArrayBoundArray;
-  TVarArrayCoorArray  = Array [0..0] of Longint;
-  PVarArrayCoorArray  = ^TVarArrayCoorArray;
-
-  PVarArray = ^TVarArray;
-  TVarArray = packed record
-    DimCount: Word;
-    Flags: Word;
-    ElementSize: Longint;
-  LockCount: Integer;
-    Data: Pointer;
-    Bounds: TVarArrayBoundArray;
-  end;
-
-  TVarType = Word;
-  PVarData = ^TVarData;
-  TVarData = packed record
-    VType: TVarType;
-    case Integer of
-      0: (Reserved1: Word;
-          case Integer of
-            0: (Reserved2, Reserved3: Word;
-                case Integer of
-                  varSmallInt: (VSmallInt: SmallInt);
-                  varInteger:  (VInteger: Longint);
-                  varSingle:   (VSingle: Single);
-                  varDouble:   (VDouble: Double);
-                  varCurrency: (VCurrency: Currency);
-                  varDate:     (VDate: Double);
-                  varOleStr:   (VOleStr: PWideChar);
-                  varDispatch: (VDispatch: Pointer);
-                  varError:    (VError: LongWord);
-                  varBoolean:  (VBoolean: WordBool);
-                  varUnknown:  (VUnknown: Pointer);
-                  varByte:     (VByte: Byte);
-                  varString:   (VString: Pointer);
-                  varAny:      (VAny: Pointer);
-                  varArray:    (VArray: PVarArray);
-                  varByRef:    (VPointer: Pointer);
-         );
-            1: (VLongs: array[0..2] of LongInt);
-         );
-      2: (VWords: array [0..6] of Word);
-      3: (VBytes: array [0..13] of Byte);
-  end;
-  Variant = TVarData;
-  PVariant = ^Variant;
-{$endif}
-
-{$ifdef hasvariant}
 { Variant functions }
-
 function VariantChangeTypeEx(var VargDest: TVarData; const VargSrc: TVarData; LCID: Integer; Flags: Word; VarType: Word): HRESULT; stdcall;
 function VariantClear(var Varg: TVarData): HRESULT; stdcall;
 function VariantCopy(var VargDest: TVarData; const VargSrc: TVarData): HRESULT; stdcall;
@@ -179,14 +103,16 @@ const
 
 {
   $Log$
-  Revision 1.4  2001-11-15 22:33:14  michael
+  Revision 1.5  2001-11-17 10:29:48  florian
+    * make cycle for win32 fixed
+
+  Revision 1.4  2001/11/15 22:33:14  michael
   + Real/Boolean support added, Start of string support
 
   Revision 1.3  2001/11/14 23:00:17  michael
   + First working variant support
 
   Revision 1.2  2001/08/19 21:02:02  florian
-    * fixed and added a lot of stuff to get the Jedi DX( headers
+    * fixed and added a lot of stuff to get the Jedi DX8 headers
       compiled
-
 }

+ 4 - 114
rtl/objpas/varutils.inc

@@ -708,122 +708,13 @@ begin
     Result:=psa^.ElementSize;
 end;
 
-{ ---------------------------------------------------------------------
-    Some debug routines
-  ---------------------------------------------------------------------}
-  
-
-Procedure DumpVariant(Const VArgSrc : TVarData);
-
-begin
-  DumpVariant(Output,VArgSrc);
-end;
-
-(*
-   tvardata = packed record
-      vtype : tvartype;
-      case integer of
-         0:(res1 : word;
-            case integer of
-               0:
-                 (res2,res3 : word;
-                  case word of
-                     varsmallint : (vsmallint : smallint);
-                     varinteger : (vinteger : longint);
-                     varsingle : (vsingle : single);
-                     vardouble : (vdouble : double);
-                     varcurrency : (vcurrency : currency);
-                     vardate : (vdate : tdatetime);
-                     varolestr : (volestr : pwidechar);
-                     vardispatch : (vdispatch : pointer);
-                     varerror : (verror : dword);
-                     varboolean : (vboolean : wordbool);
-                     varunknown : (vunknown : pointer);
-                     // vardecimal : ( : );
-                     varshortint : (vshortint : shortint);
-                     varbyte : (vbyte : byte);
-                     varword : (vword : word);
-                     varlongword : (vlongword : dword);
-                     varint64 : (vint64 : int64);
-                     varqword : (vqword : qword);
-                     varword64 : (vword64 : qword);
-                     varstring : (vstring : pointer);
-                     varany :  (vany : pointer);
-                     vararray : (varray : pvararray);
-                     varbyref : (vpointer : pointer);
-                 );
-               1:
-                 (vlongs : array[0..2] of longint);
-           );
-         1:(vwords : array[0..6] of word);
-         2:(vbytes : array[0..13] of byte);
-      end;
-
-*)
-
-Const 
-
-  VarTypeStrings : Array [varEmpty..varqword] of string = (
-  'empty',  'null',  'smallint',  'integer',  'single',  'double',
-  'currency',  'date',  'olestr',  'dispatch',  'error',  'boolean',
-  'variant',  'unknown',  'unknown','decimal',  'shortint',  'byte',  'word',
-  'longword',  'int64',  'qword');
-
-
-Procedure DumpVariant(Var F : Text; Const VArgSrc : TVarData);
-
-begin
-  If VArgSrc.vType in [varEmpty..varqword] then
-    Writeln(F,'Variant has type : ',VarTypeStrings[VArgSrc.vType])
-  else if (VArgSrc.vType=VarArray) Then
-    begin
-    Write(F,'Variant is array.');
-    exit;
-    end
-  else if (VargSrc.vType=VarByRef) then
-    begin
-    Writeln(F,'Variant is by reference.');
-    exit;
-    end
-  else
-    begin
-    Writeln(F,'Variant has unknown type: ', VargSrc.vType);
-    Exit;
-    end;
-  If VArgSrc.vType<>varEmpty then  
-    With VArgSrc do
-      begin
-      Write(F,'Value is: ') ;
-      Case vtype of 
-        varnull : Write(F,'Null');
-        varsmallint : Write(F,vsmallint);
-        varinteger : Write(F,vinteger);
-        varsingle : Write(F,vsingle);
-        vardouble : Write(F,vdouble);
-        varcurrency : Write(F,vcurrency) ;
-        vardate : Write(F,vdate) ;
-        varolestr : Write(F,'Not supported') ;
-        vardispatch : Write(F,'Not suppordted') ;
-        varerror : Write(F,'Error') ;
-        varboolean : Write(F,vboolean) ;
-        varvariant : Write(F,'Unsupported') ;
-        varunknown : Write(F,'Unsupported') ;
-        vardecimal : Write(F,'Unsupported') ;
-        varshortint : Write(F,vshortint) ;
-        varbyte : Write(F,vbyte) ;
-        varword : Write(F,vword) ;
-        varlongword : Write(F,vlongword) ;
-        varint64 : Write(F,vint64) ;
-        varqword : Write(F,vqword) ;
-      end;
-      Writeln(f); 
-      end;
-end;
-
 {$endif HASVARIANT}
 {
   $Log$
-  Revision 1.6  2001-11-15 22:33:14  michael
+  Revision 1.7  2001-11-17 10:29:48  florian
+    * make cycle for win32 fixed
+
+  Revision 1.6  2001/11/15 22:33:14  michael
   + Real/Boolean support added, Start of string support
 
   Revision 1.5  2001/11/14 23:00:17  michael
@@ -832,5 +723,4 @@ end;
   Revision 1.4  2001/08/19 21:02:02  florian
     * fixed and added a lot of stuff to get the Jedi DX( headers
       compiled
-
 }