diff --git a/CHANGES b/CHANGES index a2fc4b6..b3310cc 100644 --- a/CHANGES +++ b/CHANGES @@ -1,4 +1,236 @@ -The following are the changes from calc version 2.11.2t0 to date: +The following are the changes from calc version 2.11.3t0 to date: + + A collection of 18 patches from Ernest Bowen + : + + (1) A new flag -f has been defined which has the effect of a read + command without the need to terminate the file name with a semicolon + or newline. Thus: + + calc "read alpha; read beta;" + + may be replaced by: + + calc -f alpha -f beta + + Quotations marks are recognized in a command like + + calc -f 'alpha beta' + + in which the name of the file to be read includes a space. + + (2) Flags are interpreted even if they are in a string, as in: + + calc "-q -i define f(x) = x^2;" + + which has the effect of: + + calc -q -i "define f(x) = x^2;" + + To achieve this, the use of getopts() in calc.c has been dropped in + favour of direct reading of the arguments produced by the shell. + In effect, until a "--" or "-s" or a calc command (recognized + by not starting with '-') is encountered, the quotation signs in + command lines like the above example are ignored. Dropping getopts() + permits calc to specify completely the syntax rules calc will apply + to whatever it is given by the shell being used. + + (3) For executable script (also called interpreter) files with first + line starting with "#!", the starting of options with -S has been + replaced by ending the options with -f. For example, the first line: + + #! full_pathname_for_calc -S -q -i + + is to be replaced by: + + #! full_pathname_for_calc -q -i -f + + Thus, if the pathname is /usr/bin/calc and myfile contains: + + #!/usr/bin/calc -q -i -f + global deg = pi()/180; + define Sin(x) = sin(x * deg); + + and has been made executable by: + + chmod u+x myfile + + myfile would be like a version of calc that ignored any startup + files and had an already defined global variable deg and a function + Sin(x) which will return an approximation to the sine of x degrees. + The invocation of myfile may be followed by other options (since + the first line in the script has only flagged options) and/or calc + commands as in: + + ./myfile -c read alpha '; define f(x) = Sin(x)^2' + + (The quotation marks avoid shell interpretation of the semicolon and + parentheses.) + + (4) The old -S syntax for executable scripts implied the -s flag so that + arguments in an invocation like + + ./myfile alpha beta + + are passed to calc; in this example argv(0) = 'alpha', argv(1) = + 'beta'. This has been changed in two ways: an explicit -s is required + in the first line of the script and then the arguments passed in the + above example are argv(0) = 'myfile', argv(1) = 'alpha', argv(1) = 'beta'. + + In an ordinary command line, "-s" indicates that the shell words + after the one in which "-s" occurred are to be passed as arguments + rather than commands or options. For example: + + calc "-q -s A = 27;" alpha beta + + invokes calc with the q-flag set, one command "A = 27;", and two arguments. + + (5) Piping to calc may be followed by calc becoming interactive. + This should occur if there is no -p flag but -i is specified, e.g.: + + cat beta | calc -i -f alpha + + which will do essentially the same as: + + calc -i -f alpha -f beta + + (6) The read and help commands have been changed so that several + files may be referred to in succession by separating their names + by whitespace. For example: + + > read alpha beta gamma; + + does essentially the same as: + + > read alpha; read beta; read gamma; + + This is convenient for commands like: + + calc read file?.cal + + when file?.cal expands to something like file1.cal file2.cal file3.cal: + + myfiles='alpha beta gamma' + calc read $myfiles + + or for C-shell users: + + set myfiles=(alpha beta gamma) + calc read $myfiles + + + (7) The -once option for read has been extended to -f. For example, + + calc -f -once alpha + + will ignore alpha if alpha has been read in the startup files. In a + multiple read statement, -once applies only to the next named file. + For example + + > read -once alpha beta -once gamma; + + will read alpha and gamma only if they have not already been read, + but in any case, will read beta. + + (8) A fault in the programming for the cd command has been corrected + so that specifying a directory by a string constant will work. E.g: + + > cd "my work" + + should work if the current directory has a directory with name "my work". + + (9) new functions bernoulli(n) and euler(n) have been defined to + return the Bernoulli number and the Euler number with index n. + After evaluation for an even positive n, this value and these for + smaller positive even n are stored in a table from which the values + can be reread when required. The memory used for the stored values + can be freed by calling the function freebernoulli() or freeeuler(). + + The function catalan(n) returns the catalan number with index n. + This is evaluated using essentially comb(2*n, n)/(n+1). + + (10) A function sleep(n) has been defined which for positive n calls + the system function sleep(n) if n is an integer, usleep(n) for other + real n. This suspends operation for n seconds and returns the null + value except when n is integral and the sleep is interrupted by a + SIGINT, in which case the remaining number of seconds is returned. + + (11) The effect of config("trace", 8) which displays opcodes of + functions as they are successfully defined has been restricted to + functions defioed with explicit use of "define". Thus, it has been + deactivated for the ephemeral functions used for evaluation of calc + command lines or eval() functions. + + (12) The functions digit(), digits(), places() have been extended to + admit an optional additional argument for an integral greater-than-one + base which defaults to 10. There is now no builtin limit on the + size of n in digit(x, n, b), for example, digit(1/7, -1e100) which + would not work before can now be handled. + + (13) The function, digits(x)m which returns the number of decimal + digits in the integer part of x has been changed so that if abs(x) < + 1, it returns 0 rather than 1. This also now applies to digits(x,b). + + (14) Some programming in value.c has been improved. In particular, + several occurrences of: + + vres->v_type = v1->v_type; + ... + if (v1->v_type < 0) { + copyvalue(v1, vres); + return; + } + + have been replaced by code that achieves exactly the same result: + + vres->v_type = v1->v_type; + ... + if (v1->v_type < 0) + return; + + (15) Some operations and functions involving null-valued arguments + have been changed so that they return null-value rather than "bad + argument-type" error-value. E.g. null() << 2 is now null-valued + rather than a "bad argument for <<" error-value. + + (16) "global" and "local" may now be used in expressions. For example: + + > for (local i = 0; i < 5; i++) print i^2; + + is now acceptable, as is: + + > define f(x = global x) = (global x = x)^2; + + which breaks wise programming rules and would probably better be handled + by something like: + + > global x + > define f(t = x) = (x = t)^2; + + Both definitions produce the same code for f. For non-null t, f(t) + returns t^2 and assigns the value of t to x; f() and f(t) with null t + return x^2. + + Within expressions, "global" and "local" are to be followed by just one + identifier. In "(global a = 2, b)" the comma is a comma-operator; the + global variable a is created if necessary and assigned the value 2, the + variable b has to already exist. The statement "global a = 2, b" is + a declaration of global variables and creates both a and b if they + don't already exist. + + (18) In a config object, several components have been changed from + long to LEN so that they will now be 32 bit integers for machines with + either 32 or 64-bit longs. In setting such components, the arguments + are now to less than 2^31. Before this change: + + > config("mul2", 2^32 + 3) + + would be accepted on a 64-bit machine but result in the same as: + + > config("mul2", 3) + + +The following are the changes from calc version 2.11.2t0 to 2.11.2t1.0: Fixed a bug whereby help files are not displayed correctly on systems such as NetBSD 1.4.1. Thanks to a fix from Jakob Naumann. @@ -4767,7 +4999,7 @@ Following is a list of visible changes to calc from version 1.24.7 to 1.26.1: ## 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. ## ## @(#) $Revision: 29.11 $ -## @(#) $Id: CHANGES,v 29.11 2000/06/07 15:51:35 chongo Exp $ +## @(#) $Id: CHANGES,v 29.11 2000/06/07 15:51:35 chongo Exp chongo $ ## @(#) $Source: /usr/local/src/cmd/calc/RCS/CHANGES,v $ ## ## Under source code control: 1993/06/02 18:12:57 diff --git a/addop.c b/addop.c index 639a863..131cde0 100644 --- a/addop.c +++ b/addop.c @@ -20,7 +20,7 @@ * 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. * * @(#) $Revision: 29.2 $ - * @(#) $Id: addop.c,v 29.2 2000/06/07 14:02:13 chongo Exp $ + * @(#) $Id: addop.c,v 29.2 2000/06/07 14:02:13 chongo Exp chongo $ * @(#) $Source: /usr/local/src/cmd/calc/RCS/addop.c,v $ * * Under source code control: 1990/02/15 01:48:10 @@ -208,7 +208,7 @@ endfunc(void) memcpy((char *) fp, (char *) curfunc, size); if (curfunc != functemplate) free(curfunc); - if (conf->traceflags & TRACE_FNCODES) { + if (newname[0] != '*' && (conf->traceflags & TRACE_FNCODES)) { dumpnames = TRUE; for (size = 0; size < fp->f_opcodecount; ) { printf("%ld: ", (long)size); @@ -318,7 +318,7 @@ freefunc(FUNC *fp) /*NOTREACHED*/ } } - if (conf->traceflags & TRACE_FNCODES) { + if (newname[0] != '*' && (conf->traceflags & TRACE_FNCODES)) { printf("Freeing function \"%s\"\n",namestr(&funcnames,index)); dumpnames = FALSE; for (i = 0; i < fp->f_opcodecount; ) { diff --git a/cal/regress.cal b/cal/regress.cal index 17441ea..d215f03 100644 --- a/cal/regress.cal +++ b/cal/regress.cal @@ -18,7 +18,7 @@ * 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. * * @(#) $Revision: 29.3 $ - * @(#) $Id: regress.cal,v 29.3 2000/06/07 14:02:25 chongo Exp $ + * @(#) $Id: regress.cal,v 29.3 2000/06/07 14:02:25 chongo Exp chongo $ * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/regress.cal,v $ * * Under source code control: 1990/02/15 01:50:36 @@ -755,7 +755,7 @@ define test_functions() vrfy(den(17) == 1, '712: den(17) == 1'); vrfy(den(3/7) == 7, '713: den(3/7) == 7'); vrfy(den(-2/3) == 3, '714: den(-2/3) == 3'); - vrfy(digits(0) == 1, '715: digits(0) == 1'); + vrfy(digits(0) == 0, '715: digits(0) == 0'); vrfy(digits(9) == 1, '716: digits(9) == 1'); vrfy(digits(10) == 2, '717: digits(10) == 2'); vrfy(digits(-691) == 3, '718: digits(-691) == 3'); @@ -1029,8 +1029,8 @@ define test_functions() vrfy(digit(a,-1) == 4, '974: digit(a,-1) == 4'); vrfy(digit(a,-2) == 2, '975: digit(a,-2) == 2'); vrfy(digit(a,-3) == 8, '976: digit(a,-3) == 8'); - vrfy(digits(0) == 1, '977: digits(0) == 1'); - vrfy(digits(0.0123) == 1, '978: digits(0.0123) == 1'); + vrfy(digits(0) == 0, '977: digits(0) == 0'); + vrfy(digits(0.0123) == 0, '978: digits(0.0123) == 0'); vrfy(digits(3.7) == 1, '979: digits(3.7) == 1'); vrfy(digits(-27) == 2, '980: digits(-27) == 2'); vrfy(digits(-99.7) == 2, '981: digits(-99.7) == 2'); @@ -2987,7 +2987,7 @@ define test_error() vrfy(root(3,2,0) == error(10029), '3644: root(3,2,0) == error(10029)'); vrfy(norm("x") == error(10030), '3645: norm("x") == error(10030)'); - vrfy(null() << 2 == error(10031),'3646: null() << 2 == error(10031)'); + vrfy(list() << 2 == error(10031),'3646: list() << 2 == error(10031)'); vrfy(1.5 << 2 == error(10031), '3647: 1.5 << 2 == error(10031)'); vrfy(3 << "x" == error(10032), '3648: 3 << "x" == error(10032)'); vrfy(3 << 1.5 == error(10032), '3649: 3 << 1.5 == error(10032)'); diff --git a/calc.c b/calc.c index 20369ef..e278a1f 100644 --- a/calc.c +++ b/calc.c @@ -20,7 +20,7 @@ * 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. * * @(#) $Revision: 29.4 $ - * @(#) $Id: calc.c,v 29.4 2000/06/07 14:02:13 chongo Exp $ + * @(#) $Id: calc.c,v 29.4 2000/06/07 14:02:13 chongo Exp chongo $ * @(#) $Source: /usr/local/src/cmd/calc/RCS/calc.c,v $ * * Under source code control: 1990/02/15 01:48:11 @@ -70,8 +70,8 @@ * static definitions and functions */ static void intint(int arg); /* interrupt routine */ -static int script_args(int argc,char ***argv,char **shellfile,char **program); - +static int nextcp(char **cpp, int *ip, int argc, char **argv, BOOL haveendstr); +static void set_run_state(run state); /* * Top level calculator routine. @@ -81,187 +81,377 @@ main(int argc, char **argv) { int want_defhelp = 0; /* 1=> we only want the default help */ int cmdlen; /* length of the command string */ - char *shellfile = NULL; /* != NULL ==> name of calc shell script */ - extern char *optarg; /* option argument */ - extern int optind; /* option index */ + int newcmdlen; int c; /* option */ - char *p; - long i; + int index; + int maxindex; + char *cp; + char *endcp; + char *bp; + BOOL done = FALSE; + BOOL havearg; + BOOL haveendstr; + int len; /* * parse args */ program = argv[0]; - /* catch the case of a leading -S option */ - if (argc > 2 && strncmp(argv[1], "-S", 2) == 0) { - /* convert the calc shell options into command line options */ - argc = script_args(argc, &argv, &shellfile, &program); - /* -S implies -s */ - s_flag = TRUE; - } - /* process command line options */ - while ((c = getopt(argc, argv, "Cehim:npquvcdD:s")) != -1) { - switch (c) { - case 'C': -#if defined(CUSTOM) - allow_custom = TRUE; - break; -#else /* CUSTOM */ - /* - * we are too early in processing to call - * libcalc_call_me_last() - nothing to cleanup - */ - fprintf(stderr, - "%s: calc was built with custom functions " - "disabled, -C usage is disallowed\n", program); - exit(1); -#endif /* CUSTOM */ - case 'e': - no_env = TRUE; - break; - case 'h': - want_defhelp = 1; - break; - case 'i': - i_flag = TRUE; - break; - case 'm': - if (optarg[1] != '\0' || *optarg<'0' || *optarg>'7') { - /* - * we are too early in processing to - * call libcalc_call_me_last() - * nothing to cleanup - */ - fprintf(stderr, - "%s: unknown -m arg\n", program); - exit(1); - } - allow_read = (((*optarg-'0') & 04) > 0); - allow_write = (((*optarg-'0') & 02) > 0); - allow_exec = (((*optarg-'0') & 01) > 0); - break; - case 'n': - new_std = TRUE; - break; - case 'p': - p_flag = TRUE; - break; - case 'q': - q_flag = TRUE; - break; - case 'u': - u_flag = TRUE; - break; - case 'c': - c_flag = TRUE; - break; - case 'd': - d_flag = TRUE; - break; - case 'v': - /* - * we are too early in processing to call - * libcalc_call_me_last() - nothing to cleanup - */ - printf("%s (version %s)\n", CALC_TITLE, version()); - exit(0); - case 'D': - /* - * parse the -D optarg - * - * Could be calc_debug - * or calc_debug:resource_debug - * or calc_debug:resource_debug:user_debug - */ - calc_debug = optarg; - p = strchr(optarg, ':'); - if (p != NULL) { - *p = '\0'; - resource_debug = p+1; - p = strchr(resource_debug, ':'); - if (p != NULL) { - *p = '\0'; - user_debug = p+1; - } - } - break; - case 's': - s_flag = TRUE; - break; - case 'S': - /*FALLTHRU*/ - default: - /* - * we are too early in processing to call - * libcalc_call_me_last() - nothing to cleanup - */ - fprintf(stderr, - "usage: %s [-c] [-C] [-d] [-e] [-h] [-i] [-m mode]\n" - "\t[-D calc_debug[:resource_debug[:user_debug]]]\n" - "\t[-n] [-p] [-q] [-s] [-u] [-v] " - "[[--] calc_cmd ...]\n", - program); - exit(1); - } - } - /* - * If -S was given via a calc shell script, imply -p and -d - * unless -i was also given. - */ - if (shellfile != NULL && !i_flag) { - p_flag = TRUE; - d_flag = TRUE; - } - - /* - * look at the length of any trailing command args - * - * We make room for the trailing '\0\n' as well as an extra guard byte. - * - * However, if -S is in effect, we will pretend that we have no - * command args and allow the argv() builtin access to the strings. - */ cmdbuf[0] = '\0'; - if (s_flag) { - havecommands = FALSE; - argc_value = argc - optind; - argv_value = argv + optind; - } else { - havecommands = (optind < argc); - for (cmdlen=0, i=optind; i < argc; ++i) { - /* argument + space separator */ - cmdlen += strlen(argv[i]) + 1; + cmdlen = 0; + + /* process command line options */ + + index = 1; + cp = endcp = NULL; + maxindex = argc; + havecommands = FALSE; + while (index < maxindex && !done) { + cp = argv[index]; + if (*cp == '\0') { + index++; + continue; } - if (cmdlen > MAXCMD) { - /* - * we are too early in processing to call - * libcalc_call_me_last() - nothing to cleanup - */ + for (;;) { + havearg = FALSE; + if (*cp != '-') { + done = TRUE; + break; + } + ++cp; + if (*cp == '-') { + cp++; + while (*cp == ' ') + ++cp; + done = TRUE; + break; + } + + for (;;) { + c = *cp; + if (c == '\0' || c == ' ') + break; + switch (c) { + case 'C': +#if defined(CUSTOM) + allow_custom = TRUE; + break; +#else /* CUSTOM */ + /* + * we are too early in processing to + * call libcalc_call_me_last() - + * nothing to cleanup + */ + fprintf(stderr, + "%s: calc was built with custom" + " functions disabled, -C usage is" + " disallowed\n", program); + exit(1); +#endif /* CUSTOM */ + case 'e': + no_env = TRUE; + break; + case 'h': + want_defhelp = 1; + break; + case 'i': + i_flag = TRUE; + break; + case 'm': + cp++; + while (*cp == ' ' || *cp == '\t') + cp++; + if (*cp == '\0') { + index++; + if (index >= argc) { + fprintf(stderr, + "-m expects" + " argument"); + exit (1); + } + cp = argv[index]; + } + + if (*cp < '0' || *cp > '7') { + /* + * we are too early in + * processing to call + * libcalc_call_me_last() + * nothing to cleanup + */ + fprintf(stderr, + "%s: unknown -m arg\n", + program); + exit(1); + } + allow_read = (((*cp-'0') & 04) > 0); + allow_write = (((*cp-'0') & 02) > 0); + allow_exec = (((*cp-'0') & 01) > 0); + cp++; + if (*cp != ' ' && *cp != '\0') { + fprintf(stderr, "??? m-arg"); + exit(1); + } + havearg = TRUE; + break; + case 'n': + new_std = TRUE; + break; + case 'p': + p_flag = TRUE; + break; + case 'q': + q_flag = TRUE; + break; + case 'u': + u_flag = TRUE; + break; + case 'c': + c_flag = TRUE; + break; + case 'd': + d_flag = TRUE; + break; + case 'v': + /* + * we are too early in processing to + * call libcalc_call_me_last() - + * nothing to cleanup + */ + printf("%s (version %s)\n", + CALC_TITLE, version()); + exit(0); + case 'D': + /* + * parse the -D arg + * + * Could be: + * + * calc_debug + * calc_debug:resource_debug + * calc_debug:resource_debug:user_debug + */ + if (nextcp(&cp, &index, argc, argv, + FALSE)) { + fprintf(stderr, + "-D expects argument\n"); + exit (1); + } + havearg = TRUE; + if (*cp != ':') { + if (*cp < '0' || *cp > '9') { + fprintf(stderr, + "-D expects" + " integer\n"); + exit (1); + } + calc_debug = cp; + (void) strtol(cp, &endcp, 10); + cp = endcp; + if (*cp != '\0' && + *cp != ' ' && *cp != ':') { + fprintf(stderr, + "Bad syntax im -D" + " arg\n"); + exit (1); + } + if (*cp != ':') { + if (nextcp(&cp, &index, + argc, argv, + FALSE) + || *cp != ':') + break; + } + } + if (nextcp(&cp, &index, argc, argv, + FALSE)) { + fprintf(stderr, + "-D : expects" + " argument\n"); + exit (1); + } + if (*cp != ':') { + if (*cp < '0' || *cp > '9') { + fprintf(stderr, + "-D : expects" + " integer\n"); + exit (1); + } + resource_debug = cp; + (void) strtol(cp, &endcp, 10); + cp = endcp; + if (*cp != '\0' && + *cp != ' ' && *cp != ':') { + fprintf(stderr, + "Bad syntax im -D" + " : arg\n"); + exit (1); + } + if (*cp != ':') { + if (nextcp(&cp, &index, + argc, argv, + FALSE) + || *cp != ':') { + break; + } + } + } + if (nextcp(&cp, &index, argc, argv, + FALSE)) { + fprintf(stderr, "-D : : expects" + " argument\n"); + exit (1); + } + if (*cp < '0' || *cp > '9') { + fprintf(stderr, "-D :: expects" + " integer\n"); + exit (1); + } + user_debug = cp; + (void) strtol(cp, &endcp, 10); + cp = endcp; + if (*cp != '\0' && *cp != ' ') { + fprintf(stderr, "Bad syntax in" + " -D : : arg\n"); + exit (1); + } + break; + case 'f': + haveendstr = (cp[1] == '\0'); + if (nextcp(&cp, &index, argc, argv, + haveendstr)) { + fprintf(stderr, "-f expects" + " filename\n"); + exit (1); + } + if (*cp == ';') { + fprintf(stderr, + "-f expects" + " filename\n"); + exit (1); + } + havearg = TRUE; + if (cmdlen > 0) + cmdbuf[cmdlen++] = ' '; + strcpy(cmdbuf + cmdlen, "read "); + cmdlen += 5; + if (strncmp(cp, "-once", 5) == 0 && + (cp[5] == '\0' || cp[5] == ' ')) { + cp += 5; + haveendstr = (*cp == '\0'); + strcpy(cmdbuf+cmdlen, "-once "); + cmdlen += 6; + if (nextcp(&cp, &index, argc, + argv, haveendstr)) { + fprintf(stderr, "-f -once" + " expects" + " filename\n"); + exit (1); + } + } + bp = cmdbuf + cmdlen; + if (haveendstr) { + len = strlen(cp); + if (len == 0) { + fprintf(stderr, + "Null" + " filename!"); + exit (1); + } + if (cmdlen + len + 2 > MAXCMD) { + fprintf(stderr, + "Commands too" + " long"); + exit (1); + } + /* XXX What if *cp = '\''? */ + *bp++ = '\''; + strcpy(bp, cp); + bp += len; + *bp++ = '\''; + cp += len; + cmdlen += len + 2; + } else { + do { + if (cmdlen > MAXCMD) { + fprintf(stderr, + "Commands" + " too long"); + exit (1); + } + *bp++ = *cp++; + cmdlen++; + } while (*cp != '\0' && + *cp != ';' && + *cp != ' '); + } + if (*cp == ';') + cp++; + *bp++ = ';'; + cmdlen++; + break; + + case 's': + s_flag = TRUE; + maxindex = index + 1; + break; + default: + /* + * we are too early in processing to + * call libcalc_call_me_last() - + * nothing to cleanup + */ + fprintf(stderr, "Illegal option -%c\n", + c); + fprintf(stderr, + "usage: %s [-a] [-c] [-C] [-d] [-e] [-h] [-i] [-m mode]\n" + "\t[-D calc_debug[:resource_debug[:user_debug]]]\n" + "\t[-n] [-p] [-q] [-u] [-v] " + "[--] [calc_cmd ...]\n", + program); + exit(1); + } + if (havearg) + break; + cp++; + } + while (*cp == ' ') + cp++; + if (*cp == '\0') { + index++; + break; + } + } + } + + while (index < maxindex) { + if (cmdlen > 0) + cmdbuf[cmdlen++] = ' '; + newcmdlen = cmdlen + strlen(cp); + if (newcmdlen > MAXCMD) { fprintf(stderr, - "%s: command in arg list is too long\n", + "%s: commands too long\n", program); exit(1); } - - /* - * Form a command the remaining args separated by spaces. - */ - if (optind < argc) { - strcpy(cmdbuf, argv[optind]); - cmdlen = strlen(argv[optind]); - for (i=optind+1; i < argc; ++i) { - cmdbuf[cmdlen++] = ' '; - strcpy(cmdbuf+cmdlen, argv[i]); - cmdlen += strlen(argv[i]); - } - cmdbuf[cmdlen++] = '\n'; - cmdbuf[cmdlen] = '\0'; - } - argc_value = 0; - argv_value = argv+argc; + strcpy(cmdbuf + cmdlen, cp); + cmdlen = newcmdlen; + index++; + if (index < maxindex) + cp = argv[index]; } + havecommands = (cmdlen > 0); + + if (havecommands) { + cmdbuf[cmdlen++] = '\n'; + cmdbuf[cmdlen] = '\0'; + } + + argc_value = argc - maxindex; + argv_value = argv + maxindex; + /* * unbuffered mode */ @@ -270,6 +460,7 @@ main(int argc, char **argv) setbuf(stdout, NULL); } + /* * initialize */ @@ -295,18 +486,18 @@ main(int argc, char **argv) "Type \"exit\" to exit, or \"help\" for help."); } switch (hist_init(calcbindings)) { - case HIST_NOFILE: - fprintf(stderr, - "%s: Cannot open bindings file \"%s\", " - "fancy editing disabled.\n", - program, calcbindings); - break; + case HIST_NOFILE: + fprintf(stderr, + "%s: Cannot open bindings file \"%s\", " + "fancy editing disabled.\n", + program, calcbindings); + break; - case HIST_NOTTY: - fprintf(stderr, - "%s: Cannot set terminal modes, " - "fancy editing disabled\n", program); - break; + case HIST_NOTTY: + fprintf(stderr, + "%s: Cannot set terminal modes, " + "fancy editing disabled\n", program); + break; } } @@ -333,18 +524,10 @@ main(int argc, char **argv) */ if (run_state == RUN_BEGIN) { if (!q_flag && allow_read) { - if (conf->calc_debug & CALCDBG_RUNSTATE) - printf("main: run_state from %s to %s\n", - run_state_name(run_state), - run_state_name(RUN_RCFILES)); - run_state = RUN_RCFILES; + set_run_state(RUN_RCFILES); runrcfiles(); } - if (conf->calc_debug & CALCDBG_RUNSTATE) - printf("main: run_state from %s to %s\n", - run_state_name(run_state), - run_state_name(RUN_PRE_CMD_ARGS)); - run_state = RUN_PRE_CMD_ARGS; + set_run_state(RUN_PRE_CMD_ARGS); } while (run_state == RUN_RCFILES) { @@ -354,55 +537,27 @@ main(int argc, char **argv) if (inputlevel() == 0) { closeinput(); runrcfiles(); - if (conf->calc_debug & CALCDBG_RUNSTATE) - printf("main: run_state from %s to %s\n", - run_state_name(run_state), - run_state_name(RUN_PRE_CMD_ARGS)); - run_state = RUN_PRE_CMD_ARGS; + set_run_state(RUN_PRE_CMD_ARGS); } else { closeinput(); } } else { if ((havecommands && !i_flag) || !stdin_tty) { - if (conf->calc_debug & CALCDBG_RUNSTATE) - printf("main: run_state from %s to %s\n", - run_state_name(run_state), - run_state_name(RUN_EXIT_WITH_ERROR)); - run_state = RUN_EXIT_WITH_ERROR; + set_run_state(RUN_EXIT_WITH_ERROR); } else { - if (conf->calc_debug & CALCDBG_RUNSTATE) - printf("main: run_state from %s to %s\n", - run_state_name(run_state), - run_state_name(RUN_PRE_CMD_ARGS)); - run_state = RUN_PRE_CMD_ARGS; + set_run_state(RUN_PRE_CMD_ARGS); } } } if (run_state == RUN_PRE_CMD_ARGS) { if (havecommands) { - if (conf->calc_debug & CALCDBG_RUNSTATE) - printf("main: run_state from %s to %s\n", - run_state_name(run_state), - run_state_name(RUN_CMD_ARGS)); - run_state = RUN_CMD_ARGS; + set_run_state(RUN_CMD_ARGS); (void) openstring(cmdbuf, (long) strlen(cmdbuf)); getcommands(FALSE); closeinput(); - } else if (shellfile != NULL) { - /* XXX - shellfile stuff needs it own run_state name */ - if (conf->calc_debug & CALCDBG_RUNSTATE) - printf("main: run_state from %s to %s\n", - run_state_name(run_state), - run_state_name(RUN_CMD_ARGS)); - run_state = RUN_CMD_ARGS; - getshellfile(shellfile); } - if (conf->calc_debug & CALCDBG_RUNSTATE) - printf("main: run_state from %s to %s\n", - run_state_name(run_state), - run_state_name(RUN_PRE_TOP_LEVEL)); - run_state = RUN_PRE_TOP_LEVEL; + set_run_state(RUN_PRE_TOP_LEVEL); } while (run_state == RUN_CMD_ARGS) { @@ -410,38 +565,22 @@ main(int argc, char **argv) if ((c_flag && !stoponerror) || stoponerror < 0) { getcommands(FALSE); if (inputlevel() == 0) - if (conf->calc_debug & CALCDBG_RUNSTATE) - printf("main: run_state from %s to %s\n", - run_state_name(run_state), - run_state_name(RUN_PRE_TOP_LEVEL)); - run_state = RUN_PRE_TOP_LEVEL; + set_run_state(RUN_PRE_TOP_LEVEL); closeinput(); } else { closeinput(); if (!stdin_tty || !i_flag || p_flag) { - if (conf->calc_debug & CALCDBG_RUNSTATE) - printf("main: run_state from %s to %s\n", - run_state_name(run_state), - run_state_name(RUN_EXIT_WITH_ERROR)); - run_state = RUN_EXIT_WITH_ERROR; + set_run_state(RUN_EXIT_WITH_ERROR); } else { - if (conf->calc_debug & CALCDBG_RUNSTATE) - printf("main: run_state from %s to %s\n", - run_state_name(run_state), - run_state_name(RUN_PRE_TOP_LEVEL)); - run_state = RUN_PRE_TOP_LEVEL; + set_run_state(RUN_PRE_TOP_LEVEL); } } } if (run_state == RUN_PRE_TOP_LEVEL) { if (stdin_tty && - (((havecommands || shellfile) && !i_flag) || p_flag)) { - if (conf->calc_debug & CALCDBG_RUNSTATE) - printf("main: run_state from %s to %s\n", - run_state_name(run_state), - run_state_name(RUN_EXIT)); - run_state = RUN_EXIT; + (((havecommands) && !i_flag) || p_flag)) { + set_run_state(RUN_EXIT); } else { if (stdin_tty) { reinitialize(); @@ -449,40 +588,71 @@ main(int argc, char **argv) resetinput(); openterminal(); } - if (conf->calc_debug & CALCDBG_RUNSTATE) - printf("main: run_state from %s to %s\n", - run_state_name(run_state), - run_state_name(RUN_TOP_LEVEL)); - run_state = RUN_TOP_LEVEL; + set_run_state(RUN_TOP_LEVEL); getcommands(TRUE); } + if (p_flag || (!i_flag && havecommands)) + set_run_state(RUN_EXIT); } while (run_state == RUN_TOP_LEVEL) { + if (conf->calc_debug & CALCDBG_RUNSTATE) + printf("main: run_state = TOP_LEVEL\n"); if ((c_flag && !stoponerror) || stoponerror < 0) { getcommands(TRUE); - if (!inputisterminal()) + if (!inputisterminal()) { closeinput(); + continue; + } + if (!p_flag && i_flag && !stdin_tty) { + closeinput(); + if(!freopen("/dev/tty", "r", stdin)) { + fprintf(stderr, + "Unable to associate stdin" + " with /dev/tty"); + set_run_state(RUN_EXIT_WITH_ERROR); + break; + } + + stdin_tty = TRUE; + if (conf->calc_debug & CALCDBG_TTY) + printf("main: stdin_tty is %d\n", + stdin_tty); + reinitialize(); + } } else { if (stdin_tty) { reinitialize(); getcommands(TRUE); + } else if (inputisterminal() && + !p_flag && (!havecommands||i_flag)) { + closeinput(); + if(!freopen("/dev/tty", "r", stdin)) { + fprintf(stderr, + "Unable to associate stdin" + " with /dev/tty"); + set_run_state(RUN_EXIT_WITH_ERROR); + break; + } + stdin_tty = TRUE; + if (conf->calc_debug & CALCDBG_TTY) + printf("main: stdin_tty is %d\n", + stdin_tty); + reinitialize(); } else { - if (conf->calc_debug & CALCDBG_RUNSTATE) - printf("main: run_state from %s to %s\n", - run_state_name(run_state), - run_state_name(RUN_EXIT_WITH_ERROR)); - run_state = RUN_EXIT_WITH_ERROR; + set_run_state(RUN_EXIT_WITH_ERROR); } } } + if (conf->calc_debug & CALCDBG_RUNSTATE) + printf("main: run_state = %s\n", run_state_name(run_state)); /* * all done */ libcalc_call_me_last(); return (run_state == RUN_EXIT_WITH_ERROR || - run_state == RUN_UNKNOWN) ? 1 : 0; + run_state == RUN_ZERO) ? 1 : 0; } @@ -540,183 +710,52 @@ math_error(char *fmt, ...) } } - -/* - * script_args - concert shell script options into command line form - * - * When a calc shell script is executed, the args are presented to calc - * in a different form. Consider the a calc shell script called /tmp/calcit: - * - * #!/usr/local/bin/calc -S -q -p - * a=eval(prompt("Enter a: ")); - * b=eval(prompt("Enter b: ")); - * print a+b; - * - * When it is executed as: - * - * /tmp/calcit -D 31 - * - * then calc will receive the following as args to main(): - * - * argc: 5 - * argv[0]: "/usr/local/bin/calc" - * argv[1]: "-S -q -p -e" - * argv[2]: "/tmp/calcit" - * argv[3]: "-D" - * argv[4]: "31" - * argv[5]: NULL - * - * NOTE: The user MUST put -S as the first characters on the calc shell - * script #! line, right after the calc binary path. - * - * NOTE: The arg supplied on the #! calc shell script line are returned - * as a single string. All tabs are converted into spaces. - * - * We must remember the calc script filename, break apart the #! args - * and remove the -S argument. In the above case we would return: - * - * argc: 6 - * argv[0]: "/usr/local/bin/calc" - * argv[1]: "-q" - * argv[2]: "-p" - * argv[3]: "-e" - * argv[4]: "-D" - * argv[5]: "31" - * argv[6]: NULL - * - * shellfile: "/tmp/calcit" - * s_flag: TRUE - */ static int -script_args(int argc, char ***argv_p, char **shellfile_p, char **program_p) +nextcp(char **cpp, int *ip, int argc, char **argv, BOOL haveendstr) { - char **argv; /* new argv to return */ - char *shellfile; /* shell file pathname to return */ - int delta; /* the change needed in argc */ - int i; - int j; - char *p; - char *q; + char *cp; + int index; - /* - * must have at least 3 args and the 2nd must start with -S - */ - argv = *argv_p; - if (argc < 3 || strncmp(argv[1], "-S", 2) != 0) { - /* - * we are too early in processing to call - * libcalc_call_me_last() - nothing to cleanup - */ - fprintf(stderr, - "%s: FATAL: bad args passed to script_args\n", program); - exit(1); - } - shellfile = argv[2]; + cp = *cpp; + index = *ip; - /* - * count the additional args beyond the -S - */ - if (argv[1][2] == ' ') { - /* - * process args beyond -S on the #!/usr/local/bin line - */ - p = argv[1]+3 + strspn(argv[1]+3," "); - q = p; - if (q == '\0') { - - /* only trailing spaces after -S, ignore them */ - for (i = 3; i <= argc; ++i) { - argv[i-2] = argv[i]; - } - argc -= 2; - - } else { - - /* count the space separated strings that follow -S */ - for (delta = -1; p != NULL && *p; - p = strchr(p+1,' '), ++delta) { - /* skip multiple spaces in a row */ - p += strspn(p, " "); - } - - /* allocate the new set of argv pointers */ - argv = (char **)malloc(sizeof(char *) * argc+delta); - if (argv == NULL) { - /* - * we are too early in processing to call - * libcalc_call_me_last() - nothing to cleanup - */ - fprintf(stderr, - "%s: failed to malloc %d pointers\n", - shellfile, argc+delta); - exit(1); - } - - /* we have the same 0th arg */ - argv[0] = (*argv_p)[0]; - - /* args may be read-only, so duplicate 1st arg */ - p = strdup(q); - if (p == NULL) { - /* - * we are too early in processing to call - * libcalc_call_me_last() - nothing to cleanup - */ - fprintf(stderr, - "%s: failed to duplicate 1st arg\n", - shellfile); - exit(1); - } - - /* tokenize the 1st arg */ - for (p=strtok(q," "), i=1; p != NULL; - p=strtok(NULL," "), ++i) { - argv[i] = p; - } - - /* save the 3rd and later args */ - for (j=3; (*argv_p)[j] != NULL; ++j, ++i) { - argv[i] = (*argv_p)[j]; - } - argv[i] = NULL; - - /* set argc */ - argc = i; - } - - /* - * catch the case of #!/usr/local/bin -Stuff_not_extra_args - */ - } else if (argv[1][2] != '\0') { - - /* - * we are too early in processing to call - * libcalc_call_me_last() - nothing to cleanup - */ - fprintf(stderr, - "%s: malformed #! line, -S must be " - "followed by space or newline\n", - shellfile); - exit(1); - - /* - * Only -S was given in the #!/usr/local/bin line, so we just - * toss the 2nd and 3rd args - */ - } else { - for (i = 3; i <= argc; ++i) { - argv[i-2] = argv[i]; - } - argc -= 2; + if (haveendstr) { + index++; + *ip = index; + if (index >= argc) + return 1; + *cpp = argv[index]; + return 0; } - /* - * return and set the argc, argv, shellfile_p and s_flag values - */ - *argv_p = argv; - *shellfile_p = shellfile; - *program_p = shellfile; - s_flag = TRUE; - return argc; + if (*cp != '\0') + cp++; + for (;;) { + if (*cp == '\0') { + index++; + *ip = index; + if (index >= argc) + return 1; + cp = argv[index]; + } + while (*cp == ' ') + cp++; + if (*cp != '\0') + break; + } + *cpp = cp; + return 0; } + + +static void +set_run_state(run state) +{ + if (conf->calc_debug & CALCDBG_RUNSTATE) + printf("main: run_state from %s to %s\n", + run_state_name(run_state), + run_state_name(state)); + run_state = state; +} + diff --git a/calc.h b/calc.h index 65531d2..b826998 100644 --- a/calc.h +++ b/calc.h @@ -18,7 +18,7 @@ * 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. * * @(#) $Revision: 29.3 $ - * @(#) $Id: calc.h,v 29.3 2000/06/07 14:02:13 chongo Exp $ + * @(#) $Id: calc.h,v 29.3 2000/06/07 14:02:13 chongo Exp chongo $ * @(#) $Source: /usr/local/src/cmd/calc/RCS/calc.h,v $ * * Under source code control: 1990/02/15 01:48:31 @@ -60,7 +60,6 @@ #define MAXERROR 512 /* maximum length of error message string */ #define SYMBOLSIZE 256 /* maximum symbol name size */ -#define MAXINDICES 20 /* maximum number of indices for objects */ #define MAXLABELS 100 /* maximum number of user labels in function */ #define MAXSTRING 1024 /* maximum size of string constant */ #define MAXSTACK 1000 /* maximum depth of evaluation stack */ @@ -167,7 +166,6 @@ extern BOOL calc_tty(int fd); extern BOOL orig_tty(int fd); extern void showerrors(void); extern char *calc_strdup(CONST char *); -extern void getshellfile(char *shellfile); /* * Initialization @@ -229,15 +227,15 @@ extern int allow_exec; /* FALSE => may not execute any commands */ * calc startup and run state */ typedef enum { - RUN_UNKNOWN = -1, /* unknown or unset start state */ - RUN_BEGIN = 0, /* calc execution starts */ - RUN_RCFILES = 1, /* rc files being evaluated */ - RUN_PRE_CMD_ARGS = 2, /* prepare to evaluate cmd args */ - RUN_CMD_ARGS = 3, /* cmd args being evaluated */ - RUN_PRE_TOP_LEVEL = 4, /* prepare to start top level activity */ - RUN_TOP_LEVEL = 5, /* running at top level */ - RUN_EXIT = 6, /* normal exit from calc */ - RUN_EXIT_WITH_ERROR = 7 /* exit with error */ + RUN_ZERO, /* unknown or unset start state */ + RUN_BEGIN, /* calc execution starts */ + RUN_RCFILES, /* rc files being evaluated */ + RUN_PRE_CMD_ARGS, /* prepare to evaluate cmd args */ + RUN_CMD_ARGS, /* cmd args being evaluated */ + RUN_PRE_TOP_LEVEL, /* prepare to start top level activity */ + RUN_TOP_LEVEL, /* running at top level */ + RUN_EXIT, /* normal exit from calc */ + RUN_EXIT_WITH_ERROR /* exit with error */ } run; extern run run_state; extern char *run_state_name(run state); diff --git a/calcerr.tbl b/calcerr.tbl index 5b0f23f..7399c16 100644 --- a/calcerr.tbl +++ b/calcerr.tbl @@ -18,7 +18,7 @@ # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. # # @(#) $Revision: 29.2 $ -# @(#) $Id: calcerr.tbl,v 29.2 2000/06/07 14:02:13 chongo Exp $ +# @(#) $Id: calcerr.tbl,v 29.2 2000/06/07 14:02:13 chongo Exp chongo $ # @(#) $Source: /usr/local/src/cmd/calc/RCS/calcerr.tbl,v $ # # Under source code control: 1996/05/23 17:38:44 @@ -375,3 +375,21 @@ E_GD3 Infinite or too-large result for gd E_AGD3 Infinite or too-large result for agd E_POWER4 Too-large value for power E_ROOT4 Too-large value for root +E_DGT1 Non-real first arg for digit +E_DGT2 Non-integral second arg for digit +E_DGT3 Bad third arg for digit +E_PLCS1 Bad first argument for places +E_PLCS2 Bad second argument for places +E_DGTS1 Bad first argument for digits +E_DGTS2 Bad second argument for digits +E_ILOG Bad first argument for ilog +E_ILOGB Bad second argument for ilog +E_ILOG10 Bad argument for ilog10 +E_ILOG2 Bad argument for ilog2 +E_COMB1 Non-integer second arg for comb +E_COMB2 Too-large second arg for comb +E_CTLN Bad argument for catalan +E_BERN Bad argument for bern +E_EULER Bad argument for euler +E_SLEEP Bad argument for sleep +E_TTY calc_tty failure diff --git a/cmath.h b/cmath.h index c31d22a..4d24bce 100644 --- a/cmath.h +++ b/cmath.h @@ -18,7 +18,7 @@ * 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. * * @(#) $Revision: 29.2 $ - * @(#) $Id: cmath.h,v 29.2 2000/06/07 14:02:13 chongo Exp $ + * @(#) $Id: cmath.h,v 29.2 2000/06/07 14:02:13 chongo Exp chongo $ * @(#) $Source: /usr/local/src/cmd/calc/RCS/cmath.h,v $ * * Under source code control: 1993/07/30 19:42:45 @@ -83,6 +83,7 @@ extern BOOL ccmp(COMPLEX *c1, COMPLEX *c2); * More complicated functions. */ extern COMPLEX *cpowi(COMPLEX *c, NUMBER *q); +extern NUMBER *cilog(COMPLEX *c, ZVALUE base); /* diff --git a/codegen.c b/codegen.c index 5da4cff..75305c4 100644 --- a/codegen.c +++ b/codegen.c @@ -20,7 +20,7 @@ * 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. * * @(#) $Revision: 29.2 $ - * @(#) $Id: codegen.c,v 29.2 2000/06/07 14:02:13 chongo Exp $ + * @(#) $Id: codegen.c,v 29.2 2000/06/07 14:02:13 chongo Exp chongo $ * @(#) $Source: /usr/local/src/cmd/calc/RCS/codegen.c,v $ * * Under source code control: 1990/02/15 01:48:13 @@ -49,7 +49,7 @@ static BOOL rdonce; /* TRUE => do not reread this file */ FUNC *curfunc; -static BOOL getfilename(char *name, BOOL msg_ok, BOOL *once); +static int getfilename(char *name, BOOL *once); static BOOL getid(char *buf); static void getshowstatement(void); static void getfunction(void); @@ -71,7 +71,7 @@ static void getsimplebody(void); static void getcondition(void); static void getmatargs(void); static void getelement(void); -static void usesymbol(char *name, BOOL autodef); +static void usesymbol(char *name, int autodef); static void definesymbol(char *name, int symtype); static void getcallargs(char *name); static void do_changedir(void); @@ -90,9 +90,16 @@ static int getshiftexpr(void); static int getreference(void); static int getincdecexpr(void); static int getterm(void); -static int getidexpr(BOOL okmat, BOOL autodef); +static int getidexpr(BOOL okmat, int autodef); static long getinitlist(void); +#define INDICALLOC 8 + +static int quickindices[INDICALLOC]; +static int * newindices; +static int * indices; +static int maxindices; + /* * Read all the commands from an input file. @@ -133,49 +140,62 @@ getcommands(BOOL toplevel) return; case T_HELP: - if (!getfilename(name, FALSE, NULL)) { - strcpy(name, DEFAULTCALCHELP); + for (;;) { + switch(getfilename(name, NULL)) { + case 1: + strcpy(name, DEFAULTCALCHELP); + case 0: + givehelp(name); + continue; + default: + break; + } + break; } - givehelp(name); break; case T_READ: - if (!getfilename(name, TRUE, &rdonce)) - break; if (!allow_read) { scanerror(T_NULL, "read command disallowed by -m mode\n"); break; } - switch (opensearchfile(name,calcpath,CALCEXT,rdonce)) { - case 0: - getcommands(FALSE); - closeinput(); - break; - case 1: - /* previously read and -once was given */ - break; - case -2: - scanerror(T_NULL, - "Maximum input depth reached"); - break; - default: - scanerror(T_NULL, "Cannot open \"%s\"\n", name); + for (;;) { + if (getfilename(name, &rdonce)) + switch (opensearchfile(name,calcpath, + CALCEXT,rdonce)) { + case 0: + getcommands(FALSE); + closeinput(); + continue; + case 1: + /* prev read and -once was given */ + continue; + case -2: + scanerror(T_NULL, + "Maximum input depth reached"); + break; + default: + scanerror(T_NULL, + "Cannot open \"%s\"", name); + continue; + } break; } break; case T_WRITE: - if (!getfilename(name, TRUE, NULL)) - break; if (!allow_write) { scanerror(T_NULL, "write command disallowed by -m mode\n"); break; } - if (writeglobals(name)) + if (getfilename(name, NULL)) + break; + if (writeglobals(name)) { scanerror(T_NULL, "Error writing \"%s\"\n", name); + } break; case T_CD: @@ -529,7 +549,7 @@ getonevariable(int symtype) res = getonevariable(symtype); definesymbol(name, symtype); if (res) { - usesymbol(name, FALSE); + usesymbol(name, 0); addop(OP_ASSIGNBACK); } return res; @@ -892,7 +912,7 @@ getstatement(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *d return; case T_ELSE: - scanerror(T_SEMICOLON, "ELSE without preceeding IF"); + scanerror(T_SEMICOLON, "ELSE without preceding IF"); return; case T_SHOW: @@ -1021,7 +1041,6 @@ getobjdeclaration(int symtype) int count; /* number of elements */ int index; /* current index */ int i; /* loop counter */ - int indices[MAXINDICES]; /* indices for elements */ int oldmode; if (gettoken() != T_SYMBOL) { @@ -1038,58 +1057,89 @@ getobjdeclaration(int symtype) * Read in the definition of the elements of the object. */ count = 0; + indices = quickindices; + maxindices = INDICALLOC; + oldmode = tokenmode(TM_DEFAULT); + for (;;) { switch (gettoken()) { - case T_SYMBOL: - if (count == MAXINDICES) { - scanerror(T_SEMICOLON, - "Too many elements in OBJ " - "statement"); - (void) tokenmode(oldmode); - return; - } - index = addelement(tokensymbol()); - for (i = 0; i < count; i++) { - if (indices[i] == index) { - scanerror(T_SEMICOLON, - "Duplicate element name " - "\"%s\"", tokensymbol()); + case T_SYMBOL: + if (count == maxindices) { + if (maxindices == INDICALLOC) { + maxindices += INDICALLOC; + newindices = (int *) malloc(maxindices * + sizeof(int)); + if (newindices == NULL) { + scanerror(T_SEMICOLON, "Out of memory for indices malloc"); (void) tokenmode(oldmode); return; } + memcpy(newindices, quickindices, + INDICALLOC * sizeof(int)); + indices = newindices; + } else { + maxindices += INDICALLOC; + newindices = (int *) realloc(indices, + maxindices * sizeof(int)); + if (newindices == NULL) { + free(indices); + scanerror(T_SEMICOLON, "Out of memory for indices realloc"); + (void) tokenmode(oldmode); + return; + } + indices = newindices; } - indices[count++] = index; - if (gettoken() == T_COMMA) - continue; - rescantoken(); - if (gettoken() != T_RIGHTBRACE) { - scanerror(T_SEMICOLON, - "Bad object type definition"); + } + index = addelement(tokensymbol()); + for (i = 0; i < count; i++) { + if (indices[i] == index) { + if (indices != quickindices) + free(indices); + scanerror(T_SEMICOLON, "Duplicate element name \"%s\"", tokensymbol()); (void) tokenmode(oldmode); return; } - /*FALLTHRU*/ - case T_RIGHTBRACE: - (void) tokenmode(oldmode); - if (defineobject(name, indices, count)) { - scanerror(T_NULL, - "Object type \"%s\" is already defined", name); - return; - } - getobjvars(name, symtype); - return; - case T_NEWLINE: + } + indices[count++] = index; + if (gettoken() == T_COMMA) continue; - default: - scanerror(T_SEMICOLON, - "Bad object type definition"); + rescantoken(); + if (gettoken() != T_RIGHTBRACE) { + if (indices != quickindices) + free(indices); + scanerror(T_SEMICOLON, "Bad object type definition"); (void) tokenmode(oldmode); return; + } + /*FALLTHRU*/ + case T_RIGHTBRACE: + (void) tokenmode(oldmode); + if (defineobject(name, indices, count)) { + if (indices != quickindices) + free(indices); + scanerror(T_NULL, + "Object type \"%s\" is already defined", name); + return; + } + if (indices != quickindices) + free(indices); + getobjvars(name, symtype); + return; + case T_NEWLINE: + continue; + default: + if (indices != quickindices) + free(indices); + scanerror(T_SEMICOLON, "Bad object type definition"); + (void) tokenmode(oldmode); + return; + } } } + static void getoneobj(long index, int symtype) { @@ -1098,11 +1148,11 @@ getoneobj(long index, int symtype) if (gettoken() == T_SYMBOL) { if (symtype == SYM_UNDEFINED) { rescantoken(); - (void) getidexpr(TRUE, TRUE); + (void) getidexpr(TRUE, 1); } else { symname = tokensymbol(); definesymbol(symname, symtype); - usesymbol(symname, FALSE); + usesymbol(symname, 0); } getoneobj(index, symtype); addop(OP_ASSIGN); @@ -1181,11 +1231,11 @@ getonematrix(int symtype) if (gettoken() == T_SYMBOL) { if (symtype == SYM_UNDEFINED) { rescantoken(); - (void) getidexpr(FALSE, TRUE); + (void) getidexpr(FALSE, 1); } else { name = tokensymbol(); definesymbol(name, symtype); - usesymbol(name, FALSE); + usesymbol(name, 0); } while (gettoken() == T_COMMA); rescantoken(); @@ -2028,7 +2078,25 @@ getterm(void) case T_SYMBOL: rescantoken(); - type = getidexpr(TRUE, FALSE); + type = getidexpr(TRUE, 0); + break; + + case T_GLOBAL: + if (gettoken() != T_SYMBOL) { + scanerror(T_NULL, "Global id expected"); + break; + } + rescantoken(); + type = getidexpr(TRUE, T_GLOBAL); + break; + + case T_LOCAL: + if (gettoken() != T_SYMBOL) { + scanerror(T_NULL, "Local id expected"); + break; + } + rescantoken(); + type = getidexpr(TRUE, T_LOCAL); break; case T_LEFTBRACKET: @@ -2077,11 +2145,11 @@ getterm(void) /* * Read in an identifier expressions. * This is a symbol name followed by parenthesis, or by square brackets or - * element refernces. The symbol can be a global or a local variable name. + * element references. The symbol can be a global or a local variable name. * Returns the type of expression found. */ static int -getidexpr(BOOL okmat, BOOL autodef) +getidexpr(BOOL okmat, int autodef) { int type; char name[SYMBOLSIZE+1]; /* symbol name */ @@ -2091,18 +2159,19 @@ getidexpr(BOOL okmat, BOOL autodef) if (!getid(name)) return type; switch (gettoken()) { - case T_LEFTPAREN: - oldmode = tokenmode(TM_DEFAULT); - getcallargs(name); - (void) tokenmode(oldmode); - type = 0; - break; - case T_ASSIGN: - autodef = TRUE; - /* fall into default case */ - default: - rescantoken(); - usesymbol(name, autodef); + case T_LEFTPAREN: + oldmode = tokenmode(TM_DEFAULT); + getcallargs(name); + (void) tokenmode(oldmode); + type = 0; + break; + case T_ASSIGN: + if (autodef != T_GLOBAL && autodef != T_LOCAL) + autodef = 1; + /* fall into default case */ + default: + rescantoken(); + usesymbol(name, autodef); } /* * Now collect as many element references and matrix index operations @@ -2110,27 +2179,27 @@ getidexpr(BOOL okmat, BOOL autodef) */ for (;;) { switch (gettoken()) { - case T_LEFTBRACKET: - rescantoken(); - if (!okmat) - return type; - getmatargs(); - type = 0; - break; - case T_ARROW: - addop(OP_DEREF); - /*FALLTHRU*/ - case T_PERIOD: - getelement(); - type = 0; - break; - case T_LEFTPAREN: - scanerror(T_NULL, - "Function calls not allowed " - "as expressions"); - default: - rescantoken(); + case T_LEFTBRACKET: + rescantoken(); + if (!okmat) return type; + getmatargs(); + type = 0; + break; + case T_ARROW: + addop(OP_DEREF); + /*FALLTHRU*/ + case T_PERIOD: + getelement(); + type = 0; + break; + case T_LEFTPAREN: + scanerror(T_NULL, + "Function calls not allowed " + "as expressions"); + default: + rescantoken(); + return type; } } } @@ -2144,71 +2213,37 @@ getidexpr(BOOL okmat, BOOL autodef) * * given: * name filename to read - * msg_ok TRUE => ok to print error messages * once non-NULL => set to TRUE of -once read */ -static BOOL -getfilename(char *name, BOOL msg_ok, BOOL *once) +static int +getfilename(char *name, BOOL *once) { STRING *s; + int i; - /* look at the next token */ (void) tokenmode(TM_NEWLINES | TM_ALLSYMS); - switch (gettoken()) { - case T_STRING: - s = findstring(tokenstring()); - strcpy(name, s->s_str); - sfree(s); - break; - case T_SYMBOL: - strcpy(name, tokensymbol()); - break; - default: - if (msg_ok) - scanerror(T_SEMICOLON, "Filename expected"); - return FALSE; - } - - /* determine if we care about a possible -once option */ - if (once != NULL) { - /* we care about a possible -once option */ - if (strcmp(name, "-once") == 0) { - /* -once option found */ - *once = TRUE; - /* look for the filename */ - switch (gettoken()) { - case T_STRING: - s = findstring(tokenstring()); - strcpy(name, s->s_str); - sfree(s); - break; - case T_SYMBOL: - strcpy(name, tokensymbol()); - break; - default: - if (msg_ok) - scanerror(T_SEMICOLON, - "Filename expected"); - return FALSE; - } - } else { - *once = FALSE; + for (i = 2; i > 0; i--) { + switch (gettoken()) { + case T_STRING: + s = findstring(tokenstring()); + strcpy(name, s->s_str); + sfree(s); + break; + case T_SYMBOL: + strcpy(name, tokensymbol()); + break; + default: + rescantoken(); + return -1; } - } - /* look at the next token */ - switch (gettoken()) { - case T_SEMICOLON: - case T_NEWLINE: - case T_EOF: - break; - default: - if (msg_ok) - scanerror(T_SEMICOLON, - "Missing semicolon after filename"); - return FALSE; + if (i == 2 && once != NULL) { + if ((*once = !strcmp(name, "-once"))) + continue; + } + break; } - return TRUE; + return 0; } @@ -2433,11 +2468,26 @@ definesymbol(char *name, int symtype) * * given: * name symbol name to be checked - * autodef TRUE => define is symbol is not known + * autodef 1 => define if symbol is not known + * T_GLOBAL => get global, define if necessary */ static void -usesymbol(char *name, BOOL autodef) +usesymbol(char *name, int autodef) { + + if (autodef == T_GLOBAL) { + addopptr(OP_GLOBALADDR, (char *) addglobal(name, FALSE)); + return; + } + if (autodef == T_LOCAL) { + if (symboltype(name) == SYM_PARAM) { + scanerror(T_COMMA, + "Variable \"%s\" is already defined", name); + return; + } + addopone(OP_LOCALADDR, addlocal(name)); + return; + } switch (symboltype(name)) { case SYM_LOCAL: addopone(OP_LOCALADDR, (long) findlocal(name)); @@ -2544,24 +2594,25 @@ static void do_changedir(void) { char *p; + STRING *s; /* look at the next token */ (void) tokenmode(TM_NEWLINES | TM_ALLSYMS); /* determine the new directory */ + s = NULL; switch (gettoken()) { - case T_NULL: - case T_NEWLINE: - case T_SEMICOLON: - p = home; - break; - default: - p = tokensymbol(); /* This is not enough XXX */ - if (p == NULL) { + case T_STRING: + s = findstring(tokenstring()); + p = s->s_str; + break; + case T_SYMBOL: + p = tokensymbol(); + break; + default: p = home; - } - break; } + if (p == NULL) { fprintf(stderr, "Cannot determine HOME directory\n"); } @@ -2570,29 +2621,8 @@ do_changedir(void) if (chdir(p)) { perror(p); } - return; + if (s != NULL) + sfree(s); } -/* - * getshellfile - process the contents of a shellfile - */ -void -getshellfile(char *shellfile) -{ - /* - * treat the calc shell script as if we were reading it - */ - if (!allow_read) { - scanerror(T_NULL, - "reading of calc shell script \"%s\" " - "dislloaed by -m mode\n", shellfile); - } else if (opensearchfile(shellfile, NULL, NULL, FALSE) == 0) { - getcommands(FALSE); - closeinput(); - } else { - scanerror(T_NULL, - "Cannot open calc shell script \"%s\"\n", shellfile); - } - return; -} diff --git a/comfunc.c b/comfunc.c index 12337ca..f1defe2 100644 --- a/comfunc.c +++ b/comfunc.c @@ -20,7 +20,7 @@ * 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. * * @(#) $Revision: 29.2 $ - * @(#) $Id: comfunc.c,v 29.2 2000/06/07 14:02:13 chongo Exp $ + * @(#) $Id: comfunc.c,v 29.2 2000/06/07 14:02:13 chongo Exp chongo $ * @(#) $Source: /usr/local/src/cmd/calc/RCS/comfunc.c,v $ * * Under source code control: 1990/02/15 01:48:13 @@ -1007,7 +1007,7 @@ cpolar(NUMBER *q1, NUMBER *q2, NUMBER *epsilon) long m, n; if (qiszero(epsilon)) { - math_error("Zero epsilson for cpolar"); + math_error("Zero epsilon for cpolar"); /*NOTREACHED*/ } if (qiszero(q1)) @@ -1162,3 +1162,27 @@ cprintfr(COMPLEX *c) zprintval(i->den, 0L, 0L); } } + + +NUMBER * +cilog(COMPLEX *c, ZVALUE base) +{ + NUMBER *qr, *qi; + + qr = qilog(c->real, base); + qi = qilog(c->imag, base); + + if (qr == NULL) { + if (qi == NULL) + return NULL; + return qi; + } + if (qi == NULL) + return qr; + if (qrel(qr, qi) >= 0) { + qfree(qi); + return qr; + } + qfree(qr); + return qi; +} diff --git a/config.c b/config.c index d2f4d5e..537846c 100644 --- a/config.c +++ b/config.c @@ -20,7 +20,7 @@ * 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. * * @(#) $Revision: 29.3 $ - * @(#) $Id: config.c,v 29.3 2000/06/07 14:02:13 chongo Exp $ + * @(#) $Id: config.c,v 29.3 2000/06/07 14:02:13 chongo Exp chongo $ * @(#) $Source: /usr/local/src/cmd/calc/RCS/config.c,v $ * * Under source code control: 1991/07/20 00:21:56 @@ -109,10 +109,10 @@ CONFIG oldstd = { /* backward compatible standard configuration */ SQ_ALG2, /* size of number to use square alg 2 */ POW_ALG2, /* size of modulus to use REDC for powers */ REDC_ALG2, /* size of modulus to use REDC algorithm 2 */ - TRUE, /* ok to print a tilde on aproximations */ + TRUE, /* ok to print a tilde on approximations */ TRUE, /* ok to print tab before numeric values */ 0, /* quomod() default rounding mode */ - 2, /* quotent // default rounding mode */ + 2, /* quotient // default rounding mode */ 0, /* mod % default rounding mode */ 24, /* sqrt() default rounding mode */ 24, /* appr() default rounding mode */ @@ -149,10 +149,10 @@ CONFIG newstd = { /* new non-backward compatible configuration */ SQ_ALG2, /* size of number to use square alg 2 */ POW_ALG2, /* size of modulus to use REDC for powers */ REDC_ALG2, /* size of modulus to use REDC algorithm 2 */ - TRUE, /* ok to print a tilde on aproximations */ + TRUE, /* ok to print a tilde on approximations */ TRUE, /* ok to print tab before numeric values */ 0, /* quomod() default rounding mode */ - 0, /* quotent // default rounding mode */ + 0, /* quotient // default rounding mode */ 0, /* mod % default rounding mode */ 24, /* sqrt() default rounding mode */ 24, /* appr() default rounding mode */ @@ -287,10 +287,11 @@ static NAMETYPE truth[] = { /* - * declate static functions + * declare static functions */ static long lookup_long(NAMETYPE *set, char *name); static char *lookup_name(NAMETYPE *set, long val); +static int getlen(VALUE *vp, LEN *lp); /* @@ -360,6 +361,26 @@ lookup_name(NAMETYPE *set, long val) } +/* + * Check whether VALUE at vp is a LEN (32-bit signed integer) and if so, + * copy that integer to lp. + * Return: 1, 2, 0, or -1 XXX + */ + +static int +getlen(VALUE *vp, LEN *lp) +{ + if (vp->v_type != V_NUM || !qisint(vp->v_num)) + return 1; + if (zge31b(vp->v_num->num)) + return 2; + *lp = ztoi(vp->v_num->num); + if (*lp < 0) + return -1; + return 0; +} + + /* * Set the specified configuration type to the specified value. * An error is generated if the type number or value is illegal. @@ -370,6 +391,7 @@ setconfig(int type, VALUE *vp) NUMBER *q; CONFIG *newconf; /* new configuration to set */ long temp; + LEN len; char *p; switch (type) { @@ -414,15 +436,11 @@ setconfig(int type, VALUE *vp) break; case CONFIG_DISPLAY: - if (vp->v_type != V_NUM) { - math_error("Non-numeric for display"); + if (getlen(vp, &len)) { + math_error("Bad value for display"); /*NOTREACHED*/ } - q = vp->v_num; - temp = qtoi(q); - if (qisfrac(q) || qisneg(q) || !zistiny(q->num)) - temp = -1; - math_setdigits(temp); + math_setdigits(len); break; case CONFIG_MODE: @@ -447,91 +465,51 @@ setconfig(int type, VALUE *vp) break; case CONFIG_MAXPRINT: - if (vp->v_type != V_NUM) { - math_error("Non-numeric for maxprint"); + if (getlen(vp, &len)) { + math_error("Bad value for maxprint"); /*NOTREACHED*/ } - q = vp->v_num; - temp = qtoi(q); - if (qisfrac(q) || qisneg(q) || !zistiny(q->num)) - temp = -1; - if (temp < 0) { - math_error("Maxprint value is out of range"); - /*NOTREACHED*/ - } - conf->maxprint = temp; + conf->maxprint = len; break; case CONFIG_MUL2: - if (vp->v_type != V_NUM) { - math_error("Non-numeric for mul2"); + if (getlen(vp, &len)) { + math_error("Bad value for mul2"); /*NOTREACHED*/ } - q = vp->v_num; - temp = qtoi(q); - if (qisfrac(q) || qisneg(q)) - temp = -1; - if (temp == 0) - temp = MUL_ALG2; - if (temp < 2) { - math_error("Illegal mul2 value"); - /*NOTREACHED*/ - } - conf->mul2 = (int)temp; + if (len == 0) + len = MUL_ALG2; + conf->mul2 = len; break; case CONFIG_SQ2: - if (vp->v_type != V_NUM) { - math_error("Non-numeric for sq2"); + if (getlen(vp, &len)) { + math_error("Bad value for sq2"); /*NOTREACHED*/ } - q = vp->v_num; - temp = qtoi(q); - if (qisfrac(q) || qisneg(q)) - temp = -1; - if (temp == 0) - temp = SQ_ALG2; - if (temp < 2) { - math_error("Illegal sq2 value"); - /*NOTREACHED*/ - } - conf->sq2 = (int)temp; + if (len == 0) + len = SQ_ALG2; + conf->sq2 = len; break; case CONFIG_POW2: - if (vp->v_type != V_NUM) { - math_error("Non-numeric for pow2"); + if (getlen(vp, &len)) { + math_error("Bad value for pow2"); /*NOTREACHED*/ } - q = vp->v_num; - temp = qtoi(q); - if (qisfrac(q) || qisneg(q)) - temp = -1; - if (temp == 0) - temp = POW_ALG2; - if (temp < 1) { - math_error("Illegal pow2 value"); - /*NOTREACHED*/ - } - conf->pow2 = (int)temp; + if (len == 0) + len = POW_ALG2; + conf->pow2 = len; break; case CONFIG_REDC2: - if (vp->v_type != V_NUM) { - math_error("Non-numeric for redc2"); + if (getlen(vp, &len)) { + math_error("Bad value for redc2"); /*NOTREACHED*/ } - q = vp->v_num; - temp = qtoi(q); - if (qisfrac(q) || qisneg(q)) - temp = -1; - if (temp == 0) - temp = REDC_ALG2; - if (temp < 1) { - math_error("Illegal redc2 value"); - /*NOTREACHED*/ - } - conf->redc2 = (int)temp; + if (len == 0) + len = REDC_ALG2; + conf->redc2 = len; break; case CONFIG_TILDE: @@ -563,129 +541,75 @@ setconfig(int type, VALUE *vp) break; case CONFIG_QUOMOD: - if (vp->v_type != V_NUM) { - math_error("Non numeric for quomod"); + if (getlen(vp, &len)) { + math_error("Illegal value for quomod"); /*NOTREACHED*/ } - q = vp->v_num; - temp = qtoi(q); - if (qisfrac(q) || qisneg(q) || !zistiny(q->num)) { - math_error("Illegal quomod parameter value"); - /*NOTREACHED*/ - } - conf->quomod = temp; + conf->quomod = len; break; case CONFIG_QUO: - if (vp->v_type != V_NUM) { - math_error("Non numeric for quo"); + if (getlen(vp, &len)) { + math_error("Illegal value for quo"); /*NOTREACHED*/ } - q = vp->v_num; - temp = qtoi(q); - if (qisfrac(q) || qisneg(q) || !zistiny(q->num)) { - math_error("Illegal quo parameter value"); - /*NOTREACHED*/ - } - conf->quo = temp; + conf->quo = len; break; case CONFIG_MOD: - if (vp->v_type != V_NUM) { - math_error("Non numeric for mod"); + if (getlen(vp, &len)) { + math_error("Illegal value for mod"); /*NOTREACHED*/ } - q = vp->v_num; - temp = qtoi(q); - if (qisfrac(q) || qisneg(q) || !zistiny(q->num)) { - math_error("Illegal mod parameter value"); - /*NOTREACHED*/ - } - conf->mod = temp; + conf->mod = len; break; case CONFIG_SQRT: - if (vp->v_type != V_NUM) { - math_error("Non numeric for sqrt"); + if (getlen(vp, &len)) { + math_error("Illegal value for sqrt"); /*NOTREACHED*/ } - q = vp->v_num; - temp = qtoi(q); - if (qisfrac(q) || qisneg(q) || !zistiny(q->num)) { - math_error("Illegal sqrt parameter value"); - /*NOTREACHED*/ - } - conf->sqrt = temp; + conf->sqrt = len; break; case CONFIG_APPR: - if (vp->v_type != V_NUM) { - math_error("Non numeric for appr"); + if (getlen(vp, &len)) { + math_error("Illegal value for appr"); /*NOTREACHED*/ } - q = vp->v_num; - temp = qtoi(q); - if (qisfrac(q) || qisneg(q) || !zistiny(q->num)) { - math_error("Illegal appr parameter value"); - /*NOTREACHED*/ - } - conf->appr = temp; + conf->appr = len; break; case CONFIG_CFAPPR: - if (vp->v_type != V_NUM) { - math_error("Non numeric for cfappr"); + if (getlen(vp, &len)) { + math_error("Illegal value for cfappr"); /*NOTREACHED*/ } - q = vp->v_num; - temp = qtoi(q); - if (qisfrac(q) || qisneg(q) || !zistiny(q->num)) { - math_error("Illegal cfappr parameter value"); - /*NOTREACHED*/ - } - conf->cfappr = temp; + conf->cfappr = len; break; case CONFIG_CFSIM: - if (vp->v_type != V_NUM) { - math_error("Non numeric for cfsim"); + if (getlen(vp, &len)) { + math_error("Illegal value for cfsim"); /*NOTREACHED*/ } - q = vp->v_num; - temp = qtoi(q); - if (qisfrac(q) || qisneg(q) || !zistiny(q->num)) { - math_error("Illegal cfsim parameter value"); - /*NOTREACHED*/ - } - conf->cfsim = temp; + conf->cfsim = len; break; case CONFIG_OUTROUND: - if (vp->v_type != V_NUM) { - math_error("Non numeric for outround"); + if (getlen(vp, &len)) { + math_error("Illegal value for outround"); /*NOTREACHED*/ } - q = vp->v_num; - temp = qtoi(q); - if (qisfrac(q) || qisneg(q) || !zistiny(q->num)) { - math_error("Illegal output parameter value"); - /*NOTREACHED*/ - } - conf->outround = temp; + conf->outround = len; break; case CONFIG_ROUND: - if (vp->v_type != V_NUM) { - math_error("Non numeric for round"); + if (getlen(vp, &len)) { + math_error("Illegal value for round"); /*NOTREACHED*/ } - q = vp->v_num; - temp = qtoi(q); - if (qisfrac(q) || qisneg(q) || !zistiny(q->num)) { - math_error("Illegal output parameter value"); - /*NOTREACHED*/ - } - conf->round = temp; + conf->round = len; break; case CONFIG_LEADZERO: @@ -1311,12 +1235,12 @@ config_cmp(CONFIG *cfg1, CONFIG *cfg2) */ if (cfg1 == NULL || cfg1->epsilon == NULL || cfg1->prompt1 == NULL || cfg1->prompt2 == NULL) { - math_error("CONFIG #1 value is invaid"); + math_error("CONFIG #1 value is invalid"); /*NOTREACHED*/ } if (cfg2 == NULL || cfg2->epsilon == NULL || cfg2->prompt1 == NULL || cfg2->prompt2 == NULL) { - math_error("CONFIG #2 value is invaid"); + math_error("CONFIG #2 value is invalid"); /*NOTREACHED*/ } diff --git a/config.h b/config.h index 091ed05..2b8d388 100644 --- a/config.h +++ b/config.h @@ -20,7 +20,7 @@ * 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. * * @(#) $Revision: 29.3 $ - * @(#) $Id: config.h,v 29.3 2000/06/07 14:02:13 chongo Exp $ + * @(#) $Id: config.h,v 29.3 2000/06/07 14:02:13 chongo Exp chongo $ * @(#) $Source: /usr/local/src/cmd/calc/RCS/config.h,v $ * * Under source code control: 1995/11/01 22:20:17 @@ -110,26 +110,26 @@ */ struct config { int outmode; /* current output mode */ - long outdigits; /* current output digits for float or exp */ + LEN outdigits; /* current output digits for float or exp */ NUMBER *epsilon; /* default error for real functions */ long epsilonprec; /* epsilon binary precision (tied to epsilon) */ FLAG traceflags; /* tracing flags */ - long maxprint; /* number of elements to print */ + LEN maxprint; /* number of elements to print */ LEN mul2; /* size of number to use multiply algorithm 2 */ LEN sq2; /* size of number to use square algorithm 2 */ LEN pow2; /* size of modulus to use REDC for powers */ LEN redc2; /* size of modulus to use REDC algorithm 2 */ BOOL tilde_ok; /* ok to print a tilde on aproximations */ BOOL tab_ok; /* ok to print tab before numeric values */ - long quomod; /* quomod() default rounding mode */ - long quo; /* quotent // default rounding mode */ - long mod; /* mod % default rounding mode */ - long sqrt; /* sqrt() default rounding mode */ - long appr; /* appr() default rounding mode */ - long cfappr; /* cfappr() default rounding mode */ - long cfsim; /* cfsim() default rounding mode */ - long outround; /* output default rounding mode */ - long round; /* round()/bround() default rounding mode */ + LEN quomod; /* quomod() default rounding mode */ + LEN quo; /* quotient // default rounding mode */ + LEN mod; /* mod % default rounding mode */ + LEN sqrt; /* sqrt() default rounding mode */ + LEN appr; /* appr() default rounding mode */ + LEN cfappr; /* cfappr() default rounding mode */ + LEN cfsim; /* cfsim() default rounding mode */ + LEN outround; /* output default rounding mode */ + LEN round; /* round()/bround() default rounding mode */ BOOL leadzero; /* ok to print leading 0 before decimal pt */ BOOL fullzero; /* ok to print trailing 0's */ long maxscancount; /* max scan errors before abort */ diff --git a/custom/c_sysinfo.c b/custom/c_sysinfo.c index d042774..28f1b34 100644 --- a/custom/c_sysinfo.c +++ b/custom/c_sysinfo.c @@ -18,7 +18,7 @@ * 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. * * @(#) $Revision: 29.3 $ - * @(#) $Id: c_sysinfo.c,v 29.3 2000/06/07 14:03:03 chongo Exp $ + * @(#) $Id: c_sysinfo.c,v 29.3 2000/06/07 14:03:03 chongo Exp chongo $ * @(#) $Source: /usr/local/src/cmd/calc/custom/RCS/c_sysinfo.c,v $ * * Under source code control: 1997/03/09 23:14:40 @@ -112,7 +112,6 @@ static struct infoname sys_info[] = { {"MAXFILES", "max number of opened files", NULL, (FULL)MAXFILES}, {"MAXFULL", "largest SFULL value", NULL, (FULL)MAXFULL}, {"MAXHALF", "largest SHALF value", NULL, (FULL)MAXHALF}, - {"MAXINDICES", "max number of indices for objects", NULL, (FULL)MAXINDICES}, {"MAXLABELS", "max number of user labels in function", NULL, (FULL)MAXLABELS}, {"MAXLEN", "longest storage size allowed", NULL, (FULL)MAXLEN}, {"MAXLONG", "largest long val", NULL, (FULL)MAXLONG}, diff --git a/func.c b/func.c index cbb8bee..d03e1a7 100644 --- a/func.c +++ b/func.c @@ -20,7 +20,7 @@ * 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. * * @(#) $Revision: 29.3 $ - * @(#) $Id: func.c,v 29.3 2000/06/07 14:02:13 chongo Exp $ + * @(#) $Id: func.c,v 29.3 2000/06/07 14:02:13 chongo Exp chongo $ * @(#) $Source: /usr/local/src/cmd/calc/RCS/func.c,v $ * * Under source code control: 1990/02/15 01:48:15 @@ -160,7 +160,7 @@ static STRINGHEAD newerrorstr; /* - * arg count definitons + * arg count definitions */ #define IN 100 /* maximum number of arguments */ #define FE 0x01 /* flag to indicate default epsilon argument */ @@ -256,8 +256,8 @@ f_prompt(VALUE *vp) cp = nextline(); closeinput(); if (cp == NULL) { - math_error("End of file while prompting"); - /*NOTREACHED*/ + result.v_type = V_NULL; + return result; } if (*cp == '\0') { result.v_str = slink(&_nullstring_); @@ -278,7 +278,7 @@ f_prompt(VALUE *vp) static VALUE f_display(int count, VALUE **vals) { - long oldvalue; + LEN oldvalue; VALUE res; /* initialize VALUE */ @@ -293,9 +293,9 @@ f_display(int count, VALUE **vals) fprintf(stderr, "Out-of-range arg for display ignored\n"); else - conf->outdigits = qtoi(vals[0]->v_num); + conf->outdigits = (LEN) qtoi(vals[0]->v_num); } - res.v_num = itoq(oldvalue); + res.v_num = itoq((long) oldvalue); return res; } @@ -1012,7 +1012,7 @@ f_srand(int count, VALUE **vals) break; default: - math_error("illegal type of arg passsed to srand()"); + math_error("illegal type of arg passed to srand()"); /*NOTREACHED*/ break; } @@ -1158,7 +1158,7 @@ f_srandom(int count, VALUE **vals) break; default: - math_error("illegal type of arg passsed to srandom()"); + math_error("illegal type of arg passed to srandom()"); /*NOTREACHED*/ break; } @@ -1253,37 +1253,76 @@ f_setbit(int count, VALUE **vals) } -static NUMBER * -f_digit(NUMBER *val1, NUMBER *val2) +static VALUE +f_digit(int count, VALUE **vals) { - if (qisfrac(val2)) { - math_error("Non-integral digit position"); - /*NOTREACHED*/ + VALUE res; + ZVALUE base; + + if (vals[0]->v_type != V_NUM) + return error_value(E_DGT1); + + if (vals[1]->v_type != V_NUM || qisfrac(vals[1]->v_num)) + return error_value(E_DGT2); + + if (count == 3) { + if (vals[2]->v_type != V_NUM || qisfrac(vals[2]->v_num)) + return error_value(E_DGT3); + base = vals[2]->v_num->num; + } else { + base = _ten_; } - if (qiszero(val1) || (qisint(val1) && qisneg(val2))) - return qlink(&_qzero_); - if (zge31b(val2->num)) { - if (qisneg(val2)) { - math_error("Very large digit position"); - /*NOTREACHED*/ - } - return qlink(&_qzero_); - } - return itoq((long) qdigit(val1, qtoi(val2))); + res.v_type = V_NUM; + res.v_num = qdigit(vals[0]->v_num, vals[1]->v_num->num, base); + if (res.v_num == NULL) + return error_value(E_DGT3); + + return res; } -static NUMBER * -f_digits(NUMBER *val) +static VALUE +f_digits(int count, VALUE **vals) { - return itoq((long) qdigits(val)); + ZVALUE base; + VALUE res; + + if (vals[0]->v_type != V_NUM) + return error_value(E_DGTS1); + if (count > 1) { + if (vals[1]->v_type != V_NUM || qisfrac(vals[1]->v_num) + || qiszero(vals[1]->v_num) || qisunit(vals[1]->v_num)) + return error_value(E_DGTS2); + base = vals[1]->v_num->num; + } else { + base = _ten_; + } + res.v_type = V_NUM; + res.v_num = itoq(qdigits(vals[0]->v_num, base)); + return res; } -static NUMBER * -f_places(NUMBER *val) +static VALUE +f_places(int count, VALUE **vals) { - return itoq((long) qplaces(val)); + long places; + VALUE res; + + if (vals[0]->v_type != V_NUM) + return error_value(E_PLCS1); + if (count > 1) { + if (vals[1]->v_type != V_NUM || qisfrac(vals[1]->v_num)) + return error_value(E_PLCS2); + places = qplaces(vals[0]->v_num, vals[1]->v_num->num); + if (places == -2) + return error_value(E_PLCS2); + } else + places = qdecplaces(vals[0]->v_num); + + res.v_type = V_NUM; + res.v_num = itoq(places); + return res; } @@ -3128,6 +3167,135 @@ f_agd(int count, VALUE **vals) } +static VALUE +f_comb(VALUE *v1, VALUE *v2) +{ + long n; + VALUE result; + VALUE tmp1, tmp2, div; + + if (v2->v_type != V_NUM || qisfrac(v2->v_num)) + return error_value(E_COMB1); + result.v_subtype = V_NOSUBTYPE; + result.v_type = V_NUM; + if (qisneg(v2->v_num)) { + result.v_num = qlink(&_qzero_); + return result; + } + if (qiszero(v2->v_num)) { + result.v_num = qlink(&_qone_); + return result; + } + if (qisone(v2->v_num)) { + copyvalue(v1, &result); + return result; + } + if (v1->v_type == V_NUM) { + result.v_num = qcomb(v1->v_num, v2->v_num); + if (result.v_num == NULL) + return error_value(E_COMB2); + return result; + } + if (zge24b(v2->v_num->num)) + return error_value(E_COMB2); + n = qtoi(v2->v_num); + copyvalue(v1, &result); + decvalue(v1, &tmp1); + div.v_type = V_NUM; + div.v_num = qlink(&_qtwo_); + n--; + for (;;) { + mulvalue(&result, &tmp1, &tmp2); + freevalue(&result); + divvalue(&tmp2, &div, &result); + freevalue(&tmp2); + if (--n == 0 || !testvalue(&result) || result.v_type < 0) { + freevalue(&tmp1); + freevalue(&div); + return result; + } + decvalue(&tmp1, &tmp2); + freevalue(&tmp1); + tmp1 = tmp2; + incvalue(&div, &tmp2); + freevalue(&div); + div = tmp2; + } +} + + +static VALUE +f_bern(VALUE *vp) +{ + VALUE res; + + if (vp->v_type != V_NUM || qisfrac(vp->v_num)) + return error_value(E_BERN); + + res.v_subtype = V_NOSUBTYPE; + res.v_type = V_NUM; + res.v_num = qbern(vp->v_num->num); + if (res.v_num == NULL) + return error_value(E_BERN); + return res; +} + + +static VALUE +f_freebern(void) +{ + VALUE res; + + qfreebern(); + res.v_type = V_NULL; + res.v_subtype = V_NOSUBTYPE; + return res; +} + + +static VALUE +f_euler(VALUE *vp) +{ + VALUE res; + + if (vp->v_type!=V_NUM || qisfrac(vp->v_num)) + return error_value(E_EULER); + res.v_subtype = V_NOSUBTYPE; + res.v_type = V_NUM; + res.v_num = qeuler(vp->v_num->num); + if (res.v_num == NULL) + return error_value(E_EULER); + return res; +} + + +static VALUE +f_freeeuler(void) +{ + VALUE res; + + qfreeeuler(); + res.v_type = V_NULL; + res.v_subtype = V_NOSUBTYPE; + return res; +} + + +static VALUE +f_catalan(VALUE *vp) +{ + VALUE res; + + if (vp->v_type!=V_NUM || qisfrac(vp->v_num) || zge31b(vp->v_num->num)) + return error_value(E_CTLN); + res.v_type = V_NUM; + res.v_subtype = V_NOSUBTYPE; + res.v_num = qcatalan(vp->v_num); + if (res.v_num == NULL) + return error_value(E_CTLN); + return res; +} + static VALUE f_arg(int count, VALUE **vals) { @@ -3488,24 +3656,82 @@ f_polar(int count, VALUE **vals) } -static NUMBER * -f_ilog(NUMBER *val1, NUMBER *val2) +static VALUE +f_ilog(VALUE *v1, VALUE *v2) { - return itoq(qilog(val1, val2)); + VALUE res; + + if (v2->v_type != V_NUM || qisfrac(v2->v_num) || qiszero(v2->v_num) || + qisunit(v2->v_num)) + return error_value(E_ILOGB); + + switch(v1->v_type) { + case V_NUM: + res.v_num = qilog(v1->v_num, v2->v_num->num); + break; + case V_COM: + res.v_num = cilog(v1->v_com, v2->v_num->num); + break; + default: + return error_value(E_ILOG); + } + + if (res.v_num == NULL) + return error_value(E_LOGINF); + + res.v_type = V_NUM; + res.v_subtype = V_NOSUBTYPE; + return res; } -static NUMBER * -f_ilog2(NUMBER *val) +static VALUE +f_ilog2(VALUE *vp) { - return itoq(qilog2(val)); + VALUE res; + + switch(vp->v_type) { + case V_NUM: + res.v_num = qilog(vp->v_num, _two_); + break; + case V_COM: + res.v_num = cilog(vp->v_com, _two_); + break; + default: + return error_value(E_ILOG2); + } + + if (res.v_num == NULL) + return error_value(E_LOGINF); + + res.v_type = V_NUM; + res.v_subtype = V_NOSUBTYPE; + return res; } -static NUMBER * -f_ilog10(NUMBER *val) +static VALUE +f_ilog10(VALUE *vp) { - return itoq(qilog10(val)); + VALUE res; + + switch(vp->v_type) { + case V_NUM: + res.v_num = qilog(vp->v_num, _ten_); + break; + case V_COM: + res.v_num = cilog(vp->v_com, _ten_); + break; + default: + return error_value(E_ILOG10); + } + + if (res.v_num == NULL) + return error_value(E_LOGINF); + + res.v_type = V_NUM; + res.v_subtype = V_NOSUBTYPE; + return res; } @@ -6459,6 +6685,19 @@ f_isatty(VALUE *vp) } +static VALUE +f_calc_tty(void) +{ + VALUE res; + + if (!calc_tty(FILEID_STDIN)) + return error_value(E_TTY); + res.v_type = V_NULL; + res.v_subtype = V_NOSUBTYPE; + return res; +} + + static VALUE f_inputlevel (void) { @@ -6651,6 +6890,48 @@ f_system(VALUE *vp) } +static VALUE +f_sleep(int count, VALUE **vals) +{ + long time; + VALUE res; + NUMBER *q1, *q2; + + res.v_type = V_NULL; + if (count > 0) { + if (vals[0]->v_type != V_NUM || qisneg(vals[0]->v_num)) + return error_value(E_SLEEP); + if (qisint(vals[0]->v_num)) { + if (zge31b(vals[0]->v_num->num)) + return error_value(E_SLEEP); + time = ztoi(vals[0]->v_num->num); + time = sleep(time); + } + else { + q1 = qscale(vals[0]->v_num, 20); + q2 = qint(q1); + qfree(q1); + if (zge31b(q2->num)) { + qfree(q2); + return error_value(E_SLEEP); + } + time = ztoi(q2->num); + qfree(q2); + /* BSD 4.3 usleep has void return */ + usleep(time); + return res; + } + } else { + time = sleep(1); + } + if (time) { + res.v_type = V_NUM; + res.v_num = itoq(time); + } + return res; +} + + /* * set the default output base/mode */ @@ -7493,6 +7774,8 @@ static CONST struct builtin builtins[] = { "arithmetic mean of values"}, {"base", 0, 1, 0, OP_NOP, f_base, 0, "set default output base"}, + {"bernoulli", 1, 1, 0, OP_NOP, 0, f_bern, + "Bernoulli number for index a"}, {"bit", 2, 2, 0, OP_BIT, 0, 0, "whether bit b in value a is set"}, {"blk", 0, 3, 0, OP_NOP, 0, f_blk, @@ -7509,6 +7792,10 @@ static CONST struct builtin builtins[] = { "truncate a to b number of binary places"}, {"calclevel", 0, 0, 0, OP_NOP, 0, f_calclevel, "current calculation level"}, + {"calc_tty", 0, 0, 0, OP_NOP, 0, f_calc_tty, + "set tty for interactivity"}, + {"catalan", 1, 1, 0, OP_NOP, 0, f_catalan, + "catalan number for index a"}, {"ceil", 1, 1, 0, OP_NOP, 0, f_ceil, "smallest integer greater than or equal to number"}, {"cfappr", 1, 3, 0, OP_NOP, f_cfappr, 0, @@ -7521,7 +7808,7 @@ static CONST struct builtin builtins[] = { "command buffer"}, {"cmp", 2, 2, 0, OP_CMP, 0, 0, "compare values returning -1, 0, or 1"}, - {"comb", 2, 2, 0, OP_NOP, qcomb, 0, + {"comb", 2, 2, 0, OP_NOP, 0, f_comb, "combinatorial number a!/b!(a-b)!"}, {"config", 1, 2, 0, OP_SETCONFIG, 0, 0, "set or read configuration value"}, @@ -7555,10 +7842,10 @@ static CONST struct builtin builtins[] = { "denominator of fraction"}, {"det", 1, 1, 0, OP_NOP, 0, f_det, "determinant of matrix"}, - {"digit", 2, 2, 0, OP_NOP, f_digit, 0, + {"digit", 2, 3, 0, OP_NOP, 0, f_digit, "digit at specified decimal place of number"}, - {"digits", 1, 1, 0, OP_NOP, f_digits, 0, - "number of digits in number"}, + {"digits", 1, 2, 0, OP_NOP, 0, f_digits, + "number of digits in base b representation of a"}, {"display", 0, 1, 0, OP_NOP, 0, f_display, "number of decimal digits for displaying numbers"}, {"dp", 2, 2, 0, OP_NOP, 0, f_dp, @@ -7573,6 +7860,8 @@ static CONST struct builtin builtins[] = { "set or read calc_errno"}, {"error", 0, 1, 0, OP_NOP, 0, f_error, "generate error value"}, + {"euler", 1, 1, 0, OP_NOP, 0, f_euler, + "Euler number"}, {"eval", 1, 1, 0, OP_NOP, 0, f_eval, "evaluate expression from string to value"}, {"exp", 1, 2, 0, OP_NOP, 0, f_exp, @@ -7623,6 +7912,10 @@ static CONST struct builtin builtins[] = { "write one or more null-terminated strings to a file"}, {"free", 0, IN, FA, OP_NOP, 0, f_free, "free listed or all global variables"}, + {"freebernoulli", 0, 0, 0, OP_NOP, 0, f_freebern, + "free stored Benoulli numbers"}, + {"freeeuler", 0, 0, 0, OP_NOP, 0, f_freeeuler, + "free stored Euler numbers"}, {"freeglobals", 0, 0, 0, OP_NOP, 0, f_freeglobals, "free all global and visible static variables"}, {"freeredc", 0, 0, 0, OP_NOP, 0, f_freeredc, @@ -7663,11 +7956,11 @@ static CONST struct builtin builtins[] = { "v mod h*2^n+r, h>0, n>0, r = -1, 0 or 1"}, {"hypot", 2, 3, FE, OP_NOP, qhypot, 0, "hypotenuse of right triangle within accuracy c"}, - {"ilog", 2, 2, 0, OP_NOP, f_ilog, 0, - "integral log of one number with another"}, - {"ilog10", 1, 1, 0, OP_NOP, f_ilog10, 0, + {"ilog", 2, 2, 0, OP_NOP, 0, f_ilog, + "integral log of a to integral base b"}, + {"ilog10", 1, 1, 0, OP_NOP, 0, f_ilog10, "integral log of a number base 10"}, - {"ilog2", 1, 1, 0, OP_NOP, f_ilog2, 0, + {"ilog2", 1, 1, 0, OP_NOP, 0, f_ilog2, "integral log of a number base 2"}, {"im", 1, 1, 0, OP_IM, 0, 0, "imaginary part of complex number"}, @@ -7833,8 +8126,8 @@ static CONST struct builtin builtins[] = { "value of pi accurate to within epsilon"}, {"pix", 1, 2, 0, OP_NOP, f_pix, 0, "number of primes <= a < 2^32, return b if error"}, - {"places", 1, 1, 0, OP_NOP, f_places, 0, - "places after decimal point (-1 if infinite)"}, + {"places", 1, 2, 0, OP_NOP, 0, f_places, + "places after \"decimal\" point (-1 if infinite)"}, {"pmod", 3, 3, 0, OP_NOP, qpowermod,0, "mod of a power (a ^ b (mod c))"}, {"polar", 2, 3, 0, OP_NOP, 0, f_polar, @@ -7937,6 +8230,8 @@ static CONST struct builtin builtins[] = { "total number of elements in value"}, {"sizeof", 1, 1, 0, OP_NOP, 0, f_sizeof, "number of octets used to hold the value"}, + {"sleep", 0, 1, 0, OP_NOP, 0, f_sleep, + "suspend operatioo for a seconds"}, {"sort", 1, 1, 0, OP_NOP, 0, f_sort, "sort a copy of a matrix or list"}, {"sqrt", 1, 3, 0, OP_NOP, 0, f_sqrt, diff --git a/help/Makefile b/help/Makefile index e7e3dae..9054a6f 100644 --- a/help/Makefile +++ b/help/Makefile @@ -19,7 +19,7 @@ # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. # # @(#) $Revision: 29.3 $ -# @(#) $Id: Makefile,v 29.3 2000/06/07 14:02:33 chongo Exp $ +# @(#) $Id: Makefile,v 29.3 2000/06/07 14:02:33 chongo Exp chongo $ # @(#) $Source: /usr/local/src/cmd/calc/help/RCS/Makefile,v $ # # Under source code control: 1991/07/23 06:47:57 @@ -141,29 +141,30 @@ BLT_HELP_FILES= ${BLT_HELP_FILES_3} ${BLT_HELP_FILES_5} \ # DETAIL_HELP= abs access acos acosh acot acoth acsc acsch address agd append \ appr arg argv arrow asec asech asin asinh assign atan atan2 atanh \ - avg base bit blk blkcpy blkfree blocks bround btrunc calclevel ceil \ - cfappr cfsim char cmdbuf cmp comb conj cos cosh cot coth count cp \ - csc csch ctime delete den dereference det digit digits dp epsilon \ - errcount errmax errno error eval exp fact factor fclose fcnt feof \ - ferror fflush fgetc fgetfield fgetline fgets fgetstr fib files floor \ - fopen forall fprintf fputc fputs fputstr frac free freeglobals \ - freeredc freestatics frem freopen fscan fscanf fseek fsize ftell \ - gcd gcdrem gd getenv hash head highbit hmean hnrmod hypot ilog \ - ilog10 ilog2 im indices inputlevel insert int inverse iroot isassoc \ - isatty isblk isconfig isdefined iserror iseven isfile ishash isident \ - isint islist ismat ismult isnull isnum isobj isobjtype isodd isprime \ - isptr isqrt isrand israndom isreal isrel issimple issq isstr istype \ - jacobi join lcm lcmfact lfactor ln lowbit ltol makelist matdim \ - matfill matmax matmin matsum mattrace mattrans max md5 memsize meq \ - min minv mmin mne mod modify name near newerror nextcand nextprime \ - norm null num oldvalue ord param perm pfact pi pix places pmod polar \ - poly pop popcnt power prevcand prevprime printf prompt protect ptest \ - push putenv quo quomod rand randbit random randombit randperm rcin \ - rcmul rcout rcpow rcsq re remove reverse rewind rm root round rsearch \ - runtime saveval scale scan scanf search sec sech seed segment select \ - sgn sha sha1 sin sinh size sizeof sort sqrt srand srandom ssq str \ - strcat strerror strlen strpos strprintf strscan strscanf substr \ - sum swap system tail tan tanh test time trunc xor + avg base bernoulli bit blk blkcpy blkfree blocks bround btrunc \ + calclevel ceil cfappr cfsim char cmdbuf cmp comb conj cos cosh \ + cot coth count cp csc csch ctime delete den dereference det digit \ + digits dp epsilon errcount errmax errno error eval exp fact factor \ + fclose fcnt feof ferror fflush fgetc fgetfield fgetline fgets fgetstr \ + fib files floor fopen forall fprintf fputc fputs fputstr frac free \ + freebernoulli freeglobals freeredc freestatics frem freopen fscan \ + fscanf fseek fsize ftell gcd gcdrem gd getenv hash head highbit \ + hmean hnrmod hypot ilog ilog10 ilog2 im indices inputlevel insert \ + int inverse iroot isassoc isatty isblk isconfig isdefined iserror \ + iseven isfile ishash isident isint islist ismat ismult isnull isnum \ + isobj isobjtype isodd isprime isptr isqrt isrand israndom isreal \ + isrel issimple issq isstr istype jacobi join lcm lcmfact lfactor ln \ + lowbit ltol makelist matdim matfill matmax matmin matsum mattrace \ + mattrans max md5 memsize meq min minv mmin mne mod modify name \ + near newerror nextcand nextprime norm null num oldvalue ord param \ + perm pfact pi pix places pmod polar poly pop popcnt power prevcand \ + prevprime printf prompt protect ptest push putenv quo quomod rand \ + randbit random randombit randperm rcin rcmul rcout rcpow rcsq re \ + remove reverse rewind rm root round rsearch runtime saveval scale \ + scan scanf search sec sech seed segment select sgn sha sha1 sin \ + sinh size sizeof sort sqrt srand srandom ssq str strcat strerror \ + strlen strpos strprintf strscan strscanf substr sum swap system \ + tail tan tanh test time trunc xor # This list is of files that are clones of DETAIL_HELP files. They are # built from DETAIL_HELP files. diff --git a/help/bernoulli b/help/bernoulli new file mode 100644 index 0000000..54a61cc --- /dev/null +++ b/help/bernoulli @@ -0,0 +1,67 @@ +NAME + bernoulli - Bernoulli number + +SYNOPSIS + bernoulli(n) + +TYPES + n integer, n < 2^31 if even + + return rational + +DESCRIPTION + Returns the Bernoulli number with index n, i.e. the coefficient B_n in + the expansion + + t/(exp(t) - 1) = Sum B_n * t^n/n! + + bernouuli(n) is zero both for n < 0 and for n odd and > 2. + When bernoulli(n) is computed for positive even n, the values for + n and smaller positive even indices are stored in a table so that + a later call to bernoulli(k) with 0 <= k < n will be executed quickly. + + Considerable runtime and memory are required for calculating + bernoulli(n) for large even n. For n = 1000, the numerator has + 1779 digits, the denominator 9 digits. + + The memory used to store calculated bernoulli numbers is freed by + freebernoulli(). + +EXAMPLE + > config("mode", "frac"),; + > for (n = 0; n <= 6; n++) print bernoulli(n),; print; + 1 -1/2 1/6 0 -1/30 0 1/42 + +LIMITS + n < 2^31-1 + +LINK LIBRARY + NUMBER *qbernoulli(long n) + +SEE ALSO + euler, freebernoulli, catalan, comb, fact, perm + +## Copyright (C) 2000 Ernest Bowen +## +## Calc is open software; you can redistribute it and/or modify it under +## the terms of the version 2.1 of the GNU Lesser General Public License +## as published by the Free Software Foundation. +## +## Calc is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General +## Public License for more details. +## +## A copy of version 2.1 of the GNU Lesser General Public License is +## distributed with calc under the filename COPYING-LGPL. You should have +## received a copy with calc; if not, write to Free Software Foundation, Inc. +## 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. +## +## @(#) $Revision: 29.2 $ +## @(#) $Id: sin,v 29.2 2000/06/07 14:02:33 chongo Exp $ +## @(#) $Source: /usr/local/src/cmd/calc/help/RCS/sin,v $ +## +## Under source code control: 2000/07/13 +## File existed as early as: 2000 +## +## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ diff --git a/help/define b/help/define index 07795a4..a5ecc6e 100644 --- a/help/define +++ b/help/define @@ -1,121 +1,197 @@ -Function definitions +NAME + define - command keyword to start a function definition - Function definitions are introduced by the 'define' keyword. - Other than this, the basic structure of an ordinary definition - is like in that in C: parameters are specified for the function - within parenthesis, the function body is introduced by a left brace, - variables may declared for the function, statements implementing the - function may follow, any value to be returned by the function is specified - by a return statement, and the function definition is ended with a - right brace. +SYNTAX + define fname([param_1 [= default_1], ...]) = [expr] + define fname([param_1 [= default_1], ...]) { [statement_1 ... ] } - There are some subtle differences, however. The types of parameters - and variables are not defined at compile time, and may vary during - execution and be different in different calls to the function. For - example, a two-argument function add may be defined by +TYPES + fname identifier, not a builtin function name + param_1, ... identifiers, no two the same + default_1, ... expressions + expr expression + statement_1, ... statements - define add(a,b) { - return a + b; - } +DESCRIPTION + The intention of a function definition is that the identifier fname + becomes the name of a function which may be called by an expression + of the form fname(arg_1, arg_2, ...), where arg_1, arg_2, ... are + expressions (including possibly blanks, which are treated as + null values). Evaluation of the function begins with evaluation + of arg_1, arg_2, ...; then, in increasing order of i, if arg_i is + null-valued and "= default_i" has been included in the definition, + default_i is evaluated and its value becomes the value of arg_i. + The instructions in expr or the listed statements are then executed + with each occurrence of param_i replaced by the value obtained + for arg_i. - and be called with integer, fractional, or complex number values for a - and b, or, under some compatibility conditions, matrices or objects. - Any variable, not already defined as global, used in a definition has - to be declared as local, global or static, and retains this character - until its scope is terminated by the end of the definition, the end of - the file being read or some other condition (see help variable for - details). + In a call, arg_i may be preceded by a backquote (`) to indicate that + evaluation of arg_i is not to include a final evaluation of an lvalue. + For example, suppose a function f and a global variable A have been + defined by: - For example, the following function computes the factorial of n, where - we may suppose it is to be called only with positive integral values - for n: + define f(x) = (x = 3); + global mat A[3]; - define factorial(n) - { - local ans; + If g() is a function that evaluates to 2: - ans = 1; - while (n > 1) - ans *= n--; - return ans; - } + f(A[g()]); - (In calc, this definition is unncessary since there is a built-in - function fact(n), also expressible as n!, which returns the factorial - of n.) + assigns the value of A[2] to the parameter x and then assigns the + value 3 to x: - Any functions used in the body of the definition need not have already - been defined; it is sufficient that they have been defined when they are - encountered during evaluation when the function is called. + f(`A[g()]); - If a function definition is sufficiently simple and does not require - local or static variables, it may be defined in shortened manner by - using an equals sign following by an expression involving some or all - of the parameters and already existing global variables. + has essentially the effect of assigning A[2] as an lvalue to x and + then assigning the value 3 to A[2]. (Very old versions of calc + achieved the same result by using '&' as in f(&A[g()]).) - In this case, the definition is terminated by a newline character - (which may be preceded by a semicolon), and the value the function - returns when called will be determined by the specified expression. - Loops and "if" statements are not allowed (but ? : expressions and the - logical operators ||, && and ! are permitted). As an example, the - average of two numbers could be defined as: + The number of arguments arg_1, arg_2, ... in a call need not equal the + number of parameters. If there are fewer arguments than parameters, + the "missing" values are assigned the null value. - define average(a, b) = (a + b) / 2; + In the definition of a function, the builtin function param(n) + provides a way of referring to the parameters. If n (which may + result from evaluating an expreession) is zero, it returns the number + of arguments in a call to the function, and if 1 <= n <= param(0), + param(n) refers to the parameter with index n. - (Again, this function is not necessary, as the same result is - returned by the builtin function avg() when called with the - two arguments a, b.) + If no error occurs and no quit statement or abort statement is + encountered during evaluation of the expression or the statements, + the function call returns a value. In the expression form, this is + simply the value of the expression. - Function definitions can be very complicated. Functions may be - defined on the command line if desired, but editing of partial - functions is not possible past a single line. If an error is made - on a previous line, then the function must be finished (with probable - errors) and reentered from the beginning. Thus for complicated - functions, it is best to use an editor to create the definition in a - file, and then enter the calculator and read in the file containing - the definition. + In the statement form, if a return statement is encountered, + the "return" keyword is to be either immediately followed by an + expression or by a statement terminator (semicolon or rightbrace); + in the former case, the expression is evaluated, evaluation of + the function ceases, and the value obtained for the expression is + returned as the "value of the function"; in the no-expression case, + evaluation ceases immediately and the null-value is returned. - The parameters of a function can be referenced by name, as in - normal C usage, or by using the 'param' function. This function - returns the specified parameter of the function it is in, where - the parameters are numbered starting from 1. The total number - of parameters to the function is returned by using 'param(0)'. - Using this function allows you to implement varargs-like routines - which can handle up to 100 calling parameters. For example: + In the expression form of definition, the end of the expression expr + is to be indicated by either a semicolon or a newline not within + a part enclosed by parentheses; the definition may extend over + several physical lines by ending each line with a '\' character or by + enclosing the expression in parentheses. In interactive mode, that + a definition has not been completed is indicated by the continuation + prompt. A ctrl-C interrupt at this stage will abort the definition. - define sc() - { - local s, i; + If the expr is omitted from an expression definition, as in: - s = 0; - for (i = 1; i <= param(0); i++) - s += param(i)^3; - return s; - } + define h() = ; - defines a function which returns the sum of the cubes of all its - parameters. + any call to the function will evaluate the arguments and return the + null value. - Any identifier other than a reserved word (if, for, etc.) and the - name of a builtin function (abs, fact, sin, etc.) can be used when - defining a new function or redefining an existing function. + In the statement form, the definition ends when a matching right + brace completes the "block" started by the initial left brace. + Newlines within the block are treated as white space; statements + within the block end with a ';' or a '}' matching an earlier '{'. - An indication of how a user-defined function is stored may be obtained - by using the "show opcodes" command. For example: + If a function with name fname had been defined earlier, the old + definition has no effect on the new definition, but if the definition + is completed successfully, the new definition replaces the old one; + otherwise the old definition is retained. The number of parameters + and their names in the new definiton may be quite different from + those in the old definition. - > global alpha - > define f(x) = 5 + alpha * x - "f" defined - > show opcodes f - 0: NUMBER 5 - 2: GLOBALADDR alpha - 4: PARAMADDR 0 - 6: MUL - 7: ADD - 8: RETURN + An attempt at a definition may fail because of scanerrors as the + definition is compiled. Common causes of these are: bad syntax, + using identifiers as names of variables not yet defined. It is + not a fault to have in the definition a call to a function that has + not yet been defined; it is sufficient that the function has been + defined when a call is made to the function. + After fname has been defined, the definition may be removed by the command: -## Copyright (C) 1999 Landon Curt Noll + undefine fname + + The definitions of all user-defined functions may be removed by: + + undefine * + + If bit 0 of config("resource_debug") is set and the define command is + at interactive level, a message saying that fname has been defined + or redefined is displayed. The same message is displayed if bit 1 + of config("resource_debug") is set and the define command is read + from a file. + + The identifiers used for the parameters in a function definition do + not form part of the completed definition. For example, + + define f(a,b) = a + b; + define g(alpha, beta) = alpha + beta; + + result in identical code for the functions f, g. + + If config("trace") & 8 is nonzero, the opcodes of a newly defined + function are displayed on completion of its definition, parameters + being specified by names used in the definition. For example: + + > config("trace", 8), + > define f(a,b) = a + b + 0: PARAMADDR a + 2: PARAMADDR b + 4: ADD + 5: RETURN + f(a,b) defined + + The opcodes may also be displayed later using the show opcodes command; + parameters will be specified by indices instead of by names. For example: + + > show opco f + 0: PARAMADDR 0 + 2: PARAMADDR 1 + 4: ADD + 5: RETURN + + When a function is defined by the statement mode, the opcodes normally + include DEBUG opcodes which specify statement boundaries at which + SIGINT interruptions are likely to be least risky. Inclusion of + the DEBUG opcodes is disabled if config("trace") & 2 is nonzero. + For details, see help interrupt. + + While config("trace") & 1 is nonzero, the opcodes are displayed as + they are being evaluated. The current function is identified by its + name, or "*" in the case of a command-line and "**" in the case of + an eval(str) evaluation. + + When a function is called, argument values may be of any type for + which the operations and any functions used within the body of the + definition can be executed. For example, whatever the intention at + the time they were defined, the functions f1(), f2() defined above + may be called with integer, fractional, or complex-number values, or + with both arguments strings, or under some compatibility conditions, + matrices or objects. + +EXAMPLE + > define f(a,b) = 2*a + b; + > define g(alpha, beta) + >> { + >> local a, pi2; + >> + >> pi2 = 2 * pi(); + >> a = sin(alpha % pi2); + >> if (a > 0.0) { + >> return a*beta; + >> } + >> if (beta > 0.0) { + >> a *= cos(-beta % pi2); + >> } + >> return a; + >> } + +LIMITS + The number of arguments in a function-call cannot exceed 100. + +LIBRARY + none + +SEE ALSO + param, variable, undefine, show + +## Copyright (C) 2000 David I. Bell, Landon Curt Noll and Ernest Bowen ## ## Calc is open software; you can redistribute it and/or modify it under ## the terms of the version 2.1 of the GNU Lesser General Public License @@ -132,8 +208,9 @@ Function definitions ## 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. ## ## @(#) $Revision: 29.2 $ -## @(#) $Id: define,v 29.2 2000/06/07 14:02:33 chongo Exp $ -## @(#) $Source: /usr/local/src/cmd/calc/help/RCS/define,v $ +## @(#) $Id: sin,v 29.2 2000/06/07 14:02:33 chongo Exp $ +## @(#) $Source: /usr/local/src/cmd/calc/help/RCS/sin,v $ +## ## ## Under source code control: 1991/07/21 04:37:18 ## File existed as early as: 1991 diff --git a/help/freebernoulli b/help/freebernoulli new file mode 100644 index 0000000..a722c12 --- /dev/null +++ b/help/freebernoulli @@ -0,0 +1,49 @@ +NAME + freebernoulli - free stored Benoulli numbers + +SYNOPSIS + freebernoulli() + +TYPES + return none + +DESCRIPTION + The memory used to store calculated bernoulli numbers is freed by + freebernoulli(). + +EXAMPLE + > freebernoulli(); + +LIMITS + none + +LINK LIBRARY + void qfreebern(void); + +SEE ALSO + bernoulli + +## Copyright (C) 2000 Ernest Bowen +## +## Calc is open software; you can redistribute it and/or modify it under +## the terms of the version 2.1 of the GNU Lesser General Public License +## as published by the Free Software Foundation. +## +## Calc is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General +## Public License for more details. +## +## A copy of version 2.1 of the GNU Lesser General Public License is +## distributed with calc under the filename COPYING-LGPL. You should have +## received a copy with calc; if not, write to Free Software Foundation, Inc. +## 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. +## +## @(#) $Revision: 29.2 $ +## @(#) $Id: sin,v 29.2 2000/06/07 14:02:33 chongo Exp $ +## @(#) $Source: /usr/local/src/cmd/calc/help/RCS/sin,v $ +## +## Under source code control: 2000/07/13 +## File existed as early as: 2000 +## +## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ diff --git a/help/interrupt b/help/interrupt index 9365d94..12e0ce8 100644 --- a/help/interrupt +++ b/help/interrupt @@ -15,10 +15,13 @@ Interrupts [Abort level n] where n ranges from 1 to 3. For n equal to 1, the calculator will - abort calculations at the next statement boundary. For n equal to 2, - the calculator will abort calculations at the next opcode boundary. - For n equal to 3, the calculator will abort calculations at the next - lowest level arithmetic operation boundary. + abort calculations at the next statement boundary specified by an + ABORT opcode as described below. For n equal to 2, the calculator + will abort calculations at the next opcode boundary. For n equal to 3, + the calculator will abort calculations at the next attempt to allocate + memory for the result of an integer arithmetic operation; this + level may be appropriate for stopping a builtin operation like + inversion of a large matrix. If a final interrupt is given when n is 3, the calculator will immediately abort the current calculation and longjmp back to the @@ -27,8 +30,77 @@ Interrupts be done as a last resort. You are advised to quit the calculator after this has been done. -## Copyright (C) 1999 Landon Curt Noll -## +ABORT opcodes + + If config("trace") & 2 is zero, ABORT opcodes are introduced at + various places in the opcodes for evaluation of command lines + and functions defined by "define ... { ... }" commands. In the + following, config("trace") has been set equal to 8 so that opcodes + are displayed when a function is defined. The function f(x) + evaluates x + (x - 1) + (x - 2) + ... until a zero term is + encountered. If f() is called with a negative or fractional x, + the calculation is never completed and to stop it, an interruption + (on many systems, by ctrl-C) will be necessary. + + > config("trace", 8), + > define f(x) {local s; while (x) {s += x--} return s} + 0: DEBUG line 2 + 2: PARAMADDR x + 4: JUMPZ 19 + 6: DEBUG line 2 + 8: LOCALADDR s + 10: DUPLICATE + 11: PARAMADDR x + 13: POSTDEC + 14: POP + 15: ADD + 16: ASSIGNPOP + 17: JUMP 2 + 19: DEBUG line 2 + 21: LOCALADDR s + 23: RETURN + f(x) defined + + (The line number following DEBUG refers to the line in the file + from which the definition is read.) If an attempt is made to + evaluate f(-1), the effect of the DEBUG at opcode 6 ensures that + a single SIGINT will stop the calculation at a start of + {s += x--} loop. In interactive mode, with ^C indicating + input of ctrl-C, the displayed output is as in: + + > f(-1) + ^C + [Abort level 1] + "f": line 2: Calculation aborted at statement boundary + + The DEBUG opcodes are disabled by nonzero config("trace") & 2. + Changing config("trace") to achieve this, and defining g(x) with + the same definition as for f(x) gives: + + > define g(x) {local s; while (x) {s += x--} return s} + 0: PARAMADDR x + 2: JUMPZ 15 + 4: LOCALADDR s + 6: DUPLICATE + 7: PARAMADDR x + 9: POSTDEC + 10: POP + 11: ADD + 12: ASSIGNPOP + 13: JUMP 0 + 15: LOCALADDR s + 17: RETURN + g(x) defined + + If g(-1) is called, two interrupts are necessary, as in: + + > g(-1) + ^C + [Abort level 1] + ^C + [Abort level 2] + "g": Calculation aborted in opcode + ## Calc is open software; you can redistribute it and/or modify it under ## the terms of the version 2.1 of the GNU Lesser General Public License ## as published by the Free Software Foundation. @@ -44,7 +116,7 @@ Interrupts ## 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. ## ## @(#) $Revision: 29.2 $ -## @(#) $Id: interrupt,v 29.2 2000/06/07 14:02:33 chongo Exp $ +## @(#) $Id: interrupt,v 29.2 2000/06/07 14:02:33 chongo Exp chongo $ ## @(#) $Source: /usr/local/src/cmd/calc/help/RCS/interrupt,v $ ## ## Under source code control: 1991/07/21 04:37:21 diff --git a/help/script b/help/script index be96e7c..9cc569a 100644 --- a/help/script +++ b/help/script @@ -1,62 +1,264 @@ Calc shell scripts ------------------ - If an executable file begins with: + There are several ways calc may be used in shell scripts. The + syntax for these varies widely for different shells and systems, + but common to most are commands like echo, if, for, goto, shift, + and exit, as well as the accessing of environment parameters, shell + variables, and command-line arguments. - #!/usr/local/bin/calc -S [-other_flags ...] + As a simple example, assuming a C or Bourne shell, let add be a + file containing just one line: - the rest of the file will be processed in shell script mode. - Note that -S (UPPER CASE -S) must be the first -flag on the - ``#!'' line. Any other optional ``-other_flags'' must come - after the -S. + calc -q -- $1 + $2 - In shell script mode the contents of the file are evaluated - and executed as if they were processed by the read command. - Any optional ``-other_flags'' will by parsed first followed - by any arguments given shell script itself. + Then: - In shell script mode, -s (lower case -s) is always assumed. - In addition, -d and -p are automatically set if -i is not - given. + ./add 1.23 4.56 - For example, if the file /tmp/mersenne: + should respond with the display of: - #!/usr/local/bin/calc -S -q - # - # mersenne - an example of a calc shell script file + 5.9 - /* parse args */ - if (argv() != 1) { - fprintf(files(2), "usage: %s exp\n", config("program")); - abort "must give one exponent arg"; - } + The "-q" was included in the command to avoid reading of any + start-up calc files which could contain commands not wanted + here. The "--" indicates that there are no more options; + without it, if $1 began with '-', calc would interpret it as + the first character of another option. To execute the file, + the strings "1.23" and "4.56" were assigned to $1 and $2, so + calc was in effect asked to evaluate the string "1.23 + 4.56". - /* print the mersenne number */ - print "2^": argv(0) : "-1 =", 2^eval(argv(0))-1; + By making add executable by a command like: - is made an executable file by: + chmod u+x add - chmod +x /tmp/mersenne + the command used here may be simplified to: - then the command line: + ./add 1.23 4.56 - /tmp/mersenne 127 + Here we shall assume that any script we refer to has been made + executable in this way. - will print: + Because $1 and $2, and instructions in the script, are to read + by calc as expressions or commands, they may be much more + complicated than in the above example, but if they involve + characters with special interpretations by the shell (spaces + for word separation, * or ? or [ ...] for file-name expansion, + ! (without immediately following space) for history expansion, + ( ... ) for shell-function arguments, { ... } for brace + expansion, $ for parameter or variable expansion, <, <<, >, >> + for redirection of input or output, etc.) it will usually be + necessary to quote or escape tho characters, or usually more + conveniently, quote whole expressions with single or double + quotes. - 2^127-1 = 170141183460469231731687303715884105727 + For example, the add script should have no problem with + commands like: - Note that because -s is assumed in shell script mode and - non-dashed args are made available as strings via the argv() - builtin function. Therefore: + ./add "sqrt(2)" "3 * 4" - 2^eval(argv(0))-1 + ./add "mat A[2,2] = {1,2,3,4}" "A^2" - will print the decimal value of 2^n-1 but + ./add "2 + 3i" "(3 + 4i)^2" - 2^argv(0)-1 + If the shell arguments are to be integers, one could use + scripts like the following with arithmetic expansion + for the bash and ksh: - will not. + declare -i a=$1 + declare -i b=$2 + calc -q -- $a + $b + + and for csh: + + @ a = $1 + @ b = $2 + calc -q -- $a + $b + + Specifying the shell for a script may be done by including + in the script a first line with the "magic number" "#!" and + the full file path for the shell as in: + + #!/bin/bash + declare -i a=$1 + declare -i b=$2 + calc -q -- $a + $b + + For a script to multiply rather than add two expressions, one + could have a file mul with the one line: + + calc -q -- $1 \* $2 + or: + calc -q -- "$1 * $2" + + which will work so long as $1 and $2 are literal numbers, but + will not work for: + + ./mul 2+3 4 + or: + ./mul "2 + 3" 4 + + both of which calc interprets as evaluating 2 + 3 * 4. What should + work for most shells is: + + calc -q -- "($1) * ($2)" + + For adding an arbitrary number of expressions that evaluate to + rational numbers expressible with at most 20 decimal places, + simple shell script could be used: + + s=0 + for i do + s=`calc -q -- $s + $i` + done + echo sum = $s + + This is not particularly efficient since it calls calc once for + each argument. Also, a more serious script would permit more + general numbers. + + Another way of handling a sum of several expressions is with + the script addall2 with a here document: + + calc "-q -s" $* << + + global i, n, s; + n = argv(); + for (i = 0; i < n; i++) + s += eval(argv(i)); + print "sum =", s; + + + + In executing the command: + + ./addall2 2 3 4 + + the $* in ths script expands to 2 3 4, and because of the "-s" + in the options, calc starts with argv(0) = "2", argv(1) = "3", + argv(2)= "4". As there is only one calc process involved and + the eval() function accepts as argument any string that + represents the body of a calc function, the strings argv(0), + argv(1), ... could evaluate to any value types for which the + additions to be performed are defined, and variables defined in + one argv() can be used in later arguments. + + For systems that support interpreter files, essentially the + same thing may be done more efficiently by using calc as an + interpreter. Assuming the full path for calc is + /usr/bin/calc, one could use the file addall3 with contents + + #!/usr/bin/calc -q -s -f + global i, n, s; + n = argv(); + for (i = 1; i <= n; i++) + s += eval(argv(i)); + print "sum =", s; + + After the command: + + addall3 2 3 4 + + the arguments calc receives are argv(0) = "addall3", argv(1) = + "2", argv(3) = "3", argv(4) = "4". + + Another kind of script that can be useful is sqrts1: + + calc -q 'global s; while (scanf("%s", s) == 1) print sqrt(eval(s));' + + or what is essentially an interpreter equivalent sqrts2: + + #!/usr/bin/calc -q -f + global s; + while (scanf('%s', s) == 1) + print sqrt(eval(s)); + + If sqrts is either of these scripts, the command: + + echo 27 2+3i | sqrts + + or, if datafile contains the one line: + + 27 2+3i + + or the two lines: + + 27 + 2+3i + + either: + + cat datafile | ./sqrts + or: + ./sqrts < datafile + + should display the square-roots of 27 and 2+3i. The output could + be piped to another command by | or directed to a file by use of + > or >>. + + With no specified input, either sqrts1 or sqrts2 will wait + without any prompt for input from the keyboard and as each line + is completed display the square-roots of the expressions + entered. Exit can be achieved by entering exit or entering + ctrl-D (interpreted as EOF) rather than a line of input. + + One advantage of an interpreter file like sqrts2 (which has only + options, but neither "-s" nor "--" in its first line) is that it + can be invoked with further options as in + + echo 2 3 4 | ./sqrts2 -i -D 32 + + An advantage of non-interpreter files is that they can use shell + features. For example, for unquoted arguments or arguments in + double quotes parameter expansion (indicated by unquoted '$') and + command substitution (using backquotes) occur before lines are + compiled by calc. For example, if doit is an executable + script with contents + + calc -q -- "$1($2)" + + it may be used as in: + + ./doit sqrt 7 + and: + ./doit exp 7 + + to display the values of sqrt(7) and exp(7). The "--" prevents a + leading '-' in the $1 argument as indicating one or more additional + options. E.g., without the "--" in doit, + + ./doit -sqrt 7 + + would be interpreted as: + + calc -q "-sqrt(7)" + + in which the dash in the quoted part would be taken as indicating a + list of options -s, -q, -r, etc.; this would give an "illegal option" + error as calc has no -r option. + + In invoking the doit script it is not necessary that $1 expand to a + calc function name and $2 to an expression; all that is required is + that: + + $1($2) + + expands to a string that calc will recognize as a command. E.g.: + + ./doit "define f(x) = x^2; 2 + mod" "f(7), 6" + + does the same as: + + calc -q -- "define f(x) = x^2; 2 + mod(f(7), 6)" + + Essentially the same is achieved by the contents of doit is changed to: + + calc -q -p -- << + + $1($2) + + + + The "-p" stops calc going interactive; without it the effect would be + be the same as that of a script with the one line: + + calc -q -i -- "$1($2)" For more information use the following calc commands: @@ -65,7 +267,7 @@ For more information use the following calc commands: help config help cscript -## Copyright (C) 1999 Landon Curt Noll +## Copyright (C) 2000 Landon Curt Noll and Ernest Bowen ## ## Calc is open software; you can redistribute it and/or modify it under ## the terms of the version 2.1 of the GNU Lesser General Public License @@ -82,7 +284,7 @@ For more information use the following calc commands: ## 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. ## ## @(#) $Revision: 29.3 $ -## @(#) $Id: script,v 29.3 2000/06/07 14:02:33 chongo Exp $ +## @(#) $Id: script,v 29.3 2000/06/07 14:02:33 chongo Exp chongo $ ## @(#) $Source: /usr/local/src/cmd/calc/help/RCS/script,v $ ## ## Under source code control: 1999/11/30 05:29:48 @@ -90,3 +292,4 @@ For more information use the following calc commands: ## ## chongo /\oo/\ http://www.isthe.com/chongo/ ## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ + diff --git a/input.c b/input.c index bf3ca15..cd0a226 100644 --- a/input.c +++ b/input.c @@ -1,5 +1,5 @@ /* - * input - nsted input source file reader + * input - nested input source file reader * * Copyright (C) 1999 David I. Bell * @@ -18,7 +18,7 @@ * 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. * * @(#) $Revision: 29.2 $ - * @(#) $Id: input.c,v 29.2 2000/06/07 14:02:13 chongo Exp $ + * @(#) $Id: input.c,v 29.2 2000/06/07 14:02:13 chongo Exp chongo $ * @(#) $Source: /usr/local/src/cmd/calc/RCS/input.c,v $ * * Under source code control: 1990/02/15 01:48:16 @@ -140,7 +140,7 @@ opensearchfile(char *name, char *pathlist, char *extension, int rd_once) * / * name * . - * extenstion + * extension * \0 * guard byte */ @@ -261,7 +261,7 @@ homeexpand(char *name) char *home2; /* fullpath of the home directory */ char *fullpath; /* the malloced expanded path */ char *after; /* after the ~user or ~ */ - char *username; /* extratced username */ + char *username; /* extracted username */ /* firewall */ if (name[0] != HOMECHAR) @@ -873,7 +873,7 @@ findfreeread(void) } maxreadset += READSET_ALLOC; - /* return the furst newly allocated free entry */ + /* return the first newly allocated free entry */ return maxreadset-READSET_ALLOC; } diff --git a/lib_calc.c b/lib_calc.c index 0cf5348..470b11a 100644 --- a/lib_calc.c +++ b/lib_calc.c @@ -18,7 +18,7 @@ * 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. * * @(#) $Revision: 29.3 $ - * @(#) $Id: lib_calc.c,v 29.3 2000/06/07 14:02:13 chongo Exp $ + * @(#) $Id: lib_calc.c,v 29.3 2000/06/07 14:02:13 chongo Exp chongo $ * @(#) $Source: /usr/local/src/cmd/calc/RCS/lib_calc.c,v $ * * Under source code control: 1996/06/17 18:06:19 @@ -97,7 +97,7 @@ jmp_buf jmpbuf; /* for errors */ char *program = "calc"; /* our name */ char *base_name = "calc"; /* basename of our name */ char cmdbuf[MAXCMD+1+1+1]; /* command line expression + "\n\0" + guard */ -run run_state = RUN_UNKNOWN; /* calc startup and run state */ +run run_state = RUN_ZERO; /* calc startup run state */ /* @@ -165,7 +165,7 @@ static int init_done = 0; /* 1 => we already initialized */ static int *fd_setup = NULL; /* fd's setup for interaction or -1 */ static int fd_setup_len = 0; /* number of fd's in fd_setup */ static ttystruct *fd_orig = NULL; /* fd original state */ -static ttystruct *fd_cur = NULL; /* fd current atate */ +static ttystruct *fd_cur = NULL; /* fd current state */ static void initenv(void); /* setup calc environment */ static int find_tty_state(int fd); /* find slot for saved tty state */ @@ -314,7 +314,7 @@ initialize(void) math_cleardiversions(); math_setfp(stdout); math_setmode(MODE_INITIAL); - math_setdigits((long)DISPLAY_DEFAULT); + math_setdigits(DISPLAY_DEFAULT); conf->maxprint = MAXPRINT_DEFAULT; } @@ -431,7 +431,7 @@ initenv(void) * * Anything that uses libcalc.a can call this function after they are * completely finished with libcalc.a processing. The only effect of - * this funcion is to free storage that might otherwise go unused. + * this function is to free storage that might otherwise go unused. * * NOTE: If, for any reason, you need to do more libcalc.a processing, * then you will need to call libcalc_call_me_first() again. @@ -461,15 +461,13 @@ libcalc_call_me_last(void) /* * restore all changed descriptor states */ - if (fd_setup_len > 0) { - for (i=0; i < fd_setup_len; ++i) { - if (fd_setup[i] >= 0) { - if (conf->calc_debug & CALCDBG_TTY) - printf("libcalc_call_me_last: fd %d " - "not in original state, " - "restoring it", fd_setup[i]); - orig_tty(fd_setup[i]); - } + for (i=0; i < fd_setup_len; ++i) { + if (fd_setup[i] >= 0) { + if (conf->calc_debug & CALCDBG_TTY) + printf("libcalc_call_me_last: fd %d " + "not in original state, " + "restoring it", fd_setup[i]); + orig_tty(fd_setup[i]); } } @@ -488,24 +486,24 @@ char * run_state_name(run state) { switch (state) { - case RUN_UNKNOWN: - return "RUN_UNKNOWN"; + case RUN_ZERO: + return "ZERO"; case RUN_BEGIN: - return "RUN_BEGIN"; + return "BEGIN"; case RUN_RCFILES: - return "RUN_RCFILES"; + return "RCFILES"; case RUN_PRE_CMD_ARGS: - return "RUN_PRE_CMD_ARGS"; + return "PRE_CMD_ARGS"; case RUN_CMD_ARGS: - return "RUN_CMD_ARGS"; + return "CMD_ARGS"; case RUN_PRE_TOP_LEVEL: - return "RUN_PRE_TOP_LEVEL"; + return "PRE_TOP_LEVEL"; case RUN_TOP_LEVEL: - return "RUN_TOP_LEVEL"; + return "TOP_LEVEL"; case RUN_EXIT: - return "RUN_EXIT"; + return "EXIT"; case RUN_EXIT_WITH_ERROR: - return "RUN_EXIT_WITH_ERROR"; + return "EXIT_WITH_ERROR"; } return "RUN_invalid"; } @@ -579,7 +577,7 @@ find_tty_state(int fd) } /* - * case: need to initlally malloc some state + * case: need to initially malloc some state */ if (fd_setup_len <= 0 || fd_setup == NULL || fd_orig == NULL) { @@ -835,8 +833,8 @@ orig_tty(int fd) fd_cur[slot] = fd_orig[slot]; /* - * Since current state is the orignal state, we can free up - * this slot. This also prevents functins such as the + * Since current state is the original state, we can free up + * this slot. This also prevents functions such as the * libcalc_call_me_last() function from re-restoring it. */ fd_setup[slot] = -1; diff --git a/opcodes.c b/opcodes.c index 75cea85..dfa69a8 100644 --- a/opcodes.c +++ b/opcodes.c @@ -20,7 +20,7 @@ * 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. * * @(#) $Revision: 29.2 $ - * @(#) $Id: opcodes.c,v 29.2 2000/06/07 14:02:13 chongo Exp $ + * @(#) $Id: opcodes.c,v 29.2 2000/06/07 14:02:13 chongo Exp chongo $ * @(#) $Source: /usr/local/src/cmd/calc/RCS/opcodes.c,v $ * * Under source code control: 1990/02/15 01:48:19 @@ -225,7 +225,7 @@ static void o_paramvalue(FUNC *fp, int argcount, VALUE *args, long index) { if ((unsigned long)index >= argcount) { - math_error("Bad paramaeter index"); + math_error("Bad parameter index"); /*NOTREACHED*/ } args += index; @@ -896,7 +896,7 @@ o_deref(void) return; } if (stack->v_type != V_ADDR) { - math_error("Deferencing a non-variable"); + math_error("Dereferencing a non-variable"); /*NOTREACHED*/ } vp = vp->v_addr; @@ -3228,8 +3228,8 @@ o_quit(FUNC *fp, long index) freevalue(stack--); } freevalue(stackarray); - libcalc_call_me_last(); - exit(0); + run_state = RUN_EXIT; + longjmp(jmpbuf, 1); } if (cp) printf("%s\n", cp); @@ -3512,10 +3512,10 @@ static struct opcode opcodes[MAX_OPCODE+1] = { {o_nop, OPNUL, "NOP"}, /* no operation */ {o_localaddr, OPLOC, "LOCALADDR"}, /* address of local variable */ {o_globaladdr, OPGLB, "GLOBALADDR"}, /* address of global variable */ - {o_paramaddr, OPPAR, "PARAMADDR"}, /* address of paramater variable */ + {o_paramaddr, OPPAR, "PARAMADDR"}, /* address of parameter variable */ {o_localvalue, OPLOC, "LOCALVALUE"}, /* value of local variable */ {o_globalvalue, OPGLB, "GLOBALVALUE"}, /* value of global variable */ - {o_paramvalue, OPPAR, "PARAMVALUE"}, /* value of paramater variable */ + {o_paramvalue, OPPAR, "PARAMVALUE"}, /* value of parameter variable */ {o_number, OPONE, "NUMBER"}, /* constant real numeric value */ {o_indexaddr, OPTWO, "INDEXADDR"}, /* array index address */ {o_printresult, OPNUL, "PRINTRESULT"}, /* print result of top-level expression */ diff --git a/qfunc.c b/qfunc.c index 88fb805..9493a02 100644 --- a/qfunc.c +++ b/qfunc.c @@ -20,7 +20,7 @@ * 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. * * @(#) $Revision: 29.2 $ - * @(#) $Id: qfunc.c,v 29.2 2000/06/07 14:02:13 chongo Exp $ + * @(#) $Id: qfunc.c,v 29.2 2000/06/07 14:02:13 chongo Exp chongo $ * @(#) $Source: /usr/local/src/cmd/calc/RCS/qfunc.c,v $ * * Under source code control: 1990/02/15 01:48:20 @@ -34,10 +34,17 @@ #include "config.h" #include "prime.h" +static NUMBER **B_table; +static long B_num; +static long B_allocnum; +static NUMBER **E_table; +static long E_num; + +#define QALLOCNUM 64 /* - * Set the default precision for real calculations. - * The precision must be between zero and one. + * Set the default epsilon for approximate calculations. + * This must be greater than zero. * * given: * q number to be set as the new epsilon @@ -47,8 +54,8 @@ setepsilon(NUMBER *q) { NUMBER *old; - if (qisneg(q) || qiszero(q) || (qreli(q, 1L) >= 0)) { - math_error("Epsilon value must be between zero and one"); + if (qisneg(q) || qiszero(q)) { + math_error("Epsilon value must be greater than zero"); /*NOTREACHED*/ } old = conf->epsilon; @@ -234,7 +241,7 @@ qpowi(NUMBER *q1, NUMBER *q2) /* - * Given the legs of a right triangle, compute its hypothenuse within + * Given the legs of a right triangle, compute its hypotenuse within * the specified error. This is sqrt(a^2 + b^2). */ NUMBER * @@ -262,7 +269,7 @@ qhypot(NUMBER *q1, NUMBER *q2, NUMBER *epsilon) /* - * Given one leg of a right triangle with unit hypothenuse, calculate + * Given one leg of a right triangle with unit hypotenuse, calculate * the other leg within the specified error. This is sqrt(1 - a^2). * If the wantneg flag is nonzero, then negative square root is returned. */ @@ -557,12 +564,11 @@ qilog10(NUMBER *q) * The number is not an integer. * Compute the result if the number is greater than one. */ - if ((q->num.len > q->den.len) || - ((q->num.len == q->den.len) && (zrel(tmp1, q->den) > 0))) { - zquo(tmp1, q->den, &tmp2, 0); - n = zlog10(tmp2); - zfree(tmp2); - return n; + if (zrel(tmp1, q->den) > 0) { + zquo(tmp1, q->den, &tmp2, 0); + n = zlog10(tmp2); + zfree(tmp2); + return n; } /* * Here if the number is less than one. @@ -583,104 +589,162 @@ qilog10(NUMBER *q) * Return the integer floor of the logarithm of a number relative to * a specified integral base. */ -long -qilog(NUMBER *q1, NUMBER *q2) +NUMBER * +qilog(NUMBER *q, ZVALUE base) { long n; ZVALUE tmp1, tmp2; - if (qiszero(q1)) { - math_error("Zero argument for ilog"); - /*NOTREACHED*/ - } - if (qisfrac(q2) || zrel(q2->num, _one_) <= 0) { - math_error("Base for ilog non-integral or less than 2"); - /*NOTREACHED*/ - } - if (qisunit(q1)) - return 0; - tmp1 = q1->num; + if (qiszero(q)) + return NULL; + + if (qisunit(q)) + return qlink(&_qzero_); + if (qisint(q)) + return itoq(zlog(q->num, base)); + tmp1 = q->num; tmp1.sign = 0; - if (qisint(q1)) - return zlog(tmp1, q2->num); - if (zrel(tmp1, q1->den) > 0) { - zquo(tmp1, q1->den, &tmp2, 0); - n = zlog(tmp2, q2->num); + if (zrel(tmp1, q->den) > 0) { + zquo(tmp1, q->den, &tmp2, 0); + n = zlog(tmp2, base); zfree(tmp2); - return n; + return itoq(n); } if (zisunit(tmp1)) - zsub(q1->den, _one_, &tmp2); + zsub(q->den, _one_, &tmp2); else - zquo(q1->den, tmp1, &tmp2, 0); - n = -zlog(tmp2, q2->num) - 1; + zquo(q->den, tmp1, &tmp2, 0); + n = -zlog(tmp2, base) - 1; zfree(tmp2); - return n; + return itoq(n); } + /* - * Return the number of digits in a number, ignoring the sign. - * For fractions, this is the number of digits of its greatest integer. - * Examples: qdigits(3456) = 4, qdigits(-23.45) = 2, qdigits(.0120) = 1. + * Return the number of digits in the representation to a specified + * base of the integral part of a number. + * Examples: qdigits(3456,10) = 4, qdigits(-23.45, 10) = 2. * * given: * q number to count digits of */ long -qdigits(NUMBER *q) +qdigits(NUMBER *q, ZVALUE base) { long n; /* number of digits */ ZVALUE temp; /* temporary value */ + if (zabsrel(q->num, q->den) < 1) + return 0; if (qisint(q)) - return zdigits(q->num); + return 1 + zlog(q->num, base); zquo(q->num, q->den, &temp, 2); - n = zdigits(temp); + n = 1 + zlog(temp, base); zfree(temp); return n; } /* - * Return the digit at the specified decimal place of a number represented - * in floating point. The lowest digit of the integral part of a number - * is the zeroth decimal place. Negative decimal places indicate digits - * to the right of the decimal point. Examples: qdigit(1234.5678, 1) = 3, - * qdigit(1234.5678, -3) = 7. + * Return the digit at the specified place in the expansion to specified + * base of a rational number. The places specified by dpos are numbered from + * the "units" place just before the "decimal" point, so that negative + * dpos indicates the (-dpos)th place to the right of the point. + * Examples: qdigit(1234.5678, 1, 10) = 3, qdigit(1234.5678, -3, 10) = 7. + * The signs of the number and the base are ignored. */ -long -qdigit(NUMBER *q, long n) +NUMBER * +qdigit(NUMBER *q, ZVALUE dpos, ZVALUE base) { - ZVALUE tenpow, tmp1, tmp2; - long res; + ZVALUE N, D; + ZVALUE K; + long k; + ZVALUE A, B, C; /* temporary integers */ + NUMBER *res; /* - * Zero number or negative decimal place of integer is trivial. + * In the first stage, q is expressed as base^k * N/D where + * gcd(D, base) = 1 + * K is k as a ZVALUE */ - if (qiszero(q) || (qisint(q) && (n < 0))) - return 0; - /* - * For non-negative decimal places, answer is easy. - */ - if (n >= 0) { - if (qisint(q)) - return zdigit(q->num, n); - zquo(q->num, q->den, &tmp1, 2); - res = zdigit(tmp1, n); - zfree(tmp1); - return res; + base.sign = 0; + if (ziszero(base) || zisunit(base)) + return NULL; + if (qiszero(q) || (qisint(q) && zisneg(dpos)) || + (zge31b(dpos) && !zisneg(dpos))) + return qlink(&_qzero_); + k = zfacrem(q->num, base, &N); + if (k == 0) { + k = zgcdrem(q->den, base, &D); + if (k > 0) { + zequo(q->den, D, &A); + itoz(k, &K); + zpowi(base, K, &B); + zfree(K); + zequo(B, A, &C); + zfree(A); + zfree(B); + zmul(C, q->num, &N); + zfree(C); + k = -k; + } + else + N = q->num; } - /* - * Fractional value and want negative digit, must work harder. - */ - ztenpow(-n, &tenpow); - zmul(q->num, tenpow, &tmp1); - zfree(tenpow); - zquo(tmp1, q->den, &tmp2, 2); - tmp2.sign = 0; - res = zmodi(tmp2, 10L); - zfree(tmp1); - zfree(tmp2); + if (k >= 0) + D = q->den; + + itoz(k, &K); + if (zrel(dpos, K) >= 0) { + zsub(dpos, K, &A); + zfree(K); + zpowi(base, A, &B); + zfree(A); + zmul(D, B, &A); + zfree(B); + zquo(N, A, &B, 0); + } else { + if (zisunit(D)) { + if (k != 0) + zfree(N); + zfree(K); + if (k < 0) + zfree(D); + return qlink(&_qzero_); + } + zsub(K, dpos, &A); + zfree(K); + zpowermod(base, A, D, &C); + zfree(A); + zmod(N, D, &A, 0); + zmul(C, A, &B); + zfree(A); + zfree(C); + zmod(B, D, &A, 0); + zfree(B); + zmodinv(D, base, &B); + zsub(base, B, &C); + zfree(B); + zmul(C, A, &B); + zfree(C); + } + zfree(A); + if (k != 0) + zfree(N); + if (k < 0) + zfree(D); + zmod(B, base, &A, 0); + zfree(B); + if (ziszero(A)) { + zfree(A); + return qlink(&_qzero_); + } + if (zisone(A)) { + zfree(A); + return qlink(&_qone_); + } + res = qalloc(); + res->num = A; return res; } @@ -848,67 +912,249 @@ qperm(NUMBER *q1, NUMBER *q2) /* - * Compute the combinatorial function q1 * (q1-1) * ... * (q1-q2+1)/q2! + * Compute the combinatorial function q(q - 1) ...(q - n + 1)/n! + * n is to be a nonnegative integer */ NUMBER * -qcomb(NUMBER *q1, NUMBER *q2) +qcomb(NUMBER *q, NUMBER *n) { NUMBER *r; - NUMBER *qtmp1, *qtmp2; + NUMBER *q1, *q2; long i, j; + ZVALUE z; - if (qisfrac(q2)) { - math_error("Non-integral second argument for comb"); + if (!qisint(n) || qisneg(n)) { + math_error("Bad second arg in call to qcomb!"); /*NOTREACHED*/ } - if (qisneg(q2)) - return qlink(&_qzero_); - if (qiszero(q2) || qcmp(q1, q2) == 0) - return qlink(&_qone_); - if (qisone(q2)) - return qlink(q1); - if (qisint(q1)) { - if (qisneg(q1)) { - qtmp1 = qsub(q2, q1); - qtmp2 = qdec(qtmp1); - qfree(qtmp1); - r = qalloc(); - zcomb(qtmp2->num, q2->num, &r->num); - qfree(qtmp2); - if (qiseven(q2)) + if (qisint(q)) { + switch (zcomb(q->num, n->num, &z)) { + case 0: + return qlink(&_qzero_); + case 1: + return qlink(&_qone_); + case -1: + return qlink(&_qnegone_); + case 2: + return qlink(q); + case -2: + return NULL; + default: + r = qalloc(); + r->num = z; return r; - qtmp2 = qneg(r); - qfree(r); - return qtmp2; } - if (qrel(q2, q1) > 0) - return qlink(&_qzero_); - r = qalloc(); - zcomb(q1->num, q2->num, &r->num); - return r; } - if (zge31b(q2->num)) { - math_error("Too large second argument for comb"); - /*NOTREACHED*/ - } - i = qtoi(q2); - q1 = qlink(q1); - r = qlink(q1); + if (zge31b(n->num)) + return NULL; + i = ztoi(n->num); + q = qlink(q); + r = qlink(q); j = 1; while (--i > 0) { - qtmp1 = qdec(q1); - qfree(q1); - q1 = qtmp1; - qtmp2 = qmul(r, q1); + q1 = qdec(q); + qfree(q); + q = q1; + q2 = qmul(r, q); qfree(r); - r = qdivi(qtmp2, ++j); - qfree(qtmp2); + r = qdivi(q2, ++j); + qfree(q2); } - qfree(q1); + qfree(q); return r; } +/* + * Compute the Bernoulli number with index n + * For even positive n, newly calculated values for all even indices up + * to n are stored in table at B_table. + */ +NUMBER * +qbern(ZVALUE z) +{ + long n, i, k, m, nn, dd; + NUMBER **p; + NUMBER *s, *s1, *c, *c1, *t; + + if (zisone(z)) + return qlink(&_qneghalf_); + + if (zisodd(z) || z.sign) + return qlink(&_qzero_); + + if (zge31b(z)) + return NULL; + + n = ztoi(z); + + if (n == 0) + + return qlink(&_qone_); + + m = (n >> 1) - 1; + + if (m < B_num) + return qlink(B_table[m]); + + if (m >= B_allocnum) { + k = (m/QALLOCNUM + 1) * QALLOCNUM; + if (B_allocnum == 0) + p = (NUMBER **) malloc(k * sizeof(NUMBER *)); + else + p = (NUMBER **) realloc(B_table, + k * sizeof(NUMBER *)); + if (p == NULL) { + math_error("Not enough memory for Bernoulli numbers"); + /*NOTREACHED*/ + } + B_allocnum = k; + B_table = p; + } + for (k = B_num; k <= m; k++) { + nn = 2 * k + 3; + dd = 1; + c1 = itoq(nn); + c = qinv(c1); + qfree(c1); + s = qsub(&_qonehalf_, c); + i = k; + for (i = 0; i < k; i++) { + c1 = qmuli(c, nn--); + qfree(c); + c = qdivi(c1, dd++); + qfree(c1); + c1 = qmuli(c, nn--); + qfree(c); + c = qdivi(c1, dd++); + qfree(c1); + t = qmul(c, B_table[i]); + s1 = qsub(s, t); + qfree(t); + qfree(s); + s = s1; + } + B_table[k] = s; + qfree(c); + } + B_num = k; + return qlink(B_table[m]); +} + + +void +qfreebern(void) +{ + long k; + + if (B_num > 0) { + for (k = 0; k < B_num; k++) + qfree(B_table[k]); + free(B_table); + } + B_table = NULL; + B_allocnum = 0; + B_num = 0; +} + + +/* + * Compute the Euler number with index n = z + * For even positive n, newly calculated values with all even indices up + * to n are stored in E_table for later quick access. + */ +NUMBER * +qeuler(ZVALUE z) +{ + long i, k, m, n, nn, dd; + NUMBER **p; + NUMBER *s, *s1, *c, *c1, *t; + + + if (ziszero(z)) + return qlink(&_qone_); + if (zisodd(z) || zisneg(z)) + return qlink(&_qzero_); + if (zge31b(z)) + return NULL; + n = ztoi(z); + m = (n >> 1) - 1; + if (m < E_num) + return qlink(E_table[m]); + p = (NUMBER **) realloc(E_table, (m + 1) * sizeof(NUMBER *)); + if (p == NULL) { + math_error("Unable to allocate memory for Euler numbers"); + /*NOTREACHED*/ + } + E_table = p; + for (k = E_num; k <= m; k++) { + nn = 2 * k + 2; + dd = 1; + c = qlink(&_qone_); + s = qlink(&_qnegone_); + i = k; + for (i = 0; i < k; i++) { + c1 = qmuli(c, nn--); + qfree(c); + c = qdivi(c1, dd++); + qfree(c1); + c1 = qmuli(c, nn--); + qfree(c); + c = qdivi(c1, dd++); + qfree(c1); + t = qmul(c, E_table[i]); + s1 = qsub(s, t); + qfree(t); + qfree(s); + s = s1; + } + E_table[k] = s; + qfree(c); + } + E_num = k; + return qlink(E_table[m]); +} + + +void +qfreeeuler(void) +{ + long k; + + if (E_num > 0) { + for (k = 0; k < E_num; k++) + qfree(E_table[k]); + free(E_table); + } + E_table = NULL; + E_num = 0; +} + + +/* + * Catalan numbers: catalan(n) = comb(2*n, n)/(n+1) + * To be called only with integer q + */ +NUMBER * +qcatalan(NUMBER *q) +{ + NUMBER *A, *B; + NUMBER *res; + + if (qisneg(q)) + return qlink(&_qzero_); + A = qscale(q, 1); + B = qcomb(A, q); + if (B == NULL) + return NULL; + qfree(A); + A = qinc(q); + res = qqdiv(B, A); + qfree(A); + qfree(B); + return res; +} + /* * Compute the Jacobi function (a / b). * -1 => a is not quadratic residue mod b @@ -1236,7 +1482,7 @@ qcfappr(NUMBER *q, NUMBER *epsilon, long rnd) /* * Calculate the nearest-above, or nearest-below, or nearest, number * with denominator less than the given number, the choice between - * possibilities being dertermined by the parameter rnd. + * possibilities being determined by the parameter rnd. */ NUMBER * qcfsim(NUMBER *q, long rnd) @@ -1405,7 +1651,7 @@ qlcm(NUMBER *q1, NUMBER *q2) /* - * Remove all occurences of the specified factor from a number. + * Remove all occurrences of the specified factor from a number. * Returned number is always positive or zero. */ NUMBER * @@ -1456,7 +1702,8 @@ qgcdrem(NUMBER *q1, NUMBER *q2) return qlink(&_qone_); if (qiszero(q1)) return qlink(&_qzero_); - zgcdrem(q1->num, q2->num, &tmp); + if (zgcdrem(q1->num, q2->num, &tmp) == 0) + return qqabs(q1); if (zisunit(tmp)) { zfree(tmp); return qlink(&_qone_); @@ -1493,15 +1740,14 @@ qlowfactor(NUMBER *q1, NUMBER *q2) return utoq(zlowfactor(q1->num, count)); } - /* * Return the number of places after the decimal point needed to exactly * represent the specified number as a real number. Integers return zero, * and non-terminating decimals return minus one. Examples: - * qplaces(1/7)=-1, qplaces(3/10)= 1, qplaces(1/8)=3, qplaces(4)=0. + * qdecplaces(1.23) = 2, qdecplaces(3) = 0, qdecplaces(1/7) = -1. */ long -qplaces(NUMBER *q) +qdecplaces(NUMBER *q) { long twopow, fivepow; HALF fiveval[2]; @@ -1532,6 +1778,39 @@ qplaces(NUMBER *q) } +/* + * Return, if possible, the minimum number of places after the decimal + * point needed to exactly represent q with the specified base. + * Integers return 0 and numbers with non-terminating expansions -1. + * Returns -2 if base inadmissible + */ +long +qplaces(NUMBER *q, ZVALUE base) +{ + long count; + ZVALUE tmp; + + if (base.len == 1 && base.v[0] == 10) + return qdecplaces(q); + if (ziszero(base) || zisunit(base)) + return -2; + if (qisint(q)) + return 0; + if (zisonebit(base)) { + if (!zisonebit(q->den)) + return -1; + return 1 + (zlowbit(q->den) - 1)/zlowbit(base); + } + count = zgcdrem(q->den, base, &tmp); + if (count == 0) + return -1; + if (!zisunit(tmp)) + count = -1; + zfree(tmp); + return count; +} + + /* * Perform a probabilistic primality test (algorithm P in Knuth). * Returns FALSE if definitely not prime, or TRUE if probably prime. diff --git a/qio.c b/qio.c index 99cc99a..4e26c66 100644 --- a/qio.c +++ b/qio.c @@ -18,7 +18,7 @@ * 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. * * @(#) $Revision: 29.2 $ - * @(#) $Id: qio.c,v 29.2 2000/06/07 14:02:13 chongo Exp $ + * @(#) $Id: qio.c,v 29.2 2000/06/07 14:02:13 chongo Exp chongo $ * @(#) $Source: /usr/local/src/cmd/calc/RCS/qio.c,v $ * * Under source code control: 1993/07/30 19:42:46 @@ -191,7 +191,7 @@ qprintnum(NUMBER *q, int outmode) break; case MODE_REAL: - prec = qplaces(q); + prec = qdecplaces(q); if ((prec < 0) || (prec > conf->outdigits)) { if (conf->tilde_ok) PUTCHAR('~'); @@ -629,7 +629,7 @@ qparse(char *cp, int flags) /* * Print an integer which is guaranteed to fit in the specified number - * of columns, using imbedded '...' characters if numerator and/or + * of columns, using embedded '...' characters if numerator and/or * denominator is too large. */ void diff --git a/qmath.c b/qmath.c index 3ea42af..dab5789 100644 --- a/qmath.c +++ b/qmath.c @@ -20,7 +20,7 @@ * 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. * * @(#) $Revision: 29.2 $ - * @(#) $Id: qmath.c,v 29.2 2000/06/07 14:02:13 chongo Exp $ + * @(#) $Id: qmath.c,v 29.2 2000/06/07 14:02:13 chongo Exp chongo $ * @(#) $Source: /usr/local/src/cmd/calc/RCS/qmath.c,v $ * * Under source code control: 1990/02/15 01:48:21 @@ -43,10 +43,12 @@ NUMBER _qfour_ = { { _fourval_, 1, 0 }, { _oneval_, 1, 0 }, 1, NULL }; NUMBER _qten_ = { { _tenval_, 1, 0 }, { _oneval_, 1, 0 }, 1, NULL }; NUMBER _qnegone_ = { { _oneval_, 1, 1 }, { _oneval_, 1, 0 }, 1, NULL }; NUMBER _qonehalf_ = { { _oneval_, 1, 0 }, { _twoval_, 1, 0 }, 1, NULL }; +NUMBER _qneghalf_ = { { _oneval_, 1, 1 }, { _twoval_, 1, 0 }, 1, NULL }; NUMBER _qonesqbase_ = { { _oneval_, 1, 0 }, { _sqbaseval_, 2, 0 }, 1, NULL }; NUMBER * initnumbs[INITCONSTCOUNT] = {&_qzero_, &_qone_, &_qtwo_, &_qthree_, - &_qfour_, &_qten_, &_qnegone_, &_qonehalf_}; + &_qfour_, &_qten_, &_qnegone_, &_qonehalf_, &_qneghalf_}; + /* * Create another copy of a number. diff --git a/qmath.h b/qmath.h index 2730b8e..2a2e7c9 100644 --- a/qmath.h +++ b/qmath.h @@ -18,7 +18,7 @@ * 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. * * @(#) $Revision: 29.2 $ - * @(#) $Id: qmath.h,v 29.2 2000/06/07 14:02:13 chongo Exp $ + * @(#) $Id: qmath.h,v 29.2 2000/06/07 14:02:13 chongo Exp chongo $ * @(#) $Source: /usr/local/src/cmd/calc/RCS/qmath.h,v $ * * Under source code control: 1993/07/30 19:42:47 @@ -34,8 +34,7 @@ #include "zmath.h" -#define INITCONSTCOUNT 8 /* number of initnumbs[] pre-defined constants */ - +#define INITCONSTCOUNT 9 /* number of initnumbs[] pre-defined constants */ /* * Rational arithmetic definitions. @@ -157,14 +156,15 @@ extern BOOL qprimetest(NUMBER *q1, NUMBER *q2, NUMBER *q3); extern BOOL qissquare(NUMBER *q); extern long qilog2(NUMBER *q); extern long qilog10(NUMBER *q); -extern long qilog(NUMBER *q1, NUMBER *q2); +extern NUMBER *qilog(NUMBER *q, ZVALUE base); extern BOOL qcmpmod(NUMBER *q1, NUMBER *q2, NUMBER *q3); extern BOOL qquomod(NUMBER *q1, NUMBER *q2, NUMBER **retdiv, NUMBER **retmod); extern FLAG qnear(NUMBER *q1, NUMBER *q2, NUMBER *epsilon); -extern long qdigit(NUMBER *q, long i); +extern NUMBER *qdigit(NUMBER *q, ZVALUE dpos, ZVALUE base); extern long qprecision(NUMBER *q); -extern long qplaces(NUMBER *q); -extern long qdigits(NUMBER *q); +extern long qplaces(NUMBER *q, ZVALUE base); +extern long qdecplaces(NUMBER *q); +extern long qdigits(NUMBER *q, ZVALUE base); extern void setepsilon(NUMBER *q); extern NUMBER *qbitvalue(long i); extern NUMBER *qtenpow(long i); @@ -208,6 +208,11 @@ extern NUMBER *qacsch(NUMBER *q, NUMBER *epsilon); extern NUMBER *qacoth(NUMBER *q, NUMBER *epsilon); extern NUMBER *qlegtoleg(NUMBER *q, NUMBER *epsilon, BOOL wantneg); extern NUMBER *qpi(NUMBER *epsilon); +extern NUMBER *qcatalan(NUMBER *); +extern NUMBER *qbern(ZVALUE z); +extern void qfreebern(void); +extern NUMBER *qeuler(ZVALUE z); +extern void qfreeeuler(void); /* @@ -258,7 +263,7 @@ extern NUMBER *swap_HALF_in_NUMBER(NUMBER *dest, NUMBER *src, BOOL all); /* * constants used often by the arithmetic routines */ -extern NUMBER _qzero_, _qone_, _qnegone_, _qonehalf_, _qonesqbase_; +extern NUMBER _qzero_, _qone_, _qnegone_, _qonehalf_, _qneghalf_, _qonesqbase_; extern NUMBER _qtwo_, _qthree_, _qfour_; extern NUMBER * initnumbs[]; diff --git a/token.c b/token.c index c2095f0..55f8c5e 100644 --- a/token.c +++ b/token.c @@ -20,7 +20,7 @@ * 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. * * @(#) $Revision: 29.3 $ - * @(#) $Id: token.c,v 29.3 2000/06/07 14:02:13 chongo Exp $ + * @(#) $Id: token.c,v 29.3 2000/06/07 14:02:13 chongo Exp chongo $ * @(#) $Source: /usr/local/src/cmd/calc/RCS/token.c,v $ * * Under source code control: 1990/02/15 01:48:25 @@ -178,8 +178,8 @@ gettoken(void) type = T_NULL; while (type == T_NULL) { ch = nextchar(); - if (allsyms && ((ch!=' ') && - (ch!=';') && (ch!='"') && (ch!='\n'))) { + if (allsyms && ch!=' ' && ch!=';' && ch!='"' && + ch!='\'' && ch!='\n' && ch!=EOF) { reread(); type = eatsymbol(); break; @@ -566,10 +566,11 @@ eatsymbol(void) if (allsyms) { for (;;) { ch = nextchar(); - if ((ch == ' ') || (ch == ';') || (ch == '\n')) + if (ch == ' ' || ch == ';' || + ch == '\n' || ch == EOF) break; if (cc-- > 0) - *cp++ = (char)ch; + *cp++ = (char) ch; } reread(); *cp = '\0'; diff --git a/value.c b/value.c index 6bc5e61..d2945b1 100644 --- a/value.c +++ b/value.c @@ -18,7 +18,7 @@ * 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. * * @(#) $Revision: 29.2 $ - * @(#) $Id: value.c,v 29.2 2000/06/07 14:02:13 chongo Exp $ + * @(#) $Id: value.c,v 29.2 2000/06/07 14:02:13 chongo Exp chongo $ * @(#) $Source: /usr/local/src/cmd/calc/RCS/value.c,v $ * * Under source code control: 1990/02/15 01:48:25 @@ -57,10 +57,10 @@ freevalue(VALUE *vp) type = vp->v_type; vp->v_type = V_NULL; - if (type < 0) + vp->v_subtype = V_NOSUBTYPE; + if (type <= 0) return; switch (type) { - case V_NULL: case V_ADDR: case V_OCTET: case V_NBLOCK: @@ -111,7 +111,6 @@ freevalue(VALUE *vp) math_error("Freeing unknown value type"); /*NOTREACHED*/ } - vp->v_subtype = V_NOSUBTYPE; } @@ -341,7 +340,7 @@ negvalue(VALUE *vp, VALUE *vres) *vres = objcall(OBJ_NEG, vp, NULL_VALUE, NULL_VALUE); return; default: - if (vp->v_type < 0) + if (vp->v_type <= 0) return; *vres = error_value(E_NEG); return; @@ -349,76 +348,6 @@ negvalue(VALUE *vp, VALUE *vres) } -/* - * addnumeric - add two numeric values togethter - * - * If either value is not real or complex, it is assumed to have - * a value of 0. - * - * Result is placed in the indicated location. - */ -void -addnumeric(VALUE *v1, VALUE *v2, VALUE *vres) -{ - COMPLEX *c; - - /* - * add numeric values - */ - vres->v_subtype = V_NOSUBTYPE; - switch (TWOVAL(v1->v_type, v2->v_type)) { - case TWOVAL(V_NUM, V_NUM): - vres->v_num = qqadd(v1->v_num, v2->v_num); - vres->v_type = V_NUM; - return; - case TWOVAL(V_COM, V_NUM): - vres->v_com = caddq(v1->v_com, v2->v_num); - vres->v_type = V_COM; - return; - case TWOVAL(V_NUM, V_COM): - vres->v_com = caddq(v2->v_com, v1->v_num); - vres->v_type = V_COM; - return; - case TWOVAL(V_COM, V_COM): - vres->v_com = cadd(v1->v_com, v2->v_com); - vres->v_type = V_COM; - c = vres->v_com; - if (!cisreal(c)) - return; - vres->v_num = qlink(c->real); - vres->v_type = V_NUM; - comfree(c); - return; - } - - /* - * assume zero if a value is not numeric - */ - if (v1->v_type == V_NUM) { - /* v1 + 0 == v1 */ - vres->v_type = v1->v_type; - vres->v_num = qlink(v1->v_num); - } else if (v1->v_type == V_COM) { - /* v1 + 0 == v1 */ - vres->v_type = v1->v_type; - vres->v_com = clink(v1->v_com); - } else if (v2->v_type == V_NUM) { - /* v2 + 0 == v2 */ - vres->v_type = v2->v_type; - vres->v_num = qlink(v2->v_num); - } else if (v2->v_type == V_COM) { - /* v2 + 0 == v2 */ - vres->v_type = v2->v_type; - vres->v_com = clink(v2->v_com); - } else { - /* 0 + 0 = 0 */ - vres->v_type = V_NUM; - vres->v_num = qlink(&_qzero_); - } - return; -} - - /* * Add two arbitrary values together. * Result is placed in the indicated location. @@ -502,15 +431,12 @@ addvalue(VALUE *v1, VALUE *v2, VALUE *vres) return; default: if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) { - if (v1->v_type < 0) { - copyvalue(v1, vres); + if (v1->v_type < 0) return; - } - if (v2->v_type < 0) { - copyvalue(v2, vres); - return; - } - *vres = error_value(E_ADD); + if (v2->v_type > 0) + *vres = error_value(E_ADD); + else + vres->v_type = v2->v_type; return; } *vres = objcall(OBJ_ADD, v1, v2, NULL_VALUE); @@ -592,12 +518,10 @@ subvalue(VALUE *v1, VALUE *v2, VALUE *vres) return; default: if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) { - if (v1->v_type < 0) { - copyvalue(v1, vres); + if (v1->v_type <= 0) return; - } - if (v2->v_type < 0) { - copyvalue(v2, vres); + if (v2->v_type <= 0) { + vres->v_type = v2->v_type; return; } *vres = error_value(E_SUB); @@ -659,12 +583,10 @@ mulvalue(VALUE *v1, VALUE *v2, VALUE *vres) return; default: if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) { - if (v1->v_type < 0) { - copyvalue(v1, vres); + if (v1->v_type <= 0) return; - } - if (v2->v_type < 0) { - copyvalue(v2, vres); + if (v2->v_type <= 0) { + vres->v_type = v2->v_type; return; } *vres = error_value(E_MUL); @@ -713,8 +635,8 @@ squarevalue(VALUE *vp, VALUE *vres) *vres = objcall(OBJ_SQUARE, vp, NULL_VALUE, NULL_VALUE); return; default: - if (vp->v_type < 0) { - copyvalue(vp, vres); + if (vp->v_type <= 0) { + vres->v_type = vp->v_type; return; } *vres = error_value(E_SQUARE); @@ -767,10 +689,8 @@ invertvalue(VALUE *vp, VALUE *vres) vres->v_num = qlink(&_qzero_); return; } - if (vp->v_type < 0) { - copyvalue(vp, vres); + if (vp->v_type <= 0) return; - } *vres = error_value(E_INV); return; } @@ -819,12 +739,10 @@ andvalue(VALUE *v1, VALUE *v2, VALUE *vres) return; default: if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) { - if (v1->v_type < 0) { - copyvalue(v1, vres); + if (v1->v_type < 0) return; - } if (v2->v_type < 0) { - copyvalue(v2, vres); + vres->v_type = v2->v_type; return; } *vres = error_value(E_AND); @@ -877,12 +795,10 @@ orvalue(VALUE *v1, VALUE *v2, VALUE *vres) return; default: if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) { - if (v1->v_type < 0) { - copyvalue(v1, vres); + if (v1->v_type < 0) return; - } if (v2->v_type < 0) { - copyvalue(v2, vres); + vres->v_type = v2->v_type; return; } *vres = error_value(E_OR); @@ -1097,10 +1013,9 @@ apprvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres) vres->v_type = v1->v_type; vres->v_subtype = V_NOSUBTYPE; - if (v1->v_type < 0) { - copyvalue(v1, vres); + if (v1->v_type <= 0) return; - } + e = NULL; switch(v2->v_type) { case V_NUM: e = v2->v_num; @@ -1239,10 +1154,8 @@ roundvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres) vres->v_com = c; return; default: - if (v1->v_type < 0) { - copyvalue(v1, vres); + if (v1->v_type <= 0) return; - } *vres = error_value(E_ROUND); return; } @@ -1327,10 +1240,8 @@ broundvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres) vres->v_com = c; return; default: - if (v1->v_type < 0) { - copyvalue(v1, vres); + if (v1->v_type <= 0) return; - } *vres = error_value(E_BROUND); return; } @@ -1374,10 +1285,8 @@ intvalue(VALUE *vp, VALUE *vres) *vres = objcall(OBJ_INT, vp, NULL_VALUE, NULL_VALUE); return; default: - if (vp->v_type < 0) { - copyvalue(vp, vres); + if (vp->v_type <= 0) return; - } *vres = error_value(E_INT); return; } @@ -1423,10 +1332,8 @@ fracvalue(VALUE *vp, VALUE *vres) *vres = objcall(OBJ_FRAC, vp, NULL_VALUE, NULL_VALUE); return; default: - if (vp->v_type < 0) { - copyvalue(vp, vres); + if (vp->v_type < 0) return; - } *vres = error_value(E_FRAC); return; } @@ -1461,7 +1368,7 @@ incvalue(VALUE *vp, VALUE *vres) vres->v_addr = vp->v_addr + 1; break; default: - if (vp->v_type >= 0) + if (vp->v_type > 0) *vres = error_value(E_INCV); break; } @@ -1533,8 +1440,8 @@ conjvalue(VALUE *vp, VALUE *vres) *vres = objcall(OBJ_CONJ, vp, NULL_VALUE, NULL_VALUE); return; default: - if (vp->v_type < 0) { - copyvalue(vp, vres); + if (vp->v_type <= 0) { + vres->v_type = vp->v_type; return; } *vres = error_value(E_CONJ); @@ -1560,8 +1467,8 @@ sqrtvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres) } vres->v_type = v1->v_type; vres->v_subtype = V_NOSUBTYPE; - if (v1->v_type < 0) { - copyvalue(v1, vres); + if (v1->v_type <= 0) { + vres->v_type = v1->v_type; return; } if (v2->v_type == V_NULL) { @@ -1630,8 +1537,8 @@ rootvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres) COMPLEX *c; vres->v_subtype = V_NOSUBTYPE; - if (v1->v_type < 0) { - copyvalue(v1, vres); + if (v1->v_type <= 0) { + vres->v_type = v1->v_type; return; } if (v2->v_type != V_NUM) { @@ -1700,8 +1607,8 @@ absvalue(VALUE *v1, VALUE *v2, VALUE *vres) return; } vres->v_subtype = V_NOSUBTYPE; - if (v1->v_type < 0) { - copyvalue(v1, vres); + if (v1->v_type <= 0) { + vres->v_type = v1->v_type; return; } switch (v1->v_type) { @@ -1739,8 +1646,8 @@ normvalue(VALUE *vp, VALUE *vres) vres->v_type = vp->v_type; vres->v_subtype = V_NOSUBTYPE; - if (vp->v_type < 0) { - copyvalue(vp, vres); + if (vp->v_type <= 0) { + vres->v_type = vp->v_type; return; } switch (vp->v_type) { @@ -1786,8 +1693,8 @@ shiftvalue(VALUE *v1, VALUE *v2, BOOL rightshift, VALUE *vres) VALUE tmp; vres->v_subtype = V_NOSUBTYPE; - if (v1->v_type < 0) { - copyvalue(v1, vres); + if (v1->v_type <= 0) { + vres->v_type = v1->v_type; return; } if ((v2->v_type != V_NUM) || (qisfrac(v2->v_num))) { @@ -1872,8 +1779,8 @@ scalevalue(VALUE *v1, VALUE *v2, VALUE *vres) long n = 0; vres->v_subtype = V_NOSUBTYPE; - if (v1->v_type < 0) { - copyvalue(v1, vres); + if (v1->v_type <= 0) { + vres->v_type = v1->v_type; return; } if ((v2->v_type != V_NUM) || qisfrac(v2->v_num)) { @@ -1924,9 +1831,9 @@ powivalue(VALUE *v1, VALUE *v2, VALUE *vres) } vres->v_type = v1->v_type; vres->v_subtype = V_NOSUBTYPE; - if (v1->v_type < 0 && v1->v_type != -E_1OVER0) + if (v1->v_type <= 0 && v1->v_type != -E_1OVER0) return; - if (v2->v_type < 0) { + if (v2->v_type <= 0) { vres->v_type = v2->v_type; return; } @@ -1982,8 +1889,8 @@ powervalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres) COMPLEX *c, ctmp1, ctmp2; vres->v_subtype = V_NOSUBTYPE; - if (v1->v_type < 0) { - copyvalue(v1, vres); + if (v1->v_type <= 0) { + vres->v_type = v1->v_type; return; } if (v1->v_type != V_NUM && v1->v_type != V_COM) { @@ -2063,9 +1970,9 @@ divvalue(VALUE *v1, VALUE *v2, VALUE *vres) vres->v_type = v1->v_type; vres->v_subtype = V_NOSUBTYPE; - if (v1->v_type < 0) + if (v1->v_type <= 0) return; - if (v2->v_type < 0) { + if (v2->v_type <= 0) { if (testvalue(v1) && v2->v_type == -E_1OVER0) { vres->v_type = V_NUM; vres->v_num = qlink(&_qzero_); @@ -2146,10 +2053,9 @@ quovalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres) vres->v_type = v1->v_type; vres->v_subtype = V_NOSUBTYPE; - if (v1->v_type < 0) { - copyvalue(v1, vres); + if (v1->v_type <= 0) return; - } + if (v1->v_type == V_MAT) { vres->v_mat = matquoval(v1->v_mat, v2, v3); return; @@ -2162,8 +2068,8 @@ quovalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres) *vres = objcall(OBJ_QUO, v1, v2, v3); return; } - if (v2->v_type < 0) { - copyvalue(v2, vres); + if (v2->v_type <= 0) { + vres->v_type = v2->v_type; return; } if (v2->v_type != V_NUM) { @@ -2224,12 +2130,11 @@ modvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres) NUMBER *q1, *q2; long rnd; - vres->v_subtype = V_NOSUBTYPE; - if (v1->v_type < 0) { - copyvalue(v1, vres); - return; - } vres->v_type = v1->v_type; + vres->v_subtype = V_NOSUBTYPE; + if (v1->v_type <= 0) + return; + if (v1->v_type == V_MAT) { vres->v_mat = matmodval(v1->v_mat, v2, v3); return; @@ -2242,8 +2147,8 @@ modvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres) *vres = objcall(OBJ_MOD, v1, v2, v3); return; } - if (v2->v_type < 0) { - copyvalue(v2, vres); + if (v2->v_type <= 0) { + vres->v_type = v2->v_type; return; } if (v2->v_type != V_NUM) { @@ -2387,7 +2292,7 @@ comparevalue(VALUE *v1, VALUE *v2) return comparevalue(v2, v1); if (v1->v_type != v2->v_type) return TRUE; - if (v1->v_type < 0) + if (v1->v_type <= 0) return FALSE; switch (v1->v_type) { case V_NUM: @@ -2408,8 +2313,6 @@ comparevalue(VALUE *v1, VALUE *v2) case V_ASSOC: r = assoccmp(v1->v_assoc, v2->v_assoc); break; - case V_NULL: - break; case V_FILE: r = (v1->v_file != v2->v_file); break; @@ -2697,11 +2600,8 @@ sgnvalue(VALUE *vp, VALUE *vres) *vres = objcall(OBJ_SGN, vp, NULL_VALUE, NULL_VALUE); return; default: - if (vp->v_type < 0) { - copyvalue(vp, vres); - return; - } - *vres = error_value(E_SGN); + if (vp->v_type > 0) + *vres = error_value(E_SGN); return; } } @@ -2855,7 +2755,7 @@ config_print(CONFIG *cfg) */ if (cfg == NULL || cfg->epsilon == NULL || cfg->prompt1 == NULL || cfg->prompt2 == NULL) { - math_error("CONFIG value is invaid"); + math_error("CONFIG value is invalid"); /*NOTREACHED*/ } diff --git a/value.h b/value.h index 5f27e56..6c8e6b4 100644 --- a/value.h +++ b/value.h @@ -18,7 +18,7 @@ * 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. * * @(#) $Revision: 29.2 $ - * @(#) $Id: value.h,v 29.2 2000/06/07 14:02:13 chongo Exp $ + * @(#) $Id: value.h,v 29.2 2000/06/07 14:02:13 chongo Exp chongo $ * @(#) $Source: /usr/local/src/cmd/calc/RCS/value.h,v $ * * Under source code control: 1993/07/30 19:42:47 @@ -191,7 +191,6 @@ extern void freevalue(VALUE *vp); extern void copyvalue(VALUE *vp, VALUE *vres); extern void negvalue(VALUE *vp, VALUE *vres); extern void addvalue(VALUE *v1, VALUE *v2, VALUE *vres); -extern void addnumeric(VALUE *v1, VALUE *v2, VALUE *vres); extern void subvalue(VALUE *v1, VALUE *v2, VALUE *vres); extern void mulvalue(VALUE *v1, VALUE *v2, VALUE *vres); extern void orvalue(VALUE *v1, VALUE *v2, VALUE *vres); diff --git a/version.c b/version.c index 1b25dea..8eff278 100644 --- a/version.c +++ b/version.c @@ -19,8 +19,8 @@ * received a copy with calc; if not, write to Free Software Foundation, Inc. * 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. * - * @(#) $Revision: 29.13 $ - * @(#) $Id: version.c,v 29.13 2000/06/07 16:12:19 chongo Exp $ + * @(#) $Revision: 29.14 $ + * @(#) $Id: version.c,v 29.14 2000/07/14 07:20:42 chongo Exp chongo $ * @(#) $Source: /usr/local/src/cmd/calc/RCS/version.c,v $ * * Under source code control: 1990/05/22 11:00:58 @@ -42,8 +42,8 @@ static char *program; #define MAJOR_VER 2 /* major version */ #define MINOR_VER 11 /* minor version */ -#define MAJOR_PATCH 2 /* patch level or 0 if no patch */ -#define MINOR_PATCH "1.0" /* test number or empty string if no patch */ +#define MAJOR_PATCH 3 /* patch level or 0 if no patch */ +#define MINOR_PATCH "0" /* test number or empty string if no patch */ /* * calc version constants diff --git a/zfunc.c b/zfunc.c index a1afa0f..0c82b67 100644 --- a/zfunc.c +++ b/zfunc.c @@ -20,7 +20,7 @@ * 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. * * @(#) $Revision: 29.2 $ - * @(#) $Id: zfunc.c,v 29.2 2000/06/07 14:02:13 chongo Exp $ + * @(#) $Id: zfunc.c,v 29.2 2000/06/07 14:02:13 chongo Exp chongo $ * @(#) $Source: /usr/local/src/cmd/calc/RCS/zfunc.c,v $ * * Under source code control: 1990/02/15 01:48:27 @@ -51,7 +51,7 @@ zfact(ZVALUE z, ZVALUE *dest) math_error("Negative argument for factorial"); /*NOTREACHED*/ } - if (zge24b(z)) { + if (zge31b(z)) { math_error("Very large factorial"); /*NOTREACHED*/ } @@ -108,7 +108,7 @@ zperm(ZVALUE z1, ZVALUE z2, ZVALUE *res) math_error("Second arg larger than first in permutation"); /*NOTREACHED*/ } - if (zge24b(z2)) { + if (zge31b(z2)) { math_error("Very large permutation"); /*NOTREACHED*/ } @@ -127,58 +127,104 @@ zperm(ZVALUE z1, ZVALUE z2, ZVALUE *res) *res = ans; } - /* - * Compute the combinatorial function M! / ( N! * (M - N)! ). + * docomb evaluates binomial coefficient when z1 >= 0, z2 >= 0 */ -void -zcomb(ZVALUE z1, ZVALUE z2, ZVALUE *res) +static int +docomb(ZVALUE z1, ZVALUE z2, ZVALUE *res) { ZVALUE ans; ZVALUE mul, div, temp; FULL count, i; +#if BASEB == 16 HALF dh[2]; +#else + HALF dh[1]; +#endif - if (zisneg(z1) || zisneg(z2)) { - math_error("Negative argument for combinatorial"); - /*NOTREACHED*/ - } + if (zrel(z2, z1) > 0) + return 0; zsub(z1, z2, &temp); - if (zisneg(temp)) { + + if (zge31b(z2) && zge31b(temp)) { zfree(temp); - math_error("Second arg larger than first for combinatorial"); - /*NOTREACHED*/ + return -2; } - if (zge24b(z2) && zge24b(temp)) { - zfree(temp); - math_error("Very large combinatorial"); - /*NOTREACHED*/ - } - count = ztofull(z2); - i = ztofull(temp); - if (zge24b(z2) || (!zge24b(temp) && (i < count))) - count = i; + if (zrel(temp, z2) < 0) + count = ztofull(temp); + else + count = ztofull(z2); zfree(temp); - mul = z1; + if (count == 0) + return 1; + if (count == 1) + return 2; div.sign = 0; div.v = dh; - ans = _one_; - for (i = 1; i <= count; i++) { + div.len = 1; + zcopy(z1, &mul); + zcopy(z1, &ans); + for (i = 2; i <= count; i++) { +#if BASEB == 16 dh[0] = (HALF)(i & BASE1); dh[1] = (HALF)(i >> BASEB); div.len = 1 + (dh[1] != 0); +#else + dh[0] = (HALF) i; +#endif + zsub(mul, _one_, &temp); + zfree(mul); + mul = temp; zmul(ans, mul, &temp); zfree(ans); zquo(temp, div, &ans, 0); zfree(temp); - zsub(mul, _one_, &temp); - if (mul.v != z1.v) - zfree(mul); - mul = temp; } - if (mul.v != z1.v) - zfree(mul); + zfree(mul); *res = ans; + return 3; +} + +/* + * Compute the combinatorial function M! / ( N! * (M - N)! ). + * Returns 0 if result is 0 +* 1 1 +* 2 z1 +* -1 -1 +* -2 if too complicated +* 3 result stored at res + */ +int +zcomb(ZVALUE z1, ZVALUE z2, ZVALUE *res) +{ + ZVALUE z3, z4; + int r; + + if (z2.sign || (!z1.sign && zrel(z2, z1) > 0)) + return 0; + if (zisone(z2)) + return 2; + if (z1.sign) { + z1.sign = 0; + zsub(z1, _one_, &z3); + zadd(z3, z2, &z4); + zfree(z3); + r = docomb(z4, z2, res); + if (r == 2) { + *res = z4; + r = 3; + } + else + zfree(z4); + if (z2.v[0] & 1) { + if (r == 1) + r = -1; + if (r == 3) + res->sign = 1; + } + return r; + } + return docomb(z1, z2, res); } @@ -474,7 +520,7 @@ ztenpow(long power, ZVALUE *res) /* * Calculate modular inverse suppressing unnecessary divisions. - * This is based on the Euclidian algorithm for large numbers. + * This is based on the Euclidean algorithm for large numbers. * (Algorithm X from Knuth Vol 2, section 4.5.2. and exercise 17) * Returns TRUE if there is no solution because the numbers * are not relatively prime. @@ -1021,108 +1067,76 @@ zrelprime(ZVALUE z1, ZVALUE z2) /* - * Compute the log of one number base another, to the closest integer. - * This is the largest integer which when the second number is raised to it, - * the resulting value is less than or equal to the first number. + * Compute the integer floor of the log of an integer to a specified base. + * The signs of the integers and base are ignored. * Example: zlog(123456, 10) = 5. */ long -zlog(ZVALUE z1, ZVALUE z2) +zlog(ZVALUE z, ZVALUE base) { - register ZVALUE *zp; /* current square */ + ZVALUE *zp; /* current square */ long power; /* current power */ - long worth; /* worth of current square */ - ZVALUE val; /* current value of power */ ZVALUE temp; /* temporary */ ZVALUE squares[32]; /* table of squares of base */ + /* ignore signs */ + + z.sign = 0; + base.sign = 0; + /* - * Make sure that the numbers are > 0 and the base is > 1 + * Make sure that the numbers are nonzero and the base is > 1 */ - if (zislezero(z1) || zisleone(z2)) { - math_error("Bad arguments for log"); + if (ziszero(z) || ziszero(base) || zisone(base)) { + math_error("Zero or too small argument argument for zlog!!!"); /*NOTREACHED*/ } /* - * Reject trivial cases. + * Some trivial cases. */ - if (z1.len < z2.len) - return 0; - if ((z1.len == z2.len) && (z1.v[z1.len-1] < z2.v[z2.len-1])) - return 0; - power = zrel(z1, z2); + power = zrel(z, base); if (power <= 0) return (power + 1); - /* - * Handle any power of two special. - */ - if (zisonebit(z2)) - return (zhighbit(z1) / zlowbit(z2)); - /* - * Handle base 10 special - */ - if ((z2.len == 1) && (*z2.v == 10)) - return zlog10(z1); + + /* base - power of two */ + if (zisonebit(base)) + return (zhighbit(z) / zlowbit(base)); + + /* base = 10 */ + if (base.len == 1 && base.v[0] == 10) + return zlog10(z); /* * Now loop by squaring the base each time, and see whether or * not each successive square is still smaller than the number. */ - worth = 1; zp = &squares[0]; - *zp = z2; - while (((zp->len * 2) - 1) <= z1.len) { /* while square not too large */ + *zp = base; + while (zp->len * 2 - 1 <= z.len && zrel(z, *zp) > 0) { + /* while square not too large */ zsquare(*zp, zp + 1); zp++; - worth *= 2; } + /* - * Now back down the squares, and multiply them together to see - * exactly how many times the base can be raised by. + * Now back down the squares, */ - val = _one_; power = 0; - - /* - * We prevent the zp pointer from walking behind squares - * by stopping one short of the end and running the loop one - * more time. - * - * We could stop the loop with just zp >= squares, but stopping - * short and running the loop one last time manually helps make - * code checkers such as insure happy. - */ - for (; zp > squares; zp--, worth /= 2) { - if ((val.len + zp->len - 1) <= z1.len) { - zmul(val, *zp, &temp); - if (zrel(z1, temp) >= 0) { - zfree(val); - val = temp; - power += worth; - } else { - zfree(temp); - } + for (; zp > squares; zp--) { + if (zrel(z, *zp) >= 0) { + zquo(z, *zp, &temp, 0); + if (power) + zfree(z); + z = temp; + power++; } - if (zp != squares) - zfree(*zp); + zfree(*zp); + power <<= 1; } - /* run the loop manually one last time */ - if (zp == squares) { - if ((val.len + zp->len - 1) <= z1.len) { - zmul(val, *zp, &temp); - if (zrel(z1, temp) >= 0) { - zfree(val); - val = temp; - power += worth; - } else { - zfree(temp); - } - } - if (zp != squares) - zfree(*zp); - } - - zfree(val); + if (zrel(z, *zp) >= 0) + power++; + if (power > 1) + zfree(z); return power; } @@ -1135,70 +1149,50 @@ zlog10(ZVALUE z) { register ZVALUE *zp; /* current square */ long power; /* current power */ - long worth; /* worth of current square */ - ZVALUE val; /* current value of power */ ZVALUE temp; /* temporary */ - if (!zispos(z)) { - math_error("Non-positive number for log10"); + if (ziszero(z)) { + math_error("Zero argument argument for zlog10"); /*NOTREACHED*/ } + /* Ignore sign of z */ + z.sign = 0; + /* * Loop by squaring the base each time, and see whether or * not each successive square is still smaller than the number. */ - worth = 1; zp = &_tenpowers_[0]; *zp = _ten_; while (((zp->len * 2) - 1) <= z.len) { /* while square not too large */ + if (zp >= &_tenpowers_[TEN_MAX]) { + math_error("Maximum storable power of 10 reached!"); + /*NOTREACHED*/ + } if (zp[1].len == 0) zsquare(*zp, zp + 1); zp++; - worth *= 2; } /* * Now back down the squares, and multiply them together to see * exactly how many times the base can be raised by. */ - val = _one_; power = 0; - /* - * We prevent the zp pointer from walking behind _tenpowers_ - * by stopping one short of the end and running the loop one - * more time. - * - * We could stop the loop with just zp >= _tenpowers_, but stopping - * short and running the loop one last time manually helps make - * code checkers such as insure happy. - */ - for (; zp > _tenpowers_; zp--, worth /= 2) { - if ((val.len + zp->len - 1) <= z.len) { - zmul(val, *zp, &temp); - if (zrel(z, temp) >= 0) { - zfree(val); - val = temp; - power += worth; - } else { - zfree(temp); - } + for (; zp > _tenpowers_; zp--) { + if (zrel(z, *zp) >= 0) { + zquo(z, *zp, &temp, 0); + if (power) + zfree(z); + z = temp; + power++; } + power <<= 1; } - /* run the loop manually one last time */ - if (zp == _tenpowers_) { - if ((val.len + zp->len - 1) <= z.len) { - zmul(val, *zp, &temp); - if (zrel(z, temp) >= 0) { - zfree(val); - val = temp; - power += worth; - } else { - zfree(temp); - } - } - } - - zfree(val); + if (zrel(z, *zp) >= 0) + power++; + if (power > 1) + zfree(z); return power; } @@ -1223,7 +1217,7 @@ zdivcount(ZVALUE z1, ZVALUE z2) /* - * Remove all occurences of the specified factor from a number. + * Remove all occurrences of the specified factor from a number. * Also returns the number of factors removed as a function return value. * Example: zfacrem(540, 3, &x) returns 3 and sets x to 20. */ @@ -1357,29 +1351,47 @@ zfacrem(ZVALUE z1, ZVALUE z2, ZVALUE *rem) /* * Keep dividing a number by the gcd of it with another number until the - * result is relatively prime to the second number. + * result is relatively prime to the second number. Returns the number + * of divisions made, and if this is positive, stores result at res. */ -void +long zgcdrem(ZVALUE z1, ZVALUE z2, ZVALUE *res) { ZVALUE tmp1, tmp2; + long count, onecount; + long sh; + if (ziszero(z1) || ziszero(z2)) { + math_error("Zero argument in call to zgcdrem!!!"); + /*NOTREACHED*/ + } /* * Begin by taking the gcd for the first time. * If the number is already relatively prime, then we are done. */ z1.sign = 0; z2.sign = 0; - zgcd(z1, z2, &tmp1); - if (zisunit(tmp1) || ziszero(tmp1)) { - res->len = z1.len; - res->v = alloc(z1.len); - res->sign = 0; - zcopyval(z1, *res); - zfree(tmp1); - return; + if (zisone(z2)) + return 0; + if (zisonebit(z2)) { + sh = zlowbit(z1); + if (sh == 0) + return 0; + zshift(z1, -sh, res); + return 1 + (sh - 1)/zlowbit(z2); } + if (zisonebit(z1)) { + if (zisodd(z2)) + return 0; + *res = _one_; + return zlowbit(z1); + } + + zgcd(z1, z2, &tmp1); + if (zisunit(tmp1) || ziszero(tmp1)) + return 0; zequo(z1, tmp1, &tmp2); + count = 1; z1 = tmp2; z2 = tmp1; /* @@ -1387,15 +1399,18 @@ zgcdrem(ZVALUE z1, ZVALUE z2, ZVALUE *res) * the gcd becomes one. */ while (!zisunit(z2)) { - (void) zfacrem(z1, z2, &tmp1); - zfree(z1); - z1 = tmp1; + onecount = zfacrem(z1, z2, &tmp1); + if (onecount) { + count += onecount; + zfree(z1); + z1 = tmp1; + } zgcd(z1, z2, &tmp1); zfree(z2); z2 = tmp1; } - zfree(z2); *res = z1; + return count; } @@ -1820,7 +1835,7 @@ zroot(ZVALUE z1, ZVALUE z2, ZVALUE *dest) old.len = ztry.len; zcopyval(ztry, old); } - /* average current try and quotent for the new try */ + /* average current try and quotient for the new try */ zmul(ztry, k1, &temp); zfree(ztry); zadd(quo, temp, &temp2); diff --git a/zio.c b/zio.c index 08cf286..58526a9 100644 --- a/zio.c +++ b/zio.c @@ -18,7 +18,7 @@ * 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. * * @(#) $Revision: 29.2 $ - * @(#) $Id: zio.c,v 29.2 2000/06/07 14:02:13 chongo Exp $ + * @(#) $Id: zio.c,v 29.2 2000/06/07 14:02:13 chongo Exp chongo $ * @(#) $Source: /usr/local/src/cmd/calc/RCS/zio.c,v $ * * Under source code control: 1993/07/30 19:42:48 @@ -318,10 +318,10 @@ math_setmode(int newmode) * Set the number of digits for float or exponential output. * This also returns the previous number of digits. */ -long -math_setdigits(long newdigits) +LEN +math_setdigits(LEN newdigits) { - long olddigits; + LEN olddigits; if (newdigits < 0) { math_error("Setting illegal number of digits"); diff --git a/zmath.h b/zmath.h index a09b8ac..692c17f 100644 --- a/zmath.h +++ b/zmath.h @@ -18,7 +18,7 @@ * 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. * * @(#) $Revision: 29.2 $ - * @(#) $Id: zmath.h,v 29.2 2000/06/07 14:02:13 chongo Exp $ + * @(#) $Id: zmath.h,v 29.2 2000/06/07 14:02:13 chongo Exp chongo $ * @(#) $Source: /usr/local/src/cmd/calc/RCS/zmath.h,v $ * * Under source code control: 1993/07/30 19:42:48 @@ -332,7 +332,7 @@ extern void zlcm(ZVALUE z1, ZVALUE z2, ZVALUE *res); extern void zreduce(ZVALUE z1, ZVALUE z2, ZVALUE *z1res, ZVALUE *z2res); extern void zfact(ZVALUE z, ZVALUE *dest); extern void zperm(ZVALUE z1, ZVALUE z2, ZVALUE *res); -extern void zcomb(ZVALUE z1, ZVALUE z2, ZVALUE *res); +extern int zcomb(ZVALUE z1, ZVALUE z2, ZVALUE *res); extern FLAG zjacobi(ZVALUE z1, ZVALUE z2); extern void zfib(ZVALUE z, ZVALUE *res); extern void zpowi(ZVALUE z1, ZVALUE z2, ZVALUE *res); @@ -344,7 +344,7 @@ extern long zlog(ZVALUE z1, ZVALUE z2); extern long zlog10(ZVALUE z); extern long zdivcount(ZVALUE z1, ZVALUE z2); extern long zfacrem(ZVALUE z1, ZVALUE z2, ZVALUE *rem); -extern void zgcdrem(ZVALUE z1, ZVALUE z2, ZVALUE *res); +extern long zgcdrem(ZVALUE z1, ZVALUE z2, ZVALUE *res); extern long zdigits(ZVALUE z1); extern long zdigit(ZVALUE z1, long n); extern FLAG zsqrt(ZVALUE z1, ZVALUE *dest, long R); @@ -558,7 +558,7 @@ extern void math_divertio(void); extern void math_cleardiversions(void); extern char *math_getdivertedio(void); extern int math_setmode(int mode); -extern long math_setdigits(long digits); +extern LEN math_setdigits(LEN digits); extern void math_fmt(char *, ...);