home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume26 / calc / part20 / func.c
Encoding:
C/C++ Source or Header  |  1992-05-09  |  46.0 KB  |  1,966 lines
  1. /*
  2.  * Copyright (c) 1992 David I. Bell
  3.  * Permission is granted to use, distribute, or modify this source,
  4.  * provided that this copyright notice remains intact.
  5.  *
  6.  * Built-in functions implemented here
  7.  */
  8.  
  9. #include <sys/types.h>
  10. #include <sys/times.h>
  11. #include <time.h>
  12.  
  13. #include "calc.h"
  14. #include "opcodes.h"
  15. #include "token.h"
  16. #include "func.h"
  17. #include "string.h"
  18.  
  19.  
  20. /* if HZ & CLK_TCK are not defined, pick typical values, hope for the best */
  21. #if !defined(HZ)
  22. #  define HZ 60
  23. #endif
  24. #if !defined(CLK_TCK)
  25. # undef CLK_TCK
  26. # define CLK_TCK HZ
  27. #endif
  28.  
  29. extern int errno;
  30.  
  31.  
  32. /*
  33.  * Totally numeric functions.
  34.  */
  35. static NUMBER *f_cfsim();    /* simplify number using continued fractions */
  36. static NUMBER *f_ilog();    /* return log of one number to another */
  37. static NUMBER *f_faccnt();    /* count of divisions */
  38. static NUMBER *f_min();        /* minimum of several arguments */
  39. static NUMBER *f_max();        /* maximum of several arguments */
  40. static NUMBER *f_hmean();    /* harmonic mean */
  41. static NUMBER *f_trunc();    /* truncate number to specified decimal places */
  42. static NUMBER *f_btrunc();    /* truncate number to specified binary places */
  43. static NUMBER *f_gcd();        /* greatest common divisor */
  44. static NUMBER *f_lcm();        /* least common multiple */
  45. static NUMBER *f_xor();        /* xor of several arguments */
  46. static NUMBER *f_ceil();    /* ceiling of a fraction */
  47. static NUMBER *f_floor();    /* floor of a fraction */
  48. static NUMBER *f_meq();        /* numbers are same modular value */
  49. static NUMBER *f_isrel();    /* two numbers are relatively prime */
  50. static NUMBER *f_ismult();    /* whether one number divides another */
  51. static NUMBER *f_mne();        /* whether a and b are not equal modulo c */
  52. static NUMBER *f_isset();    /* tests if a bit of a num (base 2) is set */
  53. static NUMBER *f_highbit();    /* high bit number in base 2 representation */
  54. static NUMBER *f_lowbit();    /* low bit number in base 2 representation */
  55. static NUMBER *f_near();    /* whether two numbers are near each other */
  56. static NUMBER *f_legtoleg();    /* positive form of leg to leg */
  57. static NUMBER *f_ilog10();    /* integer log of number base 10 */
  58. static NUMBER *f_ilog2();    /* integer log of number base 2 */
  59. static NUMBER *f_digits();    /* number of digits of number */
  60. static NUMBER *f_digit();    /* digit at specified decimal place of number */
  61. static NUMBER *f_places();    /* number of decimal places of number */
  62. static NUMBER *f_primetest();    /* primality test */
  63. static NUMBER *f_issquare();    /* whether number is a square */
  64. static NUMBER *f_runtime();    /* user runtime in seconds */
  65.  
  66.  
  67. /*
  68.  * General functions.
  69.  */
  70. static VALUE f_bround();    /* round number to specified binary places */
  71. static VALUE f_round();        /* round number to specified decimal places */
  72. static VALUE f_det();        /* determinant of matrix */
  73. static VALUE f_mattrans();    /* return transpose of matrix */
  74. static VALUE f_matdim();    /* dimension of matrix */
  75. static VALUE f_matmax();    /* maximum index of matrix dimension */
  76. static VALUE f_matmin();    /* minimum index of matrix dimension */
  77. static VALUE f_matfill();    /* fill matrix with values */
  78. static VALUE f_listpush();    /* push element onto front of list */
  79. static VALUE f_listpop();    /* pop element from front of list */
  80. static VALUE f_listappend();    /* append element to end of list */
  81. static VALUE f_listremove();    /* remove element from end of list */
  82. static VALUE f_listinsert();    /* insert element into list */
  83. static VALUE f_listdelete();    /* delete element from list */
  84. static VALUE f_strlen();    /* length of string */
  85. static VALUE f_char();        /* character value of integer */
  86. static VALUE f_substr();    /* extract substring */
  87. static VALUE f_strcat();    /* concatenate strings */
  88. static VALUE f_ord();        /* get ordinal value for character */
  89. static VALUE f_avg();        /* average of several arguments */
  90. static VALUE f_ssq();        /* sum of squares */
  91. static VALUE f_poly();        /* result of evaluating polynomial */
  92. static VALUE f_sqrt();        /* square root of a number */
  93. static VALUE f_root();        /* number taken to root of another */
  94. static VALUE f_exp();        /* complex exponential */
  95. static VALUE f_ln();        /* complex natural logarithm */
  96. static VALUE f_power();        /* one value to another power */
  97. static VALUE f_cos();        /* complex cosine */
  98. static VALUE f_sin();        /* complex sine */
  99. static VALUE f_polar();        /* polar representation of complex number */
  100. static VALUE f_arg();        /* argument of complex number */
  101. static VALUE f_list();        /* create a list */
  102. static VALUE f_size();        /* number of elements in object */
  103. static VALUE f_search();    /* search matrix or list for match */
  104. static VALUE f_rsearch();    /* search matrix or list backwards for match */
  105. static VALUE f_cp();        /* cross product of vectors */
  106. static VALUE f_dp();        /* dot product of vectors */
  107. static VALUE f_prompt();    /* prompt for input line */
  108. static VALUE f_eval();        /* evaluate string into value */
  109. static VALUE f_str();        /* convert value to string */
  110. static VALUE f_fopen();        /* open file for reading or writing */
  111. static VALUE f_fprintf();    /* print data to file */
  112. static VALUE f_strprintf();    /* return printed data as a string */
  113. static VALUE f_fgetline();    /* read next line from file */
  114. static VALUE f_fgetc();        /* read next char from file */
  115. static VALUE f_fflush();    /* flush output to file */
  116. static VALUE f_printf();    /* print data to stdout */
  117. static VALUE f_fclose();    /* close file */
  118. static VALUE f_ferror();    /* whether error occurred */
  119. static VALUE f_feof();        /* whether end of file reached */
  120. static VALUE f_files();        /* return file handle or number of files */
  121.  
  122.  
  123. #define IN 100        /* maximum number of arguments */
  124. #define    FE 0x01        /* flag to indicate default epsilon argument */
  125. #define    FA 0x02        /* preserve addresses of variables */
  126.  
  127.  
  128. /*
  129.  * List of primitive built-in functions
  130.  */
  131. static struct builtin {
  132.     char *b_name;        /* name of built-in function */
  133.     short b_minargs;    /* minimum number of arguments */
  134.     short b_maxargs;    /* maximum number of arguments */
  135.     short b_flags;        /* special handling flags */
  136.     short b_opcode;        /* opcode which makes the call quick */
  137.     NUMBER *(*b_numfunc)();    /* routine to calculate numeric function */
  138.     VALUE (*b_valfunc)();    /* routine to calculate general values */
  139.     char *b_desc;        /* description of function */
  140. } builtins[] = {
  141.     "abs", 1, 2, 0, OP_ABS, 0, 0, "absolute value within accuracy b",
  142.     "acos", 1, 2, FE, OP_NOP, qacos, 0, "arccosine of a within accuracy b",
  143.     "acosh", 1, 2, FE, OP_NOP, qacosh, 0, "hyperbolic arccosine of a within accuracy b",
  144.     "append", 2, 2, FA, OP_NOP, 0, f_listappend, "append value to end of list",
  145.     "appr", 1, 2, FE, OP_NOP, qbappr, 0, "approximate a with simpler fraction to within b",
  146.     "arg", 1, 2, 0, OP_NOP, 0, f_arg, "argument (the angle) of complex number",
  147.     "asin", 1, 2, FE, OP_NOP, qasin, 0, "arcsine of a within accuracy b",
  148.     "asinh", 1, 2, FE, OP_NOP, qasinh, 0, "hyperbolic arcsine of a within accuracy b",
  149.     "atan", 1, 2, FE, OP_NOP, qatan, 0, "arctangent of a within accuracy b",
  150.     "atan2", 2, 3, FE, OP_NOP, qatan2, 0, "angle to point (b,a) within accuracy c",
  151.     "atanh", 1, 2, FE, OP_NOP, qatanh, 0, "hyperbolic arctangent of a within accuracy b",
  152.     "avg", 1, IN, 0, OP_NOP, 0, f_avg, "arithmetic mean of values",
  153.     "bround", 1, 2, 0, OP_NOP, 0, f_bround, "round value a to b number of binary places",
  154.     "btrunc", 1, 2, 0, OP_NOP, f_btrunc, 0, "truncate a to b number of binary places",
  155.     "ceil", 1, 1, 0, OP_NOP, f_ceil, 0, "smallest integer greater than or equal to number",
  156.     "cfappr", 1, 2, FE, OP_NOP, qcfappr, 0, "approximate a within accuracy b using continued fractions",
  157.     "cfsim", 1, 1, 0, OP_NOP, f_cfsim, 0, "simplify number using continued fractions",
  158.     "char", 1, 1, 0, OP_NOP, 0, f_char, "character corresponding to integer value",
  159.     "cmp", 2, 2, 0, OP_CMP, 0, 0, "compare values returning -1, 0, or 1",
  160.     "comb", 2, 2, 0, OP_NOP, qcomb, 0, "combinatorial number a!/b!(a-b)!",
  161.     "config", 1, 2, 0, OP_SETCONFIG, 0, 0, "set or read configuration value",
  162.     "conj", 1, 1, 0, OP_CONJUGATE, 0, 0, "complex conjugate of value",
  163.     "cos", 1, 2, 0, OP_NOP, 0, f_cos, "cosine of value a within accuracy b",
  164.     "cosh", 1, 2, FE, OP_NOP, qcosh, 0, "hyperbolic cosine of a within accuracy b",
  165.     "cp", 2, 2, 0, OP_NOP, 0, f_cp, "Cross product of two vectors",
  166.     "delete", 2, 2, FA, OP_NOP, 0, f_listdelete, "delete element from list a at position b",
  167.     "den", 1, 1, 0, OP_DENOMINATOR, qden, 0, "denominator of fraction",
  168.     "det", 1, 1, 0, OP_NOP, 0, f_det, "determinant of matrix",
  169.     "digit", 2, 2, 0, OP_NOP, f_digit, 0, "digit at specified decimal place of number",
  170.     "digits", 1, 1, 0, OP_NOP, f_digits, 0, "number of digits in number",
  171.     "dp", 2, 2, 0, OP_NOP, 0, f_dp, "Dot product of two vectors",
  172.     "epsilon", 0, 1, 0, OP_SETEPSILON, 0, 0, "set or read allowed error for real calculations",
  173.     "eval", 1, 1, 0, OP_NOP, 0, f_eval, "Evaluate expression from string to value",
  174.     "exp", 1, 2, 0, OP_NOP, 0, f_exp, "exponential of value a within accuracy b",
  175.     "fcnt", 2, 2, 0, OP_NOP, f_faccnt, 0, "count of times one number divides another",
  176.     "fib", 1, 1, 0, OP_NOP, qfib, 0, "fibonacci number F(n)",
  177.     "frem", 2, 2, 0, OP_NOP, qfacrem, 0, "number with all occurances of factor removed",
  178.     "fact", 1, 1, 0, OP_NOP, qfact, 0, "factorial",
  179.     "fclose", 1, 1, 0, OP_NOP, 0, f_fclose, "close file",
  180.     "feof", 1, 1, 0, OP_NOP, 0, f_feof, "whether EOF reached for file",
  181.     "ferror", 1, 1, 0, OP_NOP, 0, f_ferror, "whether error occurred for file",
  182.     "fflush", 1, 1, 0, OP_NOP, 0, f_fflush, "flush output to file",
  183.     "fgetc", 1, 1, 0, OP_NOP, 0, f_fgetc, "read next char from file",
  184.     "fgetline", 1, 1, 0, OP_NOP, 0, f_fgetline, "read next line from file",
  185.     "files", 0, 1, 0, OP_NOP, 0, f_files, "return opened file or max number of opened files",
  186.     "floor", 1, 1, 0, OP_NOP, f_floor, 0, "greatest integer less than or equal to number",
  187.     "fopen", 2, 2, 0, OP_NOP, 0, f_fopen, "open file name a in mode b",
  188.     "fprintf", 2, IN, 0, OP_NOP, 0, f_fprintf, "print formatted output to opened file",
  189.     "frac", 1, 1, 0, OP_FRAC, qfrac, 0, "fractional part of value",
  190.     "gcd", 1,IN, 0, OP_NOP, f_gcd, 0, "greatest common divisor",
  191.     "gcdrem", 2, 2, 0, OP_NOP, qgcdrem, 0, "a divided repeatedly by gcd with b",
  192.     "highbit", 1, 1, 0, OP_NOP, f_highbit, 0, "high bit number in base 2 representation",
  193.     "hmean", 1,IN, 0, OP_NOP, f_hmean, 0, "harmonic mean of values",
  194.     "hypot", 2, 3, FE, OP_NOP, qhypot, 0, "hypotenuse of right triangle within accuracy c",
  195.     "ilog", 2, 2, 0, OP_NOP, f_ilog, 0, "integral log of one number with another",
  196.     "ilog10", 1, 1, 0, OP_NOP, f_ilog10, 0, "integral log of a number base 10",
  197.     "ilog2", 1, 1, 0, OP_NOP, f_ilog2, 0, "integral log of a number base 2",
  198.     "im", 1, 1, 0, OP_IM, 0, 0, "imaginary part of complex number",
  199.     "insert", 3, 3, FA, OP_NOP, 0, f_listinsert, "insert value c into list a at position b",
  200.      "int", 1, 1, 0, OP_INT, qint, 0, "integer part of value",
  201.     "inverse", 1, 1, 0, OP_INVERT, 0, 0, "multiplicative inverse of value",
  202.     "iroot", 2, 2, 0, OP_NOP, qiroot, 0, "integer b'th root of a",
  203.     "iseven", 1, 1, 0, OP_ISEVEN, 0, 0, "whether a value is an even integer",
  204.     "isfile", 1, 1, 0, OP_ISFILE, 0, 0, "whether a value is a file",
  205.     "isint", 1, 1, 0, OP_ISINT, 0, 0, "whether a value is an integer",
  206.     "islist", 1, 1, 0, OP_ISLIST, 0, 0, "whether a value is a list",
  207.     "ismat", 1, 1, 0, OP_ISMAT, 0, 0, "whether a value is a matrix",
  208.     "ismult", 2, 2, 0, OP_NOP, f_ismult, 0, "whether a is a multiple of b",
  209.     "isnull", 1, 1, 0, OP_ISNULL, 0, 0, "whether a value is the null value",
  210.     "isnum", 1, 1, 0, OP_ISNUM, 0, 0, "whether a value is a number",
  211.     "isobj", 1, 1, 0, OP_ISOBJ, 0, 0, "whether a value is an object",
  212.     "isodd", 1, 1, 0, OP_ISODD, 0, 0, "whether a value is an odd integer",
  213.     "isqrt", 1, 1, 0, OP_NOP, qisqrt, 0, "integer part of square root",
  214.     "isreal", 1, 1, 0, OP_ISREAL, 0, 0, "whether a value is a real number",
  215.     "isset", 2, 2, 0, OP_NOP, f_isset, 0, "whether bit b of abs(a) (in base 2) is set",
  216.     "isstr", 1, 1, 0, OP_ISSTR, 0, 0, "whether a value is a string",
  217.     "isrel", 2, 2, 0, OP_NOP, f_isrel, 0, "whether two numbers are relatively prime",
  218.     "issimple", 1, 1, 0, OP_ISSIMPLE, 0, 0, "whether value is a simple type",
  219.     "issq", 1, 1, 0, OP_NOP, f_issquare, 0, "whether or not number is a square",
  220.      "istype", 2, 2, 0, OP_ISTYPE, 0, 0, "whether the type of a is same as the type of b",
  221.     "jacobi", 2, 2, 0, OP_NOP, qjacobi, 0, "-1 => a is not quadratic residue mod b\n\t\t 1 => b is composite, or a is quad residue of b",
  222.     "lcm", 1, IN, 0, OP_NOP, f_lcm, 0, "least common multiple",
  223.     "lcmfact", 1, 1, 0, OP_NOP, qlcmfact, 0, "lcm of all integers up till number",
  224.     "lfactor", 2, 2, 0, OP_NOP, qlowfactor, 0, "lowest prime factor of a in first b primes",
  225.     "list", 0, IN, 0, OP_NOP, 0, f_list, "create list of specified values",
  226.     "ln", 1, 2, 0, OP_NOP, 0, f_ln, "natural logarithm of value a within accuracy b",
  227.     "lowbit", 1, 1, 0, OP_NOP, f_lowbit, 0, "low bit number in base 2 representation",
  228.     "ltol", 1, 2, FE, OP_NOP, f_legtoleg, 0, "leg-to-leg of unit right triangle (sqrt(1 - a^2))",
  229.     "matdim", 1, 1, 0, OP_NOP, 0, f_matdim, "number of dimensions of matrix",
  230.     "matfill", 2, 3, FA, OP_NOP, 0, f_matfill, "fill matrix with value b (value c on diagonal)",
  231.     "matmax", 2, 2, 0, OP_NOP, 0, f_matmax, "maximum index of matrix a dim b",
  232.     "matmin", 2, 2, 0, OP_NOP, 0, f_matmin, "minimum index of matrix a dim b",
  233.     "mattrans", 1, 1, 0, OP_NOP, 0, f_mattrans, "transpose of matrix",
  234.     "max", 1, IN, 0, OP_NOP, f_max, 0, "maximum value",
  235.     "meq", 3, 3, 0, OP_NOP, f_meq, 0, "whether a and b are equal modulo c",
  236.     "min", 1, IN, 0, OP_NOP, f_min, 0, "minimum value",
  237.     "minv", 2, 2, 0, OP_NOP, qminv, 0, "inverse of a modulo b",
  238.     "mmin", 2, 2, 0, OP_NOP, qminmod, 0, "a mod b value with smallest abs value",
  239.     "mne", 3, 3, 0, OP_NOP, f_mne, 0, "whether a and b are not equal modulo c",
  240.     "near", 2, 3, 0, OP_NOP, f_near, 0, "sign of (abs(a-b) - c)",
  241.     "norm", 1, 1, 0, OP_NORM, 0, 0, "norm of a value (square of absolute value)",
  242.     "null", 0, 0, 0, OP_UNDEF, 0, 0, "null value",
  243.     "num", 1, 1, 0, OP_NUMERATOR, qnum, 0, "numerator of fraction",
  244.     "ord", 1, 1, 0, OP_NOP, 0, f_ord, "integer corresponding to character value",
  245.     "param", 1, 1, 0, OP_ARGVALUE, 0, 0, "value of parameter n (or parameter count if n is zero)",
  246.     "perm", 2, 2, 0, OP_NOP, qperm, 0, "permutation number a!/(a-b)!",
  247.     "pfact", 1, 1, 0, OP_NOP, qpfact, 0, "product of primes up till number",
  248.     "pi", 0, 1, FE, OP_NOP, qpi, 0, "value of pi accurate to within epsilon",
  249.     "places", 1, 1, 0, OP_NOP, f_places, 0, "places after decimal point (-1 if infinite)",
  250.     "pmod", 3, 3, 0, OP_NOP, qpowermod,0, "mod of a power (a ^ b (mod c))",
  251.     "polar", 2, 3, 0, OP_NOP, 0, f_polar, "complex value of polar coordinate (a * exp(b*1i))",
  252.     "poly", 2, IN, 0, OP_NOP, 0, f_poly, "(a1,a2,...,an,x) = a1*x^n+a2*x^(n-1)+...+an",
  253.     "pop", 1, 1, FA, OP_NOP, 0, f_listpop, "pop value from front of list",
  254.     "power", 2, 3, 0, OP_NOP, 0, f_power, "value a raised to the power b within accuracy c",
  255.     "ptest", 2, 2, 0, OP_NOP, f_primetest, 0, "probabilistic primality test",
  256.     "printf", 1, IN, 0, OP_NOP, 0, f_printf, "print formatted output to stdout",
  257.     "prompt", 1, 1, 0, OP_NOP, 0, f_prompt, "prompt for input line using value a",
  258.     "push", 2, 2, FA, OP_NOP, 0, f_listpush, "push value onto front of list",
  259.     "quomod", 4, 4, 0, OP_QUOMOD, 0, 0, "set c and d to quotient and remainder of a divided by b",
  260.     "rcin", 2, 2, 0, OP_NOP, qredcin, 0, "convert normal number a to REDC number mod b",
  261.     "rcmul", 3, 3, 0, OP_NOP, qredcmul, 0, "multiply REDC numbers a and b mod c",
  262.     "rcout", 2, 2, 0, OP_NOP, qredcout, 0, "convert REDC number a mod b to normal number",
  263.     "rcpow", 3, 3, 0, OP_NOP, qredcpower, 0, "raise REDC number a to power b mod c",
  264.     "rcsq", 2, 2, 0, OP_NOP, qredcsquare, 0, "square REDC number a mod b",
  265.     "re", 1, 1, 0, OP_RE, 0, 0, "real part of complex number",
  266.     "remove", 1, 1, FA, OP_NOP, 0, f_listremove, "remove value from end of list",
  267.     "root", 2, 3, 0, OP_NOP, 0, f_root, "value a taken to the b'th root within accuracy c",
  268.     "round", 1, 2, 0, OP_NOP, 0, f_round, "round value a to b number of decimal places",
  269.     "rsearch", 2, 3, 0, OP_NOP, 0, f_rsearch, "reverse search matrix or list for value b starting at index c",
  270.     "runtime", 0, 0, 0, OP_NOP, f_runtime, 0, "user mode cpu time in seconds",
  271.     "scale", 2, 2, 0, OP_SCALE, 0, 0, "scale value up or down by a power of two",
  272.     "search", 2, 3, 0, OP_NOP, 0, f_search, "search matrix or list for value b starting at index c",
  273.     "sgn", 1, 1, 0, OP_SGN, qsign, 0, "sign of value (-1, 0, 1)",
  274.     "sin", 1, 2, 0, OP_NOP, 0, f_sin, "sine of value a within accuracy b",
  275.     "sinh", 1, 2, FE, OP_NOP, qsinh, 0, "hyperbolic sine of a within accuracy b",
  276.     "size", 1, 1, 0, OP_NOP, 0, f_size, "total number of elements in value",
  277.     "sqrt", 1, 2, 0, OP_NOP, 0, f_sqrt, "square root of value a within accuracy b",
  278.     "ssq", 1, IN, 0, OP_NOP, 0, f_ssq, "sum of squares of values",
  279.     "str", 1, 1, 0, OP_NOP, 0, f_str, "simple value converted to string",
  280.     "strcat", 1,IN, 0, OP_NOP, 0, f_strcat, "concatenate strings together",
  281.     "strlen", 1, 1, 0, OP_NOP, 0, f_strlen, "length of string",
  282.     "strprintf", 1, IN, 0, OP_NOP, 0, f_strprintf, "return formatted output as a string",
  283.     "substr", 3, 3, 0, OP_NOP, 0, f_substr, "substring of a from position b for c chars",
  284.     "swap", 2, 2, 0, OP_SWAP, 0, 0, "swap values of variables a and b (can be dangerous)",
  285.     "tan", 1, 2, FE, OP_NOP, qtan, 0, "tangent of a within accuracy b",
  286.     "tanh", 1, 2, FE, OP_NOP, qtanh, 0, "hyperbolic tangent of a within accuracy b",
  287.     "trunc", 1, 2, 0, OP_NOP, f_trunc, 0, "truncate a to b number of decimal places",
  288.     "xor", 1, IN, 0, OP_NOP, f_xor, 0, "logical xor",
  289.     NULL, 0, 0, 0, OP_NOP, 0, 0, NULL /* end of table */
  290. };
  291.  
  292.  
  293. /*
  294.  * Call a built-in function.
  295.  * Arguments to the function are on the stack, but are not removed here.
  296.  * Functions are either purely numeric, or else can take any value type.
  297.  */
  298. VALUE
  299. builtinfunc(index, argcount, stack)
  300.     long index;
  301.     VALUE *stack;        /* arguments on the stack */
  302. {
  303.     VALUE *sp;        /* pointer to stack entries */
  304.     VALUE **vpp;        /* pointer to current value address */
  305.     struct builtin *bp;    /* builtin function to be called */
  306.     long i;            /* index */
  307.     NUMBER *numargs[IN];    /* numeric arguments for function */
  308.     VALUE *valargs[IN];    /* addresses of actual arguments */
  309.     VALUE result;        /* general result of function */
  310.  
  311.     if ((unsigned long)index >= (sizeof(builtins) / sizeof(builtins[0])) - 1)
  312.         error("Bad built-in function index");
  313.     bp = &builtins[index];
  314.     if (argcount < bp->b_minargs)
  315.         error("Too few arguments for builtin function \"%s\"", bp->b_name);
  316.     if ((argcount > bp->b_maxargs) || (argcount > IN))
  317.         error("Too many arguments for builtin function \"%s\"", bp->b_name);
  318.     /*
  319.      * If an address was passed, then point at the real variable,
  320.      * otherwise point at the stack value itself (unless the function
  321.      * is very special).
  322.      */
  323.     sp = stack - argcount + 1;
  324.     vpp = valargs;
  325.     for (i = argcount; i > 0; i--) {
  326.         if ((sp->v_type != V_ADDR) || (bp->b_flags & FA))
  327.             *vpp = sp;
  328.         else
  329.             *vpp = sp->v_addr;
  330.         sp++;
  331.         vpp++;
  332.     }
  333.     /*
  334.      * Handle general values if the function accepts them.
  335.      */
  336.     if (bp->b_valfunc) {
  337.         vpp = valargs;
  338.         if ((bp->b_minargs == 1) && (bp->b_maxargs == 1))
  339.             result = (*bp->b_valfunc)(vpp[0]);
  340.         else if ((bp->b_minargs == 2) && (bp->b_maxargs == 2))
  341.             result = (*bp->b_valfunc)(vpp[0], vpp[1]);
  342.         else if ((bp->b_minargs == 3) && (bp->b_maxargs == 3))
  343.             result = (*bp->b_valfunc)(vpp[0], vpp[1], vpp[2]);
  344.         else
  345.             result = (*bp->b_valfunc)(argcount, vpp);
  346.         return result;
  347.     }
  348.     /*
  349.      * Function must be purely numeric, so handle that.
  350.      */
  351.     vpp = valargs;
  352.     for (i = 0; i < argcount; i++) {
  353.         if ((*vpp)->v_type != V_NUM)
  354.             error("Non-real argument for builtin function %s", bp->b_name);
  355.         numargs[i] = (*vpp)->v_num;
  356.         vpp++;
  357.     }
  358.     result.v_type = V_NUM;
  359.     if (!(bp->b_flags & FE) && (bp->b_minargs != bp->b_maxargs)) {
  360.         result.v_num = (*bp->b_numfunc)(argcount, numargs);
  361.         return result;
  362.     }
  363.     if ((bp->b_flags & FE) && (argcount < bp->b_maxargs))
  364.         numargs[argcount++] = _epsilon_;
  365.  
  366.     switch (argcount) {
  367.         case 0:
  368.             result.v_num = (*bp->b_numfunc)();
  369.             break;
  370.         case 1:
  371.             result.v_num = (*bp->b_numfunc)(numargs[0]);
  372.             break;
  373.         case 2:
  374.             result.v_num = (*bp->b_numfunc)(numargs[0], numargs[1]);
  375.             break;
  376.         case 3:
  377.             result.v_num = (*bp->b_numfunc)(numargs[0], numargs[1], numargs[2]);
  378.             break;
  379.         default:
  380.             error("Bad builtin function call");
  381.     }
  382.     return result;
  383. }
  384.  
  385.  
  386. static VALUE
  387. f_eval(vp)
  388.     VALUE *vp;
  389. {
  390.     FUNC    *oldfunc;
  391.     FUNC    *newfunc;
  392.     VALUE    result;
  393.  
  394.     if (vp->v_type != V_STR)
  395.         error("Evaluating non-string argument");
  396.     (void) openstring(vp->v_str);
  397.     oldfunc = curfunc;
  398.     if (evaluate(TRUE)) {
  399.         freevalue(stack--);
  400.         newfunc = curfunc;
  401.         curfunc = oldfunc;
  402.         result = newfunc->f_savedvalue;
  403.         newfunc->f_savedvalue.v_type = V_NULL;
  404.         if (newfunc != oldfunc)
  405.             free(newfunc);
  406.         return result;
  407.     }
  408.     newfunc = curfunc;
  409.     curfunc = oldfunc;
  410.     freevalue(&newfunc->f_savedvalue);
  411.     newfunc->f_savedvalue.v_type = V_NULL;
  412.     if (newfunc != oldfunc)
  413.         free(newfunc);
  414.     error("Evaluation error");
  415.     /*NOTREACHED*/
  416. }
  417.  
  418.  
  419. static VALUE
  420. f_prompt(vp)
  421.     VALUE *vp;
  422. {
  423.     VALUE result;
  424.     char *cp;
  425.     char *newcp;
  426.  
  427.     if (inputisterminal()) {
  428.         printvalue(vp, PRINT_SHORT);
  429.         math_flush();
  430.     }
  431.     cp = nextline();
  432.     if (cp == NULL)
  433.         error("End of file while prompting");
  434.     if (*cp == '\0') {
  435.         result.v_type = V_STR;
  436.         result.v_subtype = V_STRLITERAL;
  437.         result.v_str = "";
  438.         return result;
  439.     }
  440.     newcp = (char *)malloc(strlen(cp) + 1);
  441.     if (newcp == NULL)
  442.         error("Cannot allocate string");
  443.     strcpy(newcp, cp);
  444.     result.v_str = newcp;
  445.     result.v_type = V_STR;
  446.     result.v_subtype = V_STRALLOC;
  447.     return result;
  448. }
  449.  
  450.  
  451. static VALUE
  452. f_str(vp)
  453.     VALUE *vp;
  454. {
  455.     VALUE result;
  456.     char *cp;
  457.  
  458.     switch (vp->v_type) {
  459.         case V_STR:
  460.             copyvalue(vp, &result);
  461.             return result;
  462.         case V_NULL:
  463.             result.v_str = "";
  464.             result.v_type = V_STR;
  465.             result.v_subtype = V_STRLITERAL;
  466.             return result;
  467.         case V_NUM:
  468.             divertio();
  469.             qprintnum(vp->v_num, MODE_DEFAULT);
  470.             cp = getdivertedio();
  471.             break;
  472.         case V_COM:
  473.             divertio();
  474.             comprint(vp->v_com);
  475.             cp = getdivertedio();
  476.             break;
  477.         default:
  478.             error("Non-simple type for string conversion");
  479.     }
  480.     result.v_str = cp;
  481.     result.v_type = V_STR;
  482.     result.v_subtype = V_STRALLOC;
  483.     return result;
  484. }
  485.  
  486.  
  487. static VALUE
  488. f_poly(count, vals)
  489.     VALUE **vals;
  490. {
  491.     VALUE *x;
  492.     VALUE result, tmp;
  493.  
  494.     x = vals[--count];
  495.     copyvalue(*vals++, &result);
  496.     while (--count > 0) {
  497.         mulvalue(&result, x, &tmp);
  498.         freevalue(&result);
  499.         addvalue(*vals++, &tmp, &result);
  500.         freevalue(&tmp);
  501.     }
  502.     return result;
  503. }
  504.  
  505.  
  506. static NUMBER *
  507. f_mne(val1, val2, val3)
  508.     NUMBER *val1, *val2, *val3;
  509. {
  510.     return itoq((long) qcmpmod(val1, val2, val3));
  511. }
  512.  
  513.  
  514. static NUMBER *
  515. f_isrel(val1, val2)
  516.     NUMBER *val1, *val2;
  517. {
  518.     if (qisfrac(val1) || qisfrac(val2))
  519.         error("Non-integer for isrel");
  520.     return itoq((long) zrelprime(val1->num, val2->num));
  521. }
  522.  
  523.  
  524. static NUMBER *
  525. f_issquare(vp)
  526.     NUMBER *vp;
  527. {
  528.     return itoq((long) qissquare(vp));
  529. }
  530.  
  531.  
  532. static NUMBER *
  533. f_primetest(val1, val2)
  534.     NUMBER *val1, *val2;
  535. {
  536.     return itoq((long) qprimetest(val1, val2));
  537. }
  538.  
  539.  
  540. static NUMBER *
  541. f_isset(val1, val2)
  542.     NUMBER *val1, *val2;
  543. {
  544.     if (qisfrac(val2))
  545.         error("Non-integral bit position");
  546.     if (qiszero(val1) || (qisint(val1) && qisneg(val2)))
  547.         return qlink(&_qzero_);
  548.     if (isbig(val2->num)) {
  549.         if (qisneg(val2))
  550.             error("Very large bit position");
  551.         return qlink(&_qzero_);
  552.     }
  553.     return itoq((long) qisset(val1, qtoi(val2)));
  554. }
  555.  
  556.  
  557. static NUMBER *
  558. f_digit(val1, val2)
  559.     NUMBER *val1, *val2;
  560. {
  561.     if (qisfrac(val2))
  562.         error("Non-integral digit position");
  563.     if (qiszero(val1) || (qisint(val1) && qisneg(val2)))
  564.         return qlink(&_qzero_);
  565.     if (isbig(val2->num)) {
  566.         if (qisneg(val2))
  567.             error("Very large digit position");
  568.         return qlink(&_qzero_);
  569.     }
  570.     return itoq((long) qdigit(val1, qtoi(val2)));
  571. }
  572.  
  573.  
  574. static NUMBER *
  575. f_digits(val)
  576.     NUMBER *val;
  577. {
  578.     return itoq((long) qdigits(val));
  579. }
  580.  
  581.  
  582. static NUMBER *
  583. f_places(val)
  584.     NUMBER *val;
  585. {
  586.     return itoq((long) qplaces(val));
  587. }
  588.  
  589.  
  590. static NUMBER *
  591. f_xor(count, vals)
  592.     NUMBER **vals;
  593. {
  594.     NUMBER *val, *tmp;
  595.  
  596.     val = qlink(*vals);
  597.     while (--count > 0) {
  598.         tmp = qxor(val, *++vals);
  599.         qfree(val);
  600.         val = tmp;
  601.     }
  602.     return val;
  603. }
  604.  
  605.  
  606. static NUMBER *
  607. f_min(count, vals)
  608.     NUMBER **vals;
  609. {
  610.     NUMBER *val, *tmp;
  611.  
  612.     val = qlink(*vals);
  613.     while (--count > 0) {
  614.         tmp = qmin(val, *++vals);
  615.         qfree(val);
  616.         val = tmp;
  617.     }
  618.     return val;
  619. }
  620.  
  621.  
  622. static NUMBER *
  623. f_max(count, vals)
  624.     NUMBER **vals;
  625. {
  626.     NUMBER *val, *tmp;
  627.  
  628.     val = qlink(*vals);
  629.     while (--count > 0) {
  630.         tmp = qmax(val, *++vals);
  631.         qfree(val);
  632.         val = tmp;
  633.     }
  634.     return val;
  635. }
  636.  
  637.  
  638. static NUMBER *
  639. f_gcd(count, vals)
  640.     NUMBER **vals;
  641. {
  642.     NUMBER *val, *tmp;
  643.  
  644.     val = qlink(*vals);
  645.     while (--count > 0) {
  646.         tmp = qgcd(val, *++vals);
  647.         qfree(val);
  648.         val = tmp;
  649.         if (qisunit(val))
  650.             break;
  651.     }
  652.     return val;
  653. }
  654.  
  655.  
  656. static NUMBER *
  657. f_lcm(count, vals)
  658.     NUMBER **vals;
  659. {
  660.     NUMBER *val, *tmp;
  661.  
  662.     val = qlink(*vals);
  663.     while (--count > 0) {
  664.         tmp = qlcm(val, *++vals);
  665.         qfree(val);
  666.         val = tmp;
  667.     }
  668.     return val;
  669. }
  670.  
  671.  
  672. static VALUE
  673. f_avg(count, vals)
  674.     VALUE **vals;
  675. {
  676.     int i;
  677.     VALUE result;
  678.     VALUE tmp;
  679.     VALUE div;
  680.  
  681.     result.v_num = qlink(&_qzero_);
  682.     result.v_type = V_NUM;
  683.     for (i = count; i > 0; i--) {
  684.         addvalue(&result, *vals++, &tmp);
  685.         freevalue(&result);
  686.         result = tmp;
  687.     }
  688.     if (count <= 1)
  689.         return result;
  690.     div.v_num = itoq((long) count);
  691.     div.v_type = V_NUM;
  692.     divvalue(&result, &div, &tmp);
  693.     qfree(div.v_num);
  694.     return tmp;
  695. }
  696.  
  697.  
  698. static NUMBER *
  699. f_hmean(count, vals)
  700.     NUMBER **vals;
  701. {
  702.     NUMBER *val, *tmp, *tmp2;
  703.  
  704.     val = qinv(*vals);
  705.     while (--count > 0) {
  706.         tmp2 = qinv(*++vals);
  707.         tmp = qadd(val, tmp2);
  708.         qfree(tmp2);
  709.         qfree(val);
  710.         val = tmp;
  711.     }
  712.     tmp = qinv(val);
  713.     qfree(val);
  714.     return tmp;
  715. }
  716.  
  717.  
  718. static VALUE
  719. f_ssq(count, vals)
  720.     VALUE **vals;
  721. {
  722.     VALUE result, tmp1, tmp2;
  723.  
  724.     squarevalue(*vals++, &result);
  725.     while (--count > 0) {
  726.         squarevalue(*vals++, &tmp1);
  727.         addvalue(&tmp1, &result, &tmp2);
  728.         freevalue(&tmp1);
  729.         freevalue(&result);
  730.         result = tmp2;
  731.     }
  732.     return result;
  733. }
  734.  
  735.  
  736. static NUMBER *
  737. f_ismult(val1, val2)
  738.     NUMBER *val1, *val2;
  739. {
  740.     return itoq((long) qdivides(val1, val2));
  741. }
  742.  
  743.  
  744. static NUMBER *
  745. f_meq(val1, val2, val3)
  746.     NUMBER *val1, *val2, *val3;
  747. {
  748.     NUMBER *tmp, *res;
  749.  
  750.     tmp = qsub(val1, val2);
  751.     res = itoq((long) qdivides(tmp, val3));
  752.     qfree(tmp);
  753.     return res;
  754. }
  755.  
  756.  
  757. static VALUE
  758. f_exp(count, vals)
  759.     VALUE **vals;
  760. {
  761.     VALUE result;
  762.     NUMBER *err;
  763.  
  764.     err = _epsilon_;
  765.     if (count == 2) {
  766.         if (vals[1]->v_type != V_NUM)
  767.             error("Non-real epsilon value for exp");
  768.         err = vals[1]->v_num;
  769.     }
  770.     switch (vals[0]->v_type) {
  771.         case V_NUM:
  772.             result.v_num = qexp(vals[0]->v_num, err);
  773.             result.v_type = V_NUM;
  774.             break;
  775.         case V_COM:
  776.             result.v_com = cexp(vals[0]->v_com, err);
  777.             result.v_type = V_COM;
  778.             break;
  779.         default:
  780.             error("Bad argument type for exp");
  781.     }
  782.     return result;
  783. }
  784.  
  785.  
  786. static VALUE
  787. f_ln(count, vals)
  788.     VALUE **vals;
  789. {
  790.     VALUE result;
  791.     COMPLEX temp;
  792.     NUMBER *err;
  793.  
  794.     err = _epsilon_;
  795.     if (count == 2) {
  796.         if (vals[1]->v_type != V_NUM)
  797.             error("Non-real epsilon value for ln");
  798.         err = vals[1]->v_num;
  799.     }
  800.     switch (vals[0]->v_type) {
  801.         case V_NUM:
  802.             if (!qisneg(vals[0]->v_num) && !qiszero(vals[0]->v_num)) {
  803.                 result.v_num = qln(vals[0]->v_num, err);
  804.                 result.v_type = V_NUM;
  805.                 break;
  806.             }
  807.             temp.real = vals[0]->v_num;
  808.             temp.imag = &_qzero_;
  809.             result.v_com = cln(&temp, err);
  810.             result.v_type = V_COM;
  811.             break;
  812.         case V_COM:
  813.             result.v_com = cln(vals[0]->v_com, err);
  814.             result.v_type = V_COM;
  815.             break;
  816.         default:
  817.             error("Bad argument type for ln");
  818.     }
  819.     return result;
  820. }
  821.  
  822.  
  823. static VALUE
  824. f_cos(count, vals)
  825.     VALUE **vals;
  826. {
  827.     VALUE result;
  828.     COMPLEX *c;
  829.     NUMBER *err;
  830.  
  831.     err = _epsilon_;
  832.     if (count == 2) {
  833.         if (vals[1]->v_type != V_NUM)
  834.             error("Non-real epsilon value for cos");
  835.         err = vals[1]->v_num;
  836.     }
  837.     switch (vals[0]->v_type) {
  838.         case V_NUM:
  839.             result.v_num = qcos(vals[0]->v_num, err);
  840.             result.v_type = V_NUM;
  841.             break;
  842.         case V_COM:
  843.             c = ccos(vals[0]->v_com, err);
  844.             result.v_com = c;
  845.             result.v_type = V_COM;
  846.             if (cisreal(c)) {
  847.                 result.v_num = qlink(c->real);
  848.                 result.v_type = V_NUM;
  849.                 comfree(c);
  850.             }
  851.             break;
  852.         default:
  853.             error("Bad argument type for cos");
  854.     }
  855.     return result;
  856. }
  857.  
  858.  
  859. static VALUE
  860. f_sin(count, vals)
  861.     VALUE **vals;
  862. {
  863.     VALUE result;
  864.     COMPLEX *c;
  865.     NUMBER *err;
  866.  
  867.     err = _epsilon_;
  868.     if (count == 2) {
  869.         if (vals[1]->v_type != V_NUM)
  870.             error("Non-real epsilon value for sin");
  871.         err = vals[1]->v_num;
  872.     }
  873.     switch (vals[0]->v_type) {
  874.         case V_NUM:
  875.             result.v_num = qsin(vals[0]->v_num, err);
  876.             result.v_type = V_NUM;
  877.             break;
  878.         case V_COM:
  879.             c = csin(vals[0]->v_com, err);
  880.             result.v_com = c;
  881.             result.v_type = V_COM;
  882.             if (cisreal(c)) {
  883.                 result.v_num = qlink(c->real);
  884.                 result.v_type = V_NUM;
  885.                 comfree(c);
  886.             }
  887.             break;
  888.         default:
  889.             error("Bad argument type for sin");
  890.     }
  891.     return result;
  892. }
  893.  
  894.  
  895. static VALUE
  896. f_arg(count, vals)
  897.     VALUE **vals;
  898. {
  899.     VALUE result;
  900.     COMPLEX *c;
  901.     NUMBER *err;
  902.  
  903.     err = _epsilon_;
  904.     if (count == 2) {
  905.         if (vals[1]->v_type != V_NUM)
  906.             error("Non-real epsilon value for arg");
  907.         err = vals[1]->v_num;
  908.     }
  909.     result.v_type = V_NUM;
  910.     switch (vals[0]->v_type) {
  911.         case V_NUM:
  912.             if (qisneg(vals[0]->v_num))
  913.                 result.v_num = qpi(err);
  914.             else
  915.                 result.v_num = qlink(&_qzero_);
  916.             break;
  917.         case V_COM:
  918.             c = vals[0]->v_com;
  919.             if (ciszero(c))
  920.                 result.v_num = qlink(&_qzero_);
  921.             else
  922.                 result.v_num = qatan2(c->imag, c->real, err);
  923.             break;
  924.         default:
  925.             error("Bad argument type for arg");
  926.     }
  927.     return result;
  928. }
  929.  
  930.  
  931. static NUMBER *
  932. f_legtoleg(val1, val2)
  933.     NUMBER *val1, *val2;
  934. {
  935.     return qlegtoleg(val1, val2, FALSE);
  936. }
  937.  
  938.  
  939. static NUMBER *
  940. f_trunc(count, vals)
  941.     NUMBER **vals;
  942. {
  943.     NUMBER *val;
  944.  
  945.     val = &_qzero_;
  946.     if (count == 2)
  947.         val = vals[1];
  948.     return qtrunc(*vals, val);
  949. }
  950.  
  951.  
  952. static VALUE
  953. f_bround(count, vals)
  954.     VALUE **vals;
  955. {
  956.     VALUE *vp, tmp, res;
  957.  
  958.     if (count > 1)
  959.         vp = vals[1];
  960.     else {
  961.         tmp.v_type = V_INT;
  962.         tmp.v_num = 0;
  963.         vp = &tmp;
  964.     }
  965.     broundvalue(vals[0], vp, &res);
  966.     return res;
  967. }
  968.  
  969.  
  970. static VALUE
  971. f_round(count, vals)
  972.     VALUE **vals;
  973. {
  974.     VALUE *vp, tmp, res;
  975.  
  976.     if (count > 1)
  977.         vp = vals[1];
  978.     else {
  979.         tmp.v_type = V_INT;
  980.         tmp.v_num = 0;
  981.         vp = &tmp;
  982.     }
  983.     roundvalue(vals[0], vp, &res);
  984.     return res;
  985. }
  986.  
  987.  
  988. static NUMBER *
  989. f_btrunc(count, vals)
  990.     NUMBER **vals;
  991. {
  992.     NUMBER *val;
  993.  
  994.     val = &_qzero_;
  995.     if (count == 2)
  996.         val = vals[1];
  997.     return qbtrunc(*vals, val);
  998. }
  999.  
  1000.  
  1001. static NUMBER *
  1002. f_near(count, vals)
  1003.     NUMBER **vals;
  1004. {
  1005.     NUMBER *val;
  1006.  
  1007.     val = _epsilon_;
  1008.     if (count == 3)
  1009.         val = vals[2];
  1010.     return itoq((long) qnear(vals[0], vals[1], val));
  1011. }
  1012.  
  1013.  
  1014. static NUMBER *
  1015. f_cfsim(val)
  1016.     NUMBER *val;
  1017. {
  1018.     return qcfappr(val, NULL);
  1019. }
  1020.  
  1021.  
  1022. static NUMBER *
  1023. f_ceil(val)
  1024.     NUMBER *val;
  1025. {
  1026.     NUMBER *val2;
  1027.  
  1028.     if (qisint(val))
  1029.         return qlink(val);
  1030.     val2 = qint(val);
  1031.     if (qisneg(val2))
  1032.         return val2;
  1033.     val = qinc(val2);
  1034.     qfree(val2);
  1035.     return val;
  1036. }
  1037.  
  1038.  
  1039. static NUMBER *
  1040. f_floor(val)
  1041.     NUMBER *val;
  1042. {
  1043.     NUMBER *val2;
  1044.  
  1045.     if (qisint(val))
  1046.         return qlink(val);
  1047.     val2 = qint(val);
  1048.     if (!qisneg(val2))
  1049.         return val2;
  1050.     val = qdec(val2);
  1051.     qfree(val2);
  1052.     return val;
  1053. }
  1054.  
  1055.  
  1056. static NUMBER *
  1057. f_highbit(val)
  1058.     NUMBER *val;
  1059. {
  1060.     if (qiszero(val))
  1061.         error("Highbit of zero");
  1062.     if (qisfrac(val))
  1063.         error("Highbit of non-integer");
  1064.     return itoq(zhighbit(val->num));
  1065. }
  1066.  
  1067.  
  1068. static NUMBER *
  1069. f_lowbit(val)
  1070.     NUMBER *val;
  1071. {
  1072.     if (qiszero(val))
  1073.         error("Lowbit of zero");
  1074.     if (qisfrac(val))
  1075.         error("Lowbit of non-integer");
  1076.     return itoq(zlowbit(val->num));
  1077. }
  1078.  
  1079.  
  1080. static VALUE
  1081. f_sqrt(count, vals)
  1082.     VALUE **vals;
  1083. {
  1084.     VALUE *vp, err, result;
  1085.  
  1086.     if (count > 1)
  1087.         vp = vals[1];
  1088.     else {
  1089.         err.v_num = _epsilon_;
  1090.         err.v_type = V_NUM;
  1091.         vp = &err;
  1092.     }
  1093.     sqrtvalue(vals[0], vp, &result);
  1094.     return result;
  1095. }
  1096.  
  1097.  
  1098. static VALUE
  1099. f_root(count, vals)
  1100.     VALUE **vals;
  1101. {
  1102.     VALUE *vp, err, result;
  1103.  
  1104.     if (count > 2)
  1105.         vp = vals[3];
  1106.     else {
  1107.         err.v_num = _epsilon_;
  1108.         err.v_type = V_NUM;
  1109.         vp = &err;
  1110.     }
  1111.     rootvalue(vals[0], vals[1], vp, &result);
  1112.     return result;
  1113. }
  1114.  
  1115.  
  1116. static VALUE
  1117. f_power(count, vals)
  1118.     VALUE **vals;
  1119. {
  1120.     VALUE *vp, err, result;
  1121.  
  1122.     if (count > 2)
  1123.         vp = vals[2];
  1124.     else {
  1125.         err.v_num = _epsilon_;
  1126.         err.v_type = V_NUM;
  1127.         vp = &err;
  1128.     }
  1129.     powervalue(vals[0], vals[1], vp, &result);
  1130.     return result;
  1131. }
  1132.  
  1133.  
  1134. static VALUE
  1135. f_polar(count, vals)
  1136.     VALUE **vals;
  1137. {
  1138.     VALUE *vp, err, result;
  1139.     COMPLEX *c;
  1140.  
  1141.     if (count > 2)
  1142.         vp = vals[2];
  1143.     else {
  1144.         err.v_num = _epsilon_;
  1145.         err.v_type = V_NUM;
  1146.         vp = &err;
  1147.     }
  1148.     if ((vals[0]->v_type != V_NUM) || (vals[1]->v_type != V_NUM))
  1149.         error("Non-real argument for polar");
  1150.     if ((vp->v_type != V_NUM) || qisneg(vp->v_num) || qiszero(vp->v_num))
  1151.         error("Bad epsilon value for polar");
  1152.     c = cpolar(vals[0]->v_num, vals[1]->v_num, vp->v_num);
  1153.     result.v_com = c;
  1154.     result.v_type = V_COM;
  1155.     if (cisreal(c)) {
  1156.         result.v_num = qlink(c->real);
  1157.         result.v_type = V_NUM;
  1158.         comfree(c);
  1159.     }
  1160.     return result;
  1161. }
  1162.  
  1163.  
  1164. static NUMBER *
  1165. f_ilog(val1, val2)
  1166.     NUMBER *val1, *val2;
  1167. {
  1168.     return itoq(qilog(val1, val2));
  1169. }
  1170.  
  1171.  
  1172. static NUMBER *
  1173. f_ilog2(val)
  1174.     NUMBER *val;
  1175. {
  1176.     return itoq(qilog2(val));
  1177. }
  1178.  
  1179.  
  1180. static NUMBER *
  1181. f_ilog10(val)
  1182.     NUMBER *val;
  1183. {
  1184.     return itoq(qilog10(val));
  1185. }
  1186.  
  1187.  
  1188. static NUMBER *
  1189. f_faccnt(val1, val2)
  1190.     NUMBER *val1, *val2;
  1191. {
  1192.     return itoq(qdivcount(val1, val2));
  1193. }
  1194.  
  1195.  
  1196. static VALUE
  1197. f_matfill(count, vals)
  1198.     VALUE **vals;
  1199. {
  1200.     VALUE *v1, *v2, *v3;
  1201.     VALUE result;
  1202.  
  1203.     v1 = vals[0];
  1204.     v2 = vals[1];
  1205.     v3 = (count == 3) ? vals[2] : NULL;
  1206.     if (v1->v_type != V_ADDR)
  1207.         error("Non-variable argument for matfill");
  1208.     v1 = v1->v_addr;
  1209.     if (v1->v_type != V_MAT)
  1210.         error("Non-matrix for matfill");
  1211.     if (v2->v_type == V_ADDR)
  1212.         v2 = v2->v_addr;
  1213.     if (v3 && (v3->v_type == V_ADDR))
  1214.         v3 = v3->v_addr;
  1215.     matfill(v1->v_mat, v2, v3);
  1216.     result.v_type = V_NULL;
  1217.     return result;
  1218. }
  1219.  
  1220.  
  1221. static VALUE
  1222. f_mattrans(vp)
  1223.     VALUE *vp;
  1224. {
  1225.     VALUE result;
  1226.  
  1227.     if (vp->v_type != V_MAT)
  1228.         error("Non-matrix argument for mattrans");
  1229.     result.v_type = V_MAT;
  1230.     result.v_mat = mattrans(vp->v_mat);
  1231.     return result;
  1232. }
  1233.  
  1234.  
  1235. static VALUE
  1236. f_det(vp)
  1237.     VALUE *vp;
  1238. {
  1239.     if (vp->v_type != V_MAT)
  1240.         error("Non-matrix argument for det");
  1241.     return matdet(vp->v_mat);
  1242. }
  1243.  
  1244.  
  1245. static VALUE
  1246. f_matdim(vp)
  1247.     VALUE *vp;
  1248. {
  1249.     VALUE result;
  1250.  
  1251.     if (vp->v_type != V_MAT)
  1252.         error("Non-matrix argument for matdim");
  1253.     result.v_type = V_NUM;
  1254.     result.v_num = itoq((long) vp->v_mat->m_dim);
  1255.     return result;
  1256. }
  1257.  
  1258.  
  1259. static VALUE
  1260. f_matmin(v1, v2)
  1261.     VALUE *v1, *v2;
  1262. {
  1263.     VALUE result;
  1264.     NUMBER *q;
  1265.     long i;
  1266.  
  1267.     if ((v1->v_type != V_MAT) || (v2->v_type != V_NUM))
  1268.         error("Bad argument type for matmin");
  1269.     q = v2->v_num;
  1270.     i = qtoi(q);
  1271.     if (qisfrac(q) || qisneg(q) || (i <= 0) || (i > v1->v_mat->m_dim))
  1272.         error("Bad dimension value for matmin");
  1273.     result.v_type = V_NUM;
  1274.     result.v_num = itoq(v1->v_mat->m_min[i - 1]);
  1275.     return result;
  1276. }
  1277.  
  1278.  
  1279. static VALUE
  1280. f_matmax(v1, v2)
  1281.     VALUE *v1, *v2;
  1282. {
  1283.     VALUE result;
  1284.     NUMBER *q;
  1285.     long i;
  1286.  
  1287.     if ((v1->v_type != V_MAT) || (v2->v_type != V_NUM))
  1288.         error("Bad argument type for matmax");
  1289.     q = v2->v_num;
  1290.     i = qtoi(q);
  1291.     if (qisfrac(q) || qisneg(q) || (i <= 0) || (i > v1->v_mat->m_dim))
  1292.         error("Bad dimension value for matmax");
  1293.     result.v_type = V_NUM;
  1294.     result.v_num = itoq(v1->v_mat->m_max[i - 1]);
  1295.     return result;
  1296. }
  1297.  
  1298.  
  1299. static VALUE
  1300. f_cp(v1, v2)
  1301.     VALUE *v1, *v2;
  1302. {
  1303.     VALUE result;
  1304.  
  1305.     if ((v1->v_type != V_MAT) || (v2->v_type != V_MAT))
  1306.         error("Non-matrix argument for cross product");
  1307.     result.v_type = V_MAT;
  1308.     result.v_mat = matcross(v1->v_mat, v2->v_mat);
  1309.     return result;
  1310. }
  1311.  
  1312.  
  1313. static VALUE
  1314. f_dp(v1, v2)
  1315.     VALUE *v1, *v2;
  1316. {
  1317.     if ((v1->v_type != V_MAT) || (v2->v_type != V_MAT))
  1318.         error("Non-matrix argument for dot product");
  1319.     return matdot(v1->v_mat, v2->v_mat);
  1320. }
  1321.  
  1322.  
  1323. static VALUE
  1324. f_strlen(vp)
  1325.     VALUE *vp;
  1326. {
  1327.     VALUE result;
  1328.  
  1329.     if (vp->v_type != V_STR)
  1330.         error("Non-string argument for strlen");
  1331.     result.v_type = V_NUM;
  1332.     result.v_num = itoq((long) strlen(vp->v_str));
  1333.     return result;
  1334. }
  1335.  
  1336.  
  1337. static VALUE
  1338. f_strcat(count, vals)
  1339.     VALUE **vals;
  1340. {
  1341.     register VALUE **vp;
  1342.     register char *cp;
  1343.     int i;
  1344.     long len;
  1345.     long lengths[IN];
  1346.     VALUE result;
  1347.  
  1348.     len = 1;
  1349.     vp = vals;
  1350.     for (i = 0; i < count; i++) {
  1351.         if ((*vp)->v_type != V_STR)
  1352.             error("Non-string argument for strcat");
  1353.         lengths[i] = strlen((*vp)->v_str);
  1354.         len += lengths[i];
  1355.         vp++;
  1356.     }
  1357.     cp = (char *)malloc(len);
  1358.     if (cp == NULL)
  1359.         error("No memory for strcat");
  1360.     result.v_str = cp;
  1361.     result.v_type = V_STR;
  1362.     result.v_subtype = V_STRALLOC;
  1363.     i = 0;
  1364.     for (vp = vals; count-- > 0; vp++) {
  1365.         strcpy(cp, (*vp)->v_str);
  1366.         cp += lengths[i++];
  1367.     }
  1368.     return result;
  1369. }
  1370.  
  1371.  
  1372. static VALUE
  1373. f_substr(v1, v2, v3)
  1374.     VALUE *v1, *v2, *v3;
  1375. {
  1376.     NUMBER *q1, *q2;
  1377.     long i1, i2, len;
  1378.     char *cp;
  1379.     VALUE result;
  1380.  
  1381.     if (v1->v_type != V_STR)
  1382.         error("Non-string argument for substr");
  1383.     if ((v2->v_type != V_NUM) || (v3->v_type != V_NUM))
  1384.         error("Non-numeric positions for substr");
  1385.     q1 = v2->v_num;
  1386.     q2 = v3->v_num;
  1387.     if (qisfrac(q1) || qisneg(q1) || qisfrac(q2) || qisneg(q2))
  1388.         error("Illegal positions for substr");
  1389.     i1 = qtoi(q1);
  1390.     i2 = qtoi(q2);
  1391.     cp = v1->v_str;
  1392.     len = strlen(cp);
  1393.     result.v_type = V_STR;
  1394.     if (i1 > 0)
  1395.         i1--;
  1396.     if (i1 >= len) {    /* indexing off of end */
  1397.         result.v_subtype = V_STRLITERAL;
  1398.         result.v_str = "";
  1399.         return result;
  1400.     }
  1401.     cp += i1;
  1402.     len -= i1;
  1403.     if ((i2 >= len) && (v1->v_subtype == V_STRLITERAL)) {
  1404.         result.v_subtype = V_STRLITERAL;
  1405.         result.v_str = cp;
  1406.         return result;
  1407.     }
  1408.     if (len > i2)
  1409.         len = i2;
  1410.     if (len == 1) {
  1411.         result.v_subtype = V_STRLITERAL;
  1412.         result.v_str = charstr(*cp);
  1413.         return result;
  1414.     }
  1415.     result.v_subtype = V_STRALLOC;
  1416.     result.v_str = (char *)malloc(len + 1);
  1417.     if (result.v_str == NULL)
  1418.         error("No memory for substr");
  1419.     strncpy(result.v_str, cp, len);
  1420.     result.v_str[len] = '\0';
  1421.     return result;
  1422. }
  1423.  
  1424.  
  1425. static VALUE
  1426. f_char(vp)
  1427.     VALUE *vp;
  1428. {
  1429.     long num;
  1430.     NUMBER *q;
  1431.     VALUE result;
  1432.  
  1433.     if (vp->v_type != V_NUM)
  1434.         error("Non-numeric argument for char");
  1435.     q = vp->v_num;
  1436.     num = qtoi(q);
  1437.     if (qisneg(q) || qisfrac(q) || isbig(q->num) || (num > 255))
  1438.         error("Illegal number for char");
  1439.     result.v_type = V_STR;
  1440.     result.v_subtype = V_STRLITERAL;
  1441.     result.v_str = charstr((int) num);
  1442.     return result;
  1443. }
  1444.  
  1445.  
  1446. static VALUE
  1447. f_ord(vp)
  1448.     VALUE *vp;
  1449. {
  1450.     char *str;
  1451.     VALUE result;
  1452.  
  1453.     if (vp->v_type != V_STR)
  1454.         error("Non-string argument for ord");
  1455.     str = vp->v_str;
  1456.     if (str[0] && str[1])
  1457.         error("Multi-character string given for ord");
  1458.     result.v_type = V_NUM;
  1459.     result.v_num = itoq((long) (*str & 0xff));
  1460.     return result;
  1461. }
  1462.  
  1463.  
  1464. static VALUE
  1465. f_size(vp)
  1466.     VALUE *vp;
  1467. {
  1468.     long count;
  1469.     VALUE result;
  1470.  
  1471.     switch (vp->v_type) {
  1472.         case V_NULL:    count = 0; break;
  1473.         case V_MAT:    count = vp->v_mat->m_size; break;
  1474.         case V_LIST:    count = vp->v_list->l_count; break;
  1475.         case V_OBJ:    count = vp->v_obj->o_actions->count; break;
  1476.         default:    count = 1; break;
  1477.     }
  1478.     result.v_type = V_NUM;
  1479.     result.v_num = itoq(count);
  1480.     return result;
  1481. }
  1482.  
  1483.  
  1484. static VALUE
  1485. f_search(count, vals)
  1486.     VALUE **vals;
  1487. {
  1488.     VALUE *v1, *v2;
  1489.     NUMBER *q;
  1490.     long start;
  1491.     long index;
  1492.     VALUE result;
  1493.  
  1494.     v1 = *vals++;
  1495.     v2 = *vals++;
  1496.     start = 0;
  1497.     if (count == 3) {
  1498.         if ((*vals)->v_type != V_NUM)
  1499.             error("Non-numeric start index for search");
  1500.         q = (*vals)->v_num;
  1501.         if (qisfrac(q) || qisneg(q))
  1502.             error("Bad start index for search");
  1503.         start = qtoi(q);
  1504.     }
  1505.     switch (v1->v_type) {
  1506.         case V_MAT:
  1507.             index = matsearch(v1->v_mat, v2, start);
  1508.             break;
  1509.         case V_LIST:
  1510.             index = listsearch(v1->v_list, v2, start);
  1511.             break;
  1512.         default:
  1513.             error("Bad argument type for search");
  1514.     }
  1515.     result.v_type = V_NULL;
  1516.     if (index >= 0) {
  1517.         result.v_type = V_NUM;
  1518.         result.v_num = itoq(index);
  1519.     }
  1520.     return result;
  1521. }
  1522.  
  1523.  
  1524. static VALUE
  1525. f_rsearch(count, vals)
  1526.     VALUE **vals;
  1527. {
  1528.     VALUE *v1, *v2;
  1529.     NUMBER *q;
  1530.     long start;
  1531.     long index;
  1532.     VALUE result;
  1533.  
  1534.     v1 = *vals++;
  1535.     v2 = *vals++;
  1536.     start = MAXFULL;
  1537.     if (count == 3) {
  1538.         if ((*vals)->v_type != V_NUM)
  1539.             error("Non-numeric start index for rsearch");
  1540.         q = (*vals)->v_num;
  1541.         if (qisfrac(q) || qisneg(q))
  1542.             error("Bad start index for rsearch");
  1543.         start = qtoi(q);
  1544.     }
  1545.     switch (v1->v_type) {
  1546.         case V_MAT:
  1547.             index = matrsearch(v1->v_mat, v2, start);
  1548.             break;
  1549.         case V_LIST:
  1550.             index = listrsearch(v1->v_list, v2, start);
  1551.             break;
  1552.         default:
  1553.             error("Bad argument type for rsearch");
  1554.     }
  1555.     result.v_type = V_NULL;
  1556.     if (index >= 0) {
  1557.         result.v_type = V_NUM;
  1558.         result.v_num = itoq(index);
  1559.     }
  1560.     return result;
  1561. }
  1562.  
  1563.  
  1564. static VALUE
  1565. f_list(count, vals)
  1566.     VALUE **vals;
  1567. {
  1568.     VALUE result;
  1569.  
  1570.     result.v_type = V_LIST;
  1571.     result.v_list = listalloc();
  1572.     while (count-- > 0)
  1573.         insertlistlast(result.v_list, *vals++);
  1574.     return result;
  1575. }
  1576.  
  1577.  
  1578. static VALUE
  1579. f_listinsert(v1, v2, v3)
  1580.     VALUE *v1, *v2, *v3;
  1581. {
  1582.     VALUE result;
  1583.  
  1584.     if ((v1->v_type != V_ADDR) || (v1->v_addr->v_type != V_LIST))
  1585.         error("Inserting into non-list variable");
  1586.     if (v2->v_type == V_ADDR)
  1587.         v2 = v2->v_addr;
  1588.     if ((v2->v_type != V_NUM) || qisfrac(v2->v_num))
  1589.         error("Non-integral index for list insert");
  1590.     if (v3->v_type == V_ADDR)
  1591.         v3 = v3->v_addr;
  1592.     insertlistmiddle(v1->v_addr->v_list, qtoi(v2->v_num), v3);
  1593.     result.v_type = V_NULL;
  1594.     return result;
  1595. }
  1596.  
  1597.  
  1598. static VALUE
  1599. f_listpush(v1, v2)
  1600.     VALUE *v1, *v2;
  1601. {
  1602.     VALUE result;
  1603.  
  1604.     if ((v1->v_type != V_ADDR) || (v1->v_addr->v_type != V_LIST))
  1605.         error("Pushing onto non-list variable");
  1606.     if (v2->v_type == V_ADDR)
  1607.         v2 = v2->v_addr;
  1608.     insertlistfirst(v1->v_addr->v_list, v2);
  1609.     result.v_type = V_NULL;
  1610.     return result;
  1611. }
  1612.  
  1613.  
  1614. static VALUE
  1615. f_listappend(v1, v2)
  1616.     VALUE *v1, *v2;
  1617. {
  1618.     VALUE result;
  1619.  
  1620.     if ((v1->v_type != V_ADDR) || (v1->v_addr->v_type != V_LIST))
  1621.         error("Appending to non-list variable");
  1622.     if (v2->v_type == V_ADDR)
  1623.         v2 = v2->v_addr;
  1624.     insertlistlast(v1->v_addr->v_list, v2);
  1625.     result.v_type = V_NULL;
  1626.     return result;
  1627. }
  1628.  
  1629.  
  1630. static VALUE
  1631. f_listdelete(v1, v2)
  1632.     VALUE *v1, *v2;
  1633. {
  1634.     VALUE result;
  1635.  
  1636.     if ((v1->v_type != V_ADDR) || (v1->v_addr->v_type != V_LIST))
  1637.         error("Deleting from non-list variable");
  1638.     if (v2->v_type == V_ADDR)
  1639.         v2 = v2->v_addr;
  1640.     if ((v2->v_type != V_NUM) || qisfrac(v2->v_num))
  1641.         error("Non-integral index for list delete");
  1642.     removelistmiddle(v1->v_addr->v_list, qtoi(v2->v_num), &result);
  1643.     return result;
  1644. }
  1645.  
  1646.  
  1647. static VALUE
  1648. f_listpop(vp)
  1649.     VALUE *vp;
  1650. {
  1651.     VALUE result;
  1652.  
  1653.     if ((vp->v_type != V_ADDR) || (vp->v_addr->v_type != V_LIST))
  1654.         error("Popping from non-list variable");
  1655.     removelistfirst(vp->v_addr->v_list, &result);
  1656.     return result;
  1657. }
  1658.  
  1659.  
  1660. static VALUE
  1661. f_listremove(vp)
  1662.     VALUE *vp;
  1663. {
  1664.     VALUE result;
  1665.  
  1666.     if ((vp->v_type != V_ADDR) || (vp->v_addr->v_type != V_LIST))
  1667.         error("Removing from non-list variable");
  1668.     removelistlast(vp->v_addr->v_list, &result);
  1669.     return result;
  1670. }
  1671.  
  1672.  
  1673. /*
  1674.  * Return the current runtime of calc in seconds.
  1675.  * This is the user mode time only.
  1676.  */
  1677. static NUMBER *
  1678. f_runtime()
  1679. {
  1680.     struct tms buf;
  1681.  
  1682.     times(&buf);
  1683.     return iitoq((long) buf.tms_utime, (long) CLK_TCK);
  1684. }
  1685.  
  1686.  
  1687. static VALUE
  1688. f_fopen(v1, v2)
  1689.     VALUE *v1, *v2;
  1690. {
  1691.     VALUE result;
  1692.     FILEID id;
  1693.  
  1694.     if (v1->v_type != V_STR)
  1695.         error("Non-string filename for fopen");
  1696.     if (v2->v_type != V_STR)
  1697.         error("Non-string mode for fopen");
  1698.     id = openid(v1->v_str, v2->v_str);
  1699.     if (id == FILEID_NONE) {
  1700.         result.v_type = V_NUM;
  1701.         result.v_num = itoq((long) errno);
  1702.     } else {
  1703.         result.v_type = V_FILE;
  1704.         result.v_file = id;
  1705.     }
  1706.     return result;
  1707. }
  1708.  
  1709.  
  1710. static VALUE
  1711. f_fclose(vp)
  1712.     VALUE *vp;
  1713. {
  1714.     VALUE result;
  1715.  
  1716.     if (vp->v_type != V_FILE)
  1717.         error("Non-file for fclose");
  1718.     if (closeid(vp->v_file)) {
  1719.         result.v_type = V_NUM;
  1720.         result.v_num = itoq((long) errno);
  1721.     } else
  1722.         result.v_type = V_NULL;
  1723.     return result;
  1724. }
  1725.  
  1726.  
  1727. static VALUE
  1728. f_ferror(vp)
  1729.     VALUE *vp;
  1730. {
  1731.     VALUE result;
  1732.  
  1733.     if (vp->v_type != V_FILE)
  1734.         error("Non-file for ferror");
  1735.     result.v_type = V_NUM;
  1736.     result.v_num = itoq((long) errorid(vp->v_file));
  1737.     return result;
  1738. }
  1739.  
  1740.  
  1741. static VALUE
  1742. f_feof(vp)
  1743.     VALUE *vp;
  1744. {
  1745.     VALUE result;
  1746.  
  1747.     if (vp->v_type != V_FILE)
  1748.         error("Non-file for feof");
  1749.     result.v_type = V_NUM;
  1750.     result.v_num = itoq((long) eofid(vp->v_file));
  1751.     return result;
  1752. }
  1753.  
  1754.  
  1755. static VALUE
  1756. f_fflush(vp)
  1757.     VALUE *vp;
  1758. {
  1759.     VALUE result;
  1760.  
  1761.     if (vp->v_type != V_FILE)
  1762.         error("Non-file for fflush");
  1763.     flushid(vp->v_file);
  1764.     result.v_type = V_NULL;
  1765.     return result;
  1766. }
  1767.  
  1768.  
  1769. static VALUE
  1770. f_fprintf(count, vals)
  1771.     VALUE **vals;
  1772. {
  1773.     VALUE result;
  1774.  
  1775.     if (vals[0]->v_type != V_FILE)
  1776.         error("Non-file for fprintf");
  1777.     if (vals[1]->v_type != V_STR)
  1778.         error("Non-string format for fprintf");
  1779.     idprintf(vals[0]->v_file, vals[1]->v_str, count - 2, vals + 2);
  1780.     result.v_type = V_NULL;
  1781.     return result;
  1782. }
  1783.  
  1784.  
  1785. static VALUE
  1786. f_printf(count, vals)
  1787.     VALUE **vals;
  1788. {
  1789.     VALUE result;
  1790.  
  1791.     if (vals[0]->v_type != V_STR)
  1792.         error("Non-string format for printf");
  1793.     idprintf(FILEID_STDOUT, vals[0]->v_str, count - 1, vals + 1);
  1794.     result.v_type = V_NULL;
  1795.     return result;
  1796. }
  1797.  
  1798.  
  1799. static VALUE
  1800. f_strprintf(count, vals)
  1801.     VALUE **vals;
  1802. {
  1803.     VALUE result;
  1804.  
  1805.     if (vals[0]->v_type != V_STR)
  1806.         error("Non-string format for strprintf");
  1807.     divertio();
  1808.     idprintf(FILEID_STDOUT, vals[0]->v_str, count - 1, vals + 1);
  1809.     result.v_str = getdivertedio();
  1810.     result.v_type = V_STR;
  1811.     result.v_subtype = V_STRALLOC;
  1812.     return result;
  1813. }
  1814.  
  1815.  
  1816. static VALUE
  1817. f_fgetc(vp)
  1818.     VALUE *vp;
  1819. {
  1820.     VALUE result;
  1821.     int ch;
  1822.  
  1823.     if (vp->v_type != V_FILE)
  1824.         error("Non-file for fgetc");
  1825.     ch = getcharid(vp->v_file);
  1826.     result.v_type = V_NULL;
  1827.     if (ch != EOF) {
  1828.         result.v_type = V_STR;
  1829.         result.v_subtype = V_STRLITERAL;
  1830.         result.v_str = charstr(ch);
  1831.     }
  1832.     return result;
  1833. }
  1834.  
  1835.  
  1836. static VALUE
  1837. f_fgetline(vp)
  1838.     VALUE *vp;
  1839. {
  1840.     VALUE result;
  1841.     char *str;
  1842.  
  1843.     if (vp->v_type != V_FILE)
  1844.         error("Non-file for fgetline");
  1845.     readid(vp->v_file, &str);
  1846.     result.v_type = V_NULL;
  1847.     if (str) {
  1848.         result.v_type = V_STR;
  1849.         result.v_subtype = V_STRALLOC;
  1850.         result.v_str = str;
  1851.     }
  1852.     return result;
  1853. }
  1854.  
  1855.  
  1856. static VALUE
  1857. f_files(count, vals)
  1858.     VALUE **vals;
  1859. {
  1860.     VALUE result;
  1861.  
  1862.     if (count == 0) {
  1863.         result.v_type = V_NUM;
  1864.         result.v_num = itoq((long) MAXFILES);
  1865.         return result;
  1866.     }
  1867.     if ((vals[0]->v_type != V_NUM) || qisfrac(vals[0]->v_num))
  1868.         error("Non-integer for files");
  1869.     result.v_type = V_NULL;
  1870.     result.v_file = indexid(qtoi(vals[0]->v_num));
  1871.     if (result.v_file != FILEID_NONE)
  1872.         result.v_type = V_FILE;
  1873.     return result;
  1874. }
  1875.  
  1876.  
  1877. /*
  1878.  * Show the list of primitive built-in functions
  1879.  */
  1880. void
  1881. showbuiltins()
  1882. {
  1883.     register struct builtin *bp;    /* current function */
  1884.  
  1885.     printf("\nName\tArgs\tDescription\n\n");
  1886.     for (bp = builtins; bp->b_name; bp++) {
  1887.         printf("%-9s ", bp->b_name);
  1888.         if (bp->b_maxargs == IN)
  1889.             printf("%d+    ", bp->b_minargs);
  1890.         else if (bp->b_minargs == bp->b_maxargs)
  1891.             printf("%-6d", bp->b_minargs);
  1892.         else
  1893.             printf("%d-%-4d", bp->b_minargs, bp->b_maxargs);
  1894.         printf(" %s\n", bp->b_desc);
  1895.     }
  1896.     printf("\n");
  1897. }
  1898.  
  1899.  
  1900. /*
  1901.  * Return the index of a built-in function given its name.
  1902.  * Returns minus one if the name is not known.
  1903.  */
  1904. getbuiltinfunc(name)
  1905.     char *name;
  1906. {
  1907.     register struct builtin *bp;
  1908.  
  1909.     for (bp = builtins; bp->b_name; bp++) {
  1910.         if ((*name == *bp->b_name) && (strcmp(name, bp->b_name) == 0))
  1911.         return (bp - builtins);
  1912.     }
  1913.     return -1;
  1914. }
  1915.  
  1916.  
  1917. /*
  1918.  * Given the index of a built-in function, return its name.
  1919.  */
  1920. char *
  1921. builtinname(index)
  1922.     long index;
  1923. {
  1924.     if ((unsigned long)index >= (sizeof(builtins) / sizeof(builtins[0])) - 1)
  1925.         return "";
  1926.     return builtins[index].b_name;
  1927. }
  1928.  
  1929.  
  1930. /*
  1931.  * Given the index of a built-in function, and the number of arguments seen,
  1932.  * determine if the number of arguments are legal.  This routine is called
  1933.  * during parsing time.
  1934.  */
  1935. void
  1936. builtincheck(index, count)
  1937.     long index;
  1938. {
  1939.     register struct builtin *bp;
  1940.  
  1941.     if ((unsigned long)index >= (sizeof(builtins) / sizeof(builtins[0])) - 1)
  1942.         error("Unknown built in index");
  1943.     bp = &builtins[index];
  1944.     if (count < bp->b_minargs)
  1945.         scanerror(T_NULL, "Too few arguments for builtin function \"%s\"",
  1946.     bp->b_name);
  1947.     if (count > bp->b_maxargs)
  1948.         scanerror(T_NULL, "Too many arguments for builtin function \"%s\"",
  1949.             bp->b_name);
  1950. }
  1951.  
  1952.  
  1953. /*
  1954.  * Return the opcode for a built-in function that can be used to avoid
  1955.  * the function call at all.
  1956.  */
  1957. builtinopcode(index)
  1958.     long index;
  1959. {
  1960.     if ((unsigned long)index >= (sizeof(builtins) / sizeof(builtins[0])) - 1)
  1961.         return OP_NOP;
  1962.     return builtins[index].b_opcode;
  1963. }
  1964.  
  1965. /* END CODE */
  1966.