freepascal.compiler/rtl/inc/variant.inc

{
    $Id$
    This file is part of the Free Pascal run time library.
    Copyright (c) 2001 by the Free Pascal development team

    This include file contains the implementation for variants
    support in FPC as far as it is part of the system unit

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}

var
   variantmanager : tvariantmanager;

procedure invalidvariantop;
  begin
     HandleErrorFrame(221,get_frame);
  end;

procedure vardisperror;

  begin
     HandleErrorFrame(222,get_frame);
  end;


{ ---------------------------------------------------------------------
    Compiler helper routines.
  ---------------------------------------------------------------------}


procedure varclear(var v : tvardata);
begin
   if not(v.vtype in [varempty,varerror,varnull]) then
     invalidvariantop;
end;

procedure variant_init(var v : variant);[Public,Alias:'FPC_VARIANT_INIT'];

  begin
     { calling the variant manager here is a problem because the static/global variants
       are initialized while the variant manager isn't assigned }
     fillchar(v,sizeof(variant),0);
  end;

procedure variant_clear(var v : variant);[Public,Alias:'FPC_VARIANT_CLEAR'];

  begin
     variantmanager.varclear(v);
  end;

Procedure fpc_write_text_variant(Len : Longint;var f : Text;const v : variant); iocheck; [Public,Alias:'FPC_WRITE_TEXT_VARIANT']; compilerproc;
Begin
  If (InOutRes<>0) then
   exit;
  case TextRec(f).mode of
    fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
      if len=-1 then
        variantmanager.write0variant(f,v)
      else
        variantmanager.writevariant(f,v,len);
    fmInput: InOutRes:=105
    else InOutRes:=103;
  end;
End;

function fpc_variant_to_dynarray(const v : variant;typeinfo : pointer) : pointer;compilerproc;
  begin
{$warning TODO fpc_variant_to_dynarray}
    result:=nil;
  end;

function fpc_dynarray_to_variant(const v : variant;typeinfo : pointer) : pointer;compilerproc;
  begin
{$warning TODO fpc_dynarray_to_variant}
    result:=nil;
  end;

{ ---------------------------------------------------------------------
    Overloaded operators.
  ---------------------------------------------------------------------}


{ Integer }

operator :=(const source : byte) dest : variant;

begin
  Variant_Init(Dest);
  Variantmanager.varfromInt(Dest,Source,1);
end;


operator :=(const source : shortint) dest : variant;

begin
  Variant_Init(Dest);
  Variantmanager.varfromInt(Dest,Source,-1);
end;


operator :=(const source : word) dest : variant;

begin
  Variant_Init(Dest);
  Variantmanager.varfromInt(Dest,Source,2);
end;


operator :=(const source : smallint) dest : variant;

begin
  Variant_Init(Dest);
  Variantmanager.varfromInt(Dest,Source,-2);
end;


operator :=(const source : dword) dest : variant;

begin
  Variant_Init(Dest);
  Variantmanager.varfromInt(Dest,Source,4);
end;


operator :=(const source : longint) dest : variant;

begin
//  Variant_Init(Dest);
  Variantmanager.varfromInt(Dest,Source,-4);
end;


operator :=(const source : qword) dest : variant;

begin
  Variant_Init(Dest);
  Variantmanager.varfromWord64(Dest,Source);
end;


operator :=(const source : int64) dest : variant;

begin
  Variant_Init(Dest);
  Variantmanager.varfromInt64(Dest,Source);
end;

{ Boolean }

operator :=(const source : boolean) dest : variant;

begin
  Variant_Init(Dest);
  Variantmanager.varfromBool(Dest,Source);
end;


operator :=(const source : wordbool) dest : variant;

begin
  Variant_Init(Dest);
  Variantmanager.varfromBool(Dest,Boolean(Source));
end;


operator :=(const source : longbool) dest : variant;

begin
  Variant_Init(Dest);
  Variantmanager.varfromBool(Dest,Boolean(Source));
end;


{ Chars }

operator :=(const source : char) dest : variant;

begin
  Variant_Init(Dest);
  VariantManager.VarFromPStr(Dest,Source);
end;


operator :=(const source : widechar) dest : variant;

begin
  Variant_Init(Dest);
  VariantManager.VarFromWStr(Dest,Source);
end;

{ Strings }

operator :=(const source : shortstring) dest : variant;

begin
  Variant_Init(Dest);
  VariantManager.VarFromPStr(Dest,Source);
end;


operator :=(const source : ansistring) dest : variant;

begin
  Variant_Init(Dest);
  VariantManager.VarFromLStr(Dest,Source);
end;


operator :=(const source : widestring) dest : variant;

begin
  Variant_Init(Dest);
  VariantManager.VarFromWStr(Dest,Source);
end;

{ Floats }

{$ifdef SUPPORT_SINGLE}
operator :=(const source : single) dest : variant;
begin
  Variant_Init(Dest);
  VariantManager.VarFromReal(Dest,Source);
end;
{$endif SUPPORT_SINGLE}


{$ifdef SUPPORT_DOUBLE}
operator :=(const source : double) dest : variant;
begin
  Variant_Init(Dest);
  VariantManager.VarFromReal(Dest,Source);
end;
{$endif SUPPORT_DOUBLE}


{$ifdef SUPPORT_EXTENDED}
operator :=(const source : extended) dest : variant;
begin
  Variant_Init(Dest);
  VariantManager.VarFromReal(Dest,Source);
end;
{$endif SUPPORT_EXTENDED}


{$ifdef SUPPORT_COMP}
Operator :=(const source : comp) dest : variant;
begin
  Variant_Init(Dest);
  VariantManager.VarFromReal(Dest,Source);
end;
{$endif SUPPORT_COMP}


{ Misc. }
{ Fixme!!!
operator :=(const source : currency) dest : variant;
  begin
  end;

operator :=(const source : tdatetime) dest : variant;
  begin
  end;
}
{**********************************************************************
                       from Variant assignments
 **********************************************************************}

{ Integer }

operator :=(const source : variant) dest : byte;

begin
  dest:=variantmanager.vartoint(source);
end;


operator :=(const source : variant) dest : shortint;

begin
  dest:=variantmanager.vartoint(source);
end;


operator :=(const source : variant) dest : word;

begin
  dest:=variantmanager.vartoint(source);
end;


operator :=(const source : variant) dest : smallint;

begin
  dest:=variantmanager.vartoint(source);
end;


operator :=(const source : variant) dest : dword;

begin
  dest:=variantmanager.vartoint(source);
end;


operator :=(const source : variant) dest : longint;

begin
  dest:=variantmanager.vartoint(source);
end;


operator :=(const source : variant) dest : qword;

begin
  dest:=variantmanager.vartoword64(source);
end;


operator :=(const source : variant) dest : int64;

begin
  dest:=variantmanager.vartoint64(source);
end;


{ Boolean }

operator :=(const source : variant) dest : boolean;

begin
  dest:=variantmanager.vartobool(source);
end;


operator :=(const source : variant) dest : wordbool;

begin
  dest:=variantmanager.vartobool(source);
end;


operator :=(const source : variant) dest : longbool;

begin
   dest:=variantmanager.vartobool(source);
end;


{ Chars }

operator :=(const source : variant) dest : char;

Var
  S : String;

begin
  VariantManager.VarToPStr(S,Source);
  If Length(S)>0 then
    Dest:=S[1];
end;


operator :=(const source : variant) dest : widechar;

Var
  WS : WideString;

begin
  VariantManager.VarToWStr(WS,Source);
  If Length(WS)>0 then
    Dest:=WS[1];
end;


{ Strings }

operator :=(const source : variant) dest : shortstring;

begin
  VariantManager.VarToPStr(Dest,Source);
end;

operator :=(const source : variant) dest : ansistring;

begin
  VariantManager.vartolstr(dest,source);
end;

operator :=(const source : variant) dest : widestring;

begin
  variantmanager.vartowstr(dest,source);
end;

{ Floats }

{$ifdef SUPPORT_SINGLE}
operator :=(const source : variant) dest : single;
begin
  dest:=variantmanager.vartoreal(source);
end;
{$endif SUPPORT_SINGLE}


{$ifdef SUPPORT_DOUBLE}
operator :=(const source : variant) dest : double;
begin
  dest:=variantmanager.vartoreal(source);
end;
{$endif SUPPORT_DOUBLE}


{$ifdef SUPPORT_EXTENDED}
operator :=(const source : variant) dest : extended;
begin
  dest:=variantmanager.vartoreal(source);
end;
{$endif SUPPORT_EXTENDED}


{$ifdef SUPPORT_COMP}
operator :=(const source : variant) dest : comp;
begin
  dest:=comp(variantmanager.vartoreal(source));
end;
{$endif SUPPORT_COMP}

{ Misc. }
operator :=(const source : variant) dest : currency;

begin
  dest:=variantmanager.vartocurr(source);
end;

(* FIXME !!!
operator :=(const source : variant) dest : tdatetime;

begin
  dest:=variantmanager.currtovar(source);
end;
*)
{**********************************************************************
                               Operators
 **********************************************************************}

operator or(const op1,op2 : variant) dest : variant;
  begin
     dest:=op1;
     variantmanager.varop(dest,op2,opor);
  end;

operator and(const op1,op2 : variant) dest : variant;
  begin
     dest:=op1;
     variantmanager.varop(dest,op2,opand);
  end;

operator xor(const op1,op2 : variant) dest : variant;
  begin
     dest:=op1;
     variantmanager.varop(dest,op2,opxor);
  end;

operator not(const op : variant) dest : variant;
  begin
     dest:=op;
     variantmanager.varnot(dest);
  end;

operator shl(const op1,op2 : variant) dest : variant;
  begin
     dest:=op1;
     variantmanager.varop(dest,op2,opshiftleft);
  end;

operator shr(const op1,op2 : variant) dest : variant;
  begin
     dest:=op1;
     variantmanager.varop(dest,op2,opshiftright);
  end;

operator +(const op1,op2 : variant) dest : variant;
  begin
     dest:=op1;
     variantmanager.varop(dest,op2,opadd);
  end;

operator -(const op1,op2 : variant) dest : variant;
  begin
     dest:=op1;
     variantmanager.varop(dest,op2,opsubtract);
  end;

operator *(const op1,op2 : variant) dest : variant;
  begin
     dest:=op1;
     variantmanager.varop(dest,op2,opmultiply);
  end;

operator /(const op1,op2 : variant) dest : variant;
  begin
     dest:=op1;
     variantmanager.varop(dest,op2,opdivide);
  end;

operator div(const op1,op2 : variant) dest : variant;
  begin
     dest:=op1;
     variantmanager.varop(dest,op2,opintdivide);
  end;

operator mod(const op1,op2 : variant) dest : variant;
  begin
     dest:=op1;
     variantmanager.varop(dest,op2,opmodulus);
  end;

operator -(const op : variant) dest : variant;
  begin
     dest:=op;
     variantmanager.varneg(dest);
  end;

operator =(const op1,op2 : variant) dest : boolean;
  begin
     dest:=variantmanager.cmpop(op1,op2,opcmpeq);
  end;

operator <(const op1,op2 : variant) dest : boolean;
  begin
     dest:=variantmanager.cmpop(op1,op2,opcmplt);
  end;

operator >(const op1,op2 : variant) dest : boolean;
  begin
     dest:=variantmanager.cmpop(op1,op2,opcmpgt);
  end;

operator >=(const op1,op2 : variant) dest : boolean;
  begin
     dest:=variantmanager.cmpop(op1,op2,opcmpge);
  end;

operator <=(const op1,op2 : variant) dest : boolean;
  begin
     dest:=variantmanager.cmpop(op1,op2,opcmplt);
  end;


{**********************************************************************
                      Variant manager functions
 **********************************************************************}

procedure GetVariantManager(var VarMgr: TVariantManager);

begin
  VarMgr:=VariantManager;
end;

procedure SetVariantManager(const VarMgr: TVariantManager);

begin
  VariantManager:=VarMgr;
end;

function IsVariantManagerSet: Boolean;

var
   i : longint;
begin
   I:=0;
   Result:=True;
   While Result and (I<(sizeof(tvariantmanager) div sizeof(pointer))-1) do
     begin
     Result:=Pointer(ppointer(@variantmanager+i*sizeof(pointer))^)<>Pointer(@invalidvariantop);
     Inc(I);
     end;
end;


procedure initvariantmanager;
  var
     i : longint;
  begin
     VarDispProc:=@vardisperror;
     DispCallByIDProc:=@vardisperror;
     tvardata(Unassigned).VType:=varEmpty;
     tvardata(Null).VType:=varNull;
     for i:=0 to (sizeof(tvariantmanager) div sizeof(pointer))-1 do
       ppointer(@variantmanager+i*sizeof(pointer))^:=@invalidvariantop;
     pointer(variantmanager.varclear):=@varclear
  end;


{
  $Log$
  Revision 1.18  2004-08-18 21:03:35  florian
    * sparc uses wait4 as well

  Revision 1.17  2004/05/31 20:25:04  peter
    * removed warnings

  Revision 1.16  2003/12/10 01:36:39  florian
    * real functions ifdef'ed depending on the supported types

  Revision 1.15  2003/11/05 15:26:37  florian
    + currency type can be assigned to variants now

  Revision 1.14  2003/10/04 23:40:42  florian
    * write helper comproc for variants fixed

  Revision 1.13  2003/09/03 14:09:37  florian
    * arm fixes to the common rtl code
    * some generic math code fixed
    * ...

  Revision 1.12  2002/10/10 19:24:28  florian
    + write(ln) support for variants added

  Revision 1.11  2002/10/09 20:13:26  florian
    * hopefully last fix to get things working :/

  Revision 1.10  2002/10/09 19:56:01  florian
    * variant assignments don't work yet, commented out

  Revision 1.9  2002/10/09 19:08:22  florian
    + Variant constants Unassigned and Null added

  Revision 1.8  2002/10/07 15:10:45  florian
    + variant wrappers for cmp operators added

  Revision 1.7  2002/10/07 10:27:45  florian
    + more variant wrappers added

  Revision 1.6  2002/10/06 22:13:55  florian
    * wrappers for xor, or and and operator with variants added

  Revision 1.5  2002/09/07 15:07:46  peter
    * old logs removed and tabs fixed

}