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']; {$ifdef hascompilerproc} compilerproc; {$endif}
Begin
  If (InOutRes<>0) then
   exit;
  case TextRec(f).mode of
    fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
      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
  end;
  
function fpc_dynarray_to_variant(const v : variant;typeinfo : pointer) : pointer;compilerproc;
  begin
  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 }

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

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


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

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


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

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

Operator :=(const source : comp) dest : variant;

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

{ 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 }

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

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


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

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


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

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


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

begin
  dest:=comp(variantmanager.vartoreal(source));
end;

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

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


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

begin

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.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

}