From 92b842342cd2d9ce63919e75bbe062b9a1a1632b Mon Sep 17 00:00:00 2001 From: florian Date: Sat, 17 Nov 2001 10:29:48 +0000 Subject: [PATCH] * make cycle for win32 fixed --- rtl/inc/genrtti.inc | 11 +++- rtl/objpas/cvarutil.inc | 116 ++++++++++++++++++++++++++++++++++++++- rtl/objpas/varutilh.inc | 86 ++--------------------------- rtl/objpas/varutils.inc | 118 ++-------------------------------------- 4 files changed, 134 insertions(+), 197 deletions(-) diff --git a/rtl/inc/genrtti.inc b/rtl/inc/genrtti.inc index 36b3af362f..dc7f04ca37 100644 --- a/rtl/inc/genrtti.inc +++ b/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 diff --git a/rtl/objpas/cvarutil.inc b/rtl/objpas/cvarutil.inc index d55f9d38e6..bce66acfe2 100644 --- a/rtl/objpas/cvarutil.inc +++ b/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 diff --git a/rtl/objpas/varutilh.inc b/rtl/objpas/varutilh.inc index b1b4d9c428..73added6f2 100644 --- a/rtl/objpas/varutilh.inc +++ b/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 - } diff --git a/rtl/objpas/varutils.inc b/rtl/objpas/varutils.inc index ee861c7fcf..0e07da480a 100644 --- a/rtl/objpas/varutils.inc +++ b/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 - }