drygdryg/calc
1
0
Fork 0
mirror of https://github.com/lcn2/calc.git synced 2025-08-16 01:03:29 +03:00
Code Issues Packages Projects Releases Wiki Activity

Release calc version 2.11.2t1

Browse Source
This commit is contained in:
Landon Curt Noll
2000-12-15 07:34:07 -08:00
parent 5e098d2adf
commit 296aa50ac7
52 changed files with 1670 additions and 4777 deletions
Download Patch File Download Diff File Expand all files Collapse all files

259
CHANGES
View File

@@ -1,257 +1,4 @@
The following are the changes from calc version 2.11.4t1 to date:
Added missing test8600.cal test file.
Fixes cscript files to deal with the -S flag being replaced by
-f and possibly other flags.
The following are the changes from calc version 2.11.3t0 to 2.11.4:
Increased the maximum number of args for functions from 100 to 1024.
Increased calc's internal evaluation stack from 1024 to 2048 args.
Added test8600.cal to the regression suite to test these new limits.
Updated and fixed misc typos in calc/README.
Clarified in the COPYING file that ALL calc source files, both
LGPL covered and exceptions to the LGPL files may be freely used
and distributed.
Added help files or updated for: bernoulli, calc_tty, catalan,
digit, digits, euler, freeeuler, places and sleep.
A collection of 18 patches from Ernest Bowen
<ernie at turing dot une dot edu dot au>:
(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), 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:
The following are the changes from calc version 2.11.2t0 to date:
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.
@@ -5019,8 +4766,8 @@ Following is a list of visible changes to calc from version 1.24.7 to 1.26.1:
## 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.14 $
## @(#) $Id: CHANGES,v 29.14 2000/12/15 14:58:20 chongo Exp $
## @(#) $Revision: 29.11 $
## @(#) $Id: CHANGES,v 29.11 2000/06/07 15:51:35 chongo Exp $
## @(#) $Source: /usr/local/src/cmd/calc/RCS/CHANGES,v $
##
## Under source code control: 1993/06/02 18:12:57

10
COPYING
View File

@@ -12,8 +12,8 @@ This file is Copyrighted
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
# @(#) $Revision: 29.3 $
# @(#) $Id: COPYING,v 29.3 2000/12/14 09:18:06 chongo Exp $
# @(#) $Revision: 29.2 $
# @(#) $Id: COPYING,v 29.2 2000/06/07 14:02:13 chongo Exp $
# @(#) $Source: /usr/local/src/cmd/calc/RCS/COPYING,v $
=-=
@@ -167,12 +167,6 @@ Calc copyrights and exception files
top of this file. It is important to note that you may distribute
verbatim copies of this file but you may not modify this file.
Some of these exception files are in the public domain. Other
exception files have non-LGPL Copyrights. In all cases one may
use and distribute these exception files freely. And because one
may freely distribute the LGPL covered files, the entire calc
source may be freely used and distributed.
=-=
General Copyleft and License info

8
addop.c
View File

@@ -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.3 $
* @(#) $Id: addop.c,v 29.3 2000/07/17 15:35:49 chongo Exp $
* @(#) $Revision: 29.2 $
* @(#) $Id: addop.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $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 (newname[0] != '*' && (conf->traceflags & TRACE_FNCODES)) {
if (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 (newname[0] != '*' && (conf->traceflags & TRACE_FNCODES)) {
if (conf->traceflags & TRACE_FNCODES) {
printf("Freeing function \"%s\"\n",namestr(&funcnames,index));
dumpnames = FALSE;
for (i = 0; i < fp->f_opcodecount; ) {

6
cal/Makefile
View File

@@ -18,8 +18,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.3 $
# @(#) $Id: Makefile,v 29.3 2000/12/15 14:42:52 chongo Exp $
# @(#) $Revision: 29.2 $
# @(#) $Id: Makefile,v 29.2 2000/06/07 14:02:25 chongo Exp $
# @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/Makefile,v $
#
# Under source code control: 1991/07/21 05:00:54
@@ -70,7 +70,7 @@ CALC_FILES= README bigprime.cal deg.cal ellip.cal lucas.cal lucas_chk.cal \
test3500.cal seedrandom.cal test4000.cal test4100.cal test4600.cal \
beer.cal hello.cal test5100.cal test5200.cal randombitrun.cal \
randomrun.cal xx_print.cal natnumset.cal qtime.cal test8400.cal \
test8500.cal test8600.cal
test8500.cal
# These files are found (but not built) in the distribution
#

55
cal/README
View File

@@ -1,7 +1,7 @@
Calc standard resource files
----------------------------
To load a resource file, try:
To load a reosurce file, try:
read filename
@@ -59,7 +59,7 @@ files have already been read, the read -once will act as a noop.
The "resource_debug" parameter is intended for controlling the possible
display of special information relating to functions, objects, and
other structures created by instructions in calc resource files.
other structures created by instructions in calc resoure files.
Zero value of config("resource_debug") means that no such information
is displayed. For other values, the non-zero bits which currently
have meanings are as follows:
@@ -274,7 +274,7 @@ pell.cal
pell(D)
Solve Pell's equation; Returns the solution X to: X^2 - D * Y^2 = 1.
Type the solution to Pell's equation for a particular D.
Type the solution to pells equation for a particular D.
pi.cal
@@ -288,7 +288,7 @@ pi.cal
The piforever() prints digits of pi, nicely formatted, for as long
as your free memory space and system up time allows.
The piforever() function (written by Klaus Alexander Seistrup
The piforever() funcion (written by Klaus Alexander Seistrup
<klaus@seistrup.dk>) was inspired by an algorithm conceived by
Lambert Meertens. See also the ABC Programmer's Handbook, by Geurts,
Meertens & Pemberton, published by Prentice-Hall (UK) Ltd., 1990.
@@ -356,7 +356,7 @@ quat.cal
quat_shift(a, b)
Calculate using quaternions of the form: a + bi + cj + dk. In these
functions, quaternions are manipulated in the form: s + v, where
functions, quaternians are manipulated in the form: s + v, where
s is a scalar and v is a vector of size 3.
@@ -386,7 +386,7 @@ randombitrun.cal
randombitrun([run_cnt])
Using randombit(1) to generate a sequence of random bits, determine if
the number and length of identical bits runs match what is expected.
the number and kength of identical bits runs match what is expected.
By default, run_cnt is to test the next 65536 random values.
This tests the Blum-Blum-Shub generator.
@@ -489,7 +489,7 @@ test1700.cal
value
This resource files is used by regress.cal to test the read and use keywords.
This resoure files is used by regress.cal to test the read and use keywords.
test2600.cal
@@ -514,7 +514,7 @@ test2600.cal
checkresult(x, y, z, a)
test2600(verbose, tnum)
This resource files is used by regress.cal to test some of builtin functions
This resoure files is used by regress.cal to test some of builtin functions
in terms of accuracy and roundoff.
@@ -537,7 +537,7 @@ test2700.cal
iscomsq(x)
test2700(verbose, tnum)
This resource files is used by regress.cal to test sqrt() for real and
This resoure files is used by regress.cal to test sqrt() for real and
complex values.
@@ -625,7 +625,7 @@ test4000.cal
test4000(verbose, tnum) defined
This resource file is used by regress.cal to test ptest, nextcand and
prevcand builtins.
prevcand buildins.
test4100.cal
@@ -677,35 +677,6 @@ test5200.cal
This resource file is used by regress.cal to test the fix of a
global/static bug.
test8400.cal
test8400() defined
This resource file is used by regress.cal to check for quit-based
memory leaks.
test8500.cal
global err_8500
global L_8500
global ver_8500
global old_seed_8500
global cfg_8500
onetest_8500(a,b,rnd) defined
divmod_8500(N, M1, M2, testnum) defined
This resource file is used by regress.cal to the // and % operators.
test8600.cal
global min_8600
global max_8600
global hash_8600
global hmean_8600
This resource file is used by regress.cal to test a change of
allowing up to 1024 args to be passed to a builtin function.
unitfrac.cal
unitfrac(x)
@@ -734,7 +705,7 @@ xx_print.cal
Demo for the xx_print object routines.
## Copyright (C) 2000 David I. Bell and Landon Curt Noll
## Copyright (C) 1999 David I. Bell and Landon Curt Noll
##
## Primary author: Landon Curt Noll
##
@@ -752,8 +723,8 @@ xx_print.cal
## 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.3 $
## @(#) $Id: README,v 29.3 2000/12/04 20:11:52 chongo Exp $
## @(#) $Revision: 29.2 $
## @(#) $Id: README,v 29.2 2000/06/07 14:02:25 chongo Exp $
## @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/README,v $
##
## Under source code control: 1990/02/15 01:50:32

21
cal/regress.cal
View File

@@ -17,8 +17,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.5 $
* @(#) $Id: regress.cal,v 29.5 2000/12/04 20:00:53 chongo Exp $
* @(#) $Revision: 29.3 $
* @(#) $Id: regress.cal,v 29.3 2000/06/07 14:02:25 chongo Exp $
* @(#) $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) == 0, '715: digits(0) == 0');
vrfy(digits(0) == 1, '715: digits(0) == 1');
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) == 0, '977: digits(0) == 0');
vrfy(digits(0.0123) == 0, '978: digits(0.0123) == 0');
vrfy(digits(0) == 1, '977: digits(0) == 1');
vrfy(digits(0.0123) == 1, '978: digits(0.0123) == 1');
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(list() << 2 == error(10031),'3646: list() << 2 == error(10031)');
vrfy(null() << 2 == error(10031),'3646: null() << 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)');
@@ -7538,15 +7538,6 @@ read -once "test8500";
/* 85xx: Ending test_divmod is printed by test8500.cal */
/*
* test_maxargs - test up to 1024 args being passed to a builtin function
*/
print;
print '8600: Starting test_1024args'
read -once "test8600";
/* 86xx: Ending test_1024args is printed by test8600.cal */
/*
* read various calc resource files
*

1406
cal/test8600.cal
View File

File diff suppressed because it is too large Load Diff

733
calc.c
View File

@@ -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.5 $
* @(#) $Id: calc.c,v 29.5 2000/07/17 15:35:49 chongo Exp $
* @(#) $Revision: 29.4 $
* @(#) $Id: calc.c,v 29.4 2000/06/07 14:02:13 chongo Exp $
* @(#) $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 nextcp(char **cpp, int *ip, int argc, char **argv, BOOL haveendstr);
static void set_run_state(run state);
static int script_args(int argc,char ***argv,char **shellfile,char **program);
/*
* Top level calculator routine.
@@ -81,57 +81,26 @@ main(int argc, char **argv)
{
int want_defhelp = 0; /* 1=> we only want the default help */
int cmdlen; /* length of the command string */
int newcmdlen;
char *shellfile = NULL; /* != NULL ==> name of calc shell script */
extern char *optarg; /* option argument */
extern int optind; /* option index */
int c; /* option */
int index;
int maxindex;
char *cp;
char *endcp;
char *bp;
BOOL done = FALSE;
BOOL havearg;
BOOL haveendstr;
int len;
char *p;
long i;
/*
* parse args
*/
program = argv[0];
cmdbuf[0] = '\0';
cmdlen = 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 */
index = 1;
cp = endcp = NULL;
maxindex = argc;
havecommands = FALSE;
while (index < maxindex && !done) {
cp = argv[index];
if (*cp == '\0') {
index++;
continue;
}
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;
while ((c = getopt(argc, argv, "Cehim:npquvcdD:s")) != -1) {
switch (c) {
case 'C':
#if defined(CUSTOM)
@@ -139,14 +108,12 @@ main(int argc, char **argv)
break;
#else /* CUSTOM */
/*
* we are too early in processing to
* call libcalc_call_me_last() -
* nothing to cleanup
* 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);
"%s: calc was built with custom functions "
"disabled, -C usage is disallowed\n", program);
exit(1);
#endif /* CUSTOM */
case 'e':
@@ -159,41 +126,19 @@ main(int argc, char **argv)
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') {
if (optarg[1] != '\0' || *optarg<'0' || *optarg>'7') {
/*
* we are too early in
* processing to call
* libcalc_call_me_last()
* we are too early in processing to
* call libcalc_call_me_last()
* nothing to cleanup
*/
fprintf(stderr,
"%s: unknown -m arg\n",
program);
"%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;
allow_read = (((*optarg-'0') & 04) > 0);
allow_write = (((*optarg-'0') & 02) > 0);
allow_exec = (((*optarg-'0') & 01) > 0);
break;
case 'n':
new_std = TRUE;
@@ -215,242 +160,107 @@ main(int argc, char **argv)
break;
case 'v':
/*
* we are too early in processing to
* call libcalc_call_me_last() -
* nothing to cleanup
* we are too early in processing to call
* libcalc_call_me_last() - nothing to cleanup
*/
printf("%s (version %s)\n",
CALC_TITLE, version());
printf("%s (version %s)\n", CALC_TITLE, version());
exit(0);
case 'D':
/*
* parse the -D arg
* parse the -D optarg
*
* Could be:
*
* calc_debug
* calc_debug:resource_debug
* calc_debug:resource_debug:user_debug
* Could be calc_debug
* or calc_debug:resource_debug
* or calc_debug:resource_debug:user_debug
*/
if (nextcp(&cp, &index, argc, argv,
FALSE)) {
fprintf(stderr,
"-D expects argument\n");
exit (1);
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;
}
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;
case 'S':
/*FALLTHRU*/
default:
/*
* we are too early in processing to
* call libcalc_call_me_last() -
* nothing to cleanup
* 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"
"usage: %s [-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",
"\t[-n] [-p] [-q] [-s] [-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) {
/*
* 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;
}
if (cmdlen > MAXCMD) {
/*
* we are too early in processing to call
* libcalc_call_me_last() - nothing to cleanup
*/
fprintf(stderr,
"%s: commands too long\n",
"%s: command in arg list is too long\n",
program);
exit(1);
}
strcpy(cmdbuf + cmdlen, cp);
cmdlen = newcmdlen;
index++;
if (index < maxindex)
cp = argv[index];
/*
* 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]);
}
havecommands = (cmdlen > 0);
if (havecommands) {
cmdbuf[cmdlen++] = '\n';
cmdbuf[cmdlen] = '\0';
}
argc_value = argc - maxindex;
argv_value = argv + maxindex;
argc_value = 0;
argv_value = argv+argc;
}
/*
* unbuffered mode
@@ -460,7 +270,6 @@ main(int argc, char **argv)
setbuf(stdout, NULL);
}
/*
* initialize
*/
@@ -524,10 +333,18 @@ main(int argc, char **argv)
*/
if (run_state == RUN_BEGIN) {
if (!q_flag && allow_read) {
set_run_state(RUN_RCFILES);
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;
runrcfiles();
}
set_run_state(RUN_PRE_CMD_ARGS);
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;
}
while (run_state == RUN_RCFILES) {
@@ -537,27 +354,55 @@ main(int argc, char **argv)
if (inputlevel() == 0) {
closeinput();
runrcfiles();
set_run_state(RUN_PRE_CMD_ARGS);
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;
} else {
closeinput();
}
} else {
if ((havecommands && !i_flag) || !stdin_tty) {
set_run_state(RUN_EXIT_WITH_ERROR);
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;
} else {
set_run_state(RUN_PRE_CMD_ARGS);
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;
}
}
}
if (run_state == RUN_PRE_CMD_ARGS) {
if (havecommands) {
set_run_state(RUN_CMD_ARGS);
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;
(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);
}
set_run_state(RUN_PRE_TOP_LEVEL);
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;
}
while (run_state == RUN_CMD_ARGS) {
@@ -565,22 +410,38 @@ main(int argc, char **argv)
if ((c_flag && !stoponerror) || stoponerror < 0) {
getcommands(FALSE);
if (inputlevel() == 0)
set_run_state(RUN_PRE_TOP_LEVEL);
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;
closeinput();
} else {
closeinput();
if (!stdin_tty || !i_flag || p_flag) {
set_run_state(RUN_EXIT_WITH_ERROR);
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;
} else {
set_run_state(RUN_PRE_TOP_LEVEL);
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;
}
}
}
if (run_state == RUN_PRE_TOP_LEVEL) {
if (stdin_tty &&
(((havecommands) && !i_flag) || p_flag)) {
set_run_state(RUN_EXIT);
(((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;
} else {
if (stdin_tty) {
reinitialize();
@@ -588,71 +449,40 @@ main(int argc, char **argv)
resetinput();
openterminal();
}
set_run_state(RUN_TOP_LEVEL);
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;
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 {
set_run_state(RUN_EXIT_WITH_ERROR);
}
}
}
if (conf->calc_debug & CALCDBG_RUNSTATE)
printf("main: run_state = %s\n", run_state_name(run_state));
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;
}
}
}
/*
* all done
*/
libcalc_call_me_last();
return (run_state == RUN_EXIT_WITH_ERROR ||
run_state == RUN_ZERO) ? 1 : 0;
run_state == RUN_UNKNOWN) ? 1 : 0;
}
@@ -710,52 +540,183 @@ 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
nextcp(char **cpp, int *ip, int argc, char **argv, BOOL haveendstr)
script_args(int argc, char ***argv_p, char **shellfile_p, char **program_p)
{
char *cp;
int index;
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;
cp = *cpp;
index = *ip;
/*
* 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];
/*
* count the additional args beyond the -S
*/
if (argv[1][2] == ' ') {
if (haveendstr) {
index++;
*ip = index;
if (index >= argc)
return 1;
*cpp = argv[index];
return 0;
/*
* 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, " ");
}
if (*cp != '\0')
cp++;
for (;;) {
if (*cp == '\0') {
index++;
*ip = index;
if (index >= argc)
return 1;
cp = argv[index];
/* 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);
}
while (*cp == ' ')
cp++;
if (*cp != '\0')
break;
/* 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);
}
*cpp = cp;
return 0;
/* 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;
}
/*
* 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;
}
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;
}

26
calc.h
View File

@@ -17,8 +17,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.5 $
* @(#) $Id: calc.h,v 29.5 2000/12/04 19:32:33 chongo Exp $
* @(#) $Revision: 29.3 $
* @(#) $Id: calc.h,v 29.3 2000/06/07 14:02:13 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/calc.h,v $
*
* Under source code control: 1990/02/15 01:48:31
@@ -60,9 +60,10 @@
#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 2048 /* maximum depth of evaluation stack */
#define MAXSTACK 1000 /* maximum depth of evaluation stack */
#define MAXFILES 20 /* maximum number of opened files */
#define PROMPT1 "> " /* default normal prompt*/
#define PROMPT2 ">> " /* default prompt inside multi-line input */
@@ -166,6 +167,7 @@ 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
@@ -227,15 +229,15 @@ extern int allow_exec; /* FALSE => may not execute any commands */
* calc startup and run state
*/
typedef enum {
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_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;
extern run run_state;
extern char *run_state_name(run state);

22
calcerr.tbl
View File

@@ -17,8 +17,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.3 $
# @(#) $Id: calcerr.tbl,v 29.3 2000/07/17 15:35:49 chongo Exp $
# @(#) $Revision: 29.2 $
# @(#) $Id: calcerr.tbl,v 29.2 2000/06/07 14:02:13 chongo Exp $
# @(#) $Source: /usr/local/src/cmd/calc/RCS/calcerr.tbl,v $
#
# Under source code control: 1996/05/23 17:38:44
@@ -375,21 +375,3 @@ 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

5
cmath.h
View File

@@ -17,8 +17,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.3 $
* @(#) $Id: cmath.h,v 29.3 2000/07/17 15:35:49 chongo Exp $
* @(#) $Revision: 29.2 $
* @(#) $Id: cmath.h,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/cmath.h,v $
*
* Under source code control: 1993/07/30 19:42:45
@@ -83,7 +83,6 @@ extern BOOL ccmp(COMPLEX *c1, COMPLEX *c2);
* More complicated functions.
*/
extern COMPLEX *cpowi(COMPLEX *c, NUMBER *q);
extern NUMBER *cilog(COMPLEX *c, ZVALUE base);
/*

265
codegen.c
View File

@@ -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.3 $
* @(#) $Id: codegen.c,v 29.3 2000/07/17 15:35:49 chongo Exp $
* @(#) $Revision: 29.2 $
* @(#) $Id: codegen.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $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 int getfilename(char *name, BOOL *once);
static BOOL getfilename(char *name, BOOL msg_ok, 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, int autodef);
static void usesymbol(char *name, BOOL autodef);
static void definesymbol(char *name, int symtype);
static void getcallargs(char *name);
static void do_changedir(void);
@@ -90,16 +90,9 @@ static int getshiftexpr(void);
static int getreference(void);
static int getincdecexpr(void);
static int getterm(void);
static int getidexpr(BOOL okmat, int autodef);
static int getidexpr(BOOL okmat, BOOL 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.
@@ -140,63 +133,49 @@ getcommands(BOOL toplevel)
return;
case T_HELP:
for (;;) {
switch(getfilename(name, NULL)) {
case 1:
if (!getfilename(name, FALSE, NULL)) {
strcpy(name, DEFAULTCALCHELP);
case 0:
}
givehelp(name);
continue;
default:
break;
}
break;
}
break;
case T_READ:
if (!getfilename(name, TRUE, &rdonce))
break;
if (!allow_read) {
scanerror(T_NULL,
"read command disallowed by -m mode\n");
break;
}
for (;;) {
if (getfilename(name, &rdonce))
break;
switch (opensearchfile(name,calcpath,
CALCEXT,rdonce)) {
switch (opensearchfile(name,calcpath,CALCEXT,rdonce)) {
case 0:
getcommands(FALSE);
closeinput();
continue;
break;
case 1:
/* prev read and -once was given */
continue;
/* previously read and -once was given */
break;
case -2:
scanerror(T_NULL,
"Maximum input depth reached");
break;
default:
scanerror(T_NULL,
"Cannot open \"%s\"", name);
continue;
}
scanerror(T_NULL, "Cannot open \"%s\"\n", name);
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 (getfilename(name, NULL))
break;
if (writeglobals(name)) {
if (writeglobals(name))
scanerror(T_NULL,
"Error writing \"%s\"\n", name);
}
break;
case T_CD:
@@ -550,7 +529,7 @@ getonevariable(int symtype)
res = getonevariable(symtype);
definesymbol(name, symtype);
if (res) {
usesymbol(name, 0);
usesymbol(name, FALSE);
addop(OP_ASSIGNBACK);
}
return res;
@@ -913,7 +892,7 @@ getstatement(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *d
return;
case T_ELSE:
scanerror(T_SEMICOLON, "ELSE without preceding IF");
scanerror(T_SEMICOLON, "ELSE without preceeding IF");
return;
case T_SHOW:
@@ -1042,6 +1021,7 @@ 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) {
@@ -1058,46 +1038,23 @@ 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) {
if (maxindices == INDICALLOC) {
maxindices += INDICALLOC;
newindices = (int *) malloc(maxindices *
sizeof(int));
if (newindices == NULL) {
scanerror(T_SEMICOLON, "Out of memory for indices malloc");
if (count == MAXINDICES) {
scanerror(T_SEMICOLON,
"Too many elements in OBJ "
"statement");
(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;
}
}
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());
scanerror(T_SEMICOLON,
"Duplicate element name "
"\"%s\"", tokensymbol());
(void) tokenmode(oldmode);
return;
}
@@ -1107,9 +1064,8 @@ getobjdeclaration(int symtype)
continue;
rescantoken();
if (gettoken() != T_RIGHTBRACE) {
if (indices != quickindices)
free(indices);
scanerror(T_SEMICOLON, "Bad object type definition");
scanerror(T_SEMICOLON,
"Bad object type definition");
(void) tokenmode(oldmode);
return;
}
@@ -1117,30 +1073,23 @@ getobjdeclaration(int symtype)
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");
scanerror(T_SEMICOLON,
"Bad object type definition");
(void) tokenmode(oldmode);
return;
}
}
}
static void
getoneobj(long index, int symtype)
{
@@ -1149,11 +1098,11 @@ getoneobj(long index, int symtype)
if (gettoken() == T_SYMBOL) {
if (symtype == SYM_UNDEFINED) {
rescantoken();
(void) getidexpr(TRUE, 1);
(void) getidexpr(TRUE, TRUE);
} else {
symname = tokensymbol();
definesymbol(symname, symtype);
usesymbol(symname, 0);
usesymbol(symname, FALSE);
}
getoneobj(index, symtype);
addop(OP_ASSIGN);
@@ -1232,11 +1181,11 @@ getonematrix(int symtype)
if (gettoken() == T_SYMBOL) {
if (symtype == SYM_UNDEFINED) {
rescantoken();
(void) getidexpr(FALSE, 1);
(void) getidexpr(FALSE, TRUE);
} else {
name = tokensymbol();
definesymbol(name, symtype);
usesymbol(name, 0);
usesymbol(name, FALSE);
}
while (gettoken() == T_COMMA);
rescantoken();
@@ -2079,25 +2028,7 @@ getterm(void)
case T_SYMBOL:
rescantoken();
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);
type = getidexpr(TRUE, FALSE);
break;
case T_LEFTBRACKET:
@@ -2146,11 +2077,11 @@ getterm(void)
/*
* Read in an identifier expressions.
* This is a symbol name followed by parenthesis, or by square brackets or
* element references. The symbol can be a global or a local variable name.
* element refernces. The symbol can be a global or a local variable name.
* Returns the type of expression found.
*/
static int
getidexpr(BOOL okmat, int autodef)
getidexpr(BOOL okmat, BOOL autodef)
{
int type;
char name[SYMBOLSIZE+1]; /* symbol name */
@@ -2167,8 +2098,7 @@ getidexpr(BOOL okmat, int autodef)
type = 0;
break;
case T_ASSIGN:
if (autodef != T_GLOBAL && autodef != T_LOCAL)
autodef = 1;
autodef = TRUE;
/* fall into default case */
default:
rescantoken();
@@ -2214,16 +2144,16 @@ getidexpr(BOOL okmat, int autodef)
*
* given:
* name filename to read
* msg_ok TRUE => ok to print error messages
* once non-NULL => set to TRUE of -once read
*/
static int
getfilename(char *name, BOOL *once)
static BOOL
getfilename(char *name, BOOL msg_ok, BOOL *once)
{
STRING *s;
int i;
/* look at the next token */
(void) tokenmode(TM_NEWLINES | TM_ALLSYMS);
for (i = 2; i > 0; i--) {
switch (gettoken()) {
case T_STRING:
s = findstring(tokenstring());
@@ -2234,17 +2164,51 @@ getfilename(char *name, BOOL *once)
strcpy(name, tokensymbol());
break;
default:
rescantoken();
return -1;
if (msg_ok)
scanerror(T_SEMICOLON, "Filename expected");
return FALSE;
}
if (i == 2 && once != NULL) {
if ((*once = !strcmp(name, "-once")))
continue;
}
/* 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;
}
return 0;
} else {
*once = FALSE;
}
}
/* 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;
}
return TRUE;
}
@@ -2469,26 +2433,11 @@ definesymbol(char *name, int symtype)
*
* given:
* name symbol name to be checked
* autodef 1 => define if symbol is not known
* T_GLOBAL => get global, define if necessary
* autodef TRUE => define is symbol is not known
*/
static void
usesymbol(char *name, int autodef)
usesymbol(char *name, BOOL 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));
@@ -2595,25 +2544,24 @@ 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_STRING:
s = findstring(tokenstring());
p = s->s_str;
break;
case T_SYMBOL:
p = tokensymbol();
case T_NULL:
case T_NEWLINE:
case T_SEMICOLON:
p = home;
break;
default:
p = tokensymbol(); /* This is not enough XXX */
if (p == NULL) {
p = home;
}
break;
}
if (p == NULL) {
fprintf(stderr, "Cannot determine HOME directory\n");
}
@@ -2622,8 +2570,29 @@ do_changedir(void)
if (chdir(p)) {
perror(p);
}
if (s != NULL)
sfree(s);
return;
}
/*
* 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;
}

30
comfunc.c
View File

@@ -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.3 $
* @(#) $Id: comfunc.c,v 29.3 2000/07/17 15:35:49 chongo Exp $
* @(#) $Revision: 29.2 $
* @(#) $Id: comfunc.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $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 epsilon for cpolar");
math_error("Zero epsilson for cpolar");
/*NOTREACHED*/
}
if (qiszero(q1))
@@ -1162,27 +1162,3 @@ 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;
}

244
config.c
View File

@@ -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.4 $
* @(#) $Id: config.c,v 29.4 2000/07/17 15:35:49 chongo Exp $
* @(#) $Revision: 29.3 $
* @(#) $Id: config.c,v 29.3 2000/06/07 14:02:13 chongo Exp $
* @(#) $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 approximations */
TRUE, /* ok to print a tilde on aproximations */
TRUE, /* ok to print tab before numeric values */
0, /* quomod() default rounding mode */
2, /* quotient // default rounding mode */
2, /* quotent // 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 approximations */
TRUE, /* ok to print a tilde on aproximations */
TRUE, /* ok to print tab before numeric values */
0, /* quomod() default rounding mode */
0, /* quotient // default rounding mode */
0, /* quotent // default rounding mode */
0, /* mod % default rounding mode */
24, /* sqrt() default rounding mode */
24, /* appr() default rounding mode */
@@ -287,11 +287,10 @@ static NAMETYPE truth[] = {
/*
* declare static functions
* declate 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);
/*
@@ -361,26 +360,6 @@ 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.
@@ -391,7 +370,6 @@ setconfig(int type, VALUE *vp)
NUMBER *q;
CONFIG *newconf; /* new configuration to set */
long temp;
LEN len;
char *p;
switch (type) {
@@ -436,11 +414,15 @@ setconfig(int type, VALUE *vp)
break;
case CONFIG_DISPLAY:
if (getlen(vp, &len)) {
math_error("Bad value for display");
if (vp->v_type != V_NUM) {
math_error("Non-numeric for display");
/*NOTREACHED*/
}
math_setdigits(len);
q = vp->v_num;
temp = qtoi(q);
if (qisfrac(q) || qisneg(q) || !zistiny(q->num))
temp = -1;
math_setdigits(temp);
break;
case CONFIG_MODE:
@@ -465,51 +447,91 @@ setconfig(int type, VALUE *vp)
break;
case CONFIG_MAXPRINT:
if (getlen(vp, &len)) {
math_error("Bad value for maxprint");
if (vp->v_type != V_NUM) {
math_error("Non-numeric for maxprint");
/*NOTREACHED*/
}
conf->maxprint = len;
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;
break;
case CONFIG_MUL2:
if (getlen(vp, &len)) {
math_error("Bad value for mul2");
if (vp->v_type != V_NUM) {
math_error("Non-numeric for mul2");
/*NOTREACHED*/
}
if (len == 0)
len = MUL_ALG2;
conf->mul2 = len;
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;
break;
case CONFIG_SQ2:
if (getlen(vp, &len)) {
math_error("Bad value for sq2");
if (vp->v_type != V_NUM) {
math_error("Non-numeric for sq2");
/*NOTREACHED*/
}
if (len == 0)
len = SQ_ALG2;
conf->sq2 = len;
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;
break;
case CONFIG_POW2:
if (getlen(vp, &len)) {
math_error("Bad value for pow2");
if (vp->v_type != V_NUM) {
math_error("Non-numeric for pow2");
/*NOTREACHED*/
}
if (len == 0)
len = POW_ALG2;
conf->pow2 = len;
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;
break;
case CONFIG_REDC2:
if (getlen(vp, &len)) {
math_error("Bad value for redc2");
if (vp->v_type != V_NUM) {
math_error("Non-numeric for redc2");
/*NOTREACHED*/
}
if (len == 0)
len = REDC_ALG2;
conf->redc2 = len;
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;
break;
case CONFIG_TILDE:
@@ -541,75 +563,129 @@ setconfig(int type, VALUE *vp)
break;
case CONFIG_QUOMOD:
if (getlen(vp, &len)) {
math_error("Illegal value for quomod");
if (vp->v_type != V_NUM) {
math_error("Non numeric for quomod");
/*NOTREACHED*/
}
conf->quomod = len;
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;
break;
case CONFIG_QUO:
if (getlen(vp, &len)) {
math_error("Illegal value for quo");
if (vp->v_type != V_NUM) {
math_error("Non numeric for quo");
/*NOTREACHED*/
}
conf->quo = len;
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;
break;
case CONFIG_MOD:
if (getlen(vp, &len)) {
math_error("Illegal value for mod");
if (vp->v_type != V_NUM) {
math_error("Non numeric for mod");
/*NOTREACHED*/
}
conf->mod = len;
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;
break;
case CONFIG_SQRT:
if (getlen(vp, &len)) {
math_error("Illegal value for sqrt");
if (vp->v_type != V_NUM) {
math_error("Non numeric for sqrt");
/*NOTREACHED*/
}
conf->sqrt = len;
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;
break;
case CONFIG_APPR:
if (getlen(vp, &len)) {
math_error("Illegal value for appr");
if (vp->v_type != V_NUM) {
math_error("Non numeric for appr");
/*NOTREACHED*/
}
conf->appr = len;
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;
break;
case CONFIG_CFAPPR:
if (getlen(vp, &len)) {
math_error("Illegal value for cfappr");
if (vp->v_type != V_NUM) {
math_error("Non numeric for cfappr");
/*NOTREACHED*/
}
conf->cfappr = len;
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;
break;
case CONFIG_CFSIM:
if (getlen(vp, &len)) {
math_error("Illegal value for cfsim");
if (vp->v_type != V_NUM) {
math_error("Non numeric for cfsim");
/*NOTREACHED*/
}
conf->cfsim = len;
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;
break;
case CONFIG_OUTROUND:
if (getlen(vp, &len)) {
math_error("Illegal value for outround");
if (vp->v_type != V_NUM) {
math_error("Non numeric for outround");
/*NOTREACHED*/
}
conf->outround = len;
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;
break;
case CONFIG_ROUND:
if (getlen(vp, &len)) {
math_error("Illegal value for round");
if (vp->v_type != V_NUM) {
math_error("Non numeric for round");
/*NOTREACHED*/
}
conf->round = len;
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;
break;
case CONFIG_LEADZERO:
@@ -1235,12 +1311,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 invalid");
math_error("CONFIG #1 value is invaid");
/*NOTREACHED*/
}
if (cfg2 == NULL || cfg2->epsilon == NULL || cfg2->prompt1 == NULL ||
cfg2->prompt2 == NULL) {
math_error("CONFIG #2 value is invalid");
math_error("CONFIG #2 value is invaid");
/*NOTREACHED*/
}

26
config.h
View File

@@ -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.4 $
* @(#) $Id: config.h,v 29.4 2000/07/17 15:35:49 chongo Exp $
* @(#) $Revision: 29.3 $
* @(#) $Id: config.h,v 29.3 2000/06/07 14:02:13 chongo Exp $
* @(#) $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 */
LEN outdigits; /* current output digits for float or exp */
long 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 */
LEN maxprint; /* number of elements to print */
long 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 */
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 */
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 */
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 */

20
cscript/Makefile
View File

@@ -17,8 +17,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.6 $
# @(#) $Id: Makefile,v 29.6 2000/12/15 14:56:14 chongo Exp $
# @(#) $Revision: 29.5 $
# @(#) $Id: Makefile,v 29.5 2000/06/07 14:02:59 chongo Exp $
# @(#) $Source: /usr/local/src/cmd/calc/cscript/RCS/Makefile,v $
#
# Under source code control: 1999/11/29 11:10:26
@@ -65,7 +65,7 @@ FMT= fmt
#
# The ${SCRIPT_SRC} is built from ${SCRIPT} and has the .calc extensions.
#
# This list is produced by the detaillist rule when no WARNINGS are detected.
# This list is prodiced by the detaillist rule when no WARNINGS are detected.
# To add a script:
#
# 1) Name the file with a .calc filename extension
@@ -76,15 +76,15 @@ FMT= fmt
#
# make detaillist
#
SCRIPT= mersenne piforever plus simple square
SCRIPT= mersenne piforever plus simple
SCRIPT_SRC= mersenne.calc piforever.calc plus.calc simple.calc square.calc
SCRIPT_SRC= mersenne.calc piforever.calc plus.calc simple.calc
# These files are found (but not built) in the distribution
#
DISTLIST= ${SCRIPT_SRC} ${MAKE_FILE} README
# These files are used to make (but not build) a calc .a library
# These files are used to make (but not built) a calc .a library
#
CALCLIBLIST=
@@ -92,10 +92,10 @@ CALCLIBLIST=
#
all: ${SCRIPT} ${SCRIPT_SRC} .all
# used by the upper level Makefile to determine if we have done all
# used by the upper level Makefile to determine of we have done all
#
# NOTE: Due to bogus shells found on one common system we must have
# a non-empty else clause for every if condition. *sigh*
# an non-emoty else clause for every if condition. *sigh*
#
.all:
rm -f .all
@@ -245,7 +245,3 @@ simple: simple.calc
rm -f $@
${SED} -e "1s:^#!/usr/local/src/cmd/calc/calc:#!${BINDIR}/calc:" $?>$@
${CHMOD} +x $@
square: square.calc
rm -f $@
${SED} -e "1s:^#!/usr/local/src/cmd/calc/calc:#!${BINDIR}/calc:" $?>$@
${CHMOD} +x $@

16
cscript/mersenne.calc
View File

@@ -1,4 +1,4 @@
#!/usr/local/src/cmd/calc/calc -q -s -f
#!/usr/local/src/cmd/calc/calc -S
#
# mersenne - print the value of a mersenne number
#
@@ -18,8 +18,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.3 $
# @(#) $Id: mersenne.calc,v 29.3 2000/12/15 14:56:54 chongo Exp $
# @(#) $Revision: 29.2 $
# @(#) $Id: mersenne.calc,v 29.2 2000/06/07 14:02:59 chongo Exp $
# @(#) $Source: /usr/local/src/cmd/calc/cscript/RCS/mersenne.calc,v $
#
# Under source code control: 1999/11/30 00:09:01;
@@ -35,19 +35,13 @@
/*
* parse args
*/
if (argv() != 2) {
if (argv() != 1) {
/* we include the name of this script in the error message */
fprintf(files(2), "usage: %s exp\n", config("program"));
abort "wrong number of args";
}
global n = eval(argv(1));
if (!isint(n) || n <= 0) {
quit "Argument to be a positive integer";
}
/*
* print the decimal value of 2^n-1
*/
print "2^": n : "-1 =", 2^n-1;
print "2^": argv(0) : "-1 =", 2^eval(argv(0))-1;

6
cscript/piforever.calc
View File

@@ -1,4 +1,4 @@
#!/usr/local/src/cmd/calc/calc -q -f
#!/usr/local/src/cmd/calc/calc -S
#
# piforever - print digits of pi forever (or as long as your mem/cpu allow)
#
@@ -18,8 +18,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.3 $
# @(#) $Id: piforever.calc,v 29.3 2000/12/15 14:56:54 chongo Exp $
# @(#) $Revision: 29.2 $
# @(#) $Id: piforever.calc,v 29.2 2000/06/07 14:02:59 chongo Exp $
# @(#) $Source: /usr/local/src/cmd/calc/cscript/RCS/piforever.calc,v $
#
# Under source code control: 1999/11/30 00:11:36

12
cscript/plus.calc
View File

@@ -1,4 +1,4 @@
#!/usr/local/src/cmd/calc/calc -q -s -f
#!/usr/local/src/cmd/calc/calc -S
#
# plus - add two or more arguments together
#
@@ -18,8 +18,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.3 $
# @(#) $Id: plus.calc,v 29.3 2000/12/15 14:56:54 chongo Exp $
# @(#) $Revision: 29.2 $
# @(#) $Id: plus.calc,v 29.2 2000/06/07 14:02:59 chongo Exp $
# @(#) $Source: /usr/local/src/cmd/calc/cscript/RCS/plus.calc,v $
#
# Under source code control: 1999/11/29 10:22:37
@@ -35,19 +35,19 @@
/*
* parse args
*/
if (argv() < 2) {
if (argv() < 1) {
/* we include the name of this script in the error message */
fprintf(files(2), "usage: %s value ...\n", config("program"));
abort "not enough args";
}
/*
* print the sum of the args
* print the sum of the 2 args
*
* Since args are strings, we must eval them before using them numerically.
*/
sum = 0;
for (i=1; i < argv(); ++i) {
for (i=0; i < argv(); ++i) {
sum += eval(argv(i));
}
print sum;

8
cscript/simple.calc
View File

@@ -1,4 +1,4 @@
#!/usr/local/src/cmd/calc/calc -q -f
#!/usr/local/src/cmd/calc/calc -S
#
# simple - an example of a simple calc shell script
#
@@ -18,8 +18,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.3 $
# @(#) $Id: simple.calc,v 29.3 2000/12/15 14:56:54 chongo Exp $
# @(#) $Revision: 29.2 $
# @(#) $Id: simple.calc,v 29.2 2000/06/07 14:02:59 chongo Exp $
# @(#) $Source: /usr/local/src/cmd/calc/cscript/RCS/simple.calc,v $
#
# Under source code control: 1999/11/29 10:22:37
@@ -32,4 +32,4 @@
/*
* This is an example of a simple calc shell script.
*/
print "This simple calc shell script works!"
print "The simple calc shell script works!"

35
cscript/square.calc
View File

@@ -1,35 +0,0 @@
#!/usr/local/src/cmd/calc/calc -q -f
#
# sqaure - print the squares of input values
#
# Copyright (C) 2000 Landon Curt Noll
#
# 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.1 $
# @(#) $Id: square.calc,v 29.1 2000/12/15 14:55:59 chongo Exp $
# @(#) $Source: /usr/local/src/cmd/calc/cscript/RCS/square.calc,v $
#
# Under source code control: 2000/12/15 06:52:01
# File existed as early as: 2000
#
# Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
# usage:
# mersenne exp
global s;
while ((s = prompt("")))
print "\t":eval(s)^2;

5
custom/c_sysinfo.c
View File

@@ -17,8 +17,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.4 $
* @(#) $Id: c_sysinfo.c,v 29.4 2000/07/17 15:37:12 chongo Exp $
* @(#) $Revision: 29.3 $
* @(#) $Id: c_sysinfo.c,v 29.3 2000/06/07 14:03:03 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/custom/RCS/c_sysinfo.c,v $
*
* Under source code control: 1997/03/09 23:14:40
@@ -112,6 +112,7 @@ 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},

397
func.c
View File

@@ -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.5 $
* @(#) $Id: func.c,v 29.5 2000/12/04 19:32:33 chongo Exp $
* @(#) $Revision: 29.3 $
* @(#) $Id: func.c,v 29.3 2000/06/07 14:02:13 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/func.c,v $
*
* Under source code control: 1990/02/15 01:48:15
@@ -160,9 +160,9 @@ static STRINGHEAD newerrorstr;
/*
* arg count definitions
* arg count definitons
*/
#define IN 1024 /* maximum number of arguments */
#define IN 100 /* maximum number of arguments */
#define FE 0x01 /* flag to indicate default epsilon argument */
#define FA 0x02 /* preserve addresses of variables */
@@ -256,8 +256,8 @@ f_prompt(VALUE *vp)
cp = nextline();
closeinput();
if (cp == NULL) {
result.v_type = V_NULL;
return result;
math_error("End of file while prompting");
/*NOTREACHED*/
}
if (*cp == '\0') {
result.v_str = slink(&_nullstring_);
@@ -278,7 +278,7 @@ f_prompt(VALUE *vp)
static VALUE
f_display(int count, VALUE **vals)
{
LEN oldvalue;
long 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 = (LEN) qtoi(vals[0]->v_num);
conf->outdigits = qtoi(vals[0]->v_num);
}
res.v_num = itoq((long) oldvalue);
res.v_num = itoq(oldvalue);
return res;
}
@@ -1012,7 +1012,7 @@ f_srand(int count, VALUE **vals)
break;
default:
math_error("illegal type of arg passed to srand()");
math_error("illegal type of arg passsed to srand()");
/*NOTREACHED*/
break;
}
@@ -1158,7 +1158,7 @@ f_srandom(int count, VALUE **vals)
break;
default:
math_error("illegal type of arg passed to srandom()");
math_error("illegal type of arg passsed to srandom()");
/*NOTREACHED*/
break;
}
@@ -1253,76 +1253,37 @@ f_setbit(int count, VALUE **vals)
}
static VALUE
f_digit(int count, VALUE **vals)
static NUMBER *
f_digit(NUMBER *val1, NUMBER *val2)
{
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 (qisfrac(val2)) {
math_error("Non-integral digit position");
/*NOTREACHED*/
}
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;
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)));
}
static VALUE
f_digits(int count, VALUE **vals)
static NUMBER *
f_digits(NUMBER *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;
return itoq((long) qdigits(val));
}
static VALUE
f_places(int count, VALUE **vals)
static NUMBER *
f_places(NUMBER *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;
return itoq((long) qplaces(val));
}
@@ -3167,135 +3128,6 @@ 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)
{
@@ -3656,82 +3488,24 @@ f_polar(int count, VALUE **vals)
}
static VALUE
f_ilog(VALUE *v1, VALUE *v2)
static NUMBER *
f_ilog(NUMBER *val1, NUMBER *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;
return itoq(qilog(val1, val2));
}
static VALUE
f_ilog2(VALUE *vp)
static NUMBER *
f_ilog2(NUMBER *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;
return itoq(qilog2(val));
}
static VALUE
f_ilog10(VALUE *vp)
static NUMBER *
f_ilog10(NUMBER *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;
return itoq(qilog10(val));
}
@@ -6685,19 +6459,6 @@ 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)
{
@@ -6890,48 +6651,6 @@ 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
*/
@@ -7774,8 +7493,6 @@ 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,
@@ -7792,10 +7509,6 @@ 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,
@@ -7808,7 +7521,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, 0, f_comb,
{"comb", 2, 2, 0, OP_NOP, qcomb, 0,
"combinatorial number a!/b!(a-b)!"},
{"config", 1, 2, 0, OP_SETCONFIG, 0, 0,
"set or read configuration value"},
@@ -7842,10 +7555,10 @@ static CONST struct builtin builtins[] = {
"denominator of fraction"},
{"det", 1, 1, 0, OP_NOP, 0, f_det,
"determinant of matrix"},
{"digit", 2, 3, 0, OP_NOP, 0, f_digit,
{"digit", 2, 2, 0, OP_NOP, f_digit, 0,
"digit at specified decimal place of number"},
{"digits", 1, 2, 0, OP_NOP, 0, f_digits,
"number of digits in base b representation of a"},
{"digits", 1, 1, 0, OP_NOP, f_digits, 0,
"number of digits in number"},
{"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,
@@ -7860,8 +7573,6 @@ 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,
@@ -7912,10 +7623,6 @@ 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,
@@ -7956,11 +7663,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, 0, f_ilog,
"integral log of a to integral base b"},
{"ilog10", 1, 1, 0, OP_NOP, 0, f_ilog10,
{"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,
"integral log of a number base 10"},
{"ilog2", 1, 1, 0, OP_NOP, 0, f_ilog2,
{"ilog2", 1, 1, 0, OP_NOP, f_ilog2, 0,
"integral log of a number base 2"},
{"im", 1, 1, 0, OP_IM, 0, 0,
"imaginary part of complex number"},
@@ -8126,8 +7833,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, 2, 0, OP_NOP, 0, f_places,
"places after \"decimal\" point (-1 if infinite)"},
{"places", 1, 1, 0, OP_NOP, f_places, 0,
"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,
@@ -8230,8 +7937,6 @@ 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,

47
help/Makefile
View File

@@ -18,8 +18,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.5 $
# @(#) $Id: Makefile,v 29.5 2000/12/14 10:33:06 chongo Exp $
# @(#) $Revision: 29.3 $
# @(#) $Id: Makefile,v 29.3 2000/06/07 14:02:33 chongo Exp $
# @(#) $Source: /usr/local/src/cmd/calc/help/RCS/Makefile,v $
#
# Under source code control: 1991/07/23 06:47:57
@@ -140,31 +140,30 @@ BLT_HELP_FILES= ${BLT_HELP_FILES_3} ${BLT_HELP_FILES_5} \
# This list is prodiced by the detaillist rule when no WARNINGS are detected.
#
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 bernoulli bit blk blkcpy blkfree blocks bround btrunc calc_tty \
calclevel catalan 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 euler 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 freeeuler 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 \
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 sleep sort sqrt srand srandom \
ssq str strcat strerror strlen strpos strprintf strscan strscanf \
substr sum swap system tail tan tanh test time trunc xor
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.

67
help/bernoulli
View File

@@ -1,67 +0,0 @@
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
LIBRARY
NUMBER *qbernoulli(long n)
SEE ALSO
euler, 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.3 $
## @(#) $Id: bernoulli,v 29.3 2000/12/14 10:32:24 chongo Exp $
## @(#) $Source: /usr/local/src/cmd/calc/help/RCS/bernoulli,v $
##
## Under source code control: 2000/07/13 01:33:00
## File existed as early as: 2000
##
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/

52
help/calc_tty
View File

@@ -1,52 +0,0 @@
NAME
calc_tty - restore normal input conditions for interactive use
SYNOPSIS
calc_tty()
TYPES
return none if appears to be successful, error-value otherwise
DESCRIPTION
This may enable a return to normal operation if abnormal activity
results from a change of one or more terminal characteristics, as
may occur when activity is resumed by an fg command after a ctrl-Z
interrupt, or by any of the three commands:
> !stty echo
> !stty -cbreak
> !stty echo -cbreak
EXAMPLE
> calc_tty();
LIBRARY
none
SEE ALSO
none
## 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.1 $
## @(#) $Id: calc_tty,v 29.1 2000/12/14 10:31:45 chongo Exp $
## @(#) $Source: /usr/local/src/cmd/calc/help/RCS/calc_tty,v $
##
## Under source code control: 2000/12/14 01:33:00
## File existed as early as: 2000
##
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/

63
help/catalan
View File

@@ -1,63 +0,0 @@
NAME
catalan - Catalan number
SYNOPSIS
catalan(n)
TYPES
n integer
return integer
DESCRIPTION
If n >= 0, this returns the Catalan number for index n:
catalan(n) = comb(2*n,n)/(n + 1)
Zero is returned for negative n.
The Catalan numbers occur in solutions of several elementary
combinatorial problems, e.g. for n >= 1, catalan(n) is the number of
ways of using parentheses to express a product of n + 1 letters in
terms of binary products; it is the number of ways of dissecting a
convex polygon with n + 2 sides into triangles by nonintersecting
diagonals; it is the number of integer-component-incrementing paths
from (x,y) = (0,0) to (x,y) = (n,n) for which always y <= x.
EXAMPLE
> print catalan(2), catalan(3), catalan(4), catalan(20)
2 5 14 6564120420
LIMITS
none
LINK LIBRARY
NUMBER *qcatalan(NUMBER *n)
SEE ALSO
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.1 $
## @(#) $Id: catalan,v 29.1 2000/12/14 10:31:45 chongo Exp $
## @(#) $Source: /usr/local/src/cmd/calc/help/RCS/catalan,v $
##
## Under source code control: 2000/12/14 01:33:00
## File existed as early as: 2000
##
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/

271
help/define
View File

@@ -1,197 +1,121 @@
NAME
define - command keyword to start a function definition
Function definitions
SYNTAX
define fname([param_1 [= default_1], ...]) = [expr]
define fname([param_1 [= default_1], ...]) { [statement_1 ... ] }
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.
TYPES
fname identifier, not a builtin function name
param_1, ... identifiers, no two the same
default_1, ... expressions
expr expression
statement_1, ... statements
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
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.
define add(a,b) {
return a + b;
}
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:
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).
define f(x) = (x = 3);
global mat A[3];
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:
If g() is a function that evaluates to 2:
define factorial(n)
{
local ans;
f(A[g()]);
ans = 1;
while (n > 1)
ans *= n--;
return ans;
}
assigns the value of A[2] to the parameter x and then assigns the
value 3 to x:
(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.)
f(`A[g()]);
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.
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()]).)
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.
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.
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:
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.
define average(a, b) = (a + b) / 2;
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.
(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.)
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.
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 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.
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:
If the expr is omitted from an expression definition, as in:
define sc()
{
local s, i;
define h() = ;
s = 0;
for (i = 1; i <= param(0); i++)
s += param(i)^3;
return s;
}
any call to the function will evaluate the arguments and return the
null value.
defines a function which returns the sum of the cubes of all its
parameters.
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 '{'.
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.
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.
An indication of how a user-defined function is stored may be obtained
by using the "show opcodes" command. For example:
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.
> 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
After fname has been defined, the definition may be removed by the command:
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
## Copyright (C) 1999 Landon Curt Noll
##
## 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
@@ -207,11 +131,10 @@ SEE ALSO
## 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.3 $
## @(#) $Id: define,v 29.3 2000/07/17 15:36:26 chongo Exp $
## @(#) $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 $
##
##
## Under source code control: 1991/07/21 04:37:18
## File existed as early as: 1991
##

91
help/digit
View File

@@ -1,93 +1,38 @@
NAME
digit - digit at specified position in a "decimal" representation
digit - digit at specified position in a decimal representation
SYNOPSIS
digit(x, n [, b])
digit(x, y)
TYPES
x real
n integer
b integer >= 2, default = 10
y integer
return integer
DESCRIPTION
By extending the digits on the left, and if necessary, the digits
on the right, by infinite strings of zeros, abs(x) may be considered
to have the decimal representation:
d(x,n,b) returns the digit with index n in a standard base-b "decimal"
representation of x, which may be described as follows:
For an arbitrary base b >= 2, following the pattern of decimal (base 10)
notation in elementary arithmetic, a base-b "decimal" representation of
a positive real number may be considered to be specified by a finite or
infinite sequence of "digits" with possibly a "decimal" point
to indicate where the fractional part of the representation begins.
Just as the digits for base 10 are the integers 0, 1, 2, ..., 9, the
digits for a base-b representation are the integers d for which
0 <= d < b. The index for a digit position is the count, positively to
the left, of the number from the "units" position immediately to the
left of the "decimal" point; the digit d_n at position n contributes
additively d_n * b^n to the value of x. For example,
d_2 d_1 d_0 . d_-1 d_-2
represents the number
d_2 * b^2 + d_1 * b + d0 + d_-1 * b^-1 + d_-2 * b^-2
The sequence of digits has to be infinite if den(x) has a prime factor
which is not a factor of the base b. In cases where the representation
may terminate, the digits are considered to continue with an infinite
string of zeros rather than the other possibility of an infinite
sequence of (b - 1)s. Thus, for the above example, d_n = 0 for
n = -3, -4, ... Similarly, a representation may be considered to
continue with an infinite string of zeros on the left, so that in the
above example d_n = 0 also for n >= 3.
For negative x, digit(x,n,b) is given by digit(abs(x),n,b); the
standard "decimal" representation of this x is a - sign followed by
the representation of abs(x).
In calc, the "real" numbers are all rational and for these the
digits following the decimal point eventually form a recurring sequence.
With base-b digits for x as explained above, the integer whose base-b
representation is
b_n+k-1 b_n_k-2 ... b_n,
i.e. the k digits with last digit b_n, is given by
digit(b^-r * x, q, b^k)
if r and q satisfy n = q * b + r.
... d_2 d_1 d_0.d_-1 d_-2 ...
digit(x,y) then returns the digit d_y.
EXAMPLE
> a = 123456.789
> for (n = 6; n >= -6; n++) print digit(a, n),; print
0 1 2 3 4 5 6 7 8 9 0 0 0
> x = 12.34
> print digit(x,2), digit(x,1), digit(x,0), digit(x,-1), digit(x,-2)
0 1 2 3 4
> for (n = 6; n >= -6; n--) print digit(a, n, 100),; print
0 0 0 0 12 34 56 78 90 0 0 0 0
> for (n = 6; n >= -6; n--) print digit(a, n, 256),; print
0 0 0 0 1 226 64 201 251 231 108 139 67
> for (n = 1; n >= -12; n++) print digit(10/7, n),; print
> 0 1 4 2 8 5 7 1 4 2 8 5 7 1
> print digit(10/7, -7e1000, 1e6)
428571
> x = 10/7
> print digit(x,1), digit(x,0), digit(x,-1), digit(x,-2), digit(x,-3)
0 1 4 2 8
LIMITS
The absolute value of the integral part of x is assumed to be less
than 2^2^31, ensuring that digit(x, n, b) will be zero if n >= 2^31.
The size of negative n is limited only by the capacity of the computer
being used.
If x is not an integer, y > -2^31
LINK LIBRARY
NUMBER * qdigit(NUMBER *q, ZVALUE dpos, ZVALUE base)
long qdigit(NUMBER *x, long y)
SEE ALSO
bit
@@ -108,8 +53,8 @@ SEE ALSO
## 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.3 $
## @(#) $Id: digit,v 29.3 2000/12/14 10:32:24 chongo Exp $
## @(#) $Revision: 29.2 $
## @(#) $Id: digit,v 29.2 2000/06/07 14:02:33 chongo Exp $
## @(#) $Source: /usr/local/src/cmd/calc/help/RCS/digit,v $
##
## Under source code control: 1995/10/03 10:40:01

24
help/digits
View File

@@ -1,36 +1,30 @@
NAME
digits - return number of "decimal" digits in an integral part
digits - return number of digits in an integer or integer part
SYNOPSIS
digits(x [,b])
digits(x)
TYPES
x real
b integer >= 2, defaults to 10
return integer
DESCRIPTION
Returns the least non-negative integer n for which abs(x) < b^n.
digits(x, b) = 0 if and only if abs(x) < 1.
For real x with absolute value >= 1, digits(x, b) is the number
of digits in the standard base-b "decimal" representation of int(abs(x));
this is also given by 1 + ilog(x, b).
For real x, digits(x) returns the number of digits in the decimal
representation of int(abs(x)). If x >= 1, digits(x) = 1 + ilog10(x).
EXAMPLE
> print digits(0), digits(0.0123), digits(3.7), digits(-27), digits(-99.7)
0 0 1 2 2
1 1 1 2 2
LIMITS
none
LINK LIBRARY
long qdigits(NUMBER *q, ZVALUE base)
long qdigits(NUMBER *x)
SEE ALSO
digit, places
places
## Copyright (C) 1999 Landon Curt Noll
##
@@ -48,8 +42,8 @@ SEE ALSO
## 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.3 $
## @(#) $Id: digits,v 29.3 2000/12/14 10:32:24 chongo Exp $
## @(#) $Revision: 29.2 $
## @(#) $Id: digits,v 29.2 2000/06/07 14:02:33 chongo Exp $
## @(#) $Source: /usr/local/src/cmd/calc/help/RCS/digits,v $
##
## Under source code control: 1995/10/03 10:40:01

63
help/euler
View File

@@ -1,63 +0,0 @@
NAME
euler - Euler number
SYNOPSIS
euler(n)
TYPES
n integer, n <= 1000000 if even
return integer
DESCRIPTION
Returns the Euler number with index n, i.e. the coefficient E_n in
the expansion
sech(t) = Sigma E_n * t^n/n!
When euler(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 euler(k) with 0 <= k <= n will be executed quickly.
If euler(k) is called with negative k, zero is returned and the
memory used by the table iu freed.
Considerable runtime and memery are required for calculating
euler(n) for large even n.
EXAMPLE
> for (n = 0; n <= 6; n++) print euler(n),; print;
1 0 -1 0 5 0 -61
LIMITS
none
LINK LIBRARY
NUMBER *qeuler(long n)
SEE ALSO
bernoulli, bell, 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.1 $
## @(#) $Id: euler,v 29.1 2000/12/14 10:31:45 chongo Exp $
## @(#) $Source: /usr/local/src/cmd/calc/help/RCS/euler,v $
##
## Under source code control: 2000/12/14 01:33:00
## File existed as early as: 2000
##
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/

49
help/freebernoulli
View File

@@ -1,49 +0,0 @@
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: freebernoulli,v 29.2 2000/07/17 15:36:26 chongo Exp $
## @(#) $Source: /usr/local/src/cmd/calc/help/RCS/freebernoulli,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/

49
help/freeeuler
View File

@@ -1,49 +0,0 @@
NAME
freeeuler - free stored Euler numbers
SYNOPSIS
freeeuler()
TYPES
return none
DESCRIPTION
The memory used to store calculated Euler numbers is freed by
freeeuler().
EXAMPLE
> freeeuler();
LIMITS
none
LINK LIBRARY
void qfreeeuler(void);
SEE ALSO
euler, bernoulli, freebernoulli
## 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.1 $
## @(#) $Id: freeeuler,v 29.1 2000/12/14 10:31:45 chongo Exp $
## @(#) $Source: /usr/local/src/cmd/calc/help/RCS/freeeuler,v $
##
## Under source code control: 2000/12/14 01:33:00
## File existed as early as: 2000
##
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/

88
help/interrupt
View File

@@ -15,13 +15,10 @@ 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 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.
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.
If a final interrupt is given when n is 3, the calculator will
immediately abort the current calculation and longjmp back to the
@@ -30,77 +27,8 @@ Interrupts
be done as a last resort. You are advised to quit the calculator
after this has been done.
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
## Copyright (C) 1999 Landon Curt Noll
##
## 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.
@@ -115,8 +43,8 @@ ABORT opcodes
## 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.4 $
## @(#) $Id: interrupt,v 29.4 2000/07/17 15:38:52 chongo Exp $
## @(#) $Revision: 29.2 $
## @(#) $Id: interrupt,v 29.2 2000/06/07 14:02:33 chongo Exp $
## @(#) $Source: /usr/local/src/cmd/calc/help/RCS/interrupt,v $
##
## Under source code control: 1991/07/21 04:37:21

29
help/places
View File

@@ -1,41 +1,34 @@
NAME
places - return number of "decimal" places in a fractional part
places - return number of decimal places
SYNOPSIS
places(x [,b])
places(x)
TYPES
x real
b integer >= 2, defaults to 10
return integer
DESCRIPTION
Returns the least non-negative integer n for which b^n * x is an
integer, or -1 if there is no such integer.
If x has a finite decimal representation (with nonzero last digit),
places(x) returns the number of digits after the decimal point in this
representation; this is the least non-negative integer n for which
10^n * x is an integer.
places(x,b) = 0 if and only if x is an integer.
places(x,b) = n > 0 if and only if the fractional part of abs(x)
has a finite base-b "decimal" representation with n digits of which
the last digit is nonzero. This occurs if and only if every prime
factor of den(x) is a factor of b.
If x does not have a finite decimal representation, places(x) returns -1.
EXAMPLE
> print places(3), places(0.0123), places(3.70), places(1e-10), places(3/7)
0 4 1 10 -1
> print places(0.0123, 2), places(.625, 2), places(.625, 8)
-1 3 1
LIMITS
none
LINK LIBRARY
long qplaces(NUMBER *q, ZVALUE base)
long qplaces(NUMBER *x)
SEE ALSO
digit, digits
digits
## Copyright (C) 1999 Landon Curt Noll
##
@@ -53,8 +46,8 @@ SEE ALSO
## 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.3 $
## @(#) $Id: places,v 29.3 2000/12/14 10:32:24 chongo Exp $
## @(#) $Revision: 29.2 $
## @(#) $Id: places,v 29.2 2000/06/07 14:02:33 chongo Exp $
## @(#) $Source: /usr/local/src/cmd/calc/help/RCS/places,v $
##
## Under source code control: 1995/10/03 10:40:02

283
help/script
View File

@@ -1,264 +1,62 @@
Calc shell scripts
------------------
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.
If an executable file begins with:
As a simple example, assuming a C or Bourne shell, let add be a
file containing just one line:
#!/usr/local/bin/calc -S [-other_flags ...]
calc -q -- $1 + $2
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.
Then:
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.
./add 1.23 4.56
In shell script mode, -s (lower case -s) is always assumed.
In addition, -d and -p are automatically set if -i is not
given.
should respond with the display of:
For example, if the file /tmp/mersenne:
5.9
#!/usr/local/bin/calc -S -q
#
# mersenne - an example of a calc shell script file
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".
/* parse args */
if (argv() != 1) {
fprintf(files(2), "usage: %s exp\n", config("program"));
abort "must give one exponent arg";
}
By making add executable by a command like:
/* print the mersenne number */
print "2^": argv(0) : "-1 =", 2^eval(argv(0))-1;
chmod u+x add
is made an executable file by:
the command used here may be simplified to:
chmod +x /tmp/mersenne
./add 1.23 4.56
then the command line:
Here we shall assume that any script we refer to has been made
executable in this way.
/tmp/mersenne 127
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.
will print:
For example, the add script should have no problem with
commands like:
2^127-1 = 170141183460469231731687303715884105727
./add "sqrt(2)" "3 * 4"
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 "mat A[2,2] = {1,2,3,4}" "A^2"
2^eval(argv(0))-1
./add "2 + 3i" "(3 + 4i)^2"
will print the decimal value of 2^n-1 but
If the shell arguments are to be integers, one could use
scripts like the following with arithmetic expansion
for the bash and ksh:
2^argv(0)-1
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)"
will not.
For more information use the following calc commands:
@@ -267,7 +65,7 @@ For more information use the following calc commands:
help config
help cscript
## Copyright (C) 2000 Landon Curt Noll and Ernest Bowen
## Copyright (C) 1999 Landon Curt Noll
##
## 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
@@ -283,8 +81,8 @@ For more information use the following calc commands:
## 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.4 $
## @(#) $Id: script,v 29.4 2000/07/17 15:36:26 chongo Exp $
## @(#) $Revision: 29.3 $
## @(#) $Id: script,v 29.3 2000/06/07 14:02:33 chongo Exp $
## @(#) $Source: /usr/local/src/cmd/calc/help/RCS/script,v $
##
## Under source code control: 1999/11/30 05:29:48
@@ -292,4 +90,3 @@ For more information use the following calc commands:
##
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/

68
help/sleep
View File

@@ -1,68 +0,0 @@
NAME
sleep - suspend operation for a specified time
SYNOPSIS
sleep([n])
TYPES
n non-negative real, defaults to 1
return integer or null value
DESCRIPTION
This uses the C-library sleep (if n is integral) or usleep (for
non-integral n) to suspend operation for n seconds. If n is an
integer and the sleep is stopped by an interruption, the number
of seconds remaining is returned.
One kind of use is to slow down output to permit easier reading of
results, as in:
> for (i = 0; i < 100; i++) {
print sqrt(i);
sleep(1/2);
}
The following illustrates what happens if ctrl-C is hit 5 seconds
after the first command:
> print sleep(20)
[Abort level 1]
15
>
EXAMPLE
> sleep(1/3);
> sleep(20);
LIBRARY
none
SEE ALSO
none
## 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.1 $
## @(#) $Id: sleep,v 29.1 2000/12/14 10:31:45 chongo Exp $
## @(#) $Source: /usr/local/src/cmd/calc/help/RCS/sleep,v $
##
## Under source code control: 2000/12/14 01:33:00
## File existed as early as: 2000
##
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/

12
input.c
View File

@@ -1,5 +1,5 @@
/*
* input - nested input source file reader
* input - nsted input source file reader
*
* Copyright (C) 1999 David I. Bell
*
@@ -17,8 +17,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.3 $
* @(#) $Id: input.c,v 29.3 2000/07/17 15:35:49 chongo Exp $
* @(#) $Revision: 29.2 $
* @(#) $Id: input.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $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
* .
* extension
* extenstion
* \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; /* extracted username */
char *username; /* extratced username */
/* firewall */
if (name[0] != HOMECHAR)
@@ -873,7 +873,7 @@ findfreeread(void)
}
maxreadset += READSET_ALLOC;
/* return the first newly allocated free entry */
/* return the furst newly allocated free entry */
return maxreadset-READSET_ALLOC;
}

40
lib_calc.c
View File

@@ -17,8 +17,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.4 $
* @(#) $Id: lib_calc.c,v 29.4 2000/07/17 15:35:49 chongo Exp $
* @(#) $Revision: 29.3 $
* @(#) $Id: lib_calc.c,v 29.3 2000/06/07 14:02:13 chongo Exp $
* @(#) $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_ZERO; /* calc startup run state */
run run_state = RUN_UNKNOWN; /* calc startup and 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 state */
static ttystruct *fd_cur = NULL; /* fd current atate */
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(DISPLAY_DEFAULT);
math_setdigits((long)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 function is to free storage that might otherwise go unused.
* this funcion 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,6 +461,7 @@ 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)
@@ -470,6 +471,7 @@ libcalc_call_me_last(void)
orig_tty(fd_setup[i]);
}
}
}
/*
* all done
@@ -486,24 +488,24 @@ char *
run_state_name(run state)
{
switch (state) {
case RUN_ZERO:
return "ZERO";
case RUN_UNKNOWN:
return "RUN_UNKNOWN";
case RUN_BEGIN:
return "BEGIN";
return "RUN_BEGIN";
case RUN_RCFILES:
return "RCFILES";
return "RUN_RCFILES";
case RUN_PRE_CMD_ARGS:
return "PRE_CMD_ARGS";
return "RUN_PRE_CMD_ARGS";
case RUN_CMD_ARGS:
return "CMD_ARGS";
return "RUN_CMD_ARGS";
case RUN_PRE_TOP_LEVEL:
return "PRE_TOP_LEVEL";
return "RUN_PRE_TOP_LEVEL";
case RUN_TOP_LEVEL:
return "TOP_LEVEL";
return "RUN_TOP_LEVEL";
case RUN_EXIT:
return "EXIT";
return "RUN_EXIT";
case RUN_EXIT_WITH_ERROR:
return "EXIT_WITH_ERROR";
return "RUN_EXIT_WITH_ERROR";
}
return "RUN_invalid";
}
@@ -577,7 +579,7 @@ find_tty_state(int fd)
}
/*
* case: need to initially malloc some state
* case: need to initlally malloc some state
*/
if (fd_setup_len <= 0 || fd_setup == NULL || fd_orig == NULL) {
@@ -833,8 +835,8 @@ orig_tty(int fd)
fd_cur[slot] = fd_orig[slot];
/*
* Since current state is the original state, we can free up
* this slot. This also prevents functions such as the
* Since current state is the orignal state, we can free up
* this slot. This also prevents functins such as the
* libcalc_call_me_last() function from re-restoring it.
*/
fd_setup[slot] = -1;

16
opcodes.c
View File

@@ -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.3 $
* @(#) $Id: opcodes.c,v 29.3 2000/07/17 15:35:49 chongo Exp $
* @(#) $Revision: 29.2 $
* @(#) $Id: opcodes.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $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 parameter index");
math_error("Bad paramaeter index");
/*NOTREACHED*/
}
args += index;
@@ -896,7 +896,7 @@ o_deref(void)
return;
}
if (stack->v_type != V_ADDR) {
math_error("Dereferencing a non-variable");
math_error("Deferencing a non-variable");
/*NOTREACHED*/
}
vp = vp->v_addr;
@@ -3228,8 +3228,8 @@ o_quit(FUNC *fp, long index)
freevalue(stack--);
}
freevalue(stackarray);
run_state = RUN_EXIT;
longjmp(jmpbuf, 1);
libcalc_call_me_last();
exit(0);
}
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 parameter variable */
{o_paramaddr, OPPAR, "PARAMADDR"}, /* address of paramater variable */
{o_localvalue, OPLOC, "LOCALVALUE"}, /* value of local variable */
{o_globalvalue, OPGLB, "GLOBALVALUE"}, /* value of global variable */
{o_paramvalue, OPPAR, "PARAMVALUE"}, /* value of parameter variable */
{o_paramvalue, OPPAR, "PARAMVALUE"}, /* value of paramater 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 */

513
qfunc.c
View File

@@ -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.3 $
* @(#) $Id: qfunc.c,v 29.3 2000/07/17 15:35:49 chongo Exp $
* @(#) $Revision: 29.2 $
* @(#) $Id: qfunc.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/qfunc.c,v $
*
* Under source code control: 1990/02/15 01:48:20
@@ -34,17 +34,10 @@
#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 epsilon for approximate calculations.
* This must be greater than zero.
* Set the default precision for real calculations.
* The precision must be between zero and one.
*
* given:
* q number to be set as the new epsilon
@@ -54,8 +47,8 @@ setepsilon(NUMBER *q)
{
NUMBER *old;
if (qisneg(q) || qiszero(q)) {
math_error("Epsilon value must be greater than zero");
if (qisneg(q) || qiszero(q) || (qreli(q, 1L) >= 0)) {
math_error("Epsilon value must be between zero and one");
/*NOTREACHED*/
}
old = conf->epsilon;
@@ -241,7 +234,7 @@ qpowi(NUMBER *q1, NUMBER *q2)
/*
* Given the legs of a right triangle, compute its hypotenuse within
* Given the legs of a right triangle, compute its hypothenuse within
* the specified error. This is sqrt(a^2 + b^2).
*/
NUMBER *
@@ -269,7 +262,7 @@ qhypot(NUMBER *q1, NUMBER *q2, NUMBER *epsilon)
/*
* Given one leg of a right triangle with unit hypotenuse, calculate
* Given one leg of a right triangle with unit hypothenuse, 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.
*/
@@ -564,7 +557,8 @@ qilog10(NUMBER *q)
* The number is not an integer.
* Compute the result if the number is greater than one.
*/
if (zrel(tmp1, q->den) > 0) {
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);
@@ -589,162 +583,104 @@ qilog10(NUMBER *q)
* Return the integer floor of the logarithm of a number relative to
* a specified integral base.
*/
NUMBER *
qilog(NUMBER *q, ZVALUE base)
long
qilog(NUMBER *q1, NUMBER *q2)
{
long n;
ZVALUE tmp1, tmp2;
if (qiszero(q))
return NULL;
if (qisunit(q))
return qlink(&_qzero_);
if (qisint(q))
return itoq(zlog(q->num, base));
tmp1 = q->num;
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;
tmp1.sign = 0;
if (zrel(tmp1, q->den) > 0) {
zquo(tmp1, q->den, &tmp2, 0);
n = zlog(tmp2, base);
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);
zfree(tmp2);
return itoq(n);
return n;
}
if (zisunit(tmp1))
zsub(q->den, _one_, &tmp2);
zsub(q1->den, _one_, &tmp2);
else
zquo(q->den, tmp1, &tmp2, 0);
n = -zlog(tmp2, base) - 1;
zquo(q1->den, tmp1, &tmp2, 0);
n = -zlog(tmp2, q2->num) - 1;
zfree(tmp2);
return itoq(n);
return n;
}
/*
* 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.
* 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.
*
* given:
* q number to count digits of
*/
long
qdigits(NUMBER *q, ZVALUE base)
qdigits(NUMBER *q)
{
long n; /* number of digits */
ZVALUE temp; /* temporary value */
if (zabsrel(q->num, q->den) < 1)
return 0;
if (qisint(q))
return 1 + zlog(q->num, base);
return zdigits(q->num);
zquo(q->num, q->den, &temp, 2);
n = 1 + zlog(temp, base);
n = zdigits(temp);
zfree(temp);
return n;
}
/*
* 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.
* 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.
*/
NUMBER *
qdigit(NUMBER *q, ZVALUE dpos, ZVALUE base)
long
qdigit(NUMBER *q, long n)
{
ZVALUE N, D;
ZVALUE K;
long k;
ZVALUE A, B, C; /* temporary integers */
NUMBER *res;
ZVALUE tenpow, tmp1, tmp2;
long res;
/*
* In the first stage, q is expressed as base^k * N/D where
* gcd(D, base) = 1
* K is k as a ZVALUE
* Zero number or negative decimal place of integer is trivial.
*/
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;
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;
}
else
N = q->num;
}
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;
/*
* 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);
return res;
}
@@ -912,249 +848,67 @@ qperm(NUMBER *q1, NUMBER *q2)
/*
* Compute the combinatorial function q(q - 1) ...(q - n + 1)/n!
* n is to be a nonnegative integer
* Compute the combinatorial function q1 * (q1-1) * ... * (q1-q2+1)/q2!
*/
NUMBER *
qcomb(NUMBER *q, NUMBER *n)
qcomb(NUMBER *q1, NUMBER *q2)
{
NUMBER *r;
NUMBER *q1, *q2;
NUMBER *qtmp1, *qtmp2;
long i, j;
ZVALUE z;
if (!qisint(n) || qisneg(n)) {
math_error("Bad second arg in call to qcomb!");
if (qisfrac(q2)) {
math_error("Non-integral second argument for comb");
/*NOTREACHED*/
}
if (qisint(q)) {
switch (zcomb(q->num, n->num, &z)) {
case 0:
if (qisneg(q2))
return qlink(&_qzero_);
case 1:
if (qiszero(q2) || qcmp(q1, q2) == 0)
return qlink(&_qone_);
case -1:
return qlink(&_qnegone_);
case 2:
return qlink(q);
case -2:
return NULL;
default:
if (qisone(q2))
return qlink(q1);
if (qisint(q1)) {
if (qisneg(q1)) {
qtmp1 = qsub(q2, q1);
qtmp2 = qdec(qtmp1);
qfree(qtmp1);
r = qalloc();
r->num = z;
zcomb(qtmp2->num, q2->num, &r->num);
qfree(qtmp2);
if (qiseven(q2))
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*/
}
if (zge31b(n->num))
return NULL;
i = ztoi(n->num);
q = qlink(q);
r = qlink(q);
i = qtoi(q2);
q1 = qlink(q1);
r = qlink(q1);
j = 1;
while (--i > 0) {
q1 = qdec(q);
qfree(q);
q = q1;
q2 = qmul(r, q);
qtmp1 = qdec(q1);
qfree(q1);
q1 = qtmp1;
qtmp2 = qmul(r, q1);
qfree(r);
r = qdivi(q2, ++j);
qfree(q2);
r = qdivi(qtmp2, ++j);
qfree(qtmp2);
}
qfree(q);
qfree(q1);
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
@@ -1482,7 +1236,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 determined by the parameter rnd.
* possibilities being dertermined by the parameter rnd.
*/
NUMBER *
qcfsim(NUMBER *q, long rnd)
@@ -1651,7 +1405,7 @@ qlcm(NUMBER *q1, NUMBER *q2)
/*
* Remove all occurrences of the specified factor from a number.
* Remove all occurences of the specified factor from a number.
* Returned number is always positive or zero.
*/
NUMBER *
@@ -1702,8 +1456,7 @@ qgcdrem(NUMBER *q1, NUMBER *q2)
return qlink(&_qone_);
if (qiszero(q1))
return qlink(&_qzero_);
if (zgcdrem(q1->num, q2->num, &tmp) == 0)
return qqabs(q1);
zgcdrem(q1->num, q2->num, &tmp);
if (zisunit(tmp)) {
zfree(tmp);
return qlink(&_qone_);
@@ -1740,14 +1493,15 @@ 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:
* qdecplaces(1.23) = 2, qdecplaces(3) = 0, qdecplaces(1/7) = -1.
* qplaces(1/7)=-1, qplaces(3/10)= 1, qplaces(1/8)=3, qplaces(4)=0.
*/
long
qdecplaces(NUMBER *q)
qplaces(NUMBER *q)
{
long twopow, fivepow;
HALF fiveval[2];
@@ -1778,39 +1532,6 @@ qdecplaces(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.

8
qio.c
View File

@@ -17,8 +17,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.3 $
* @(#) $Id: qio.c,v 29.3 2000/07/17 15:35:49 chongo Exp $
* @(#) $Revision: 29.2 $
* @(#) $Id: qio.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $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 = qdecplaces(q);
prec = qplaces(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 embedded '...' characters if numerator and/or
* of columns, using imbedded '...' characters if numerator and/or
* denominator is too large.
*/
void

8
qmath.c
View File

@@ -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.3 $
* @(#) $Id: qmath.c,v 29.3 2000/07/17 15:35:49 chongo Exp $
* @(#) $Revision: 29.2 $
* @(#) $Id: qmath.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/qmath.c,v $
*
* Under source code control: 1990/02/15 01:48:21
@@ -43,12 +43,10 @@ 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_, &_qneghalf_};
&_qfour_, &_qten_, &_qnegone_, &_qonehalf_};
/*
* Create another copy of a number.

23
qmath.h
View File

@@ -17,8 +17,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.3 $
* @(#) $Id: qmath.h,v 29.3 2000/07/17 15:35:49 chongo Exp $
* @(#) $Revision: 29.2 $
* @(#) $Id: qmath.h,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/qmath.h,v $
*
* Under source code control: 1993/07/30 19:42:47
@@ -34,7 +34,8 @@
#include "zmath.h"
#define INITCONSTCOUNT 9 /* number of initnumbs[] pre-defined constants */
#define INITCONSTCOUNT 8 /* number of initnumbs[] pre-defined constants */
/*
* Rational arithmetic definitions.
@@ -156,15 +157,14 @@ 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 NUMBER *qilog(NUMBER *q, ZVALUE base);
extern long qilog(NUMBER *q1, NUMBER *q2);
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 NUMBER *qdigit(NUMBER *q, ZVALUE dpos, ZVALUE base);
extern long qdigit(NUMBER *q, long i);
extern long qprecision(NUMBER *q);
extern long qplaces(NUMBER *q, ZVALUE base);
extern long qdecplaces(NUMBER *q);
extern long qdigits(NUMBER *q, ZVALUE base);
extern long qplaces(NUMBER *q);
extern long qdigits(NUMBER *q);
extern void setepsilon(NUMBER *q);
extern NUMBER *qbitvalue(long i);
extern NUMBER *qtenpow(long i);
@@ -208,11 +208,6 @@ 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);
/*
@@ -263,7 +258,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_, _qneghalf_, _qonesqbase_;
extern NUMBER _qzero_, _qone_, _qnegone_, _qonehalf_, _qonesqbase_;
extern NUMBER _qtwo_, _qthree_, _qfour_;
extern NUMBER * initnumbs[];

13
token.c
View File

@@ -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.4 $
* @(#) $Id: token.c,v 29.4 2000/07/17 15:35:49 chongo Exp $
* @(#) $Revision: 29.3 $
* @(#) $Id: token.c,v 29.3 2000/06/07 14:02:13 chongo Exp $
* @(#) $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!='\'' && ch!='\n' && ch!=EOF) {
if (allsyms && ((ch!=' ') &&
(ch!=';') && (ch!='"') && (ch!='\n'))) {
reread();
type = eatsymbol();
break;
@@ -566,11 +566,10 @@ eatsymbol(void)
if (allsyms) {
for (;;) {
ch = nextchar();
if (ch == ' ' || ch == ';' ||
ch == '\n' || ch == EOF)
if ((ch == ' ') || (ch == ';') || (ch == '\n'))
break;
if (cc-- > 0)
*cp++ = (char) ch;
*cp++ = (char)ch;
}
reread();
*cp = '\0';

222
value.c
View File

@@ -17,8 +17,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.3 $
* @(#) $Id: value.c,v 29.3 2000/07/17 15:35:49 chongo Exp $
* @(#) $Revision: 29.2 $
* @(#) $Id: value.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $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;
vp->v_subtype = V_NOSUBTYPE;
if (type <= 0)
if (type < 0)
return;
switch (type) {
case V_NULL:
case V_ADDR:
case V_OCTET:
case V_NBLOCK:
@@ -111,6 +111,7 @@ freevalue(VALUE *vp)
math_error("Freeing unknown value type");
/*NOTREACHED*/
}
vp->v_subtype = V_NOSUBTYPE;
}
@@ -340,7 +341,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;
@@ -348,6 +349,76 @@ 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.
@@ -431,12 +502,15 @@ 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)
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
if (v2->v_type > 0)
}
if (v2->v_type < 0) {
copyvalue(v2, vres);
return;
}
*vres = error_value(E_ADD);
else
vres->v_type = v2->v_type;
return;
}
*vres = objcall(OBJ_ADD, v1, v2, NULL_VALUE);
@@ -518,10 +592,12 @@ 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)
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
if (v2->v_type <= 0) {
vres->v_type = v2->v_type;
}
if (v2->v_type < 0) {
copyvalue(v2, vres);
return;
}
*vres = error_value(E_SUB);
@@ -583,10 +659,12 @@ 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)
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
if (v2->v_type <= 0) {
vres->v_type = v2->v_type;
}
if (v2->v_type < 0) {
copyvalue(v2, vres);
return;
}
*vres = error_value(E_MUL);
@@ -635,8 +713,8 @@ squarevalue(VALUE *vp, VALUE *vres)
*vres = objcall(OBJ_SQUARE, vp, NULL_VALUE, NULL_VALUE);
return;
default:
if (vp->v_type <= 0) {
vres->v_type = vp->v_type;
if (vp->v_type < 0) {
copyvalue(vp, vres);
return;
}
*vres = error_value(E_SQUARE);
@@ -689,8 +767,10 @@ invertvalue(VALUE *vp, VALUE *vres)
vres->v_num = qlink(&_qzero_);
return;
}
if (vp->v_type <= 0)
if (vp->v_type < 0) {
copyvalue(vp, vres);
return;
}
*vres = error_value(E_INV);
return;
}
@@ -739,10 +819,12 @@ 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)
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
}
if (v2->v_type < 0) {
vres->v_type = v2->v_type;
copyvalue(v2, vres);
return;
}
*vres = error_value(E_AND);
@@ -795,10 +877,12 @@ 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)
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
}
if (v2->v_type < 0) {
vres->v_type = v2->v_type;
copyvalue(v2, vres);
return;
}
*vres = error_value(E_OR);
@@ -1013,9 +1097,10 @@ 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)
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
}
e = NULL;
switch(v2->v_type) {
case V_NUM: e = v2->v_num;
@@ -1154,8 +1239,10 @@ roundvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
vres->v_com = c;
return;
default:
if (v1->v_type <= 0)
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
}
*vres = error_value(E_ROUND);
return;
}
@@ -1240,8 +1327,10 @@ broundvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
vres->v_com = c;
return;
default:
if (v1->v_type <= 0)
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
}
*vres = error_value(E_BROUND);
return;
}
@@ -1285,8 +1374,10 @@ intvalue(VALUE *vp, VALUE *vres)
*vres = objcall(OBJ_INT, vp, NULL_VALUE, NULL_VALUE);
return;
default:
if (vp->v_type <= 0)
if (vp->v_type < 0) {
copyvalue(vp, vres);
return;
}
*vres = error_value(E_INT);
return;
}
@@ -1332,8 +1423,10 @@ fracvalue(VALUE *vp, VALUE *vres)
*vres = objcall(OBJ_FRAC, vp, NULL_VALUE, NULL_VALUE);
return;
default:
if (vp->v_type < 0)
if (vp->v_type < 0) {
copyvalue(vp, vres);
return;
}
*vres = error_value(E_FRAC);
return;
}
@@ -1368,7 +1461,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;
}
@@ -1440,8 +1533,8 @@ conjvalue(VALUE *vp, VALUE *vres)
*vres = objcall(OBJ_CONJ, vp, NULL_VALUE, NULL_VALUE);
return;
default:
if (vp->v_type <= 0) {
vres->v_type = vp->v_type;
if (vp->v_type < 0) {
copyvalue(vp, vres);
return;
}
*vres = error_value(E_CONJ);
@@ -1467,8 +1560,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) {
vres->v_type = v1->v_type;
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
}
if (v2->v_type == V_NULL) {
@@ -1537,8 +1630,8 @@ rootvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
COMPLEX *c;
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type <= 0) {
vres->v_type = v1->v_type;
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
}
if (v2->v_type != V_NUM) {
@@ -1607,8 +1700,8 @@ absvalue(VALUE *v1, VALUE *v2, VALUE *vres)
return;
}
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type <= 0) {
vres->v_type = v1->v_type;
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
}
switch (v1->v_type) {
@@ -1646,8 +1739,8 @@ normvalue(VALUE *vp, VALUE *vres)
vres->v_type = vp->v_type;
vres->v_subtype = V_NOSUBTYPE;
if (vp->v_type <= 0) {
vres->v_type = vp->v_type;
if (vp->v_type < 0) {
copyvalue(vp, vres);
return;
}
switch (vp->v_type) {
@@ -1693,8 +1786,8 @@ shiftvalue(VALUE *v1, VALUE *v2, BOOL rightshift, VALUE *vres)
VALUE tmp;
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type <= 0) {
vres->v_type = v1->v_type;
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
}
if ((v2->v_type != V_NUM) || (qisfrac(v2->v_num))) {
@@ -1779,8 +1872,8 @@ scalevalue(VALUE *v1, VALUE *v2, VALUE *vres)
long n = 0;
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type <= 0) {
vres->v_type = v1->v_type;
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
}
if ((v2->v_type != V_NUM) || qisfrac(v2->v_num)) {
@@ -1831,9 +1924,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;
}
@@ -1889,8 +1982,8 @@ powervalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
COMPLEX *c, ctmp1, ctmp2;
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type <= 0) {
vres->v_type = v1->v_type;
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
}
if (v1->v_type != V_NUM && v1->v_type != V_COM) {
@@ -1970,9 +2063,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_);
@@ -2053,9 +2146,10 @@ 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)
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
}
if (v1->v_type == V_MAT) {
vres->v_mat = matquoval(v1->v_mat, v2, v3);
return;
@@ -2068,8 +2162,8 @@ quovalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
*vres = objcall(OBJ_QUO, v1, v2, v3);
return;
}
if (v2->v_type <= 0) {
vres->v_type = v2->v_type;
if (v2->v_type < 0) {
copyvalue(v2, vres);
return;
}
if (v2->v_type != V_NUM) {
@@ -2130,11 +2224,12 @@ modvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
NUMBER *q1, *q2;
long rnd;
vres->v_type = v1->v_type;
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type <= 0)
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
}
vres->v_type = v1->v_type;
if (v1->v_type == V_MAT) {
vres->v_mat = matmodval(v1->v_mat, v2, v3);
return;
@@ -2147,8 +2242,8 @@ modvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
*vres = objcall(OBJ_MOD, v1, v2, v3);
return;
}
if (v2->v_type <= 0) {
vres->v_type = v2->v_type;
if (v2->v_type < 0) {
copyvalue(v2, vres);
return;
}
if (v2->v_type != V_NUM) {
@@ -2292,7 +2387,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:
@@ -2313,6 +2408,8 @@ 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;
@@ -2600,7 +2697,10 @@ sgnvalue(VALUE *vp, VALUE *vres)
*vres = objcall(OBJ_SGN, vp, NULL_VALUE, NULL_VALUE);
return;
default:
if (vp->v_type > 0)
if (vp->v_type < 0) {
copyvalue(vp, vres);
return;
}
*vres = error_value(E_SGN);
return;
}
@@ -2755,7 +2855,7 @@ config_print(CONFIG *cfg)
*/
if (cfg == NULL || cfg->epsilon == NULL || cfg->prompt1 == NULL ||
cfg->prompt2 == NULL) {
math_error("CONFIG value is invalid");
math_error("CONFIG value is invaid");
/*NOTREACHED*/
}

5
value.h
View File

@@ -17,8 +17,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.3 $
* @(#) $Id: value.h,v 29.3 2000/07/17 15:35:49 chongo Exp $
* @(#) $Revision: 29.2 $
* @(#) $Id: value.h,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/value.h,v $
*
* Under source code control: 1993/07/30 19:42:47
@@ -191,6 +191,7 @@ 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);

6
version.c
View File

@@ -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.17 $
* @(#) $Id: version.c,v 29.17 2000/12/15 14:58:20 chongo Exp $
* @(#) $Revision: 29.12 $
* @(#) $Id: version.c,v 29.12 2000/06/07 15:50:55 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/version.c,v $
*
* Under source code control: 1990/05/22 11:00:58
@@ -42,7 +42,7 @@ static char *program;
#define MAJOR_VER 2 /* major version */
#define MINOR_VER 11 /* minor version */
#define MAJOR_PATCH 4 /* patch level or 0 if no patch */
#define MAJOR_PATCH 2 /* patch level or 0 if no patch */
#define MINOR_PATCH "1" /* test number or empty string if no patch */
/*

337
zfunc.c
View File

@@ -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.3 $
* @(#) $Id: zfunc.c,v 29.3 2000/07/17 15:35:49 chongo Exp $
* @(#) $Revision: 29.2 $
* @(#) $Id: zfunc.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $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 (zge31b(z)) {
if (zge24b(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 (zge31b(z2)) {
if (zge24b(z2)) {
math_error("Very large permutation");
/*NOTREACHED*/
}
@@ -127,104 +127,58 @@ zperm(ZVALUE z1, ZVALUE z2, ZVALUE *res)
*res = ans;
}
/*
* docomb evaluates binomial coefficient when z1 >= 0, z2 >= 0
* Compute the combinatorial function M! / ( N! * (M - N)! ).
*/
static int
docomb(ZVALUE z1, ZVALUE z2, ZVALUE *res)
void
zcomb(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 (zrel(z2, z1) > 0)
return 0;
zsub(z1, z2, &temp);
if (zge31b(z2) && zge31b(temp)) {
zfree(temp);
return -2;
if (zisneg(z1) || zisneg(z2)) {
math_error("Negative argument for combinatorial");
/*NOTREACHED*/
}
if (zrel(temp, z2) < 0)
count = ztofull(temp);
else
count = ztofull(z2);
zsub(z1, z2, &temp);
if (zisneg(temp)) {
zfree(temp);
if (count == 0)
return 1;
if (count == 1)
return 2;
math_error("Second arg larger than first for combinatorial");
/*NOTREACHED*/
}
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;
zfree(temp);
mul = z1;
div.sign = 0;
div.v = dh;
div.len = 1;
zcopy(z1, &mul);
zcopy(z1, &ans);
for (i = 2; i <= count; i++) {
#if BASEB == 16
ans = _one_;
for (i = 1; i <= count; i++) {
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);
*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);
}
@@ -520,7 +474,7 @@ ztenpow(long power, ZVALUE *res)
/*
* Calculate modular inverse suppressing unnecessary divisions.
* This is based on the Euclidean algorithm for large numbers.
* This is based on the Euclidian 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.
@@ -1067,76 +1021,108 @@ zrelprime(ZVALUE z1, ZVALUE z2)
/*
* Compute the integer floor of the log of an integer to a specified base.
* The signs of the integers and base are ignored.
* 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.
* Example: zlog(123456, 10) = 5.
*/
long
zlog(ZVALUE z, ZVALUE base)
zlog(ZVALUE z1, ZVALUE z2)
{
ZVALUE *zp; /* current square */
register 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 nonzero and the base is > 1
* Make sure that the numbers are > 0 and the base is > 1
*/
if (ziszero(z) || ziszero(base) || zisone(base)) {
math_error("Zero or too small argument argument for zlog!!!");
if (zislezero(z1) || zisleone(z2)) {
math_error("Bad arguments for log");
/*NOTREACHED*/
}
/*
* Some trivial cases.
* Reject trivial cases.
*/
power = zrel(z, base);
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);
if (power <= 0)
return (power + 1);
/* 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);
/*
* 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);
/*
* 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 = base;
while (zp->len * 2 - 1 <= z.len && zrel(z, *zp) > 0) {
/* while square not too large */
*zp = z2;
while (((zp->len * 2) - 1) <= z1.len) { /* 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.
*/
val = _one_;
power = 0;
/*
* Now back down the squares,
* 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.
*/
power = 0;
for (; zp > squares; zp--) {
if (zrel(z, *zp) >= 0) {
zquo(z, *zp, &temp, 0);
if (power)
zfree(z);
z = temp;
power++;
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);
}
}
if (zp != squares)
zfree(*zp);
power <<= 1;
}
if (zrel(z, *zp) >= 0)
power++;
if (power > 1)
zfree(z);
/* 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);
return power;
}
@@ -1149,50 +1135,70 @@ 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 (ziszero(z)) {
math_error("Zero argument argument for zlog10");
if (!zispos(z)) {
math_error("Non-positive number for log10");
/*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;
for (; zp > _tenpowers_; zp--) {
if (zrel(z, *zp) >= 0) {
zquo(z, *zp, &temp, 0);
if (power)
zfree(z);
z = temp;
power++;
/*
* 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);
}
power <<= 1;
}
if (zrel(z, *zp) >= 0)
power++;
if (power > 1)
zfree(z);
}
/* 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);
return power;
}
@@ -1217,7 +1223,7 @@ zdivcount(ZVALUE z1, ZVALUE z2)
/*
* Remove all occurrences of the specified factor from a number.
* Remove all occurences 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.
*/
@@ -1351,47 +1357,29 @@ 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. Returns the number
* of divisions made, and if this is positive, stores result at res.
* result is relatively prime to the second number.
*/
long
void
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;
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;
if (zisunit(tmp1) || ziszero(tmp1)) {
res->len = z1.len;
res->v = alloc(z1.len);
res->sign = 0;
zcopyval(z1, *res);
zfree(tmp1);
return;
}
zequo(z1, tmp1, &tmp2);
count = 1;
z1 = tmp2;
z2 = tmp1;
/*
@@ -1399,18 +1387,15 @@ zgcdrem(ZVALUE z1, ZVALUE z2, ZVALUE *res)
* the gcd becomes one.
*/
while (!zisunit(z2)) {
onecount = zfacrem(z1, z2, &tmp1);
if (onecount) {
count += onecount;
(void) zfacrem(z1, z2, &tmp1);
zfree(z1);
z1 = tmp1;
}
zgcd(z1, z2, &tmp1);
zfree(z2);
z2 = tmp1;
}
zfree(z2);
*res = z1;
return count;
}
@@ -1835,7 +1820,7 @@ zroot(ZVALUE z1, ZVALUE z2, ZVALUE *dest)
old.len = ztry.len;
zcopyval(ztry, old);
}
/* average current try and quotient for the new try */
/* average current try and quotent for the new try */
zmul(ztry, k1, &temp);
zfree(ztry);
zadd(quo, temp, &temp2);

10
zio.c
View File

@@ -17,8 +17,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.3 $
* @(#) $Id: zio.c,v 29.3 2000/07/17 15:35:49 chongo Exp $
* @(#) $Revision: 29.2 $
* @(#) $Id: zio.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $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.
*/
LEN
math_setdigits(LEN newdigits)
long
math_setdigits(long newdigits)
{
LEN olddigits;
long olddigits;
if (newdigits < 0) {
math_error("Setting illegal number of digits");

10
zmath.h
View File

@@ -17,8 +17,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.3 $
* @(#) $Id: zmath.h,v 29.3 2000/07/17 15:35:49 chongo Exp $
* @(#) $Revision: 29.2 $
* @(#) $Id: zmath.h,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $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 int zcomb(ZVALUE z1, ZVALUE z2, ZVALUE *res);
extern void 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 long zgcdrem(ZVALUE z1, ZVALUE z2, ZVALUE *res);
extern void 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 LEN math_setdigits(LEN digits);
extern long math_setdigits(long digits);
extern void math_fmt(char *, ...);

7
zmod.c
View File

@@ -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.3 $
* @(#) $Id: zmod.c,v 29.3 2000/07/17 15:35:49 chongo Exp $
* @(#) $Revision: 29.2 $
* @(#) $Id: zmod.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/zmod.c,v $
*
* Under source code control: 1991/05/22 23:03:55
@@ -544,9 +544,10 @@ zpowermod(ZVALUE z1, ZVALUE z2, ZVALUE z3, ZVALUE *res)
*res = _zero_;
return;
}
if (zisone(z1)) {
if (zisone(z1) && ziseven(z2)) {
if (ztmp.len)
zfree(ztmp);
zfree(z1);
*res = _one_;
return;
}