home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / icon / Source / Iconx / C / Fconv < prev    next >
Encoding:
Text File  |  1990-07-19  |  4.2 KB  |  228 lines
  1. /*
  2.  * fconv.c -- abs, cset, integer, numeric, proc, real, string.
  3.  */
  4.  
  5. #include "../h/config.h"
  6. #include "../h/rt.h"
  7. #include "rproto.h"
  8.  
  9.  
  10. /*
  11.  * abs(x) - absolute value of x.
  12.  */
  13. FncDcl(abs,1)
  14.    {
  15.    switch (cvnum(&Arg1)) {
  16.       /*
  17.        * If Arg1 is convertible to a numeric, turn Arg0 into
  18.        *  a descriptor for the appropriate type and value.  If the
  19.        *  conversion fails, produce an error.  This code assumes that
  20.        *  n = -n is always valid, which is not necessarily correct.
  21.        */
  22.       case T_Integer:
  23.          MakeInt(Abs(IntVal(Arg1)), &Arg0);
  24.          break;
  25.  
  26.       case T_Real:
  27.          makereal(BlkLoc(Arg1)->realblk.realval, &Arg0);
  28.          if (BlkLoc(Arg0)->realblk.realval < 0.0)
  29.             BlkLoc(Arg0)->realblk.realval = -BlkLoc(Arg0)->realblk.realval;
  30.          break;
  31.  
  32. #ifdef LargeInts
  33.      case T_Bignum:
  34.      cpbignum(&Arg1, &Arg0);
  35.      BlkLoc(Arg0)->bignumblk.sign = 0;
  36.      break;
  37. #endif                    /* LargeInts */
  38.  
  39.       default:
  40.          RunErr(102, &Arg1);
  41.       }
  42.    Return;
  43.    }
  44.  
  45.  
  46. /*
  47.  * cset(x) - convert x to cset.
  48.  */
  49.  
  50. FncDcl(cset,1)
  51.    {
  52.    register int i;
  53.    register struct b_cset *bp;
  54.    int *cs, csbuf[CsetSize];
  55.  
  56.    if (blkreq((word)sizeof(struct b_cset)) == Error) 
  57.       RunErr(0, NULL);
  58.  
  59.    if (Arg1.dword == D_Cset)
  60.       /*
  61.        * Arg1 already a cset, just return it.
  62.        */
  63.       Arg0 = Arg1;
  64.    else if (cvcset(&Arg1, &cs, csbuf) != CvtFail) {
  65.       /*
  66.        * Arg1 was convertible to cset and the result resides in csbuf.
  67.        *  Allocate *  a cset, make Arg0 a descriptor for it and copy the
  68.        *  bits from csbuf into it.
  69.        */
  70.       Arg0.dword = D_Cset;
  71.       bp = alccset();
  72.       BlkLoc(Arg0) =  (union block *) bp;
  73.       for (i = 0; i < CsetSize; i++)
  74.          bp->bits[i] = cs[i];
  75.       }
  76.    else            /* Not a cset nor convertible to one. */
  77.       Fail;
  78.    Return;
  79.    }
  80.  
  81.  
  82. /*
  83.  * integer(x) - convert x to integer.
  84.  */
  85.  
  86. FncDcl(integer,1)
  87.    {
  88.  
  89. #ifdef LargeInts
  90.    switch (cvnum(&Arg1)) {
  91.  
  92.       case T_Integer:
  93.       case T_Bignum:
  94.      Arg0 = Arg1;
  95.      break;
  96.  
  97.       case T_Real:
  98.      if (realtobig(&Arg1, &Arg0) == Error)  /* alcbignum failed */
  99.         RunErr(0, NULL);
  100.      break;
  101. #else                    /* LargeInts */
  102.    switch (cvint(&Arg1)) {
  103.  
  104.       case T_Integer:
  105.          Arg0 = Arg1;
  106.          break;
  107. #endif                    /* LargeInts */
  108.  
  109.       default:
  110.          Fail;
  111.       }
  112.    Return;
  113.    }
  114.  
  115. /*
  116.  * numeric(x) - convert x to numeric type.
  117.  */
  118. FncDcl(numeric,1)
  119.    {
  120.    switch (cvnum(&Arg1)) {
  121.  
  122.       case T_Integer:
  123.  
  124. #ifdef LargeInts
  125.       case T_Bignum:
  126. #endif                    /* LargeInts */
  127.  
  128.       case T_Real:
  129.      Arg0 = Arg1;
  130.          break;
  131.  
  132.       default:
  133.          Fail;
  134.       }
  135.    Return;
  136.    }
  137.  
  138.  
  139. /*
  140.  * proc(x,i) - convert x to a procedure if possible; use i to
  141.  *  resolve ambiguous string names.
  142.  */
  143. FncDcl(proc,2)
  144.    {
  145.    char sbuf[MaxCvtLen];
  146.    long i;
  147.    
  148.    /*
  149.     * If Arg1 is already a proc, just return it in Arg0.
  150.     */
  151.    Arg0 = Arg1;
  152.    if (Arg0.dword == D_Proc)
  153.       Return;
  154.    if (cvstr(&Arg0, sbuf) == CvtFail)
  155.       Fail;
  156.    /*
  157.     * Arg2 defaults to 1.
  158.     */
  159.    if (defshort(&Arg2, 1) == Error) 
  160.       RunErr(0, NULL);
  161.  
  162.    i = IntVal(Arg2);
  163.  
  164.    if (i < 1 || i > 3)
  165.       RunErr(205, &Arg2);
  166.  
  167.    /*
  168.     * Attempt to convert Arg0 to a procedure descriptor using args to
  169.     *  discriminate between procedures with the same names.  Fail if
  170.     *  the conversion isn't successful.
  171.     */
  172.    if (strprc(&Arg0,i) == CvtFail)
  173.       Fail;
  174.  
  175.    Return;
  176.    }
  177.  
  178.  
  179. /*
  180.  * real(x) - convert x to real.
  181.  */
  182.  
  183. FncDcl(real,1)
  184.    {
  185.    /*
  186.     * If Arg1 is already a real, just return it.  Otherwise convert it and
  187.     *  return it, failing if the conversion is unsuccessful.
  188.     */
  189.    if (Arg1.dword == D_Real)
  190.       Arg0 = Arg1;
  191.    else if (cvreal(&Arg1) == T_Real)
  192.       Arg0 = Arg1;
  193.    else
  194.       Fail;
  195.    Return;
  196.    }
  197.  
  198. /*
  199.  * string(x) - convert x to string.
  200.  */
  201.  
  202. FncDcl(string,1)
  203.    {
  204.    char sbuf[MaxCvtLen];
  205.  
  206.    Arg0 = Arg1;
  207.    switch (cvstr(&Arg0, sbuf)) {
  208.  
  209.       /*
  210.        * If Arg1 is not a string, allocate it and return it; if it is a
  211.        *  string, just return it; fail otherwise.
  212.        */
  213.       case Cvt:
  214.      /*
  215.           * Allocate converted string
  216.           */
  217.          if (strreq(StrLen(Arg0)) == Error) 
  218.             RunErr(0, NULL);
  219.          StrLoc(Arg0) = alcstr(StrLoc(Arg0), StrLen(Arg0));
  220.  
  221.       case NoCvt:
  222.          Return;
  223.  
  224.       default:
  225.          Fail;
  226.       }
  227.    }
  228.