/*
 * fconv.c -- abs, cset, integer, numeric, proc, real, string.
 */

#include "..\h\config.h"
#include "..\h\rt.h"
#include "rproto.h"


/*
 * abs(x) - absolute value of x.
 */
FncDcl(abs,1)
   {
   switch (cvnum(&Arg1)) {
      /*
       * If Arg1 is convertible to a numeric, turn Arg0 into
       *  a descriptor for the appropriate type and value.  If the
       *  conversion fails, produce an error.  This code assumes that
       *  n = -n is always valid, which is not necessarily correct.
       */
      case T_Integer:
         MakeInt(Abs(IntVal(Arg1)), &Arg0);
         break;

      case T_Real:
         makereal(BlkLoc(Arg1)->realblk.realval, &Arg0);
         if (BlkLoc(Arg0)->realblk.realval < 0.0)
            BlkLoc(Arg0)->realblk.realval = -BlkLoc(Arg0)->realblk.realval;
         break;

#ifdef LargeInts
     case T_Bignum:
	 cpbignum(&Arg1, &Arg0);
	 BlkLoc(Arg0)->bignumblk.sign = 0;
	 break;
#endif					/* LargeInts */

      default:
         RunErr(102, &Arg1);
      }
   Return;
   }


/*
 * cset(x) - convert x to cset.
 */

FncDcl(cset,1)
   {
   register int i;
   register struct b_cset *bp;
   int *cs, csbuf[CsetSize];

   if (blkreq((word)sizeof(struct b_cset)) == Error) 
      RunErr(0, NULL);

   if (Arg1.dword == D_Cset)
      /*
       * Arg1 already a cset, just return it.
       */
      Arg0 = Arg1;
   else if (cvcset(&Arg1, &cs, csbuf) != CvtFail) {
      /*
       * Arg1 was convertible to cset and the result resides in csbuf.
       *  Allocate *  a cset, make Arg0 a descriptor for it and copy the
       *  bits from csbuf into it.
       */
      Arg0.dword = D_Cset;
      bp = alccset();
      BlkLoc(Arg0) =  (union block *) bp;
      for (i = 0; i < CsetSize; i++)
         bp->bits[i] = cs[i];
      }
   else			/* Not a cset nor convertible to one. */
      Fail;
   Return;
   }


/*
 * integer(x) - convert x to integer.
 */

FncDcl(integer,1)
   {

#ifdef LargeInts
   switch (cvnum(&Arg1)) {

      case T_Integer:
      case T_Bignum:
	 Arg0 = Arg1;
	 break;

      case T_Real:
	 if (realtobig(&Arg1, &Arg0) == Error)  /* alcbignum failed */
	    RunErr(0, NULL);
	 break;
#else					/* LargeInts */
   switch (cvint(&Arg1)) {

      case T_Integer:
         Arg0 = Arg1;
         break;
#endif					/* LargeInts */

      default:
         Fail;
      }
   Return;
   }

/*
 * numeric(x) - convert x to numeric type.
 */
FncDcl(numeric,1)
   {
   switch (cvnum(&Arg1)) {

      case T_Integer:

#ifdef LargeInts
      case T_Bignum:
#endif					/* LargeInts */

      case T_Real:
	 Arg0 = Arg1;
         break;

      default:
         Fail;
      }
   Return;
   }


/*
 * proc(x,i) - convert x to a procedure if possible; use i to
 *  resolve ambiguous string names.
 */
FncDcl(proc,2)
   {
   char sbuf[MaxCvtLen];
   long i;
   
   /*
    * If Arg1 is already a proc, just return it in Arg0.
    */
   Arg0 = Arg1;
   if (Arg0.dword == D_Proc)
      Return;
   if (cvstr(&Arg0, sbuf) == CvtFail)
      Fail;
   /*
    * Arg2 defaults to 1.
    */
   if (defshort(&Arg2, 1) == Error) 
      RunErr(0, NULL);

   i = IntVal(Arg2);

   if (i < 1 || i > 3)
      RunErr(205, &Arg2);

   /*
    * Attempt to convert Arg0 to a procedure descriptor using args to
    *  discriminate between procedures with the same names.  Fail if
    *  the conversion isn't successful.
    */
   if (strprc(&Arg0,i) == CvtFail)
      Fail;

   Return;
   }


/*
 * real(x) - convert x to real.
 */

FncDcl(real,1)
   {
   /*
    * If Arg1 is already a real, just return it.  Otherwise convert it and
    *  return it, failing if the conversion is unsuccessful.
    */
   if (Arg1.dword == D_Real)
      Arg0 = Arg1;
   else if (cvreal(&Arg1) == T_Real)
      Arg0 = Arg1;
   else
      Fail;
   Return;
   }

/*
 * string(x) - convert x to string.
 */

FncDcl(string,1)
   {
   char sbuf[MaxCvtLen];

   Arg0 = Arg1;
   switch (cvstr(&Arg0, sbuf)) {

      /*
       * If Arg1 is not a string, allocate it and return it; if it is a
       *  string, just return it; fail otherwise.
       */
      case Cvt:
	 /*
          * Allocate converted string
          */
         if (strreq(StrLen(Arg0)) == Error) 
            RunErr(0, NULL);
         StrLoc(Arg0) = alcstr(StrLoc(Arg0), StrLen(Arg0));

      case NoCvt:
         Return;

      default:
         Fail;
      }
   }