home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v92.tgz / v92.tar / v92 / src / runtime / fconv.r < prev    next >
Text File  |  1996-03-22  |  5KB  |  220 lines
  1. /*
  2.  * fconv.r -- abs, cset, integer, numeric, proc, real, string.
  3.  */
  4.  
  5. "abs(N) - produces the absolute value of N."
  6.  
  7. function{1} abs(n)
  8.    /*
  9.     * If n is convertible to a small integer or real, this code returns
  10.     * -n if n is negative -- not valid in all cases.  (Should return a
  11.     * LargeInt in that case?)
  12.     */
  13.    if cnv:(exact)C_integer(n) then {
  14.       abstract {
  15.          return integer
  16.          }
  17.       inline {
  18.          return C_integer Abs(n);
  19.          }
  20.       }
  21.  
  22. #ifdef LargeInts
  23.    else if cnv:(exact)integer(n) then {
  24.       abstract {
  25.          return integer
  26.          }
  27.       inline {
  28.          cpbignum(&n,&result);
  29.      BlkLoc(result)->bignumblk.sign = 0;
  30.          return result;
  31.          }
  32.       }
  33. #endif                    /* LargeInts */
  34.  
  35.    else if cnv:C_double(n) then {
  36.       abstract {
  37.          return real
  38.          }
  39.       inline {
  40.  
  41. #if SASC 
  42.          return C_double __builtin_fabs(n);
  43. #else
  44.          return C_double Abs(n);
  45. #endif                    /* SASC */
  46.  
  47.          }
  48.       }
  49.    else
  50.       runerr(102,n)
  51. end
  52.  
  53.  
  54. /*
  55.  * The convertible types cset, integer, real, and string are identical
  56.  *  enough to be expansions of a single macro, parameterized by type.
  57.  */
  58. #begdef ReturnYourselfAs(t)
  59. #t "(x) - produces a value of type " #t " resulting from the conversion of x, "
  60.    "but fails if the conversion is not possible."
  61. function{0,1} t(x)
  62.  
  63.    if cnv:t(x) then {
  64.       abstract {
  65.          return t
  66.          }
  67.       inline {
  68.          return x;
  69.          }
  70.       }
  71.    else {
  72.       abstract {
  73.          return empty_type
  74.          }
  75.       inline {
  76.          fail;
  77.          }
  78.       }
  79. end
  80.  
  81. #enddef
  82.  
  83. ReturnYourselfAs(cset)     /* cset(x) - convert to cset or fail */
  84. ReturnYourselfAs(integer)  /* integer(x) - convert to integer or fail */
  85. ReturnYourselfAs(real)     /* real(x) - convert to real or fail */
  86. ReturnYourselfAs(string)   /* string(x) - convert to string or fail */
  87.  
  88.  
  89.  
  90. "numeric(x) - produces an integer or real number resulting from the "
  91. "type conversion of x, but fails if the conversion is not possible."
  92.  
  93. function{0,1} numeric(n)
  94.  
  95.    if cnv:(exact)integer(n) then {
  96.       abstract {
  97.          return integer
  98.          }
  99.       inline {
  100.          return n;
  101.          }
  102.       }
  103.    else if cnv:real(n) then {
  104.       abstract {
  105.          return real
  106.          }
  107.       inline {
  108.          return n;
  109.          }
  110.       }
  111.    else {
  112.       abstract {
  113.          return empty_type
  114.          }
  115.       inline {
  116.          fail;
  117.          }
  118.       }
  119. end
  120.  
  121.  
  122. "proc(x,i) - convert x to a procedure if possible; use i to resolve "
  123. "ambiguous string names."
  124.  
  125. #ifdef MultiThread
  126. function{0,1} proc(x,i,c)
  127. #else                    /* MultiThread */
  128. function{0,1} proc(x,i)
  129. #endif                    /* MultiThread */
  130.  
  131.    if is:proc(x) then {
  132.       abstract {
  133.          return proc
  134.          }
  135.       inline {
  136.  
  137. #ifdef MultiThread
  138.      if (!is:null(c)) {
  139.         struct progstate *p;
  140.         if (!is:coexpr(c)) runerr(118,c);
  141.         /*
  142.          * Test to see whether a given procedure belongs to a given
  143.          * program.  Currently this is a sleazy pointer arithmetic check.
  144.          */
  145.         p = BlkLoc(c)->coexpr.program;
  146.         if (! InRange(p, BlkLoc(x)->proc.entryp.icode,
  147.               (char *)p + p->hsize))
  148.            fail;
  149.         }
  150. #endif                    /* MultiThread */
  151.          return x;
  152.          }
  153.       }
  154.  
  155.    else if cnv:tmp_string(x) then {
  156.       /*
  157.        * i must be 0, 1, 2, or 3; it defaults to 1.
  158.        */
  159.       if !def:C_integer(i, 1) then
  160.          runerr(101, i)
  161.       inline {
  162.          if (i < 0 || i > 3) {
  163.             irunerr(205, i);
  164.             errorfail;
  165.             }
  166.          }   
  167.  
  168.       abstract {
  169.          return proc
  170.          }
  171.       inline {
  172.          struct b_proc *prc;
  173.  
  174. #ifdef MultiThread
  175.      struct progstate *prog, *savedprog;
  176.  
  177.      savedprog = curpstate;
  178.      if (is:null(c)) {
  179.         prog = curpstate;
  180.         }
  181.      else if (is:coexpr(c)) {
  182.         prog = BlkLoc(c)->coexpr.program;
  183.         }
  184.      else {
  185.         runerr(118,c);
  186.         }
  187.  
  188.      ENTERPSTATE(prog);
  189. #endif                        /* MultiThread */
  190.  
  191.          /*
  192.           * Attempt to convert Arg0 to a procedure descriptor using i to
  193.           *  discriminate between procedures with the same names.  If i
  194.           *  is zero, only check builtins and ignore user procedures.
  195.           *  Fail if the conversion isn't successful.
  196.           */
  197.      if (i == 0)
  198.             prc = bi_strprc(&x, 0);
  199.      else
  200.          prc = strprc(&x, i);
  201.  
  202. #ifdef MultiThread
  203.      ENTERPSTATE(savedprog);
  204. #endif                        /* MultiThread */
  205.          if (prc == NULL)
  206.             fail;
  207.          else
  208.             return proc(prc);
  209.          }
  210.       }
  211.    else {
  212.       abstract {
  213.          return empty_type
  214.          }
  215.       inline {
  216.          fail;
  217.          }
  218.       }
  219. end
  220.