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