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.4t2

Browse Source
This commit is contained in:
Landon Curt Noll
2000-12-17 05:12:29 -08:00
parent 296aa50ac7
commit 3d55811205
59 changed files with 5084 additions and 1727 deletions
Download Patch File Download Diff File Expand all files Collapse all files

278
CHANGES
View File

@@ -1,4 +1,276 @@
The following are the changes from calc version 2.11.2t0 to date:
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.
Added regression tests for builtin functions bernoulli, catalan,
euler, freeeuler, and sleep. Added non-base 10 regression tests
for digit, digits and places.
The bernoulli.cal script now just calls the bernoulli() builtin
function. It remains for backward compatibility.
The Makefile now builds have_fpos_pos.h to determine if the
a non-scalar FILEPOS has a __pos stucture element. If it does,
the FILEPOS_BITS is taken to be the size of just the __pos element.
Misc fixes related to non-scalar (e.g., structure) FILEPOS. Fixed
a compile problems where non-scalar FILEPOS were incorrectly assigned.
Fixed make depend rule.
Return an error on malloc / realloc failures for bernoulli and
euler functions.
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:
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.
@@ -4766,8 +5038,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.11 $
## @(#) $Id: CHANGES,v 29.11 2000/06/07 15:51:35 chongo Exp $
## @(#) $Revision: 29.16 $
## @(#) $Id: CHANGES,v 29.16 2000/12/17 13:07:54 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.2 $
# @(#) $Id: COPYING,v 29.2 2000/06/07 14:02:13 chongo Exp $
# @(#) $Revision: 29.3 $
# @(#) $Id: COPYING,v 29.3 2000/12/14 09:18:06 chongo Exp $
# @(#) $Source: /usr/local/src/cmd/calc/RCS/COPYING,v $
=-=
@@ -167,6 +167,12 @@ 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

135
Makefile
View File

@@ -20,8 +20,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.9 $
# @(#) $Id: Makefile.ship,v 29.9 2000/06/07 15:50:19 chongo Exp $
# @(#) $Revision: 29.10 $
# @(#) $Id: Makefile.ship,v 29.10 2000/12/17 12:23:29 chongo Exp $
# @(#) $Source: /usr/local/src/cmd/calc/RCS/Makefile.ship,v $
#
# Under source code control: 1990/02/15 01:48:41
@@ -42,7 +42,7 @@
#
# value meaning
# -------- -------
# (nothing) let the makefile guess at what you need
# (nothing) let the Makefile guess at what you need
# -DUSE_TERMIOS use struct termios from <termios.h>
# -DUSE_TERMIO use struct termios from <termio.h>
# -DUSE_SGTTY use struct sgttyb from <sys/ioctl.h>
@@ -63,7 +63,7 @@ TERMCONTROL=
# If you do not have vsprintf(), then calc will try sprintf() and hope
# for the best.
#
# If HAVE_VSPRINTF is empty, this makefile will run the have_stdvs.c and/or
# If HAVE_VSPRINTF is empty, this Makefile will run the have_stdvs.c and/or
# have_varvs.c program to determine if vsprintf() is supported. If
# HAVE_VSPRINTF is set to -DDONT_HAVE_VSPRINTF then calc will hope that
# sprintf() will work.
@@ -78,7 +78,7 @@ HAVE_VSPRINTF=
# Big Endian: Amdahl, 68k, Pyramid, Mips, Sparc, ...
# Little Endian: Vax, 32k, Spim (Dec Mips), i386, i486, ...
#
# If in doubt, leave BYTE_ORDER empty. This makefile will attempt to
# If in doubt, leave BYTE_ORDER empty. This Makefile will attempt to
# use BYTE_ORDER in <machine/endian.h> or it will attempt to run
# the endian program. If you get syntax errors when you compile,
# try forcing the value to be BIG_ENDIAN and run the calc regression
@@ -92,7 +92,7 @@ BYTE_ORDER=
# Determine the number of bits in a long
#
# If in doubt, leave LONG_BITS empty. This makefile will run
# If in doubt, leave LONG_BITS empty. This Makefile will run
# the longbits program to determine the length.
#
# In order to avoid make brain damage in some systems, we avoid placing
@@ -125,7 +125,7 @@ LONGLONG_BITS=
# Determine if we have the ANSI C fgetpos and fsetpos alternate interface
# to the ftell() and fseek() (with whence set to SEEK_SET) functions.
#
# If HAVE_FPOS is empty, this makefile will run the have_fpos program
# If HAVE_FPOS is empty, this Makefile will run the have_fpos program
# to determine if there is are fgetpos and fsetpos functions. If HAVE_FPOS
# is set to -DHAVE_NO_FPOS, then calc will use ftell() and fseek().
#
@@ -134,11 +134,22 @@ LONGLONG_BITS=
HAVE_FPOS=
#HAVE_FPOS= -DHAVE_NO_FPOS
# Determine if we have an __pos element of a file position (fpos_t) structure.
#
# If HAVE_FPOS_POS is empty, this Makefile will run the have_fpos_pos program
# to determine if fpos_t has a __pos structure element. If HAVE_FPOS_POS
# is set to -DHAVE_NO_FPOS_POS, then calc assume there is no __pos element.
#
# If in doubt, leave HAVE_FPOS_POS empty and this Makefile will figure it out.
#
HAVE_FPOS_POS=
#HAVE_FPOS= -DHAVE_NO_FPOS_POS
# Determine if we have an off_t which one can perform arithmetic operations,
# assignments and comparisons. On some systems off_t is some sort of union
# or struct.
#
# If HAVE_OFFSCL is empty, this makefile will run the have_offscl program
# If HAVE_OFFSCL is empty, this Makefile will run the have_offscl program
# to determine if off_t is a scalar. If HAVE_OFFSCL is set to the value
# -DOFF_T_NON_SCALAR when calc will assume that off_t some sort of
# union or struct which.
@@ -153,7 +164,7 @@ HAVE_OFFSCL=
# or struct. Some systems do not have an fpos_t and long is as a file
# offset instead.
#
# If HAVE_POSSCL is empty, this makefile will run the have_offscl program
# If HAVE_POSSCL is empty, this Makefile will run the have_offscl program
# to determine if off_t is a scalar, or if there is no off_t and long
# (a scalar) should be used instead. If HAVE_POSSCL is set to the value
# -DFILEPOS_NON_SCALAR when calc will assume that fpos_t exists and is
@@ -166,7 +177,7 @@ HAVE_POSSCL=
# Determine if we have ANSI C const.
#
# If HAVE_CONST is empty, this makefile will run the have_const program
# If HAVE_CONST is empty, this Makefile will run the have_const program
# to determine if const is supported. If HAVE_CONST is set to -DHAVE_NO_CONST,
# then calc will not use const.
#
@@ -177,7 +188,7 @@ HAVE_CONST=
# Determine if we have uid_t
#
# If HAVE_UID_T is empty, this makefile will run the have_uid_t program
# If HAVE_UID_T is empty, this Makefile will run the have_uid_t program
# to determine if const is supported. If HAVE_UID_T is set to -DHAVE_NO_UID_T,
# then calc will treat uid_t as an unsigned short. This only matters if
# $HOME is not set and calc must look up the home directory in /etc/passwd.
@@ -189,7 +200,7 @@ HAVE_UID_T=
# Determine if we have memcpy(), memset() and strchr()
#
# If HAVE_NEWSTR is empty, this makefile will run the have_newstr program
# If HAVE_NEWSTR is empty, this Makefile will run the have_newstr program
# to determine if memcpy(), memset() and strchr() are supported. If
# HAVE_NEWSTR is set to -DHAVE_NO_NEWSTR, then calc will use bcopy() instead
# of memcpy(), use bfill() instead of memset(), and use index() instead of
@@ -202,7 +213,7 @@ HAVE_NEWSTR=
# Determine if we have memmove()
#
# If HAVE_MEMMOVE is empty, this makefile will run the have_memmv program
# If HAVE_MEMMOVE is empty, this Makefile will run the have_memmv program
# to determine if memmove() is supported. If HAVE_MEMMOVE is set to
# -DHAVE_NO_MEMMOVE, then calc will use internal functions to simulate
# the memory move function that does correct overlapping memory modes.
@@ -214,7 +225,7 @@ HAVE_MEMMOVE=
# Determine if we have ustat()
#
# If HAVE_USTAT is empty, this makefile will run the have_memmv program
# If HAVE_USTAT is empty, this Makefile will run the have_memmv program
# to determine if ustat() is supported. If HAVE_USTAT is set to
# -DHAVE_NO_USTAT, then calc will use internal functions to simulate
# the memory move function that does correct overlapping memory modes.
@@ -226,7 +237,7 @@ HAVE_USTAT=
# Determine if we have getsid()
#
# If HAVE_GETSID is empty, this makefile will run the have_memmv program
# If HAVE_GETSID is empty, this Makefile will run the have_memmv program
# to determine if getsid() is supported. If HAVE_GETSID is set to
# -DHAVE_NO_GETSID, then calc will use internal functions to simulate
# the memory move function that does correct overlapping memory modes.
@@ -238,7 +249,7 @@ HAVE_GETSID=
# Determine if we have getpgid()
#
# If HAVE_GETPGID is empty, this makefile will run the have_memmv program
# If HAVE_GETPGID is empty, this Makefile will run the have_memmv program
# to determine if getpgid() is supported. If HAVE_GETPGID is set to
# -DHAVE_NO_GETPGID, then calc will use internal functions to simulate
# the memory move function that does correct overlapping memory modes.
@@ -250,7 +261,7 @@ HAVE_GETPGID=
# Determine if we have clock_gettime()
#
# If HAVE_GETTIME is empty, this makefile will run the have_memmv program
# If HAVE_GETTIME is empty, this Makefile will run the have_memmv program
# to determine if clock_gettime() is supported. If HAVE_GETTIME is set to
# -DHAVE_NO_GETTIME, then calc will use internal functions to simulate
# the memory move function that does correct overlapping memory modes.
@@ -262,7 +273,7 @@ HAVE_GETTIME=
# Determine if we have getprid()
#
# If HAVE_GETPRID is empty, this makefile will run the have_memmv program
# If HAVE_GETPRID is empty, this Makefile will run the have_memmv program
# to determine if getprid() is supported. If HAVE_GETPRID is set to
# -DHAVE_NO_GETPRID, then calc will use internal functions to simulate
# the memory move function that does correct overlapping memory modes.
@@ -274,7 +285,7 @@ HAVE_GETPRID=
# Determine if we have /dev/urandom
#
# If HAVE_URANDOM is empty, this makefile will run the have_memmv program
# If HAVE_URANDOM is empty, this Makefile will run the have_memmv program
# to determine if /dev/urandom is supported. If HAVE_URANDOM is set to
# -DHAVE_NO_URANDOM, then calc will use internal functions to simulate
# the memory move function that does correct overlapping memory modes.
@@ -286,7 +297,7 @@ HAVE_URANDOM=
# Determine if we have getrusage()
#
# If HAVE_GETRUSAGE is empty, this makefile will run the have_memmv program
# If HAVE_GETRUSAGE is empty, this Makefile will run the have_memmv program
# to determine if getrusage() is supported. If HAVE_GETRUSAGE is set to
# -DHAVE_NO_GETRUSAGE, then calc will use internal functions to simulate
# the memory move function that does correct overlapping memory modes.
@@ -298,7 +309,7 @@ HAVE_GETRUSAGE=
# Determine if we have strdup()
#
# If HAVE_STRDUP is empty, this makefile will run the have_memmv program
# If HAVE_STRDUP is empty, this Makefile will run the have_memmv program
# to determine if strdup() is supported. If HAVE_STRDUP is set to
# -DHAVE_NO_STRDUP, then calc will use internal functions to simulate
# the memory move function that does correct overlapping memory modes.
@@ -824,8 +835,8 @@ ECHO= /bin/echo
# Makefile debug
#
# Q=@ do not echo internal makefile actions (quiet mode)
# Q= echo internal makefile actions (debug / verbose mode)
# Q=@ do not echo internal Makefile actions (quiet mode)
# Q= echo internal Makefile actions (debug / verbose mode)
#
# V=@: do not echo debug statements (quiet mode)
# V=@ do echo debug statements (debug / verbose mode)
@@ -885,7 +896,7 @@ LIB_H_SRC= alloc.h blkcpy.h block.h byteswap.h calc.h cmath.h \
# we build these .h files during the make
#
BUILD_H_SRC= align32.h args.h calcerr.h conf.h endian_calc.h \
fposval.h have_const.h have_fpos.h have_malloc.h \
fposval.h have_const.h have_fpos.h have_fpos_pos.h have_malloc.h \
have_memmv.h have_newstr.h have_offscl.h have_posscl.h \
have_stdlib.h have_string.h have_times.h have_uid_t.h \
have_unistd.h longbits.h longlong.h terminal.h \
@@ -903,7 +914,7 @@ BUILD_C_SRC= calcerr.c
#
UTIL_C_SRC= align32.c endian.c longbits.c have_newstr.c have_uid_t.c \
have_const.c have_stdvs.c have_varvs.c fposval.c have_fpos.c \
longlong.c have_offscl.c have_posscl.c have_memmv.c \
have_fpos_pos.c longlong.c have_offscl.c have_posscl.c have_memmv.c \
have_ustat.c have_getsid.c have_getpgid.c \
have_gettime.c have_getprid.c have_rusage.c have_strdup.c
@@ -918,8 +929,8 @@ UTIL_MISC_SRC= calcerr_h.sed calcerr_h.awk calcerr_c.sed calcerr_c.awk \
# There MUST be a .o for every .c in UTIL_C_SRC.
#
UTIL_OBJS= endian.o longbits.o have_newstr.o have_uid_t.o \
have_const.o fposval.o have_fpos.o longlong.o try_strarg.o \
have_stdvs.o have_varvs.o have_posscl.o have_memmv.o \
have_const.o fposval.o have_fpos.o have_fpos_pos.o longlong.o \
try_strarg.o have_stdvs.o have_varvs.o have_posscl.o have_memmv.o \
have_ustat.o have_getsid.o have_getpgid.o \
have_gettime.o have_getprid.o ver_calc.o have_rusage.o have_strdup.o
@@ -936,7 +947,7 @@ UTIL_PROGS= align32 fposval have_uid_t longlong have_const \
have_ustat have_getsid have_getpgid \
have_gettime have_getprid ver_calc have_strdup
# The complete list of makefile vars passed down to custom/Makefile.
# The complete list of Makefile vars passed down to custom/Makefile.
#
CUSTOM_PASSDOWN= Q="${Q}" \
TOPDIR="${TOPDIR}" \
@@ -964,7 +975,7 @@ CUSTOM_PASSDOWN= Q="${Q}" \
MAKEDEPEND=${MAKEDEPEND} \
SORT=${SORT}
# The complete list of makefile vars passed down to sample/Makefile.
# The complete list of Makefile vars passed down to sample/Makefile.
#
SAMPLE_PASSDOWN= Q="${Q}" \
TOPDIR="${TOPDIR}" \
@@ -991,7 +1002,7 @@ SAMPLE_PASSDOWN= Q="${Q}" \
CHMOD=${CHMOD} \
SORT=${SORT}
# The compelte list of makefile vars passed down to help/Makefile.
# The compelte list of Makefile vars passed down to help/Makefile.
#
HELP_PASSDOWN= Q="${Q}" \
TOPDIR="${TOPDIR}" \
@@ -1005,7 +1016,7 @@ HELP_PASSDOWN= Q="${Q}" \
CHMOD=${CHMOD} \
FMT=${FMT}
# The compelte list of makefile vars passed down to cal/Makefile.
# The compelte list of Makefile vars passed down to cal/Makefile.
#
CAL_PASSDOWN= Q="${Q}" \
TOPDIR="${TOPDIR}" \
@@ -1013,7 +1024,7 @@ CAL_PASSDOWN= Q="${Q}" \
MAKE_FILE=${MAKE_FILE} \
CHMOD=${CHMOD}
# The compelte list of makefile vars passed down to cscript/Makefile.
# The compelte list of Makefile vars passed down to cscript/Makefile.
#
CSCRIPT_PASSDOWN= Q="${Q}" \
BINDIR="${BINDIR}" \
@@ -1559,7 +1570,51 @@ have_fpos.h: have_fpos.c ${MAKE_FILE}
true; \
fi
fposval.h: fposval.c have_fpos.h have_offscl.h have_posscl.h \
have_fpos_pos.h: have_fpos_pos.c have_fpos.h have_posscl.h ${MAKE_FILE}
-${Q}rm -f have_fpos_pos have_fpos_pos.o fpos_tmp have_fpos_pos.h
${Q}echo 'forming have_fpos_pos.h'
${Q}echo '/*' > have_fpos_pos.h
${Q}echo ' * DO NOT EDIT -- generated by the Makefile' \
>> have_fpos_pos.h
${Q}echo ' */' >> have_fpos_pos.h
${Q}echo '' >> have_fpos_pos.h
${Q}echo '' >> have_fpos_pos.h
${Q}echo '#if !defined(__HAVE_FPOS_POS_H__)' >> have_fpos_pos.h
${Q}echo '#define __HAVE_FPOS_POS_H__' >> have_fpos_pos.h
${Q}echo '' >> have_fpos_pos.h
${Q}echo '' >> have_fpos_pos.h
${Q}echo '/* do we have fgetpos & fsetpos functions? */' \
>> have_fpos_pos.h
-${Q}rm -f have_fpos_pos.o have_fpos_pos
-${Q}${LCC} ${HAVE_FPOS_POS} ${ICFLAGS} have_fpos_pos.c -c \
2>/dev/null; true
-${Q}${LCC} ${ILDFLAGS} have_fpos_pos.o -o have_fpos_pos \
2>/dev/null; true
-${Q}${SHELL} -c "./have_fpos_pos > fpos_tmp 2>/dev/null" \
>/dev/null 2>&1; true
-${Q}if [ -s fpos_tmp ]; then \
cat fpos_tmp >> have_fpos_pos.h; \
else \
echo '#undef HAVE_FPOS_POS /* no */' >> have_fpos_pos.h; \
echo '' >> have_fpos_pos.h; \
echo '#undef FPOS_POS_BITS' >> have_fpos_pos.h; \
fi
${Q}echo '' >> have_fpos_pos.h
${Q}echo '' >> have_fpos_pos.h
${Q}echo '#endif /* !__HAVE_FPOS_POS_H__ */' >> have_fpos_pos.h
-${Q}rm -f have_fpos_pos have_fpos_pos.o fpos_tmp
${Q}echo 'have_fpos_pos.h formed'
-@if [ -z "${Q}" ]; then \
echo ''; \
echo '=-=-= start of $@ =-=-='; \
cat $@; \
echo '=-=-= end of $@ =-=-='; \
echo ''; \
else \
true; \
fi
fposval.h: fposval.c have_fpos.h have_fpos_pos.h have_offscl.h have_posscl.h \
endian_calc.h ${MAKE_FILE}
-${Q}rm -f fposv_tmp fposval fposval.o fposval.h
${Q}echo 'forming fposval.h'
@@ -2423,7 +2478,7 @@ sample/all:
##
#
# The BSDI cdrom makefile expects certain files to be pre-built in a sub-dir
# The BSDI cdrom Makefile expects certain files to be pre-built in a sub-dir
# called gen_h. This rule creats this sub-directory so that the release can
# be shipped off to BSDI. You can ignore this rule.
#
@@ -2591,15 +2646,15 @@ chk: ./cal/regress.cal
# debug
#
# make env:
# * print major makefile variables
# * print major Makefile variables
#
# make mkdebug:
# * print major makefile variables
# * print major Makefile variables
# * build anything not yet built
#
# make debug:
# * remove everything that was previously built
# * print major makefile variables
# * print major Makefile variables
# * make everything
# * run the regression tests
##
@@ -2612,6 +2667,7 @@ env:
@echo "LONG_BITS=${LONG_BITS}"; echo ""
@echo "LONGLONG_BITS=${LONGLONG_BITS}"; echo ""
@echo "HAVE_FPOS=${HAVE_FPOS}"; echo ""
@echo "HAVE_FPOS_POS=${HAVE_FPOS_POS}"; echo ""
@echo "HAVE_OFFSCL=${HAVE_OFFSCL}"; echo ""
@echo "HAVE_POSSCL=${HAVE_POSSCL}"; echo ""
@echo "HAVE_CONST=${HAVE_CONST}"; echo ""
@@ -3282,6 +3338,7 @@ file.o: fposval.h
file.o: hash.h
file.o: have_const.h
file.o: have_fpos.h
file.o: have_fpos_pos.h
file.o: have_malloc.h
file.o: have_memmv.h
file.o: have_newstr.h
@@ -3299,6 +3356,7 @@ file.o: zmath.h
fposval.o: endian_calc.h
fposval.o: fposval.c
fposval.o: have_fpos.h
fposval.o: have_fpos_pos.h
fposval.o: have_offscl.h
fposval.o: have_posscl.h
func.o: alloc.h
@@ -3369,6 +3427,9 @@ hash.o: zrand.h
hash.o: zrandom.h
have_const.o: have_const.c
have_fpos.o: have_fpos.c
have_fpos_pos.o: have_fpos.h
have_fpos_pos.o: have_fpos_pos.c
have_fpos_pos.o: have_posscl.h
have_getpgid.o: have_getpgid.c
have_getprid.o: have_getprid.c
have_getsid.o: have_getsid.c

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

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.2 $
# @(#) $Id: Makefile,v 29.2 2000/06/07 14:02:25 chongo Exp $
# @(#) $Revision: 29.3 $
# @(#) $Id: Makefile,v 29.3 2000/12/15 14:42:52 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
test8500.cal test8600.cal
# These files are found (but not built) in the distribution
#

59
cal/README
View File

@@ -1,7 +1,7 @@
Calc standard resource files
----------------------------
To load a reosurce file, try:
To load a resource 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 resoure files.
other structures created by instructions in calc resource 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:
@@ -116,6 +116,10 @@ bernoulli.cal
Calculate the nth Bernoulli number.
NOTE: There is now a bernoulli() builtin function. This file is
left here for backward compatibility and now simply returns
the buildin function.
bigprime.cal
@@ -274,7 +278,7 @@ pell.cal
pell(D)
Solve Pell's equation; Returns the solution X to: X^2 - D * Y^2 = 1.
Type the solution to pells equation for a particular D.
Type the solution to Pell's equation for a particular D.
pi.cal
@@ -288,7 +292,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() funcion (written by Klaus Alexander Seistrup
The piforever() function (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 +360,7 @@ quat.cal
quat_shift(a, b)
Calculate using quaternions of the form: a + bi + cj + dk. In these
functions, quaternians are manipulated in the form: s + v, where
functions, quaternions are manipulated in the form: s + v, where
s is a scalar and v is a vector of size 3.
@@ -386,7 +390,7 @@ randombitrun.cal
randombitrun([run_cnt])
Using randombit(1) to generate a sequence of random bits, determine if
the number and kength of identical bits runs match what is expected.
the number and length 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 +493,7 @@ test1700.cal
value
This resoure files is used by regress.cal to test the read and use keywords.
This resource files is used by regress.cal to test the read and use keywords.
test2600.cal
@@ -514,7 +518,7 @@ test2600.cal
checkresult(x, y, z, a)
test2600(verbose, tnum)
This resoure files is used by regress.cal to test some of builtin functions
This resource files is used by regress.cal to test some of builtin functions
in terms of accuracy and roundoff.
@@ -537,7 +541,7 @@ test2700.cal
iscomsq(x)
test2700(verbose, tnum)
This resoure files is used by regress.cal to test sqrt() for real and
This resource files is used by regress.cal to test sqrt() for real and
complex values.
@@ -625,7 +629,7 @@ test4000.cal
test4000(verbose, tnum) defined
This resource file is used by regress.cal to test ptest, nextcand and
prevcand buildins.
prevcand builtins.
test4100.cal
@@ -677,6 +681,35 @@ 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)
@@ -705,7 +738,7 @@ xx_print.cal
Demo for the xx_print object routines.
## Copyright (C) 1999 David I. Bell and Landon Curt Noll
## Copyright (C) 2000 David I. Bell and Landon Curt Noll
##
## Primary author: Landon Curt Noll
##
@@ -723,8 +756,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.2 $
## @(#) $Id: README,v 29.2 2000/06/07 14:02:25 chongo Exp $
## @(#) $Revision: 29.4 $
## @(#) $Id: README,v 29.4 2000/12/17 12:26:04 chongo Exp $
## @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/README,v $
##
## Under source code control: 1990/02/15 01:50:32

17
cal/bernoulli.cal
View File

@@ -1,7 +1,7 @@
/*
* bernoulli - clculate the Nth Bernoulli number B(n)
*
* Copyright (C) 1999 David I. Bell
* Copyright (C) 2000 David I. Bell and 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
@@ -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.2 $
* @(#) $Id: bernoulli.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Revision: 29.3 $
* @(#) $Id: bernoulli.cal,v 29.3 2000/12/17 12:26:04 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/bernoulli.cal,v $
*
* Under source code control: 1991/09/30 11:18:41
@@ -29,12 +29,16 @@
/*
* Calculate the Nth Bernoulli number B(n).
* This uses the following symbolic formula to calculate B(n):
*
* NOTE: This is now a bulitin function.
*
* The non-buildin code used the following symbolic formula to calculate B(n):
*
* (b+1)^(n+1) - b^(n+1) = 0
*
* where b is a dummy value, and each power b^i gets replaced by B(i).
* For example, for n = 3:
*
* (b+1)^4 - b^4 = 0
* b^4 + 4*b^3 + 6*b^2 + 4*b + 1 - b^4 = 0
* 4*b^3 + 6*b^2 + 4*b + 1 = 0
@@ -48,11 +52,14 @@
*/
/*
static Bnmax;
static mat Bn[1001];
*/
define B(n)
{
/*
local nn, np1, i, sum, mulval, divval, combval;
if (!isint(n) || (n < 0))
@@ -85,4 +92,6 @@ define B(n)
}
Bnmax = n;
return Bn[n];
*/
return bernoulli(n);
}

101
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.3 $
* @(#) $Id: regress.cal,v 29.3 2000/06/07 14:02:25 chongo Exp $
* @(#) $Revision: 29.6 $
* @(#) $Id: regress.cal,v 29.6 2000/12/17 12:26:42 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) == 1, '715: digits(0) == 1');
vrfy(digits(0) == 0, '715: digits(0) == 0');
vrfy(digits(9) == 1, '716: digits(9) == 1');
vrfy(digits(10) == 2, '717: digits(10) == 2');
vrfy(digits(-691) == 3, '718: digits(-691) == 3');
@@ -1029,8 +1029,8 @@ define test_functions()
vrfy(digit(a,-1) == 4, '974: digit(a,-1) == 4');
vrfy(digit(a,-2) == 2, '975: digit(a,-2) == 2');
vrfy(digit(a,-3) == 8, '976: digit(a,-3) == 8');
vrfy(digits(0) == 1, '977: digits(0) == 1');
vrfy(digits(0.0123) == 1, '978: digits(0.0123) == 1');
vrfy(digits(0) == 0, '977: digits(0) == 0');
vrfy(digits(0.0123) == 0, '978: digits(0.0123) == 0');
vrfy(digits(3.7) == 1, '979: digits(3.7) == 1');
vrfy(digits(-27) == 2, '980: digits(-27) == 2');
vrfy(digits(-99.7) == 2, '981: digits(-99.7) == 2');
@@ -1223,7 +1223,85 @@ define test_functions()
vrfy(hnrmod(21<<500+7,3,500,-1) == (21<<500+7)%(3<<500-1),
'1112: hnrmod(21<<500+7,3,500,-1) == (21<<500+7)%(3<<500-1)');
print '1113: Ending test_functions';
/*
* catalan testing
*/
vrfy(catalan(2) == 2, '1113: catalan(2) == 2');
vrfy(catalan(3) == 5, '1114: catalan(3) == 5');
vrfy(catalan(4) == 14, '1115: catalan(4) == 14');
vrfy(catalan(20) == 6564120420, '1116: catalan(20) == 6564120420');
/*
* bernoulli builtin function testing
*/
vrfy(bernoulli(0) == 1, '1117: bernoulli(0) == 1');
vrfy(bernoulli(1) == -1/2, '1118: bernoulli(1) == -1/2');
vrfy(bernoulli(2) == 1/6, '1119: bernoulli(2) == 1/6');
vrfy(bernoulli(3) == 0, '1120: bernoulli(3) == 0');
vrfy(bernoulli(4) == -1/30, '1121: bernoulli(4) == -1/30');
vrfy(bernoulli(5) == 0, '1122: bernoulli(5) == 0');
vrfy(bernoulli(6) == 1/42, '1123: bernoulli(6) == 1/42');
vrfy(bernoulli(32) == -7709321041217/510,
'1124: bernoulli(32) == -7709321041217/510');
/*
* euler function testing
*/
vrfy(euler(0) == 1, '1125: euler(0) == 1');
vrfy(euler(1) == 0, '1126: euler(1) == 0');
vrfy(euler(2) == -1, '1127: euler(2) == -1');
vrfy(euler(3) == 0, '1128: euler(3) == 0');
vrfy(freeeuler() == null(), '1129: freeeuler() == null()');
vrfy(euler(4) == 5, '1130: euler(4) == 5');
vrfy(euler(5) == 0, '1131: euler(5) == 0');
vrfy(euler(6) == -61, '1132: euler(6) == -61');
vrfy(euler(32) == 177519391579539289436664789665,
'1130: euler(32) == 177519391579539289436664789665');
vrfy(freeeuler() == null(), '1133: freeeuler() == null()');
/*
* digit with non-10 base
*/
a = 123456.789;
print '1134: a = 123456.789';
vrfy(digit(a, 6, 100) == 0, '1135: digit(a, 6, 100) == 0');
vrfy(digit(a, 5, 100) == 0, '1136: digit(a, 5, 100) == 0');
vrfy(digit(a, 4, 100) == 0, '1137: digit(a, 4, 100) == 0');
vrfy(digit(a, 3, 100) == 0, '1138: digit(a, 3, 100) == 0');
vrfy(digit(a, 2, 100) == 12, '1139: digit(a, 2, 100) == 12');
vrfy(digit(a, 1, 100) == 34, '1140: digit(a, 1, 100) == 34');
vrfy(digit(a, 0, 100) == 56, '1141: digit(a, 0, 100) == 56');
vrfy(digit(a, -1, 100) == 78, '1142: digit(a, -1, 100) == 78');
vrfy(digit(a, -2, 100) == 90, '1143: digit(a, -2, 100) == 90');
vrfy(digit(a, -3, 100) == 0, '1144: digit(a, -3, 100) == 0');
vrfy(digit(a, -4, 100) == 0, '1145: digit(a, -4, 100) == 0');
vrfy(digit(a, -5, 100) == 0, '1146: digit(a, -5, 100) == 0');
vrfy(digit(a, -6, 100) == 0, '1146: digit(a, -6, 100) == 0');
/*
* digits with a non-10 base
*/
vrfy(digits(a, 100) == 3, '1147: digits(a, 100) == 3');
vrfy(digits(2^256-1, 256) == 32,'1148: digits(2^256-1, 256) == 32');
/*
* places with a non-10 base
*/
vrfy(places(0.0123, 2) == -1, '1149: places(0.0123, 2) == -1');
vrfy(places(0.625, 2) == 3, '1150: places(0.625, 2) == 3');
vrfy(places(0.625, 8) == 1, '1151: places(0.625, 8) == 1');
vrfy(places(171/2^712, 2) == 712,
'1152: places(171/2^7120.625, 2) == 712');
vrfy(places(171/2^712, 64) == 119,
'1152: places(171/2^7120.625, 64) == 119');
/*
* verify sleep
*/
vrfy(sleep(1/5) == null(), '1153: sleep(1/5) == null()');
vrfy(sleep(1) == null(), '1154: sleep(1) == null()');
print '1155: Ending test_functions';
}
print '017: parsed test_functions()';
@@ -2987,7 +3065,7 @@ define test_error()
vrfy(root(3,2,0) == error(10029),
'3644: root(3,2,0) == error(10029)');
vrfy(norm("x") == error(10030), '3645: norm("x") == error(10030)');
vrfy(null() << 2 == error(10031),'3646: null() << 2 == error(10031)');
vrfy(list() << 2 == error(10031),'3646: list() << 2 == error(10031)');
vrfy(1.5 << 2 == error(10031), '3647: 1.5 << 2 == error(10031)');
vrfy(3 << "x" == error(10032), '3648: 3 << "x" == error(10032)');
vrfy(3 << 1.5 == error(10032), '3649: 3 << 1.5 == error(10032)');
@@ -7538,6 +7616,15 @@ 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 Normal file
View File

File diff suppressed because it is too large Load Diff

897
calc.c
View File

File diff suppressed because it is too large Load Diff

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.3 $
* @(#) $Id: calc.h,v 29.3 2000/06/07 14:02:13 chongo Exp $
* @(#) $Revision: 29.5 $
* @(#) $Id: calc.h,v 29.5 2000/12/04 19:32:33 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/calc.h,v $
*
* Under source code control: 1990/02/15 01:48:31
@@ -60,10 +60,9 @@
#define MAXERROR 512 /* maximum length of error message string */
#define SYMBOLSIZE 256 /* maximum symbol name size */
#define MAXINDICES 20 /* maximum number of indices for objects */
#define MAXLABELS 100 /* maximum number of user labels in function */
#define MAXSTRING 1024 /* maximum size of string constant */
#define MAXSTACK 1000 /* maximum depth of evaluation stack */
#define MAXSTACK 2048 /* 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 */
@@ -167,7 +166,6 @@ extern BOOL calc_tty(int fd);
extern BOOL orig_tty(int fd);
extern void showerrors(void);
extern char *calc_strdup(CONST char *);
extern void getshellfile(char *shellfile);
/*
* Initialization
@@ -229,15 +227,15 @@ extern int allow_exec; /* FALSE => may not execute any commands */
* calc startup and run state
*/
typedef enum {
RUN_UNKNOWN = -1, /* unknown or unset start state */
RUN_BEGIN = 0, /* calc execution starts */
RUN_RCFILES = 1, /* rc files being evaluated */
RUN_PRE_CMD_ARGS = 2, /* prepare to evaluate cmd args */
RUN_CMD_ARGS = 3, /* cmd args being evaluated */
RUN_PRE_TOP_LEVEL = 4, /* prepare to start top level activity */
RUN_TOP_LEVEL = 5, /* running at top level */
RUN_EXIT = 6, /* normal exit from calc */
RUN_EXIT_WITH_ERROR = 7 /* exit with error */
RUN_ZERO, /* unknown or unset start state */
RUN_BEGIN, /* calc execution starts */
RUN_RCFILES, /* rc files being evaluated */
RUN_PRE_CMD_ARGS, /* prepare to evaluate cmd args */
RUN_CMD_ARGS, /* cmd args being evaluated */
RUN_PRE_TOP_LEVEL, /* prepare to start top level activity */
RUN_TOP_LEVEL, /* running at top level */
RUN_EXIT, /* normal exit from calc */
RUN_EXIT_WITH_ERROR /* exit with error */
} run;
extern run run_state;
extern char *run_state_name(run state);

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.2 $
# @(#) $Id: calcerr.tbl,v 29.2 2000/06/07 14:02:13 chongo Exp $
# @(#) $Revision: 29.3 $
# @(#) $Id: calcerr.tbl,v 29.3 2000/07/17 15:35:49 chongo Exp $
# @(#) $Source: /usr/local/src/cmd/calc/RCS/calcerr.tbl,v $
#
# Under source code control: 1996/05/23 17:38:44
@@ -375,3 +375,21 @@ E_GD3 Infinite or too-large result for gd
E_AGD3 Infinite or too-large result for agd
E_POWER4 Too-large value for power
E_ROOT4 Too-large value for root
E_DGT1 Non-real first arg for digit
E_DGT2 Non-integral second arg for digit
E_DGT3 Bad third arg for digit
E_PLCS1 Bad first argument for places
E_PLCS2 Bad second argument for places
E_DGTS1 Bad first argument for digits
E_DGTS2 Bad second argument for digits
E_ILOG Bad first argument for ilog
E_ILOGB Bad second argument for ilog
E_ILOG10 Bad argument for ilog10
E_ILOG2 Bad argument for ilog2
E_COMB1 Non-integer second arg for comb
E_COMB2 Too-large second arg for comb
E_CTLN Bad argument for catalan
E_BERN Bad argument for bern
E_EULER Bad argument for euler
E_SLEEP Bad argument for sleep
E_TTY calc_tty failure

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

421
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.2 $
* @(#) $Id: codegen.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $Revision: 29.3 $
* @(#) $Id: codegen.c,v 29.3 2000/07/17 15:35:49 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 BOOL getfilename(char *name, BOOL msg_ok, BOOL *once);
static int getfilename(char *name, BOOL *once);
static BOOL getid(char *buf);
static void getshowstatement(void);
static void getfunction(void);
@@ -71,7 +71,7 @@ static void getsimplebody(void);
static void getcondition(void);
static void getmatargs(void);
static void getelement(void);
static void usesymbol(char *name, BOOL autodef);
static void usesymbol(char *name, int autodef);
static void definesymbol(char *name, int symtype);
static void getcallargs(char *name);
static void do_changedir(void);
@@ -90,9 +90,16 @@ static int getshiftexpr(void);
static int getreference(void);
static int getincdecexpr(void);
static int getterm(void);
static int getidexpr(BOOL okmat, BOOL autodef);
static int getidexpr(BOOL okmat, int autodef);
static long getinitlist(void);
#define INDICALLOC 8
static int quickindices[INDICALLOC];
static int * newindices;
static int * indices;
static int maxindices;
/*
* Read all the commands from an input file.
@@ -133,49 +140,63 @@ getcommands(BOOL toplevel)
return;
case T_HELP:
if (!getfilename(name, FALSE, NULL)) {
strcpy(name, DEFAULTCALCHELP);
for (;;) {
switch(getfilename(name, NULL)) {
case 1:
strcpy(name, DEFAULTCALCHELP);
case 0:
givehelp(name);
continue;
default:
break;
}
break;
}
givehelp(name);
break;
case T_READ:
if (!getfilename(name, TRUE, &rdonce))
break;
if (!allow_read) {
scanerror(T_NULL,
"read command disallowed by -m mode\n");
break;
}
switch (opensearchfile(name,calcpath,CALCEXT,rdonce)) {
case 0:
getcommands(FALSE);
closeinput();
break;
case 1:
/* previously read and -once was given */
break;
case -2:
scanerror(T_NULL,
"Maximum input depth reached");
break;
default:
scanerror(T_NULL, "Cannot open \"%s\"\n", name);
for (;;) {
if (getfilename(name, &rdonce))
break;
switch (opensearchfile(name,calcpath,
CALCEXT,rdonce)) {
case 0:
getcommands(FALSE);
closeinput();
continue;
case 1:
/* prev read and -once was given */
continue;
case -2:
scanerror(T_NULL,
"Maximum input depth reached");
break;
default:
scanerror(T_NULL,
"Cannot open \"%s\"", name);
continue;
}
break;
}
break;
case T_WRITE:
if (!getfilename(name, TRUE, NULL))
break;
if (!allow_write) {
scanerror(T_NULL,
"write command disallowed by -m mode\n");
break;
}
if (writeglobals(name))
if (getfilename(name, NULL))
break;
if (writeglobals(name)) {
scanerror(T_NULL,
"Error writing \"%s\"\n", name);
}
break;
case T_CD:
@@ -529,7 +550,7 @@ getonevariable(int symtype)
res = getonevariable(symtype);
definesymbol(name, symtype);
if (res) {
usesymbol(name, FALSE);
usesymbol(name, 0);
addop(OP_ASSIGNBACK);
}
return res;
@@ -892,7 +913,7 @@ getstatement(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *d
return;
case T_ELSE:
scanerror(T_SEMICOLON, "ELSE without preceeding IF");
scanerror(T_SEMICOLON, "ELSE without preceding IF");
return;
case T_SHOW:
@@ -1021,7 +1042,6 @@ getobjdeclaration(int symtype)
int count; /* number of elements */
int index; /* current index */
int i; /* loop counter */
int indices[MAXINDICES]; /* indices for elements */
int oldmode;
if (gettoken() != T_SYMBOL) {
@@ -1038,58 +1058,89 @@ getobjdeclaration(int symtype)
* Read in the definition of the elements of the object.
*/
count = 0;
indices = quickindices;
maxindices = INDICALLOC;
oldmode = tokenmode(TM_DEFAULT);
for (;;) {
switch (gettoken()) {
case T_SYMBOL:
if (count == MAXINDICES) {
scanerror(T_SEMICOLON,
"Too many elements in OBJ "
"statement");
(void) tokenmode(oldmode);
return;
}
index = addelement(tokensymbol());
for (i = 0; i < count; i++) {
if (indices[i] == index) {
scanerror(T_SEMICOLON,
"Duplicate element name "
"\"%s\"", tokensymbol());
case T_SYMBOL:
if (count == maxindices) {
if (maxindices == INDICALLOC) {
maxindices += INDICALLOC;
newindices = (int *) malloc(maxindices *
sizeof(int));
if (newindices == NULL) {
scanerror(T_SEMICOLON, "Out of memory for indices malloc");
(void) tokenmode(oldmode);
return;
}
memcpy(newindices, quickindices,
INDICALLOC * sizeof(int));
indices = newindices;
} else {
maxindices += INDICALLOC;
newindices = (int *) realloc(indices,
maxindices * sizeof(int));
if (newindices == NULL) {
free(indices);
scanerror(T_SEMICOLON, "Out of memory for indices realloc");
(void) tokenmode(oldmode);
return;
}
indices = newindices;
}
indices[count++] = index;
if (gettoken() == T_COMMA)
continue;
rescantoken();
if (gettoken() != T_RIGHTBRACE) {
scanerror(T_SEMICOLON,
"Bad object type definition");
}
index = addelement(tokensymbol());
for (i = 0; i < count; i++) {
if (indices[i] == index) {
if (indices != quickindices)
free(indices);
scanerror(T_SEMICOLON, "Duplicate element name \"%s\"", tokensymbol());
(void) tokenmode(oldmode);
return;
}
/*FALLTHRU*/
case T_RIGHTBRACE:
(void) tokenmode(oldmode);
if (defineobject(name, indices, count)) {
scanerror(T_NULL,
"Object type \"%s\" is already defined", name);
return;
}
getobjvars(name, symtype);
return;
case T_NEWLINE:
}
indices[count++] = index;
if (gettoken() == T_COMMA)
continue;
default:
scanerror(T_SEMICOLON,
"Bad object type definition");
rescantoken();
if (gettoken() != T_RIGHTBRACE) {
if (indices != quickindices)
free(indices);
scanerror(T_SEMICOLON, "Bad object type definition");
(void) tokenmode(oldmode);
return;
}
/*FALLTHRU*/
case T_RIGHTBRACE:
(void) tokenmode(oldmode);
if (defineobject(name, indices, count)) {
if (indices != quickindices)
free(indices);
scanerror(T_NULL,
"Object type \"%s\" is already defined", name);
return;
}
if (indices != quickindices)
free(indices);
getobjvars(name, symtype);
return;
case T_NEWLINE:
continue;
default:
if (indices != quickindices)
free(indices);
scanerror(T_SEMICOLON, "Bad object type definition");
(void) tokenmode(oldmode);
return;
}
}
}
static void
getoneobj(long index, int symtype)
{
@@ -1098,11 +1149,11 @@ getoneobj(long index, int symtype)
if (gettoken() == T_SYMBOL) {
if (symtype == SYM_UNDEFINED) {
rescantoken();
(void) getidexpr(TRUE, TRUE);
(void) getidexpr(TRUE, 1);
} else {
symname = tokensymbol();
definesymbol(symname, symtype);
usesymbol(symname, FALSE);
usesymbol(symname, 0);
}
getoneobj(index, symtype);
addop(OP_ASSIGN);
@@ -1181,11 +1232,11 @@ getonematrix(int symtype)
if (gettoken() == T_SYMBOL) {
if (symtype == SYM_UNDEFINED) {
rescantoken();
(void) getidexpr(FALSE, TRUE);
(void) getidexpr(FALSE, 1);
} else {
name = tokensymbol();
definesymbol(name, symtype);
usesymbol(name, FALSE);
usesymbol(name, 0);
}
while (gettoken() == T_COMMA);
rescantoken();
@@ -2028,7 +2079,25 @@ getterm(void)
case T_SYMBOL:
rescantoken();
type = getidexpr(TRUE, FALSE);
type = getidexpr(TRUE, 0);
break;
case T_GLOBAL:
if (gettoken() != T_SYMBOL) {
scanerror(T_NULL, "Global id expected");
break;
}
rescantoken();
type = getidexpr(TRUE, T_GLOBAL);
break;
case T_LOCAL:
if (gettoken() != T_SYMBOL) {
scanerror(T_NULL, "Local id expected");
break;
}
rescantoken();
type = getidexpr(TRUE, T_LOCAL);
break;
case T_LEFTBRACKET:
@@ -2077,11 +2146,11 @@ getterm(void)
/*
* Read in an identifier expressions.
* This is a symbol name followed by parenthesis, or by square brackets or
* element refernces. The symbol can be a global or a local variable name.
* element references. The symbol can be a global or a local variable name.
* Returns the type of expression found.
*/
static int
getidexpr(BOOL okmat, BOOL autodef)
getidexpr(BOOL okmat, int autodef)
{
int type;
char name[SYMBOLSIZE+1]; /* symbol name */
@@ -2091,18 +2160,19 @@ getidexpr(BOOL okmat, BOOL autodef)
if (!getid(name))
return type;
switch (gettoken()) {
case T_LEFTPAREN:
oldmode = tokenmode(TM_DEFAULT);
getcallargs(name);
(void) tokenmode(oldmode);
type = 0;
break;
case T_ASSIGN:
autodef = TRUE;
/* fall into default case */
default:
rescantoken();
usesymbol(name, autodef);
case T_LEFTPAREN:
oldmode = tokenmode(TM_DEFAULT);
getcallargs(name);
(void) tokenmode(oldmode);
type = 0;
break;
case T_ASSIGN:
if (autodef != T_GLOBAL && autodef != T_LOCAL)
autodef = 1;
/* fall into default case */
default:
rescantoken();
usesymbol(name, autodef);
}
/*
* Now collect as many element references and matrix index operations
@@ -2110,27 +2180,27 @@ getidexpr(BOOL okmat, BOOL autodef)
*/
for (;;) {
switch (gettoken()) {
case T_LEFTBRACKET:
rescantoken();
if (!okmat)
return type;
getmatargs();
type = 0;
break;
case T_ARROW:
addop(OP_DEREF);
/*FALLTHRU*/
case T_PERIOD:
getelement();
type = 0;
break;
case T_LEFTPAREN:
scanerror(T_NULL,
"Function calls not allowed "
"as expressions");
default:
rescantoken();
case T_LEFTBRACKET:
rescantoken();
if (!okmat)
return type;
getmatargs();
type = 0;
break;
case T_ARROW:
addop(OP_DEREF);
/*FALLTHRU*/
case T_PERIOD:
getelement();
type = 0;
break;
case T_LEFTPAREN:
scanerror(T_NULL,
"Function calls not allowed "
"as expressions");
default:
rescantoken();
return type;
}
}
}
@@ -2144,71 +2214,37 @@ getidexpr(BOOL okmat, BOOL autodef)
*
* given:
* name filename to read
* msg_ok TRUE => ok to print error messages
* once non-NULL => set to TRUE of -once read
*/
static BOOL
getfilename(char *name, BOOL msg_ok, BOOL *once)
static int
getfilename(char *name, BOOL *once)
{
STRING *s;
int i;
/* look at the next token */
(void) tokenmode(TM_NEWLINES | TM_ALLSYMS);
switch (gettoken()) {
case T_STRING:
s = findstring(tokenstring());
strcpy(name, s->s_str);
sfree(s);
break;
case T_SYMBOL:
strcpy(name, tokensymbol());
break;
default:
if (msg_ok)
scanerror(T_SEMICOLON, "Filename expected");
return FALSE;
}
/* determine if we care about a possible -once option */
if (once != NULL) {
/* we care about a possible -once option */
if (strcmp(name, "-once") == 0) {
/* -once option found */
*once = TRUE;
/* look for the filename */
switch (gettoken()) {
case T_STRING:
s = findstring(tokenstring());
strcpy(name, s->s_str);
sfree(s);
break;
case T_SYMBOL:
strcpy(name, tokensymbol());
break;
default:
if (msg_ok)
scanerror(T_SEMICOLON,
"Filename expected");
return FALSE;
}
} else {
*once = FALSE;
for (i = 2; i > 0; i--) {
switch (gettoken()) {
case T_STRING:
s = findstring(tokenstring());
strcpy(name, s->s_str);
sfree(s);
break;
case T_SYMBOL:
strcpy(name, tokensymbol());
break;
default:
rescantoken();
return -1;
}
}
/* look at the next token */
switch (gettoken()) {
case T_SEMICOLON:
case T_NEWLINE:
case T_EOF:
break;
default:
if (msg_ok)
scanerror(T_SEMICOLON,
"Missing semicolon after filename");
return FALSE;
if (i == 2 && once != NULL) {
if ((*once = !strcmp(name, "-once")))
continue;
}
break;
}
return TRUE;
return 0;
}
@@ -2433,11 +2469,26 @@ definesymbol(char *name, int symtype)
*
* given:
* name symbol name to be checked
* autodef TRUE => define is symbol is not known
* autodef 1 => define if symbol is not known
* T_GLOBAL => get global, define if necessary
*/
static void
usesymbol(char *name, BOOL autodef)
usesymbol(char *name, int autodef)
{
if (autodef == T_GLOBAL) {
addopptr(OP_GLOBALADDR, (char *) addglobal(name, FALSE));
return;
}
if (autodef == T_LOCAL) {
if (symboltype(name) == SYM_PARAM) {
scanerror(T_COMMA,
"Variable \"%s\" is already defined", name);
return;
}
addopone(OP_LOCALADDR, addlocal(name));
return;
}
switch (symboltype(name)) {
case SYM_LOCAL:
addopone(OP_LOCALADDR, (long) findlocal(name));
@@ -2544,24 +2595,25 @@ static void
do_changedir(void)
{
char *p;
STRING *s;
/* look at the next token */
(void) tokenmode(TM_NEWLINES | TM_ALLSYMS);
/* determine the new directory */
s = NULL;
switch (gettoken()) {
case T_NULL:
case T_NEWLINE:
case T_SEMICOLON:
p = home;
break;
default:
p = tokensymbol(); /* This is not enough XXX */
if (p == NULL) {
case T_STRING:
s = findstring(tokenstring());
p = s->s_str;
break;
case T_SYMBOL:
p = tokensymbol();
break;
default:
p = home;
}
break;
}
if (p == NULL) {
fprintf(stderr, "Cannot determine HOME directory\n");
}
@@ -2570,29 +2622,8 @@ do_changedir(void)
if (chdir(p)) {
perror(p);
}
return;
if (s != NULL)
sfree(s);
}
/*
* getshellfile - process the contents of a shellfile
*/
void
getshellfile(char *shellfile)
{
/*
* treat the calc shell script as if we were reading it
*/
if (!allow_read) {
scanerror(T_NULL,
"reading of calc shell script \"%s\" "
"dislloaed by -m mode\n", shellfile);
} else if (opensearchfile(shellfile, NULL, NULL, FALSE) == 0) {
getcommands(FALSE);
closeinput();
} else {
scanerror(T_NULL,
"Cannot open calc shell script \"%s\"\n", shellfile);
}
return;
}

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.2 $
* @(#) $Id: comfunc.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $Revision: 29.3 $
* @(#) $Id: comfunc.c,v 29.3 2000/07/17 15:35:49 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 epsilson for cpolar");
math_error("Zero epsilon for cpolar");
/*NOTREACHED*/
}
if (qiszero(q1))
@@ -1162,3 +1162,27 @@ cprintfr(COMPLEX *c)
zprintval(i->den, 0L, 0L);
}
}
NUMBER *
cilog(COMPLEX *c, ZVALUE base)
{
NUMBER *qr, *qi;
qr = qilog(c->real, base);
qi = qilog(c->imag, base);
if (qr == NULL) {
if (qi == NULL)
return NULL;
return qi;
}
if (qi == NULL)
return qr;
if (qrel(qr, qi) >= 0) {
qfree(qi);
return qr;
}
qfree(qr);
return qi;
}

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.3 $
* @(#) $Id: config.c,v 29.3 2000/06/07 14:02:13 chongo Exp $
* @(#) $Revision: 29.4 $
* @(#) $Id: config.c,v 29.4 2000/07/17 15:35:49 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 aproximations */
TRUE, /* ok to print a tilde on approximations */
TRUE, /* ok to print tab before numeric values */
0, /* quomod() default rounding mode */
2, /* quotent // default rounding mode */
2, /* quotient // default rounding mode */
0, /* mod % default rounding mode */
24, /* sqrt() default rounding mode */
24, /* appr() default rounding mode */
@@ -149,10 +149,10 @@ CONFIG newstd = { /* new non-backward compatible configuration */
SQ_ALG2, /* size of number to use square alg 2 */
POW_ALG2, /* size of modulus to use REDC for powers */
REDC_ALG2, /* size of modulus to use REDC algorithm 2 */
TRUE, /* ok to print a tilde on aproximations */
TRUE, /* ok to print a tilde on approximations */
TRUE, /* ok to print tab before numeric values */
0, /* quomod() default rounding mode */
0, /* quotent // default rounding mode */
0, /* quotient // default rounding mode */
0, /* mod % default rounding mode */
24, /* sqrt() default rounding mode */
24, /* appr() default rounding mode */
@@ -287,10 +287,11 @@ static NAMETYPE truth[] = {
/*
* declate static functions
* declare static functions
*/
static long lookup_long(NAMETYPE *set, char *name);
static char *lookup_name(NAMETYPE *set, long val);
static int getlen(VALUE *vp, LEN *lp);
/*
@@ -360,6 +361,26 @@ lookup_name(NAMETYPE *set, long val)
}
/*
* Check whether VALUE at vp is a LEN (32-bit signed integer) and if so,
* copy that integer to lp.
* Return: 1, 2, 0, or -1 XXX
*/
static int
getlen(VALUE *vp, LEN *lp)
{
if (vp->v_type != V_NUM || !qisint(vp->v_num))
return 1;
if (zge31b(vp->v_num->num))
return 2;
*lp = ztoi(vp->v_num->num);
if (*lp < 0)
return -1;
return 0;
}
/*
* Set the specified configuration type to the specified value.
* An error is generated if the type number or value is illegal.
@@ -370,6 +391,7 @@ setconfig(int type, VALUE *vp)
NUMBER *q;
CONFIG *newconf; /* new configuration to set */
long temp;
LEN len;
char *p;
switch (type) {
@@ -414,15 +436,11 @@ setconfig(int type, VALUE *vp)
break;
case CONFIG_DISPLAY:
if (vp->v_type != V_NUM) {
math_error("Non-numeric for display");
if (getlen(vp, &len)) {
math_error("Bad value for display");
/*NOTREACHED*/
}
q = vp->v_num;
temp = qtoi(q);
if (qisfrac(q) || qisneg(q) || !zistiny(q->num))
temp = -1;
math_setdigits(temp);
math_setdigits(len);
break;
case CONFIG_MODE:
@@ -447,91 +465,51 @@ setconfig(int type, VALUE *vp)
break;
case CONFIG_MAXPRINT:
if (vp->v_type != V_NUM) {
math_error("Non-numeric for maxprint");
if (getlen(vp, &len)) {
math_error("Bad value for maxprint");
/*NOTREACHED*/
}
q = vp->v_num;
temp = qtoi(q);
if (qisfrac(q) || qisneg(q) || !zistiny(q->num))
temp = -1;
if (temp < 0) {
math_error("Maxprint value is out of range");
/*NOTREACHED*/
}
conf->maxprint = temp;
conf->maxprint = len;
break;
case CONFIG_MUL2:
if (vp->v_type != V_NUM) {
math_error("Non-numeric for mul2");
if (getlen(vp, &len)) {
math_error("Bad value for mul2");
/*NOTREACHED*/
}
q = vp->v_num;
temp = qtoi(q);
if (qisfrac(q) || qisneg(q))
temp = -1;
if (temp == 0)
temp = MUL_ALG2;
if (temp < 2) {
math_error("Illegal mul2 value");
/*NOTREACHED*/
}
conf->mul2 = (int)temp;
if (len == 0)
len = MUL_ALG2;
conf->mul2 = len;
break;
case CONFIG_SQ2:
if (vp->v_type != V_NUM) {
math_error("Non-numeric for sq2");
if (getlen(vp, &len)) {
math_error("Bad value for sq2");
/*NOTREACHED*/
}
q = vp->v_num;
temp = qtoi(q);
if (qisfrac(q) || qisneg(q))
temp = -1;
if (temp == 0)
temp = SQ_ALG2;
if (temp < 2) {
math_error("Illegal sq2 value");
/*NOTREACHED*/
}
conf->sq2 = (int)temp;
if (len == 0)
len = SQ_ALG2;
conf->sq2 = len;
break;
case CONFIG_POW2:
if (vp->v_type != V_NUM) {
math_error("Non-numeric for pow2");
if (getlen(vp, &len)) {
math_error("Bad value for pow2");
/*NOTREACHED*/
}
q = vp->v_num;
temp = qtoi(q);
if (qisfrac(q) || qisneg(q))
temp = -1;
if (temp == 0)
temp = POW_ALG2;
if (temp < 1) {
math_error("Illegal pow2 value");
/*NOTREACHED*/
}
conf->pow2 = (int)temp;
if (len == 0)
len = POW_ALG2;
conf->pow2 = len;
break;
case CONFIG_REDC2:
if (vp->v_type != V_NUM) {
math_error("Non-numeric for redc2");
if (getlen(vp, &len)) {
math_error("Bad value for redc2");
/*NOTREACHED*/
}
q = vp->v_num;
temp = qtoi(q);
if (qisfrac(q) || qisneg(q))
temp = -1;
if (temp == 0)
temp = REDC_ALG2;
if (temp < 1) {
math_error("Illegal redc2 value");
/*NOTREACHED*/
}
conf->redc2 = (int)temp;
if (len == 0)
len = REDC_ALG2;
conf->redc2 = len;
break;
case CONFIG_TILDE:
@@ -563,129 +541,75 @@ setconfig(int type, VALUE *vp)
break;
case CONFIG_QUOMOD:
if (vp->v_type != V_NUM) {
math_error("Non numeric for quomod");
if (getlen(vp, &len)) {
math_error("Illegal value for quomod");
/*NOTREACHED*/
}
q = vp->v_num;
temp = qtoi(q);
if (qisfrac(q) || qisneg(q) || !zistiny(q->num)) {
math_error("Illegal quomod parameter value");
/*NOTREACHED*/
}
conf->quomod = temp;
conf->quomod = len;
break;
case CONFIG_QUO:
if (vp->v_type != V_NUM) {
math_error("Non numeric for quo");
if (getlen(vp, &len)) {
math_error("Illegal value for quo");
/*NOTREACHED*/
}
q = vp->v_num;
temp = qtoi(q);
if (qisfrac(q) || qisneg(q) || !zistiny(q->num)) {
math_error("Illegal quo parameter value");
/*NOTREACHED*/
}
conf->quo = temp;
conf->quo = len;
break;
case CONFIG_MOD:
if (vp->v_type != V_NUM) {
math_error("Non numeric for mod");
if (getlen(vp, &len)) {
math_error("Illegal value for mod");
/*NOTREACHED*/
}
q = vp->v_num;
temp = qtoi(q);
if (qisfrac(q) || qisneg(q) || !zistiny(q->num)) {
math_error("Illegal mod parameter value");
/*NOTREACHED*/
}
conf->mod = temp;
conf->mod = len;
break;
case CONFIG_SQRT:
if (vp->v_type != V_NUM) {
math_error("Non numeric for sqrt");
if (getlen(vp, &len)) {
math_error("Illegal value for sqrt");
/*NOTREACHED*/
}
q = vp->v_num;
temp = qtoi(q);
if (qisfrac(q) || qisneg(q) || !zistiny(q->num)) {
math_error("Illegal sqrt parameter value");
/*NOTREACHED*/
}
conf->sqrt = temp;
conf->sqrt = len;
break;
case CONFIG_APPR:
if (vp->v_type != V_NUM) {
math_error("Non numeric for appr");
if (getlen(vp, &len)) {
math_error("Illegal value for appr");
/*NOTREACHED*/
}
q = vp->v_num;
temp = qtoi(q);
if (qisfrac(q) || qisneg(q) || !zistiny(q->num)) {
math_error("Illegal appr parameter value");
/*NOTREACHED*/
}
conf->appr = temp;
conf->appr = len;
break;
case CONFIG_CFAPPR:
if (vp->v_type != V_NUM) {
math_error("Non numeric for cfappr");
if (getlen(vp, &len)) {
math_error("Illegal value for cfappr");
/*NOTREACHED*/
}
q = vp->v_num;
temp = qtoi(q);
if (qisfrac(q) || qisneg(q) || !zistiny(q->num)) {
math_error("Illegal cfappr parameter value");
/*NOTREACHED*/
}
conf->cfappr = temp;
conf->cfappr = len;
break;
case CONFIG_CFSIM:
if (vp->v_type != V_NUM) {
math_error("Non numeric for cfsim");
if (getlen(vp, &len)) {
math_error("Illegal value for cfsim");
/*NOTREACHED*/
}
q = vp->v_num;
temp = qtoi(q);
if (qisfrac(q) || qisneg(q) || !zistiny(q->num)) {
math_error("Illegal cfsim parameter value");
/*NOTREACHED*/
}
conf->cfsim = temp;
conf->cfsim = len;
break;
case CONFIG_OUTROUND:
if (vp->v_type != V_NUM) {
math_error("Non numeric for outround");
if (getlen(vp, &len)) {
math_error("Illegal value for outround");
/*NOTREACHED*/
}
q = vp->v_num;
temp = qtoi(q);
if (qisfrac(q) || qisneg(q) || !zistiny(q->num)) {
math_error("Illegal output parameter value");
/*NOTREACHED*/
}
conf->outround = temp;
conf->outround = len;
break;
case CONFIG_ROUND:
if (vp->v_type != V_NUM) {
math_error("Non numeric for round");
if (getlen(vp, &len)) {
math_error("Illegal value for round");
/*NOTREACHED*/
}
q = vp->v_num;
temp = qtoi(q);
if (qisfrac(q) || qisneg(q) || !zistiny(q->num)) {
math_error("Illegal output parameter value");
/*NOTREACHED*/
}
conf->round = temp;
conf->round = len;
break;
case CONFIG_LEADZERO:
@@ -1311,12 +1235,12 @@ config_cmp(CONFIG *cfg1, CONFIG *cfg2)
*/
if (cfg1 == NULL || cfg1->epsilon == NULL || cfg1->prompt1 == NULL ||
cfg1->prompt2 == NULL) {
math_error("CONFIG #1 value is invaid");
math_error("CONFIG #1 value is invalid");
/*NOTREACHED*/
}
if (cfg2 == NULL || cfg2->epsilon == NULL || cfg2->prompt1 == NULL ||
cfg2->prompt2 == NULL) {
math_error("CONFIG #2 value is invaid");
math_error("CONFIG #2 value is invalid");
/*NOTREACHED*/
}

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.3 $
* @(#) $Id: config.h,v 29.3 2000/06/07 14:02:13 chongo Exp $
* @(#) $Revision: 29.4 $
* @(#) $Id: config.h,v 29.4 2000/07/17 15:35:49 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 */
long outdigits; /* current output digits for float or exp */
LEN outdigits; /* current output digits for float or exp */
NUMBER *epsilon; /* default error for real functions */
long epsilonprec; /* epsilon binary precision (tied to epsilon) */
FLAG traceflags; /* tracing flags */
long maxprint; /* number of elements to print */
LEN maxprint; /* number of elements to print */
LEN mul2; /* size of number to use multiply algorithm 2 */
LEN sq2; /* size of number to use square algorithm 2 */
LEN pow2; /* size of modulus to use REDC for powers */
LEN redc2; /* size of modulus to use REDC algorithm 2 */
BOOL tilde_ok; /* ok to print a tilde on aproximations */
BOOL tab_ok; /* ok to print tab before numeric values */
long quomod; /* quomod() default rounding mode */
long quo; /* quotent // default rounding mode */
long mod; /* mod % default rounding mode */
long sqrt; /* sqrt() default rounding mode */
long appr; /* appr() default rounding mode */
long cfappr; /* cfappr() default rounding mode */
long cfsim; /* cfsim() default rounding mode */
long outround; /* output default rounding mode */
long round; /* round()/bround() default rounding mode */
LEN quomod; /* quomod() default rounding mode */
LEN quo; /* quotient // default rounding mode */
LEN mod; /* mod % default rounding mode */
LEN sqrt; /* sqrt() default rounding mode */
LEN appr; /* appr() default rounding mode */
LEN cfappr; /* cfappr() default rounding mode */
LEN cfsim; /* cfsim() default rounding mode */
LEN outround; /* output default rounding mode */
LEN round; /* round()/bround() default rounding mode */
BOOL leadzero; /* ok to print leading 0 before decimal pt */
BOOL fullzero; /* ok to print trailing 0's */
long maxscancount; /* max scan errors before abort */

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.5 $
# @(#) $Id: Makefile,v 29.5 2000/06/07 14:02:59 chongo Exp $
# @(#) $Revision: 29.6 $
# @(#) $Id: Makefile,v 29.6 2000/12/15 14:56:14 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 prodiced by the detaillist rule when no WARNINGS are detected.
# This list is produced 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
SCRIPT= mersenne piforever plus simple square
SCRIPT_SRC= mersenne.calc piforever.calc plus.calc simple.calc
SCRIPT_SRC= mersenne.calc piforever.calc plus.calc simple.calc square.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 built) a calc .a library
# These files are used to make (but not build) a calc .a library
#
CALCLIBLIST=
@@ -92,10 +92,10 @@ CALCLIBLIST=
#
all: ${SCRIPT} ${SCRIPT_SRC} .all
# used by the upper level Makefile to determine of we have done all
# used by the upper level Makefile to determine if we have done all
#
# NOTE: Due to bogus shells found on one common system we must have
# an non-emoty else clause for every if condition. *sigh*
# a non-empty else clause for every if condition. *sigh*
#
.all:
rm -f .all
@@ -245,3 +245,7 @@ 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 -S
#!/usr/local/src/cmd/calc/calc -q -s -f
#
# 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.2 $
# @(#) $Id: mersenne.calc,v 29.2 2000/06/07 14:02:59 chongo Exp $
# @(#) $Revision: 29.3 $
# @(#) $Id: mersenne.calc,v 29.3 2000/12/15 14:56:54 chongo Exp $
# @(#) $Source: /usr/local/src/cmd/calc/cscript/RCS/mersenne.calc,v $
#
# Under source code control: 1999/11/30 00:09:01;
@@ -35,13 +35,19 @@
/*
* parse args
*/
if (argv() != 1) {
if (argv() != 2) {
/* 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^": argv(0) : "-1 =", 2^eval(argv(0))-1;
print "2^": n : "-1 =", 2^n-1;

6
cscript/piforever.calc
View File

@@ -1,4 +1,4 @@
#!/usr/local/src/cmd/calc/calc -S
#!/usr/local/src/cmd/calc/calc -q -f
#
# 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.2 $
# @(#) $Id: piforever.calc,v 29.2 2000/06/07 14:02:59 chongo Exp $
# @(#) $Revision: 29.3 $
# @(#) $Id: piforever.calc,v 29.3 2000/12/15 14:56:54 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 -S
#!/usr/local/src/cmd/calc/calc -q -s -f
#
# 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.2 $
# @(#) $Id: plus.calc,v 29.2 2000/06/07 14:02:59 chongo Exp $
# @(#) $Revision: 29.3 $
# @(#) $Id: plus.calc,v 29.3 2000/12/15 14:56:54 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() < 1) {
if (argv() < 2) {
/* 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 2 args
* print the sum of the args
*
* Since args are strings, we must eval them before using them numerically.
*/
sum = 0;
for (i=0; i < argv(); ++i) {
for (i=1; 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 -S
#!/usr/local/src/cmd/calc/calc -q -f
#
# 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.2 $
# @(#) $Id: simple.calc,v 29.2 2000/06/07 14:02:59 chongo Exp $
# @(#) $Revision: 29.3 $
# @(#) $Id: simple.calc,v 29.3 2000/12/15 14:56:54 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 "The simple calc shell script works!"
print "This simple calc shell script works!"

35
cscript/square.calc Normal file
View File

@@ -0,0 +1,35 @@
#!/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;

9
custom/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.2 $
# @(#) $Id: Makefile,v 29.2 2000/06/07 14:03:03 chongo Exp $
# @(#) $Revision: 29.3 $
# @(#) $Id: Makefile,v 29.3 2000/12/17 12:28:15 chongo Exp $
# @(#) $Source: /usr/local/src/cmd/calc/custom/RCS/Makefile,v $
#
# Under source code control: 1997/03/09 02:28:54
@@ -406,7 +406,10 @@ depend:
echo '#endif /* '"$$tag"' */' >> "skel/custom/$$i"; \
done
${Q}(cd ..; ${MAKE} hsrc)
${Q}for i in `cd ..; ${MAKE} h_list`; do \
${Q}for i in `cd ..; ${MAKE} h_list 2>&1 | \
${SED} -e '/Entering directory/d' \
-e '/Nothing to be done/d' \
-e '/Leaving directory/d'`; do \
tag="`echo $$i | ${SED} 's/[\.+,:]/_/g'`"; \
echo "#if !defined($$tag)" > "skel/$$i"; \
echo "#define $$tag" >> "skel/$$i"; \

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.3 $
* @(#) $Id: c_sysinfo.c,v 29.3 2000/06/07 14:03:03 chongo Exp $
* @(#) $Revision: 29.4 $
* @(#) $Id: c_sysinfo.c,v 29.4 2000/07/17 15:37:12 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,7 +112,6 @@ static struct infoname sys_info[] = {
{"MAXFILES", "max number of opened files", NULL, (FULL)MAXFILES},
{"MAXFULL", "largest SFULL value", NULL, (FULL)MAXFULL},
{"MAXHALF", "largest SHALF value", NULL, (FULL)MAXHALF},
{"MAXINDICES", "max number of indices for objects", NULL, (FULL)MAXINDICES},
{"MAXLABELS", "max number of user labels in function", NULL, (FULL)MAXLABELS},
{"MAXLEN", "longest storage size allowed", NULL, (FULL)MAXLEN},
{"MAXLONG", "largest long val", NULL, (FULL)MAXLONG},

10
file.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.2 $
* @(#) $Id: file.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $Revision: 29.3 $
* @(#) $Id: file.c,v 29.3 2000/12/17 12:24:42 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/file.c,v $
*
* Under source code control: 1991/07/20 00:21:56
@@ -40,6 +40,7 @@
#include "calc.h"
#include "longbits.h"
#include "have_fpos.h"
#include "have_fpos_pos.h"
#include "fposval.h"
#include "file.h"
#include "calcerr.h"
@@ -1239,7 +1240,8 @@ z2filepos(ZVALUE zpos)
if (!zgtmaxfull(zpos)) {
/* ztofull puts the value into native byte order */
pos = ztofull(zpos);
ret = pos;
memset(&ret, 0, sizeof(FILEPOS));
memcpy((void *)&ret, (void *)&pos, sizeof(pos));
return ret;
}
@@ -1251,7 +1253,7 @@ z2filepos(ZVALUE zpos)
memcpy(&tmp, zpos.v, sizeof(FILEPOS));
} else {
/* copy what bits we can into the temp value */
tmp = 0;
memset(&tmp, 0, sizeof(FILEPOS));
memcpy(&tmp, zpos.v, zpos.len*BASEB/8);
}
/* swap into native byte order */

14
fposval.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.2 $
* @(#) $Id: fposval.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $Revision: 29.3 $
* @(#) $Id: fposval.c,v 29.3 2000/12/17 12:25:36 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/fposval.c,v $
*
* Under source code control: 1994/11/05 03:19:52
@@ -63,6 +63,7 @@
#include "endian_calc.h"
#include "have_offscl.h"
#include "have_posscl.h"
#include "have_fpos_pos.h"
char *program; /* our name */
@@ -83,9 +84,14 @@ main(int argc, char **argv)
/*
* print the file position information
*/
#if defined(HAVE_FPOS_POS)
printf("#undef FILEPOS_BITS\n");
printf("#define FILEPOS_BITS %d\n", FPOS_POS_BITS);
#else /* ! HAVE_FPOS_POS */
fileposlen = sizeof(FILEPOS)*8;
printf("#undef FILEPOS_BITS\n");
printf("#define FILEPOS_BITS %d\n", fileposlen);
#endif /* ! HAVE_FPOS_POS */
#if CALC_BYTE_ORDER == BIG_ENDIAN
/*
* Big Endian
@@ -113,8 +119,8 @@ main(int argc, char **argv)
* Normally a "(*(dest) = *(src))" would do, but on some
* systems a FILEPOS is not a scalar hince we must memcpy.
*/
printf("#define SWAP_HALF_IN_FILEPOS(dest, src)\t%s%d%s\n",
"memcpy((void *)(dest), (void *)(src), sizeof(",fileposlen,"))");
printf("#define SWAP_HALF_IN_FILEPOS(dest, src)\t%s\n",
"memcpy((void *)(dest), (void *)(src), sizeof(FPOS_POS_BITS))");
#endif /* HAVE_FILEPOS_SCALAR */
#endif /* CALC_BYTE_ORDER == BIG_ENDIAN */
putchar('\n');

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.3 $
* @(#) $Id: func.c,v 29.3 2000/06/07 14:02:13 chongo Exp $
* @(#) $Revision: 29.5 $
* @(#) $Id: func.c,v 29.5 2000/12/04 19:32:33 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 definitons
* arg count definitions
*/
#define IN 100 /* maximum number of arguments */
#define IN 1024 /* 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) {
math_error("End of file while prompting");
/*NOTREACHED*/
result.v_type = V_NULL;
return result;
}
if (*cp == '\0') {
result.v_str = slink(&_nullstring_);
@@ -278,7 +278,7 @@ f_prompt(VALUE *vp)
static VALUE
f_display(int count, VALUE **vals)
{
long oldvalue;
LEN oldvalue;
VALUE res;
/* initialize VALUE */
@@ -293,9 +293,9 @@ f_display(int count, VALUE **vals)
fprintf(stderr,
"Out-of-range arg for display ignored\n");
else
conf->outdigits = qtoi(vals[0]->v_num);
conf->outdigits = (LEN) qtoi(vals[0]->v_num);
}
res.v_num = itoq(oldvalue);
res.v_num = itoq((long) oldvalue);
return res;
}
@@ -1012,7 +1012,7 @@ f_srand(int count, VALUE **vals)
break;
default:
math_error("illegal type of arg passsed to srand()");
math_error("illegal type of arg passed to srand()");
/*NOTREACHED*/
break;
}
@@ -1158,7 +1158,7 @@ f_srandom(int count, VALUE **vals)
break;
default:
math_error("illegal type of arg passsed to srandom()");
math_error("illegal type of arg passed to srandom()");
/*NOTREACHED*/
break;
}
@@ -1253,37 +1253,76 @@ f_setbit(int count, VALUE **vals)
}
static NUMBER *
f_digit(NUMBER *val1, NUMBER *val2)
static VALUE
f_digit(int count, VALUE **vals)
{
if (qisfrac(val2)) {
math_error("Non-integral digit position");
/*NOTREACHED*/
VALUE res;
ZVALUE base;
if (vals[0]->v_type != V_NUM)
return error_value(E_DGT1);
if (vals[1]->v_type != V_NUM || qisfrac(vals[1]->v_num))
return error_value(E_DGT2);
if (count == 3) {
if (vals[2]->v_type != V_NUM || qisfrac(vals[2]->v_num))
return error_value(E_DGT3);
base = vals[2]->v_num->num;
} else {
base = _ten_;
}
if (qiszero(val1) || (qisint(val1) && qisneg(val2)))
return qlink(&_qzero_);
if (zge31b(val2->num)) {
if (qisneg(val2)) {
math_error("Very large digit position");
/*NOTREACHED*/
}
return qlink(&_qzero_);
}
return itoq((long) qdigit(val1, qtoi(val2)));
res.v_type = V_NUM;
res.v_num = qdigit(vals[0]->v_num, vals[1]->v_num->num, base);
if (res.v_num == NULL)
return error_value(E_DGT3);
return res;
}
static NUMBER *
f_digits(NUMBER *val)
static VALUE
f_digits(int count, VALUE **vals)
{
return itoq((long) qdigits(val));
ZVALUE base;
VALUE res;
if (vals[0]->v_type != V_NUM)
return error_value(E_DGTS1);
if (count > 1) {
if (vals[1]->v_type != V_NUM || qisfrac(vals[1]->v_num)
|| qiszero(vals[1]->v_num) || qisunit(vals[1]->v_num))
return error_value(E_DGTS2);
base = vals[1]->v_num->num;
} else {
base = _ten_;
}
res.v_type = V_NUM;
res.v_num = itoq(qdigits(vals[0]->v_num, base));
return res;
}
static NUMBER *
f_places(NUMBER *val)
static VALUE
f_places(int count, VALUE **vals)
{
return itoq((long) qplaces(val));
long places;
VALUE res;
if (vals[0]->v_type != V_NUM)
return error_value(E_PLCS1);
if (count > 1) {
if (vals[1]->v_type != V_NUM || qisfrac(vals[1]->v_num))
return error_value(E_PLCS2);
places = qplaces(vals[0]->v_num, vals[1]->v_num->num);
if (places == -2)
return error_value(E_PLCS2);
} else
places = qdecplaces(vals[0]->v_num);
res.v_type = V_NUM;
res.v_num = itoq(places);
return res;
}
@@ -3128,6 +3167,135 @@ f_agd(int count, VALUE **vals)
}
static VALUE
f_comb(VALUE *v1, VALUE *v2)
{
long n;
VALUE result;
VALUE tmp1, tmp2, div;
if (v2->v_type != V_NUM || qisfrac(v2->v_num))
return error_value(E_COMB1);
result.v_subtype = V_NOSUBTYPE;
result.v_type = V_NUM;
if (qisneg(v2->v_num)) {
result.v_num = qlink(&_qzero_);
return result;
}
if (qiszero(v2->v_num)) {
result.v_num = qlink(&_qone_);
return result;
}
if (qisone(v2->v_num)) {
copyvalue(v1, &result);
return result;
}
if (v1->v_type == V_NUM) {
result.v_num = qcomb(v1->v_num, v2->v_num);
if (result.v_num == NULL)
return error_value(E_COMB2);
return result;
}
if (zge24b(v2->v_num->num))
return error_value(E_COMB2);
n = qtoi(v2->v_num);
copyvalue(v1, &result);
decvalue(v1, &tmp1);
div.v_type = V_NUM;
div.v_num = qlink(&_qtwo_);
n--;
for (;;) {
mulvalue(&result, &tmp1, &tmp2);
freevalue(&result);
divvalue(&tmp2, &div, &result);
freevalue(&tmp2);
if (--n == 0 || !testvalue(&result) || result.v_type < 0) {
freevalue(&tmp1);
freevalue(&div);
return result;
}
decvalue(&tmp1, &tmp2);
freevalue(&tmp1);
tmp1 = tmp2;
incvalue(&div, &tmp2);
freevalue(&div);
div = tmp2;
}
}
static VALUE
f_bern(VALUE *vp)
{
VALUE res;
if (vp->v_type != V_NUM || qisfrac(vp->v_num))
return error_value(E_BERN);
res.v_subtype = V_NOSUBTYPE;
res.v_type = V_NUM;
res.v_num = qbern(vp->v_num->num);
if (res.v_num == NULL)
return error_value(E_BERN);
return res;
}
static VALUE
f_freebern(void)
{
VALUE res;
qfreebern();
res.v_type = V_NULL;
res.v_subtype = V_NOSUBTYPE;
return res;
}
static VALUE
f_euler(VALUE *vp)
{
VALUE res;
if (vp->v_type!=V_NUM || qisfrac(vp->v_num))
return error_value(E_EULER);
res.v_subtype = V_NOSUBTYPE;
res.v_type = V_NUM;
res.v_num = qeuler(vp->v_num->num);
if (res.v_num == NULL)
return error_value(E_EULER);
return res;
}
static VALUE
f_freeeuler(void)
{
VALUE res;
qfreeeuler();
res.v_type = V_NULL;
res.v_subtype = V_NOSUBTYPE;
return res;
}
static VALUE
f_catalan(VALUE *vp)
{
VALUE res;
if (vp->v_type!=V_NUM || qisfrac(vp->v_num) || zge31b(vp->v_num->num))
return error_value(E_CTLN);
res.v_type = V_NUM;
res.v_subtype = V_NOSUBTYPE;
res.v_num = qcatalan(vp->v_num);
if (res.v_num == NULL)
return error_value(E_CTLN);
return res;
}
static VALUE
f_arg(int count, VALUE **vals)
{
@@ -3488,24 +3656,82 @@ f_polar(int count, VALUE **vals)
}
static NUMBER *
f_ilog(NUMBER *val1, NUMBER *val2)
static VALUE
f_ilog(VALUE *v1, VALUE *v2)
{
return itoq(qilog(val1, val2));
VALUE res;
if (v2->v_type != V_NUM || qisfrac(v2->v_num) || qiszero(v2->v_num) ||
qisunit(v2->v_num))
return error_value(E_ILOGB);
switch(v1->v_type) {
case V_NUM:
res.v_num = qilog(v1->v_num, v2->v_num->num);
break;
case V_COM:
res.v_num = cilog(v1->v_com, v2->v_num->num);
break;
default:
return error_value(E_ILOG);
}
if (res.v_num == NULL)
return error_value(E_LOGINF);
res.v_type = V_NUM;
res.v_subtype = V_NOSUBTYPE;
return res;
}
static NUMBER *
f_ilog2(NUMBER *val)
static VALUE
f_ilog2(VALUE *vp)
{
return itoq(qilog2(val));
VALUE res;
switch(vp->v_type) {
case V_NUM:
res.v_num = qilog(vp->v_num, _two_);
break;
case V_COM:
res.v_num = cilog(vp->v_com, _two_);
break;
default:
return error_value(E_ILOG2);
}
if (res.v_num == NULL)
return error_value(E_LOGINF);
res.v_type = V_NUM;
res.v_subtype = V_NOSUBTYPE;
return res;
}
static NUMBER *
f_ilog10(NUMBER *val)
static VALUE
f_ilog10(VALUE *vp)
{
return itoq(qilog10(val));
VALUE res;
switch(vp->v_type) {
case V_NUM:
res.v_num = qilog(vp->v_num, _ten_);
break;
case V_COM:
res.v_num = cilog(vp->v_com, _ten_);
break;
default:
return error_value(E_ILOG10);
}
if (res.v_num == NULL)
return error_value(E_LOGINF);
res.v_type = V_NUM;
res.v_subtype = V_NOSUBTYPE;
return res;
}
@@ -6459,6 +6685,19 @@ f_isatty(VALUE *vp)
}
static VALUE
f_calc_tty(void)
{
VALUE res;
if (!calc_tty(FILEID_STDIN))
return error_value(E_TTY);
res.v_type = V_NULL;
res.v_subtype = V_NOSUBTYPE;
return res;
}
static VALUE
f_inputlevel (void)
{
@@ -6651,6 +6890,48 @@ f_system(VALUE *vp)
}
static VALUE
f_sleep(int count, VALUE **vals)
{
long time;
VALUE res;
NUMBER *q1, *q2;
res.v_type = V_NULL;
if (count > 0) {
if (vals[0]->v_type != V_NUM || qisneg(vals[0]->v_num))
return error_value(E_SLEEP);
if (qisint(vals[0]->v_num)) {
if (zge31b(vals[0]->v_num->num))
return error_value(E_SLEEP);
time = ztoi(vals[0]->v_num->num);
time = sleep(time);
}
else {
q1 = qscale(vals[0]->v_num, 20);
q2 = qint(q1);
qfree(q1);
if (zge31b(q2->num)) {
qfree(q2);
return error_value(E_SLEEP);
}
time = ztoi(q2->num);
qfree(q2);
/* BSD 4.3 usleep has void return */
usleep(time);
return res;
}
} else {
time = sleep(1);
}
if (time) {
res.v_type = V_NUM;
res.v_num = itoq(time);
}
return res;
}
/*
* set the default output base/mode
*/
@@ -7493,6 +7774,8 @@ static CONST struct builtin builtins[] = {
"arithmetic mean of values"},
{"base", 0, 1, 0, OP_NOP, f_base, 0,
"set default output base"},
{"bernoulli", 1, 1, 0, OP_NOP, 0, f_bern,
"Bernoulli number for index a"},
{"bit", 2, 2, 0, OP_BIT, 0, 0,
"whether bit b in value a is set"},
{"blk", 0, 3, 0, OP_NOP, 0, f_blk,
@@ -7509,6 +7792,10 @@ static CONST struct builtin builtins[] = {
"truncate a to b number of binary places"},
{"calclevel", 0, 0, 0, OP_NOP, 0, f_calclevel,
"current calculation level"},
{"calc_tty", 0, 0, 0, OP_NOP, 0, f_calc_tty,
"set tty for interactivity"},
{"catalan", 1, 1, 0, OP_NOP, 0, f_catalan,
"catalan number for index a"},
{"ceil", 1, 1, 0, OP_NOP, 0, f_ceil,
"smallest integer greater than or equal to number"},
{"cfappr", 1, 3, 0, OP_NOP, f_cfappr, 0,
@@ -7521,7 +7808,7 @@ static CONST struct builtin builtins[] = {
"command buffer"},
{"cmp", 2, 2, 0, OP_CMP, 0, 0,
"compare values returning -1, 0, or 1"},
{"comb", 2, 2, 0, OP_NOP, qcomb, 0,
{"comb", 2, 2, 0, OP_NOP, 0, f_comb,
"combinatorial number a!/b!(a-b)!"},
{"config", 1, 2, 0, OP_SETCONFIG, 0, 0,
"set or read configuration value"},
@@ -7555,10 +7842,10 @@ static CONST struct builtin builtins[] = {
"denominator of fraction"},
{"det", 1, 1, 0, OP_NOP, 0, f_det,
"determinant of matrix"},
{"digit", 2, 2, 0, OP_NOP, f_digit, 0,
{"digit", 2, 3, 0, OP_NOP, 0, f_digit,
"digit at specified decimal place of number"},
{"digits", 1, 1, 0, OP_NOP, f_digits, 0,
"number of digits in number"},
{"digits", 1, 2, 0, OP_NOP, 0, f_digits,
"number of digits in base b representation of a"},
{"display", 0, 1, 0, OP_NOP, 0, f_display,
"number of decimal digits for displaying numbers"},
{"dp", 2, 2, 0, OP_NOP, 0, f_dp,
@@ -7573,6 +7860,8 @@ static CONST struct builtin builtins[] = {
"set or read calc_errno"},
{"error", 0, 1, 0, OP_NOP, 0, f_error,
"generate error value"},
{"euler", 1, 1, 0, OP_NOP, 0, f_euler,
"Euler number"},
{"eval", 1, 1, 0, OP_NOP, 0, f_eval,
"evaluate expression from string to value"},
{"exp", 1, 2, 0, OP_NOP, 0, f_exp,
@@ -7623,6 +7912,10 @@ static CONST struct builtin builtins[] = {
"write one or more null-terminated strings to a file"},
{"free", 0, IN, FA, OP_NOP, 0, f_free,
"free listed or all global variables"},
{"freebernoulli", 0, 0, 0, OP_NOP, 0, f_freebern,
"free stored Benoulli numbers"},
{"freeeuler", 0, 0, 0, OP_NOP, 0, f_freeeuler,
"free stored Euler numbers"},
{"freeglobals", 0, 0, 0, OP_NOP, 0, f_freeglobals,
"free all global and visible static variables"},
{"freeredc", 0, 0, 0, OP_NOP, 0, f_freeredc,
@@ -7663,11 +7956,11 @@ static CONST struct builtin builtins[] = {
"v mod h*2^n+r, h>0, n>0, r = -1, 0 or 1"},
{"hypot", 2, 3, FE, OP_NOP, qhypot, 0,
"hypotenuse of right triangle within accuracy c"},
{"ilog", 2, 2, 0, OP_NOP, f_ilog, 0,
"integral log of one number with another"},
{"ilog10", 1, 1, 0, OP_NOP, f_ilog10, 0,
{"ilog", 2, 2, 0, OP_NOP, 0, f_ilog,
"integral log of a to integral base b"},
{"ilog10", 1, 1, 0, OP_NOP, 0, f_ilog10,
"integral log of a number base 10"},
{"ilog2", 1, 1, 0, OP_NOP, f_ilog2, 0,
{"ilog2", 1, 1, 0, OP_NOP, 0, f_ilog2,
"integral log of a number base 2"},
{"im", 1, 1, 0, OP_IM, 0, 0,
"imaginary part of complex number"},
@@ -7833,8 +8126,8 @@ static CONST struct builtin builtins[] = {
"value of pi accurate to within epsilon"},
{"pix", 1, 2, 0, OP_NOP, f_pix, 0,
"number of primes <= a < 2^32, return b if error"},
{"places", 1, 1, 0, OP_NOP, f_places, 0,
"places after decimal point (-1 if infinite)"},
{"places", 1, 2, 0, OP_NOP, 0, f_places,
"places after \"decimal\" point (-1 if infinite)"},
{"pmod", 3, 3, 0, OP_NOP, qpowermod,0,
"mod of a power (a ^ b (mod c))"},
{"polar", 2, 3, 0, OP_NOP, 0, f_polar,
@@ -7937,6 +8230,8 @@ static CONST struct builtin builtins[] = {
"total number of elements in value"},
{"sizeof", 1, 1, 0, OP_NOP, 0, f_sizeof,
"number of octets used to hold the value"},
{"sleep", 0, 1, 0, OP_NOP, 0, f_sleep,
"suspend operatioo for a seconds"},
{"sort", 1, 1, 0, OP_NOP, 0, f_sort,
"sort a copy of a matrix or list"},
{"sqrt", 1, 3, 0, OP_NOP, 0, f_sqrt,

59
have_fpos_pos.c Normal file
View File

@@ -0,0 +1,59 @@
/*
* have_fpos_pos - Determine if a __pos element in FILEPOS
*
* 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: have_fpos_pos.c,v 29.1 2000/12/17 11:25:22 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/have_fpos_pos.c,v $
*
* Under source code control: 2000/12/17 01:23
* File existed as early as: 2000
*
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/
/*
* If the symbol HAVE_NO_FPOS is defined, we will output nothing.
* If the HAVE_FILEPOS_SCALAR is defuned, we will output nothing.
* If we are able to compile this program, then we must have the
* __pos element in a non-scalar FILEPOS.
*/
#include <stdio.h>
#include "have_fpos.h"
#include "have_posscl.h"
int
main(void)
{
#if !defined(HAVE_NO_FPOS) && !defined(HAVE_FILEPOS_SCALAR)
fpos_t pos; /* file position */
/* print a __pos element in fpos_t */
printf("#undef HAVE_FPOS_POS\n");
printf("#define HAVE_FPOS_POS 1 /* yes */\n\n");
/* determine __pos element size */
printf("#undef FPOS_POS_BITS\n");
printf("#define FPOS_POS_BITS %d\n\n", sizeof(pos.__pos)*8);
#endif
/* exit(0); */
return 0;
}

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.3 $
# @(#) $Id: Makefile,v 29.3 2000/06/07 14:02:33 chongo Exp $
# @(#) $Revision: 29.5 $
# @(#) $Id: Makefile,v 29.5 2000/12/14 10:33:06 chongo Exp $
# @(#) $Source: /usr/local/src/cmd/calc/help/RCS/Makefile,v $
#
# Under source code control: 1991/07/23 06:47:57
@@ -140,30 +140,31 @@ 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 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 \
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 \
push putenv quo quomod rand randbit random randombit randperm rcin \
rcmul rcout rcpow rcsq re remove reverse rewind rm root round rsearch \
runtime saveval scale scan scanf search sec sech seed segment select \
sgn sha sha1 sin sinh size sizeof sort sqrt srand srandom ssq str \
strcat strerror strlen strpos strprintf strscan strscanf substr \
sum swap system tail tan tanh test time trunc xor
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
# This list is of files that are clones of DETAIL_HELP files. They are
# built from DETAIL_HELP files.

67
help/bernoulli Normal file
View File

@@ -0,0 +1,67 @@
NAME
bernoulli - Bernoulli number
SYNOPSIS
bernoulli(n)
TYPES
n integer, n < 2^31 if even
return rational
DESCRIPTION
Returns the Bernoulli number with index n, i.e. the coefficient B_n in
the expansion
t/(exp(t) - 1) = Sum B_n * t^n/n!
bernouuli(n) is zero both for n < 0 and for n odd and > 2.
When bernoulli(n) is computed for positive even n, the values for
n and smaller positive even indices are stored in a table so that
a later call to bernoulli(k) with 0 <= k < n will be executed quickly.
Considerable runtime and memory are required for calculating
bernoulli(n) for large even n. For n = 1000, the numerator has
1779 digits, the denominator 9 digits.
The memory used to store calculated bernoulli numbers is freed by
freebernoulli().
EXAMPLE
> config("mode", "frac"),;
> for (n = 0; n <= 6; n++) print bernoulli(n),; print;
1 -1/2 1/6 0 -1/30 0 1/42
LIMITS
n < 2^31-1
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.4 $
## @(#) $Id: bernoulli,v 29.4 2000/12/17 12:27:58 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 Normal file
View File

@@ -0,0 +1,52 @@
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 Normal file
View File

@@ -0,0 +1,63 @@
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.2 $
## @(#) $Id: catalan,v 29.2 2000/12/17 12:27:58 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,121 +1,197 @@
Function definitions
NAME
define - command keyword to start a function definition
Function definitions are introduced by the 'define' keyword.
Other than this, the basic structure of an ordinary definition
is like in that in C: parameters are specified for the function
within parenthesis, the function body is introduced by a left brace,
variables may declared for the function, statements implementing the
function may follow, any value to be returned by the function is specified
by a return statement, and the function definition is ended with a
right brace.
SYNTAX
define fname([param_1 [= default_1], ...]) = [expr]
define fname([param_1 [= default_1], ...]) { [statement_1 ... ] }
There are some subtle differences, however. The types of parameters
and variables are not defined at compile time, and may vary during
execution and be different in different calls to the function. For
example, a two-argument function add may be defined by
TYPES
fname identifier, not a builtin function name
param_1, ... identifiers, no two the same
default_1, ... expressions
expr expression
statement_1, ... statements
define add(a,b) {
return a + b;
}
DESCRIPTION
The intention of a function definition is that the identifier fname
becomes the name of a function which may be called by an expression
of the form fname(arg_1, arg_2, ...), where arg_1, arg_2, ... are
expressions (including possibly blanks, which are treated as
null values). Evaluation of the function begins with evaluation
of arg_1, arg_2, ...; then, in increasing order of i, if arg_i is
null-valued and "= default_i" has been included in the definition,
default_i is evaluated and its value becomes the value of arg_i.
The instructions in expr or the listed statements are then executed
with each occurrence of param_i replaced by the value obtained
for arg_i.
and be called with integer, fractional, or complex number values for a
and b, or, under some compatibility conditions, matrices or objects.
Any variable, not already defined as global, used in a definition has
to be declared as local, global or static, and retains this character
until its scope is terminated by the end of the definition, the end of
the file being read or some other condition (see help variable for
details).
In a call, arg_i may be preceded by a backquote (`) to indicate that
evaluation of arg_i is not to include a final evaluation of an lvalue.
For example, suppose a function f and a global variable A have been
defined by:
For example, the following function computes the factorial of n, where
we may suppose it is to be called only with positive integral values
for n:
define f(x) = (x = 3);
global mat A[3];
define factorial(n)
{
local ans;
If g() is a function that evaluates to 2:
ans = 1;
while (n > 1)
ans *= n--;
return ans;
}
f(A[g()]);
(In calc, this definition is unncessary since there is a built-in
function fact(n), also expressible as n!, which returns the factorial
of n.)
assigns the value of A[2] to the parameter x and then assigns the
value 3 to x:
Any functions used in the body of the definition need not have already
been defined; it is sufficient that they have been defined when they are
encountered during evaluation when the function is called.
f(`A[g()]);
If a function definition is sufficiently simple and does not require
local or static variables, it may be defined in shortened manner by
using an equals sign following by an expression involving some or all
of the parameters and already existing global variables.
has essentially the effect of assigning A[2] as an lvalue to x and
then assigning the value 3 to A[2]. (Very old versions of calc
achieved the same result by using '&' as in f(&A[g()]).)
In this case, the definition is terminated by a newline character
(which may be preceded by a semicolon), and the value the function
returns when called will be determined by the specified expression.
Loops and "if" statements are not allowed (but ? : expressions and the
logical operators ||, && and ! are permitted). As an example, the
average of two numbers could be defined as:
The number of arguments arg_1, arg_2, ... in a call need not equal the
number of parameters. If there are fewer arguments than parameters,
the "missing" values are assigned the null value.
define average(a, b) = (a + b) / 2;
In the definition of a function, the builtin function param(n)
provides a way of referring to the parameters. If n (which may
result from evaluating an expreession) is zero, it returns the number
of arguments in a call to the function, and if 1 <= n <= param(0),
param(n) refers to the parameter with index n.
(Again, this function is not necessary, as the same result is
returned by the builtin function avg() when called with the
two arguments a, b.)
If no error occurs and no quit statement or abort statement is
encountered during evaluation of the expression or the statements,
the function call returns a value. In the expression form, this is
simply the value of the expression.
Function definitions can be very complicated. Functions may be
defined on the command line if desired, but editing of partial
functions is not possible past a single line. If an error is made
on a previous line, then the function must be finished (with probable
errors) and reentered from the beginning. Thus for complicated
functions, it is best to use an editor to create the definition in a
file, and then enter the calculator and read in the file containing
the definition.
In the statement form, if a return statement is encountered,
the "return" keyword is to be either immediately followed by an
expression or by a statement terminator (semicolon or rightbrace);
in the former case, the expression is evaluated, evaluation of
the function ceases, and the value obtained for the expression is
returned as the "value of the function"; in the no-expression case,
evaluation ceases immediately and the null-value is returned.
The parameters of a function can be referenced by name, as in
normal C usage, or by using the 'param' function. This function
returns the specified parameter of the function it is in, where
the parameters are numbered starting from 1. The total number
of parameters to the function is returned by using 'param(0)'.
Using this function allows you to implement varargs-like routines
which can handle up to 100 calling parameters. For example:
In the expression form of definition, the end of the expression expr
is to be indicated by either a semicolon or a newline not within
a part enclosed by parentheses; the definition may extend over
several physical lines by ending each line with a '\' character or by
enclosing the expression in parentheses. In interactive mode, that
a definition has not been completed is indicated by the continuation
prompt. A ctrl-C interrupt at this stage will abort the definition.
define sc()
{
local s, i;
If the expr is omitted from an expression definition, as in:
s = 0;
for (i = 1; i <= param(0); i++)
s += param(i)^3;
return s;
}
define h() = ;
defines a function which returns the sum of the cubes of all its
parameters.
any call to the function will evaluate the arguments and return the
null value.
Any identifier other than a reserved word (if, for, etc.) and the
name of a builtin function (abs, fact, sin, etc.) can be used when
defining a new function or redefining an existing function.
In the statement form, the definition ends when a matching right
brace completes the "block" started by the initial left brace.
Newlines within the block are treated as white space; statements
within the block end with a ';' or a '}' matching an earlier '{'.
An indication of how a user-defined function is stored may be obtained
by using the "show opcodes" command. For example:
If a function with name fname had been defined earlier, the old
definition has no effect on the new definition, but if the definition
is completed successfully, the new definition replaces the old one;
otherwise the old definition is retained. The number of parameters
and their names in the new definiton may be quite different from
those in the old definition.
> global alpha
> define f(x) = 5 + alpha * x
"f" defined
> show opcodes f
0: NUMBER 5
2: GLOBALADDR alpha
4: PARAMADDR 0
6: MUL
7: ADD
8: RETURN
An attempt at a definition may fail because of scanerrors as the
definition is compiled. Common causes of these are: bad syntax,
using identifiers as names of variables not yet defined. It is
not a fault to have in the definition a call to a function that has
not yet been defined; it is sufficient that the function has been
defined when a call is made to the function.
After fname has been defined, the definition may be removed by the command:
## Copyright (C) 1999 Landon Curt Noll
undefine fname
The definitions of all user-defined functions may be removed by:
undefine *
If bit 0 of config("resource_debug") is set and the define command is
at interactive level, a message saying that fname has been defined
or redefined is displayed. The same message is displayed if bit 1
of config("resource_debug") is set and the define command is read
from a file.
The identifiers used for the parameters in a function definition do
not form part of the completed definition. For example,
define f(a,b) = a + b;
define g(alpha, beta) = alpha + beta;
result in identical code for the functions f, g.
If config("trace") & 8 is nonzero, the opcodes of a newly defined
function are displayed on completion of its definition, parameters
being specified by names used in the definition. For example:
> config("trace", 8),
> define f(a,b) = a + b
0: PARAMADDR a
2: PARAMADDR b
4: ADD
5: RETURN
f(a,b) defined
The opcodes may also be displayed later using the show opcodes command;
parameters will be specified by indices instead of by names. For example:
> show opco f
0: PARAMADDR 0
2: PARAMADDR 1
4: ADD
5: RETURN
When a function is defined by the statement mode, the opcodes normally
include DEBUG opcodes which specify statement boundaries at which
SIGINT interruptions are likely to be least risky. Inclusion of
the DEBUG opcodes is disabled if config("trace") & 2 is nonzero.
For details, see help interrupt.
While config("trace") & 1 is nonzero, the opcodes are displayed as
they are being evaluated. The current function is identified by its
name, or "*" in the case of a command-line and "**" in the case of
an eval(str) evaluation.
When a function is called, argument values may be of any type for
which the operations and any functions used within the body of the
definition can be executed. For example, whatever the intention at
the time they were defined, the functions f1(), f2() defined above
may be called with integer, fractional, or complex-number values, or
with both arguments strings, or under some compatibility conditions,
matrices or objects.
EXAMPLE
> define f(a,b) = 2*a + b;
> define g(alpha, beta)
>> {
>> local a, pi2;
>>
>> pi2 = 2 * pi();
>> a = sin(alpha % pi2);
>> if (a > 0.0) {
>> return a*beta;
>> }
>> if (beta > 0.0) {
>> a *= cos(-beta % pi2);
>> }
>> return a;
>> }
LIMITS
The number of arguments in a function-call cannot exceed 100.
LIBRARY
none
SEE ALSO
param, variable, undefine, show
## Copyright (C) 2000 David I. Bell, Landon Curt Noll and Ernest Bowen
##
## Calc is open software; you can redistribute it and/or modify it under
## the terms of the version 2.1 of the GNU Lesser General Public License
@@ -131,10 +207,11 @@ Function definitions
## 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: define,v 29.2 2000/06/07 14:02:33 chongo Exp $
## @(#) $Revision: 29.3 $
## @(#) $Id: define,v 29.3 2000/07/17 15:36:26 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,38 +1,93 @@
NAME
digit - digit at specified position in a decimal representation
digit - digit at specified position in a "decimal" representation
SYNOPSIS
digit(x, y)
digit(x, n [, b])
TYPES
x real
y integer
n integer
b integer >= 2, default = 10
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_2 d_1 d_0.d_-1 d_-2 ...
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.
digit(x,y) then returns the digit d_y.
EXAMPLE
> x = 12.34
> print digit(x,2), digit(x,1), digit(x,0), digit(x,-1), digit(x,-2)
0 1 2 3 4
> 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 = 10/7
> print digit(x,1), digit(x,0), digit(x,-1), digit(x,-2), digit(x,-3)
0 1 4 2 8
> 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
LIMITS
If x is not an integer, y > -2^31
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.
LINK LIBRARY
long qdigit(NUMBER *x, long y)
NUMBER * qdigit(NUMBER *q, ZVALUE dpos, ZVALUE base)
SEE ALSO
bit
@@ -53,8 +108,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.2 $
## @(#) $Id: digit,v 29.2 2000/06/07 14:02:33 chongo Exp $
## @(#) $Revision: 29.4 $
## @(#) $Id: digit,v 29.4 2000/12/17 12:27:58 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,30 +1,36 @@
NAME
digits - return number of digits in an integer or integer part
digits - return number of "decimal" digits in an integral part
SYNOPSIS
digits(x)
digits(x [,b])
TYPES
x real
b integer >= 2, defaults to 10
return integer
DESCRIPTION
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).
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).
EXAMPLE
> print digits(0), digits(0.0123), digits(3.7), digits(-27), digits(-99.7)
1 1 1 2 2
0 0 1 2 2
LIMITS
none
LINK LIBRARY
long qdigits(NUMBER *x)
long qdigits(NUMBER *q, ZVALUE base)
SEE ALSO
places
digit, places
## Copyright (C) 1999 Landon Curt Noll
##
@@ -42,8 +48,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.2 $
## @(#) $Id: digits,v 29.2 2000/06/07 14:02:33 chongo Exp $
## @(#) $Revision: 29.3 $
## @(#) $Id: digits,v 29.3 2000/12/14 10:32:24 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 Normal file
View File

@@ -0,0 +1,63 @@
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.2 $
## @(#) $Id: euler,v 29.2 2000/12/17 12:27:58 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 Normal file
View File

@@ -0,0 +1,49 @@
NAME
freebernoulli - free stored Benoulli numbers
SYNOPSIS
freebernoulli()
TYPES
return none
DESCRIPTION
The memory used to store calculated bernoulli numbers is freed by
freebernoulli().
EXAMPLE
> freebernoulli();
LIMITS
none
LINK LIBRARY
void qfreebern(void);
SEE ALSO
bernoulli
## Copyright (C) 2000 Ernest Bowen
##
## Calc is open software; you can redistribute it and/or modify it under
## the terms of the version 2.1 of the GNU Lesser General Public License
## as published by the Free Software Foundation.
##
## Calc is distributed in the hope that it will be useful, but WITHOUT
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
## Public License for more details.
##
## A copy of version 2.1 of the GNU Lesser General Public License is
## distributed with calc under the filename COPYING-LGPL. You should have
## received a copy with calc; if not, write to Free Software Foundation, Inc.
## 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
##
## @(#) $Revision: 29.2 $
## @(#) $Id: 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 Normal file
View File

@@ -0,0 +1,49 @@
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,10 +15,13 @@ Interrupts
[Abort level n]
where n ranges from 1 to 3. For n equal to 1, the calculator will
abort calculations at the next statement boundary. For n equal to 2,
the calculator will abort calculations at the next opcode boundary.
For n equal to 3, the calculator will abort calculations at the next
lowest level arithmetic operation boundary.
abort calculations at the next statement boundary specified by an
ABORT opcode as described below. For n equal to 2, the calculator
will abort calculations at the next opcode boundary. For n equal to 3,
the calculator will abort calculations at the next attempt to allocate
memory for the result of an integer arithmetic operation; this
level may be appropriate for stopping a builtin operation like
inversion of a large matrix.
If a final interrupt is given when n is 3, the calculator will
immediately abort the current calculation and longjmp back to the
@@ -27,8 +30,77 @@ Interrupts
be done as a last resort. You are advised to quit the calculator
after this has been done.
## Copyright (C) 1999 Landon Curt Noll
##
ABORT opcodes
If config("trace") & 2 is zero, ABORT opcodes are introduced at
various places in the opcodes for evaluation of command lines
and functions defined by "define ... { ... }" commands. In the
following, config("trace") has been set equal to 8 so that opcodes
are displayed when a function is defined. The function f(x)
evaluates x + (x - 1) + (x - 2) + ... until a zero term is
encountered. If f() is called with a negative or fractional x,
the calculation is never completed and to stop it, an interruption
(on many systems, by ctrl-C) will be necessary.
> config("trace", 8),
> define f(x) {local s; while (x) {s += x--} return s}
0: DEBUG line 2
2: PARAMADDR x
4: JUMPZ 19
6: DEBUG line 2
8: LOCALADDR s
10: DUPLICATE
11: PARAMADDR x
13: POSTDEC
14: POP
15: ADD
16: ASSIGNPOP
17: JUMP 2
19: DEBUG line 2
21: LOCALADDR s
23: RETURN
f(x) defined
(The line number following DEBUG refers to the line in the file
from which the definition is read.) If an attempt is made to
evaluate f(-1), the effect of the DEBUG at opcode 6 ensures that
a single SIGINT will stop the calculation at a start of
{s += x--} loop. In interactive mode, with ^C indicating
input of ctrl-C, the displayed output is as in:
> f(-1)
^C
[Abort level 1]
"f": line 2: Calculation aborted at statement boundary
The DEBUG opcodes are disabled by nonzero config("trace") & 2.
Changing config("trace") to achieve this, and defining g(x) with
the same definition as for f(x) gives:
> define g(x) {local s; while (x) {s += x--} return s}
0: PARAMADDR x
2: JUMPZ 15
4: LOCALADDR s
6: DUPLICATE
7: PARAMADDR x
9: POSTDEC
10: POP
11: ADD
12: ASSIGNPOP
13: JUMP 0
15: LOCALADDR s
17: RETURN
g(x) defined
If g(-1) is called, two interrupts are necessary, as in:
> g(-1)
^C
[Abort level 1]
^C
[Abort level 2]
"g": Calculation aborted in opcode
## Calc is open software; you can redistribute it and/or modify it under
## the terms of the version 2.1 of the GNU Lesser General Public License
## as published by the Free Software Foundation.
@@ -43,8 +115,8 @@ Interrupts
## 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: interrupt,v 29.2 2000/06/07 14:02:33 chongo Exp $
## @(#) $Revision: 29.4 $
## @(#) $Id: interrupt,v 29.4 2000/07/17 15:38:52 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,34 +1,41 @@
NAME
places - return number of decimal places
places - return number of "decimal" places in a fractional part
SYNOPSIS
places(x)
places(x [,b])
TYPES
x real
b integer >= 2, defaults to 10
return integer
DESCRIPTION
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.
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 does not have a finite decimal representation, places(x) returns -1.
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.
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 *x)
long qplaces(NUMBER *q, ZVALUE base)
SEE ALSO
digits
digit, digits
## Copyright (C) 1999 Landon Curt Noll
##
@@ -46,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.2 $
## @(#) $Id: places,v 29.2 2000/06/07 14:02:33 chongo Exp $
## @(#) $Revision: 29.4 $
## @(#) $Id: places,v 29.4 2000/12/17 12:27:58 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,62 +1,264 @@
Calc shell scripts
------------------
If an executable file begins with:
There are several ways calc may be used in shell scripts. The
syntax for these varies widely for different shells and systems,
but common to most are commands like echo, if, for, goto, shift,
and exit, as well as the accessing of environment parameters, shell
variables, and command-line arguments.
#!/usr/local/bin/calc -S [-other_flags ...]
As a simple example, assuming a C or Bourne shell, let add be a
file containing just one line:
the rest of the file will be processed in shell script mode.
Note that -S (UPPER CASE -S) must be the first -flag on the
``#!'' line. Any other optional ``-other_flags'' must come
after the -S.
calc -q -- $1 + $2
In shell script mode the contents of the file are evaluated
and executed as if they were processed by the read command.
Any optional ``-other_flags'' will by parsed first followed
by any arguments given shell script itself.
Then:
In shell script mode, -s (lower case -s) is always assumed.
In addition, -d and -p are automatically set if -i is not
given.
./add 1.23 4.56
For example, if the file /tmp/mersenne:
should respond with the display of:
#!/usr/local/bin/calc -S -q
#
# mersenne - an example of a calc shell script file
5.9
/* parse args */
if (argv() != 1) {
fprintf(files(2), "usage: %s exp\n", config("program"));
abort "must give one exponent arg";
}
The "-q" was included in the command to avoid reading of any
start-up calc files which could contain commands not wanted
here. The "--" indicates that there are no more options;
without it, if $1 began with '-', calc would interpret it as
the first character of another option. To execute the file,
the strings "1.23" and "4.56" were assigned to $1 and $2, so
calc was in effect asked to evaluate the string "1.23 + 4.56".
/* print the mersenne number */
print "2^": argv(0) : "-1 =", 2^eval(argv(0))-1;
By making add executable by a command like:
is made an executable file by:
chmod u+x add
chmod +x /tmp/mersenne
the command used here may be simplified to:
then the command line:
./add 1.23 4.56
/tmp/mersenne 127
Here we shall assume that any script we refer to has been made
executable in this way.
will print:
Because $1 and $2, and instructions in the script, are to read
by calc as expressions or commands, they may be much more
complicated than in the above example, but if they involve
characters with special interpretations by the shell (spaces
for word separation, * or ? or [ ...] for file-name expansion,
! (without immediately following space) for history expansion,
( ... ) for shell-function arguments, { ... } for brace
expansion, $ for parameter or variable expansion, <, <<, >, >>
for redirection of input or output, etc.) it will usually be
necessary to quote or escape tho characters, or usually more
conveniently, quote whole expressions with single or double
quotes.
2^127-1 = 170141183460469231731687303715884105727
For example, the add script should have no problem with
commands like:
Note that because -s is assumed in shell script mode and
non-dashed args are made available as strings via the argv()
builtin function. Therefore:
./add "sqrt(2)" "3 * 4"
2^eval(argv(0))-1
./add "mat A[2,2] = {1,2,3,4}" "A^2"
will print the decimal value of 2^n-1 but
./add "2 + 3i" "(3 + 4i)^2"
2^argv(0)-1
If the shell arguments are to be integers, one could use
scripts like the following with arithmetic expansion
for the bash and ksh:
will not.
declare -i a=$1
declare -i b=$2
calc -q -- $a + $b
and for csh:
@ a = $1
@ b = $2
calc -q -- $a + $b
Specifying the shell for a script may be done by including
in the script a first line with the "magic number" "#!" and
the full file path for the shell as in:
#!/bin/bash
declare -i a=$1
declare -i b=$2
calc -q -- $a + $b
For a script to multiply rather than add two expressions, one
could have a file mul with the one line:
calc -q -- $1 \* $2
or:
calc -q -- "$1 * $2"
which will work so long as $1 and $2 are literal numbers, but
will not work for:
./mul 2+3 4
or:
./mul "2 + 3" 4
both of which calc interprets as evaluating 2 + 3 * 4. What should
work for most shells is:
calc -q -- "($1) * ($2)"
For adding an arbitrary number of expressions that evaluate to
rational numbers expressible with at most 20 decimal places,
simple shell script could be used:
s=0
for i do
s=`calc -q -- $s + $i`
done
echo sum = $s
This is not particularly efficient since it calls calc once for
each argument. Also, a more serious script would permit more
general numbers.
Another way of handling a sum of several expressions is with
the script addall2 with a here document:
calc "-q -s" $* << +
global i, n, s;
n = argv();
for (i = 0; i < n; i++)
s += eval(argv(i));
print "sum =", s;
+
In executing the command:
./addall2 2 3 4
the $* in ths script expands to 2 3 4, and because of the "-s"
in the options, calc starts with argv(0) = "2", argv(1) = "3",
argv(2)= "4". As there is only one calc process involved and
the eval() function accepts as argument any string that
represents the body of a calc function, the strings argv(0),
argv(1), ... could evaluate to any value types for which the
additions to be performed are defined, and variables defined in
one argv() can be used in later arguments.
For systems that support interpreter files, essentially the
same thing may be done more efficiently by using calc as an
interpreter. Assuming the full path for calc is
/usr/bin/calc, one could use the file addall3 with contents
#!/usr/bin/calc -q -s -f
global i, n, s;
n = argv();
for (i = 1; i <= n; i++)
s += eval(argv(i));
print "sum =", s;
After the command:
addall3 2 3 4
the arguments calc receives are argv(0) = "addall3", argv(1) =
"2", argv(3) = "3", argv(4) = "4".
Another kind of script that can be useful is sqrts1:
calc -q 'global s; while (scanf("%s", s) == 1) print sqrt(eval(s));'
or what is essentially an interpreter equivalent sqrts2:
#!/usr/bin/calc -q -f
global s;
while (scanf('%s', s) == 1)
print sqrt(eval(s));
If sqrts is either of these scripts, the command:
echo 27 2+3i | sqrts
or, if datafile contains the one line:
27 2+3i
or the two lines:
27
2+3i
either:
cat datafile | ./sqrts
or:
./sqrts < datafile
should display the square-roots of 27 and 2+3i. The output could
be piped to another command by | or directed to a file by use of
> or >>.
With no specified input, either sqrts1 or sqrts2 will wait
without any prompt for input from the keyboard and as each line
is completed display the square-roots of the expressions
entered. Exit can be achieved by entering exit or entering
ctrl-D (interpreted as EOF) rather than a line of input.
One advantage of an interpreter file like sqrts2 (which has only
options, but neither "-s" nor "--" in its first line) is that it
can be invoked with further options as in
echo 2 3 4 | ./sqrts2 -i -D 32
An advantage of non-interpreter files is that they can use shell
features. For example, for unquoted arguments or arguments in
double quotes parameter expansion (indicated by unquoted '$') and
command substitution (using backquotes) occur before lines are
compiled by calc. For example, if doit is an executable
script with contents
calc -q -- "$1($2)"
it may be used as in:
./doit sqrt 7
and:
./doit exp 7
to display the values of sqrt(7) and exp(7). The "--" prevents a
leading '-' in the $1 argument as indicating one or more additional
options. E.g., without the "--" in doit,
./doit -sqrt 7
would be interpreted as:
calc -q "-sqrt(7)"
in which the dash in the quoted part would be taken as indicating a
list of options -s, -q, -r, etc.; this would give an "illegal option"
error as calc has no -r option.
In invoking the doit script it is not necessary that $1 expand to a
calc function name and $2 to an expression; all that is required is
that:
$1($2)
expands to a string that calc will recognize as a command. E.g.:
./doit "define f(x) = x^2; 2 + mod" "f(7), 6"
does the same as:
calc -q -- "define f(x) = x^2; 2 + mod(f(7), 6)"
Essentially the same is achieved by the contents of doit is changed to:
calc -q -p -- << +
$1($2)
+
The "-p" stops calc going interactive; without it the effect would be
be the same as that of a script with the one line:
calc -q -i -- "$1($2)"
For more information use the following calc commands:
@@ -65,7 +267,7 @@ For more information use the following calc commands:
help config
help cscript
## Copyright (C) 1999 Landon Curt Noll
## Copyright (C) 2000 Landon Curt Noll and Ernest Bowen
##
## Calc is open software; you can redistribute it and/or modify it under
## the terms of the version 2.1 of the GNU Lesser General Public License
@@ -81,8 +283,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.3 $
## @(#) $Id: script,v 29.3 2000/06/07 14:02:33 chongo Exp $
## @(#) $Revision: 29.4 $
## @(#) $Id: script,v 29.4 2000/07/17 15:36:26 chongo Exp $
## @(#) $Source: /usr/local/src/cmd/calc/help/RCS/script,v $
##
## Under source code control: 1999/11/30 05:29:48
@@ -90,3 +292,4 @@ For more information use the following calc commands:
##
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/

68
help/sleep Normal file
View File

@@ -0,0 +1,68 @@
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.2 $
## @(#) $Id: sleep,v 29.2 2000/12/17 12:27:58 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 - nsted input source file reader
* input - nested 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.2 $
* @(#) $Id: input.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $Revision: 29.3 $
* @(#) $Id: input.c,v 29.3 2000/07/17 15:35:49 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
* .
* extenstion
* extension
* \0
* guard byte
*/
@@ -261,7 +261,7 @@ homeexpand(char *name)
char *home2; /* fullpath of the home directory */
char *fullpath; /* the malloced expanded path */
char *after; /* after the ~user or ~ */
char *username; /* extratced username */
char *username; /* extracted username */
/* firewall */
if (name[0] != HOMECHAR)
@@ -873,7 +873,7 @@ findfreeread(void)
}
maxreadset += READSET_ALLOC;
/* return the furst newly allocated free entry */
/* return the first newly allocated free entry */
return maxreadset-READSET_ALLOC;
}

54
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.3 $
* @(#) $Id: lib_calc.c,v 29.3 2000/06/07 14:02:13 chongo Exp $
* @(#) $Revision: 29.4 $
* @(#) $Id: lib_calc.c,v 29.4 2000/07/17 15:35:49 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_UNKNOWN; /* calc startup and run state */
run run_state = RUN_ZERO; /* calc startup run state */
/*
@@ -165,7 +165,7 @@ static int init_done = 0; /* 1 => we already initialized */
static int *fd_setup = NULL; /* fd's setup for interaction or -1 */
static int fd_setup_len = 0; /* number of fd's in fd_setup */
static ttystruct *fd_orig = NULL; /* fd original state */
static ttystruct *fd_cur = NULL; /* fd current atate */
static ttystruct *fd_cur = NULL; /* fd current state */
static void initenv(void); /* setup calc environment */
static int find_tty_state(int fd); /* find slot for saved tty state */
@@ -314,7 +314,7 @@ initialize(void)
math_cleardiversions();
math_setfp(stdout);
math_setmode(MODE_INITIAL);
math_setdigits((long)DISPLAY_DEFAULT);
math_setdigits(DISPLAY_DEFAULT);
conf->maxprint = MAXPRINT_DEFAULT;
}
@@ -431,7 +431,7 @@ initenv(void)
*
* Anything that uses libcalc.a can call this function after they are
* completely finished with libcalc.a processing. The only effect of
* this funcion is to free storage that might otherwise go unused.
* this function is to free storage that might otherwise go unused.
*
* NOTE: If, for any reason, you need to do more libcalc.a processing,
* then you will need to call libcalc_call_me_first() again.
@@ -461,15 +461,13 @@ libcalc_call_me_last(void)
/*
* restore all changed descriptor states
*/
if (fd_setup_len > 0) {
for (i=0; i < fd_setup_len; ++i) {
if (fd_setup[i] >= 0) {
if (conf->calc_debug & CALCDBG_TTY)
printf("libcalc_call_me_last: fd %d "
"not in original state, "
"restoring it", fd_setup[i]);
orig_tty(fd_setup[i]);
}
for (i=0; i < fd_setup_len; ++i) {
if (fd_setup[i] >= 0) {
if (conf->calc_debug & CALCDBG_TTY)
printf("libcalc_call_me_last: fd %d "
"not in original state, "
"restoring it", fd_setup[i]);
orig_tty(fd_setup[i]);
}
}
@@ -488,24 +486,24 @@ char *
run_state_name(run state)
{
switch (state) {
case RUN_UNKNOWN:
return "RUN_UNKNOWN";
case RUN_ZERO:
return "ZERO";
case RUN_BEGIN:
return "RUN_BEGIN";
return "BEGIN";
case RUN_RCFILES:
return "RUN_RCFILES";
return "RCFILES";
case RUN_PRE_CMD_ARGS:
return "RUN_PRE_CMD_ARGS";
return "PRE_CMD_ARGS";
case RUN_CMD_ARGS:
return "RUN_CMD_ARGS";
return "CMD_ARGS";
case RUN_PRE_TOP_LEVEL:
return "RUN_PRE_TOP_LEVEL";
return "PRE_TOP_LEVEL";
case RUN_TOP_LEVEL:
return "RUN_TOP_LEVEL";
return "TOP_LEVEL";
case RUN_EXIT:
return "RUN_EXIT";
return "EXIT";
case RUN_EXIT_WITH_ERROR:
return "RUN_EXIT_WITH_ERROR";
return "EXIT_WITH_ERROR";
}
return "RUN_invalid";
}
@@ -579,7 +577,7 @@ find_tty_state(int fd)
}
/*
* case: need to initlally malloc some state
* case: need to initially malloc some state
*/
if (fd_setup_len <= 0 || fd_setup == NULL || fd_orig == NULL) {
@@ -835,8 +833,8 @@ orig_tty(int fd)
fd_cur[slot] = fd_orig[slot];
/*
* Since current state is the orignal state, we can free up
* this slot. This also prevents functins such as the
* Since current state is the original state, we can free up
* this slot. This also prevents functions such as the
* libcalc_call_me_last() function from re-restoring it.
*/
fd_setup[slot] = -1;

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.2 $
* @(#) $Id: opcodes.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $Revision: 29.3 $
* @(#) $Id: opcodes.c,v 29.3 2000/07/17 15:35:49 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 paramaeter index");
math_error("Bad parameter index");
/*NOTREACHED*/
}
args += index;
@@ -896,7 +896,7 @@ o_deref(void)
return;
}
if (stack->v_type != V_ADDR) {
math_error("Deferencing a non-variable");
math_error("Dereferencing a non-variable");
/*NOTREACHED*/
}
vp = vp->v_addr;
@@ -3228,8 +3228,8 @@ o_quit(FUNC *fp, long index)
freevalue(stack--);
}
freevalue(stackarray);
libcalc_call_me_last();
exit(0);
run_state = RUN_EXIT;
longjmp(jmpbuf, 1);
}
if (cp)
printf("%s\n", cp);
@@ -3512,10 +3512,10 @@ static struct opcode opcodes[MAX_OPCODE+1] = {
{o_nop, OPNUL, "NOP"}, /* no operation */
{o_localaddr, OPLOC, "LOCALADDR"}, /* address of local variable */
{o_globaladdr, OPGLB, "GLOBALADDR"}, /* address of global variable */
{o_paramaddr, OPPAR, "PARAMADDR"}, /* address of paramater variable */
{o_paramaddr, OPPAR, "PARAMADDR"}, /* address of parameter variable */
{o_localvalue, OPLOC, "LOCALVALUE"}, /* value of local variable */
{o_globalvalue, OPGLB, "GLOBALVALUE"}, /* value of global variable */
{o_paramvalue, OPPAR, "PARAMVALUE"}, /* value of paramater variable */
{o_paramvalue, OPPAR, "PARAMVALUE"}, /* value of parameter variable */
{o_number, OPONE, "NUMBER"}, /* constant real numeric value */
{o_indexaddr, OPTWO, "INDEXADDR"}, /* array index address */
{o_printresult, OPNUL, "PRINTRESULT"}, /* print result of top-level expression */

533
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.2 $
* @(#) $Id: qfunc.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $Revision: 29.4 $
* @(#) $Id: qfunc.c,v 29.4 2000/12/17 13:07:32 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/qfunc.c,v $
*
* Under source code control: 1990/02/15 01:48:20
@@ -34,10 +34,17 @@
#include "config.h"
#include "prime.h"
static NUMBER **B_table;
static long B_num;
static long B_allocnum;
static NUMBER **E_table;
static long E_num;
#define QALLOCNUM 64
/*
* Set the default precision for real calculations.
* The precision must be between zero and one.
* Set the default epsilon for approximate calculations.
* This must be greater than zero.
*
* given:
* q number to be set as the new epsilon
@@ -47,8 +54,8 @@ setepsilon(NUMBER *q)
{
NUMBER *old;
if (qisneg(q) || qiszero(q) || (qreli(q, 1L) >= 0)) {
math_error("Epsilon value must be between zero and one");
if (qisneg(q) || qiszero(q)) {
math_error("Epsilon value must be greater than zero");
/*NOTREACHED*/
}
old = conf->epsilon;
@@ -234,7 +241,7 @@ qpowi(NUMBER *q1, NUMBER *q2)
/*
* Given the legs of a right triangle, compute its hypothenuse within
* Given the legs of a right triangle, compute its hypotenuse within
* the specified error. This is sqrt(a^2 + b^2).
*/
NUMBER *
@@ -262,7 +269,7 @@ qhypot(NUMBER *q1, NUMBER *q2, NUMBER *epsilon)
/*
* Given one leg of a right triangle with unit hypothenuse, calculate
* Given one leg of a right triangle with unit hypotenuse, calculate
* the other leg within the specified error. This is sqrt(1 - a^2).
* If the wantneg flag is nonzero, then negative square root is returned.
*/
@@ -557,12 +564,11 @@ qilog10(NUMBER *q)
* The number is not an integer.
* Compute the result if the number is greater than one.
*/
if ((q->num.len > q->den.len) ||
((q->num.len == q->den.len) && (zrel(tmp1, q->den) > 0))) {
zquo(tmp1, q->den, &tmp2, 0);
n = zlog10(tmp2);
zfree(tmp2);
return n;
if (zrel(tmp1, q->den) > 0) {
zquo(tmp1, q->den, &tmp2, 0);
n = zlog10(tmp2);
zfree(tmp2);
return n;
}
/*
* Here if the number is less than one.
@@ -583,104 +589,162 @@ qilog10(NUMBER *q)
* Return the integer floor of the logarithm of a number relative to
* a specified integral base.
*/
long
qilog(NUMBER *q1, NUMBER *q2)
NUMBER *
qilog(NUMBER *q, ZVALUE base)
{
long n;
ZVALUE tmp1, tmp2;
if (qiszero(q1)) {
math_error("Zero argument for ilog");
/*NOTREACHED*/
}
if (qisfrac(q2) || zrel(q2->num, _one_) <= 0) {
math_error("Base for ilog non-integral or less than 2");
/*NOTREACHED*/
}
if (qisunit(q1))
return 0;
tmp1 = q1->num;
if (qiszero(q))
return NULL;
if (qisunit(q))
return qlink(&_qzero_);
if (qisint(q))
return itoq(zlog(q->num, base));
tmp1 = q->num;
tmp1.sign = 0;
if (qisint(q1))
return zlog(tmp1, q2->num);
if (zrel(tmp1, q1->den) > 0) {
zquo(tmp1, q1->den, &tmp2, 0);
n = zlog(tmp2, q2->num);
if (zrel(tmp1, q->den) > 0) {
zquo(tmp1, q->den, &tmp2, 0);
n = zlog(tmp2, base);
zfree(tmp2);
return n;
return itoq(n);
}
if (zisunit(tmp1))
zsub(q1->den, _one_, &tmp2);
zsub(q->den, _one_, &tmp2);
else
zquo(q1->den, tmp1, &tmp2, 0);
n = -zlog(tmp2, q2->num) - 1;
zquo(q->den, tmp1, &tmp2, 0);
n = -zlog(tmp2, base) - 1;
zfree(tmp2);
return n;
return itoq(n);
}
/*
* Return the number of digits in a number, ignoring the sign.
* For fractions, this is the number of digits of its greatest integer.
* Examples: qdigits(3456) = 4, qdigits(-23.45) = 2, qdigits(.0120) = 1.
* Return the number of digits in the representation to a specified
* base of the integral part of a number.
* Examples: qdigits(3456,10) = 4, qdigits(-23.45, 10) = 2.
*
* given:
* q number to count digits of
*/
long
qdigits(NUMBER *q)
qdigits(NUMBER *q, ZVALUE base)
{
long n; /* number of digits */
ZVALUE temp; /* temporary value */
if (zabsrel(q->num, q->den) < 1)
return 0;
if (qisint(q))
return zdigits(q->num);
return 1 + zlog(q->num, base);
zquo(q->num, q->den, &temp, 2);
n = zdigits(temp);
n = 1 + zlog(temp, base);
zfree(temp);
return n;
}
/*
* Return the digit at the specified decimal place of a number represented
* in floating point. The lowest digit of the integral part of a number
* is the zeroth decimal place. Negative decimal places indicate digits
* to the right of the decimal point. Examples: qdigit(1234.5678, 1) = 3,
* qdigit(1234.5678, -3) = 7.
* Return the digit at the specified place in the expansion to specified
* base of a rational number. The places specified by dpos are numbered from
* the "units" place just before the "decimal" point, so that negative
* dpos indicates the (-dpos)th place to the right of the point.
* Examples: qdigit(1234.5678, 1, 10) = 3, qdigit(1234.5678, -3, 10) = 7.
* The signs of the number and the base are ignored.
*/
long
qdigit(NUMBER *q, long n)
NUMBER *
qdigit(NUMBER *q, ZVALUE dpos, ZVALUE base)
{
ZVALUE tenpow, tmp1, tmp2;
long res;
ZVALUE N, D;
ZVALUE K;
long k;
ZVALUE A, B, C; /* temporary integers */
NUMBER *res;
/*
* Zero number or negative decimal place of integer is trivial.
* In the first stage, q is expressed as base^k * N/D where
* gcd(D, base) = 1
* K is k as a ZVALUE
*/
if (qiszero(q) || (qisint(q) && (n < 0)))
return 0;
/*
* For non-negative decimal places, answer is easy.
*/
if (n >= 0) {
if (qisint(q))
return zdigit(q->num, n);
zquo(q->num, q->den, &tmp1, 2);
res = zdigit(tmp1, n);
zfree(tmp1);
return res;
base.sign = 0;
if (ziszero(base) || zisunit(base))
return NULL;
if (qiszero(q) || (qisint(q) && zisneg(dpos)) ||
(zge31b(dpos) && !zisneg(dpos)))
return qlink(&_qzero_);
k = zfacrem(q->num, base, &N);
if (k == 0) {
k = zgcdrem(q->den, base, &D);
if (k > 0) {
zequo(q->den, D, &A);
itoz(k, &K);
zpowi(base, K, &B);
zfree(K);
zequo(B, A, &C);
zfree(A);
zfree(B);
zmul(C, q->num, &N);
zfree(C);
k = -k;
}
else
N = q->num;
}
/*
* Fractional value and want negative digit, must work harder.
*/
ztenpow(-n, &tenpow);
zmul(q->num, tenpow, &tmp1);
zfree(tenpow);
zquo(tmp1, q->den, &tmp2, 2);
tmp2.sign = 0;
res = zmodi(tmp2, 10L);
zfree(tmp1);
zfree(tmp2);
if (k >= 0)
D = q->den;
itoz(k, &K);
if (zrel(dpos, K) >= 0) {
zsub(dpos, K, &A);
zfree(K);
zpowi(base, A, &B);
zfree(A);
zmul(D, B, &A);
zfree(B);
zquo(N, A, &B, 0);
} else {
if (zisunit(D)) {
if (k != 0)
zfree(N);
zfree(K);
if (k < 0)
zfree(D);
return qlink(&_qzero_);
}
zsub(K, dpos, &A);
zfree(K);
zpowermod(base, A, D, &C);
zfree(A);
zmod(N, D, &A, 0);
zmul(C, A, &B);
zfree(A);
zfree(C);
zmod(B, D, &A, 0);
zfree(B);
zmodinv(D, base, &B);
zsub(base, B, &C);
zfree(B);
zmul(C, A, &B);
zfree(C);
}
zfree(A);
if (k != 0)
zfree(N);
if (k < 0)
zfree(D);
zmod(B, base, &A, 0);
zfree(B);
if (ziszero(A)) {
zfree(A);
return qlink(&_qzero_);
}
if (zisone(A)) {
zfree(A);
return qlink(&_qone_);
}
res = qalloc();
res->num = A;
return res;
}
@@ -848,67 +912,255 @@ qperm(NUMBER *q1, NUMBER *q2)
/*
* Compute the combinatorial function q1 * (q1-1) * ... * (q1-q2+1)/q2!
* Compute the combinatorial function q(q - 1) ...(q - n + 1)/n!
* n is to be a nonnegative integer
*/
NUMBER *
qcomb(NUMBER *q1, NUMBER *q2)
qcomb(NUMBER *q, NUMBER *n)
{
NUMBER *r;
NUMBER *qtmp1, *qtmp2;
NUMBER *q1, *q2;
long i, j;
ZVALUE z;
if (qisfrac(q2)) {
math_error("Non-integral second argument for comb");
if (!qisint(n) || qisneg(n)) {
math_error("Bad second arg in call to qcomb!");
/*NOTREACHED*/
}
if (qisneg(q2))
return qlink(&_qzero_);
if (qiszero(q2) || qcmp(q1, q2) == 0)
return qlink(&_qone_);
if (qisone(q2))
return qlink(q1);
if (qisint(q1)) {
if (qisneg(q1)) {
qtmp1 = qsub(q2, q1);
qtmp2 = qdec(qtmp1);
qfree(qtmp1);
r = qalloc();
zcomb(qtmp2->num, q2->num, &r->num);
qfree(qtmp2);
if (qiseven(q2))
if (qisint(q)) {
switch (zcomb(q->num, n->num, &z)) {
case 0:
return qlink(&_qzero_);
case 1:
return qlink(&_qone_);
case -1:
return qlink(&_qnegone_);
case 2:
return qlink(q);
case -2:
return NULL;
default:
r = qalloc();
r->num = z;
return r;
qtmp2 = qneg(r);
qfree(r);
return qtmp2;
}
if (qrel(q2, q1) > 0)
return qlink(&_qzero_);
r = qalloc();
zcomb(q1->num, q2->num, &r->num);
return r;
}
if (zge31b(q2->num)) {
math_error("Too large second argument for comb");
/*NOTREACHED*/
}
i = qtoi(q2);
q1 = qlink(q1);
r = qlink(q1);
if (zge31b(n->num))
return NULL;
i = ztoi(n->num);
q = qlink(q);
r = qlink(q);
j = 1;
while (--i > 0) {
qtmp1 = qdec(q1);
qfree(q1);
q1 = qtmp1;
qtmp2 = qmul(r, q1);
q1 = qdec(q);
qfree(q);
q = q1;
q2 = qmul(r, q);
qfree(r);
r = qdivi(qtmp2, ++j);
qfree(qtmp2);
r = qdivi(q2, ++j);
qfree(q2);
}
qfree(q1);
qfree(q);
return r;
}
/*
* Compute the Bernoulli number with index n
* For even positive n, newly calculated values for all even indices up
* to n are stored in table at B_table.
*/
NUMBER *
qbern(ZVALUE z)
{
long n, i, k, m, nn, dd;
NUMBER **p;
NUMBER *s, *s1, *c, *c1, *t;
size_t sz;
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;
sz = k * sizeof(NUMBER *);
if (sz < (size_t) k)
return NULL;
if (B_allocnum == 0)
p = (NUMBER **) malloc(sz);
else
p = (NUMBER **) realloc(B_table, sz);
if (p == NULL)
return NULL;
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;
size_t sz;
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]);
sz = (m + 1) * sizeof(NUMBER *);
if (sz < (size_t) m + 1)
return NULL;
if (E_num)
p = (NUMBER **) realloc(E_table, sz);
else
p = (NUMBER **) malloc(sz);
if (p == NULL)
return NULL;
E_table = p;
for (k = E_num; k <= m; k++) {
nn = 2 * k + 2;
dd = 1;
c = qlink(&_qone_);
s = qlink(&_qnegone_);
i = k;
for (i = 0; i < k; i++) {
c1 = qmuli(c, nn--);
qfree(c);
c = qdivi(c1, dd++);
qfree(c1);
c1 = qmuli(c, nn--);
qfree(c);
c = qdivi(c1, dd++);
qfree(c1);
t = qmul(c, E_table[i]);
s1 = qsub(s, t);
qfree(t);
qfree(s);
s = s1;
}
E_table[k] = s;
qfree(c);
}
E_num = k;
return qlink(E_table[m]);
}
void
qfreeeuler(void)
{
long k;
if (E_num > 0) {
for (k = 0; k < E_num; k++)
qfree(E_table[k]);
free(E_table);
}
E_table = NULL;
E_num = 0;
}
/*
* Catalan numbers: catalan(n) = comb(2*n, n)/(n+1)
* To be called only with integer q
*/
NUMBER *
qcatalan(NUMBER *q)
{
NUMBER *A, *B;
NUMBER *res;
if (qisneg(q))
return qlink(&_qzero_);
A = qscale(q, 1);
B = qcomb(A, q);
if (B == NULL)
return NULL;
qfree(A);
A = qinc(q);
res = qqdiv(B, A);
qfree(A);
qfree(B);
return res;
}
/*
* Compute the Jacobi function (a / b).
* -1 => a is not quadratic residue mod b
@@ -1236,7 +1488,7 @@ qcfappr(NUMBER *q, NUMBER *epsilon, long rnd)
/*
* Calculate the nearest-above, or nearest-below, or nearest, number
* with denominator less than the given number, the choice between
* possibilities being dertermined by the parameter rnd.
* possibilities being determined by the parameter rnd.
*/
NUMBER *
qcfsim(NUMBER *q, long rnd)
@@ -1405,7 +1657,7 @@ qlcm(NUMBER *q1, NUMBER *q2)
/*
* Remove all occurences of the specified factor from a number.
* Remove all occurrences of the specified factor from a number.
* Returned number is always positive or zero.
*/
NUMBER *
@@ -1456,7 +1708,8 @@ qgcdrem(NUMBER *q1, NUMBER *q2)
return qlink(&_qone_);
if (qiszero(q1))
return qlink(&_qzero_);
zgcdrem(q1->num, q2->num, &tmp);
if (zgcdrem(q1->num, q2->num, &tmp) == 0)
return qqabs(q1);
if (zisunit(tmp)) {
zfree(tmp);
return qlink(&_qone_);
@@ -1493,15 +1746,14 @@ qlowfactor(NUMBER *q1, NUMBER *q2)
return utoq(zlowfactor(q1->num, count));
}
/*
* Return the number of places after the decimal point needed to exactly
* represent the specified number as a real number. Integers return zero,
* and non-terminating decimals return minus one. Examples:
* qplaces(1/7)=-1, qplaces(3/10)= 1, qplaces(1/8)=3, qplaces(4)=0.
* qdecplaces(1.23) = 2, qdecplaces(3) = 0, qdecplaces(1/7) = -1.
*/
long
qplaces(NUMBER *q)
qdecplaces(NUMBER *q)
{
long twopow, fivepow;
HALF fiveval[2];
@@ -1532,6 +1784,39 @@ qplaces(NUMBER *q)
}
/*
* Return, if possible, the minimum number of places after the decimal
* point needed to exactly represent q with the specified base.
* Integers return 0 and numbers with non-terminating expansions -1.
* Returns -2 if base inadmissible
*/
long
qplaces(NUMBER *q, ZVALUE base)
{
long count;
ZVALUE tmp;
if (base.len == 1 && base.v[0] == 10)
return qdecplaces(q);
if (ziszero(base) || zisunit(base))
return -2;
if (qisint(q))
return 0;
if (zisonebit(base)) {
if (!zisonebit(q->den))
return -1;
return 1 + (zlowbit(q->den) - 1)/zlowbit(base);
}
count = zgcdrem(q->den, base, &tmp);
if (count == 0)
return -1;
if (!zisunit(tmp))
count = -1;
zfree(tmp);
return count;
}
/*
* Perform a probabilistic primality test (algorithm P in Knuth).
* Returns FALSE if definitely not prime, or TRUE if probably prime.

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.2 $
* @(#) $Id: qio.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $Revision: 29.3 $
* @(#) $Id: qio.c,v 29.3 2000/07/17 15:35:49 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 = qplaces(q);
prec = qdecplaces(q);
if ((prec < 0) || (prec > conf->outdigits)) {
if (conf->tilde_ok)
PUTCHAR('~');
@@ -629,7 +629,7 @@ qparse(char *cp, int flags)
/*
* Print an integer which is guaranteed to fit in the specified number
* of columns, using imbedded '...' characters if numerator and/or
* of columns, using embedded '...' characters if numerator and/or
* denominator is too large.
*/
void

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.2 $
* @(#) $Id: qmath.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $Revision: 29.3 $
* @(#) $Id: qmath.c,v 29.3 2000/07/17 15:35:49 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/qmath.c,v $
*
* Under source code control: 1990/02/15 01:48:21
@@ -43,10 +43,12 @@ NUMBER _qfour_ = { { _fourval_, 1, 0 }, { _oneval_, 1, 0 }, 1, NULL };
NUMBER _qten_ = { { _tenval_, 1, 0 }, { _oneval_, 1, 0 }, 1, NULL };
NUMBER _qnegone_ = { { _oneval_, 1, 1 }, { _oneval_, 1, 0 }, 1, NULL };
NUMBER _qonehalf_ = { { _oneval_, 1, 0 }, { _twoval_, 1, 0 }, 1, NULL };
NUMBER _qneghalf_ = { { _oneval_, 1, 1 }, { _twoval_, 1, 0 }, 1, NULL };
NUMBER _qonesqbase_ = { { _oneval_, 1, 0 }, { _sqbaseval_, 2, 0 }, 1, NULL };
NUMBER * initnumbs[INITCONSTCOUNT] = {&_qzero_, &_qone_, &_qtwo_, &_qthree_,
&_qfour_, &_qten_, &_qnegone_, &_qonehalf_};
&_qfour_, &_qten_, &_qnegone_, &_qonehalf_, &_qneghalf_};
/*
* Create another copy of a number.

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.2 $
* @(#) $Id: qmath.h,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $Revision: 29.3 $
* @(#) $Id: qmath.h,v 29.3 2000/07/17 15:35:49 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/qmath.h,v $
*
* Under source code control: 1993/07/30 19:42:47
@@ -34,8 +34,7 @@
#include "zmath.h"
#define INITCONSTCOUNT 8 /* number of initnumbs[] pre-defined constants */
#define INITCONSTCOUNT 9 /* number of initnumbs[] pre-defined constants */
/*
* Rational arithmetic definitions.
@@ -157,14 +156,15 @@ extern BOOL qprimetest(NUMBER *q1, NUMBER *q2, NUMBER *q3);
extern BOOL qissquare(NUMBER *q);
extern long qilog2(NUMBER *q);
extern long qilog10(NUMBER *q);
extern long qilog(NUMBER *q1, NUMBER *q2);
extern NUMBER *qilog(NUMBER *q, ZVALUE base);
extern BOOL qcmpmod(NUMBER *q1, NUMBER *q2, NUMBER *q3);
extern BOOL qquomod(NUMBER *q1, NUMBER *q2, NUMBER **retdiv, NUMBER **retmod);
extern FLAG qnear(NUMBER *q1, NUMBER *q2, NUMBER *epsilon);
extern long qdigit(NUMBER *q, long i);
extern NUMBER *qdigit(NUMBER *q, ZVALUE dpos, ZVALUE base);
extern long qprecision(NUMBER *q);
extern long qplaces(NUMBER *q);
extern long qdigits(NUMBER *q);
extern long qplaces(NUMBER *q, ZVALUE base);
extern long qdecplaces(NUMBER *q);
extern long qdigits(NUMBER *q, ZVALUE base);
extern void setepsilon(NUMBER *q);
extern NUMBER *qbitvalue(long i);
extern NUMBER *qtenpow(long i);
@@ -208,6 +208,11 @@ extern NUMBER *qacsch(NUMBER *q, NUMBER *epsilon);
extern NUMBER *qacoth(NUMBER *q, NUMBER *epsilon);
extern NUMBER *qlegtoleg(NUMBER *q, NUMBER *epsilon, BOOL wantneg);
extern NUMBER *qpi(NUMBER *epsilon);
extern NUMBER *qcatalan(NUMBER *);
extern NUMBER *qbern(ZVALUE z);
extern void qfreebern(void);
extern NUMBER *qeuler(ZVALUE z);
extern void qfreeeuler(void);
/*
@@ -258,7 +263,7 @@ extern NUMBER *swap_HALF_in_NUMBER(NUMBER *dest, NUMBER *src, BOOL all);
/*
* constants used often by the arithmetic routines
*/
extern NUMBER _qzero_, _qone_, _qnegone_, _qonehalf_, _qonesqbase_;
extern NUMBER _qzero_, _qone_, _qnegone_, _qonehalf_, _qneghalf_, _qonesqbase_;
extern NUMBER _qtwo_, _qthree_, _qfour_;
extern NUMBER * initnumbs[];

9
sample/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.2 $
# @(#) $Id: Makefile,v 29.2 2000/06/07 14:02:54 chongo Exp $
# @(#) $Revision: 29.3 $
# @(#) $Id: Makefile,v 29.3 2000/12/17 12:28:31 chongo Exp $
# @(#) $Source: /usr/local/src/cmd/calc/sample/RCS/Makefile,v $
#
# Under source code control: 1997/04/19 22:46:49
@@ -378,7 +378,10 @@ depend:
fi; \
done
${Q}(cd ..; ${MAKE} hsrc)
${Q}for i in `cd ..; ${MAKE} h_list`; do \
${Q}for i in `cd ..; ${MAKE} h_list 2>&1 | \
${SED} -e '/Entering directory/d' \
-e '/Nothing to be done/d' \
-e '/Leaving directory/d'`; do \
tag="`echo $$i | ${SED} 's/[\.+,:]/_/g'`"; \
echo "#if !defined($$tag)" > "skel/$$i"; \
echo "#define $$tag" >> "skel/$$i"; \

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

228
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.2 $
* @(#) $Id: value.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $Revision: 29.3 $
* @(#) $Id: value.c,v 29.3 2000/07/17 15:35:49 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;
if (type < 0)
vp->v_subtype = V_NOSUBTYPE;
if (type <= 0)
return;
switch (type) {
case V_NULL:
case V_ADDR:
case V_OCTET:
case V_NBLOCK:
@@ -111,7 +111,6 @@ freevalue(VALUE *vp)
math_error("Freeing unknown value type");
/*NOTREACHED*/
}
vp->v_subtype = V_NOSUBTYPE;
}
@@ -341,7 +340,7 @@ negvalue(VALUE *vp, VALUE *vres)
*vres = objcall(OBJ_NEG, vp, NULL_VALUE, NULL_VALUE);
return;
default:
if (vp->v_type < 0)
if (vp->v_type <= 0)
return;
*vres = error_value(E_NEG);
return;
@@ -349,76 +348,6 @@ negvalue(VALUE *vp, VALUE *vres)
}
/*
* addnumeric - add two numeric values togethter
*
* If either value is not real or complex, it is assumed to have
* a value of 0.
*
* Result is placed in the indicated location.
*/
void
addnumeric(VALUE *v1, VALUE *v2, VALUE *vres)
{
COMPLEX *c;
/*
* add numeric values
*/
vres->v_subtype = V_NOSUBTYPE;
switch (TWOVAL(v1->v_type, v2->v_type)) {
case TWOVAL(V_NUM, V_NUM):
vres->v_num = qqadd(v1->v_num, v2->v_num);
vres->v_type = V_NUM;
return;
case TWOVAL(V_COM, V_NUM):
vres->v_com = caddq(v1->v_com, v2->v_num);
vres->v_type = V_COM;
return;
case TWOVAL(V_NUM, V_COM):
vres->v_com = caddq(v2->v_com, v1->v_num);
vres->v_type = V_COM;
return;
case TWOVAL(V_COM, V_COM):
vres->v_com = cadd(v1->v_com, v2->v_com);
vres->v_type = V_COM;
c = vres->v_com;
if (!cisreal(c))
return;
vres->v_num = qlink(c->real);
vres->v_type = V_NUM;
comfree(c);
return;
}
/*
* assume zero if a value is not numeric
*/
if (v1->v_type == V_NUM) {
/* v1 + 0 == v1 */
vres->v_type = v1->v_type;
vres->v_num = qlink(v1->v_num);
} else if (v1->v_type == V_COM) {
/* v1 + 0 == v1 */
vres->v_type = v1->v_type;
vres->v_com = clink(v1->v_com);
} else if (v2->v_type == V_NUM) {
/* v2 + 0 == v2 */
vres->v_type = v2->v_type;
vres->v_num = qlink(v2->v_num);
} else if (v2->v_type == V_COM) {
/* v2 + 0 == v2 */
vres->v_type = v2->v_type;
vres->v_com = clink(v2->v_com);
} else {
/* 0 + 0 = 0 */
vres->v_type = V_NUM;
vres->v_num = qlink(&_qzero_);
}
return;
}
/*
* Add two arbitrary values together.
* Result is placed in the indicated location.
@@ -502,15 +431,12 @@ addvalue(VALUE *v1, VALUE *v2, VALUE *vres)
return;
default:
if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) {
if (v1->v_type < 0) {
copyvalue(v1, vres);
if (v1->v_type < 0)
return;
}
if (v2->v_type < 0) {
copyvalue(v2, vres);
return;
}
*vres = error_value(E_ADD);
if (v2->v_type > 0)
*vres = error_value(E_ADD);
else
vres->v_type = v2->v_type;
return;
}
*vres = objcall(OBJ_ADD, v1, v2, NULL_VALUE);
@@ -592,12 +518,10 @@ subvalue(VALUE *v1, VALUE *v2, VALUE *vres)
return;
default:
if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) {
if (v1->v_type < 0) {
copyvalue(v1, vres);
if (v1->v_type <= 0)
return;
}
if (v2->v_type < 0) {
copyvalue(v2, vres);
if (v2->v_type <= 0) {
vres->v_type = v2->v_type;
return;
}
*vres = error_value(E_SUB);
@@ -659,12 +583,10 @@ mulvalue(VALUE *v1, VALUE *v2, VALUE *vres)
return;
default:
if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) {
if (v1->v_type < 0) {
copyvalue(v1, vres);
if (v1->v_type <= 0)
return;
}
if (v2->v_type < 0) {
copyvalue(v2, vres);
if (v2->v_type <= 0) {
vres->v_type = v2->v_type;
return;
}
*vres = error_value(E_MUL);
@@ -713,8 +635,8 @@ squarevalue(VALUE *vp, VALUE *vres)
*vres = objcall(OBJ_SQUARE, vp, NULL_VALUE, NULL_VALUE);
return;
default:
if (vp->v_type < 0) {
copyvalue(vp, vres);
if (vp->v_type <= 0) {
vres->v_type = vp->v_type;
return;
}
*vres = error_value(E_SQUARE);
@@ -767,10 +689,8 @@ invertvalue(VALUE *vp, VALUE *vres)
vres->v_num = qlink(&_qzero_);
return;
}
if (vp->v_type < 0) {
copyvalue(vp, vres);
if (vp->v_type <= 0)
return;
}
*vres = error_value(E_INV);
return;
}
@@ -819,12 +739,10 @@ andvalue(VALUE *v1, VALUE *v2, VALUE *vres)
return;
default:
if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) {
if (v1->v_type < 0) {
copyvalue(v1, vres);
if (v1->v_type < 0)
return;
}
if (v2->v_type < 0) {
copyvalue(v2, vres);
vres->v_type = v2->v_type;
return;
}
*vres = error_value(E_AND);
@@ -877,12 +795,10 @@ orvalue(VALUE *v1, VALUE *v2, VALUE *vres)
return;
default:
if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) {
if (v1->v_type < 0) {
copyvalue(v1, vres);
if (v1->v_type < 0)
return;
}
if (v2->v_type < 0) {
copyvalue(v2, vres);
vres->v_type = v2->v_type;
return;
}
*vres = error_value(E_OR);
@@ -1097,10 +1013,9 @@ apprvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
vres->v_type = v1->v_type;
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type < 0) {
copyvalue(v1, vres);
if (v1->v_type <= 0)
return;
}
e = NULL;
switch(v2->v_type) {
case V_NUM: e = v2->v_num;
@@ -1239,10 +1154,8 @@ roundvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
vres->v_com = c;
return;
default:
if (v1->v_type < 0) {
copyvalue(v1, vres);
if (v1->v_type <= 0)
return;
}
*vres = error_value(E_ROUND);
return;
}
@@ -1327,10 +1240,8 @@ broundvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
vres->v_com = c;
return;
default:
if (v1->v_type < 0) {
copyvalue(v1, vres);
if (v1->v_type <= 0)
return;
}
*vres = error_value(E_BROUND);
return;
}
@@ -1374,10 +1285,8 @@ intvalue(VALUE *vp, VALUE *vres)
*vres = objcall(OBJ_INT, vp, NULL_VALUE, NULL_VALUE);
return;
default:
if (vp->v_type < 0) {
copyvalue(vp, vres);
if (vp->v_type <= 0)
return;
}
*vres = error_value(E_INT);
return;
}
@@ -1423,10 +1332,8 @@ fracvalue(VALUE *vp, VALUE *vres)
*vres = objcall(OBJ_FRAC, vp, NULL_VALUE, NULL_VALUE);
return;
default:
if (vp->v_type < 0) {
copyvalue(vp, vres);
if (vp->v_type < 0)
return;
}
*vres = error_value(E_FRAC);
return;
}
@@ -1461,7 +1368,7 @@ incvalue(VALUE *vp, VALUE *vres)
vres->v_addr = vp->v_addr + 1;
break;
default:
if (vp->v_type >= 0)
if (vp->v_type > 0)
*vres = error_value(E_INCV);
break;
}
@@ -1533,8 +1440,8 @@ conjvalue(VALUE *vp, VALUE *vres)
*vres = objcall(OBJ_CONJ, vp, NULL_VALUE, NULL_VALUE);
return;
default:
if (vp->v_type < 0) {
copyvalue(vp, vres);
if (vp->v_type <= 0) {
vres->v_type = vp->v_type;
return;
}
*vres = error_value(E_CONJ);
@@ -1560,8 +1467,8 @@ sqrtvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
}
vres->v_type = v1->v_type;
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type < 0) {
copyvalue(v1, vres);
if (v1->v_type <= 0) {
vres->v_type = v1->v_type;
return;
}
if (v2->v_type == V_NULL) {
@@ -1630,8 +1537,8 @@ rootvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
COMPLEX *c;
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type < 0) {
copyvalue(v1, vres);
if (v1->v_type <= 0) {
vres->v_type = v1->v_type;
return;
}
if (v2->v_type != V_NUM) {
@@ -1700,8 +1607,8 @@ absvalue(VALUE *v1, VALUE *v2, VALUE *vres)
return;
}
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type < 0) {
copyvalue(v1, vres);
if (v1->v_type <= 0) {
vres->v_type = v1->v_type;
return;
}
switch (v1->v_type) {
@@ -1739,8 +1646,8 @@ normvalue(VALUE *vp, VALUE *vres)
vres->v_type = vp->v_type;
vres->v_subtype = V_NOSUBTYPE;
if (vp->v_type < 0) {
copyvalue(vp, vres);
if (vp->v_type <= 0) {
vres->v_type = vp->v_type;
return;
}
switch (vp->v_type) {
@@ -1786,8 +1693,8 @@ shiftvalue(VALUE *v1, VALUE *v2, BOOL rightshift, VALUE *vres)
VALUE tmp;
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type < 0) {
copyvalue(v1, vres);
if (v1->v_type <= 0) {
vres->v_type = v1->v_type;
return;
}
if ((v2->v_type != V_NUM) || (qisfrac(v2->v_num))) {
@@ -1872,8 +1779,8 @@ scalevalue(VALUE *v1, VALUE *v2, VALUE *vres)
long n = 0;
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type < 0) {
copyvalue(v1, vres);
if (v1->v_type <= 0) {
vres->v_type = v1->v_type;
return;
}
if ((v2->v_type != V_NUM) || qisfrac(v2->v_num)) {
@@ -1924,9 +1831,9 @@ powivalue(VALUE *v1, VALUE *v2, VALUE *vres)
}
vres->v_type = v1->v_type;
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type < 0 && v1->v_type != -E_1OVER0)
if (v1->v_type <= 0 && v1->v_type != -E_1OVER0)
return;
if (v2->v_type < 0) {
if (v2->v_type <= 0) {
vres->v_type = v2->v_type;
return;
}
@@ -1982,8 +1889,8 @@ powervalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
COMPLEX *c, ctmp1, ctmp2;
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type < 0) {
copyvalue(v1, vres);
if (v1->v_type <= 0) {
vres->v_type = v1->v_type;
return;
}
if (v1->v_type != V_NUM && v1->v_type != V_COM) {
@@ -2063,9 +1970,9 @@ divvalue(VALUE *v1, VALUE *v2, VALUE *vres)
vres->v_type = v1->v_type;
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type < 0)
if (v1->v_type <= 0)
return;
if (v2->v_type < 0) {
if (v2->v_type <= 0) {
if (testvalue(v1) && v2->v_type == -E_1OVER0) {
vres->v_type = V_NUM;
vres->v_num = qlink(&_qzero_);
@@ -2146,10 +2053,9 @@ quovalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
vres->v_type = v1->v_type;
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type < 0) {
copyvalue(v1, vres);
if (v1->v_type <= 0)
return;
}
if (v1->v_type == V_MAT) {
vres->v_mat = matquoval(v1->v_mat, v2, v3);
return;
@@ -2162,8 +2068,8 @@ quovalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
*vres = objcall(OBJ_QUO, v1, v2, v3);
return;
}
if (v2->v_type < 0) {
copyvalue(v2, vres);
if (v2->v_type <= 0) {
vres->v_type = v2->v_type;
return;
}
if (v2->v_type != V_NUM) {
@@ -2224,12 +2130,11 @@ modvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
NUMBER *q1, *q2;
long rnd;
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
}
vres->v_type = v1->v_type;
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type <= 0)
return;
if (v1->v_type == V_MAT) {
vres->v_mat = matmodval(v1->v_mat, v2, v3);
return;
@@ -2242,8 +2147,8 @@ modvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
*vres = objcall(OBJ_MOD, v1, v2, v3);
return;
}
if (v2->v_type < 0) {
copyvalue(v2, vres);
if (v2->v_type <= 0) {
vres->v_type = v2->v_type;
return;
}
if (v2->v_type != V_NUM) {
@@ -2387,7 +2292,7 @@ comparevalue(VALUE *v1, VALUE *v2)
return comparevalue(v2, v1);
if (v1->v_type != v2->v_type)
return TRUE;
if (v1->v_type < 0)
if (v1->v_type <= 0)
return FALSE;
switch (v1->v_type) {
case V_NUM:
@@ -2408,8 +2313,6 @@ comparevalue(VALUE *v1, VALUE *v2)
case V_ASSOC:
r = assoccmp(v1->v_assoc, v2->v_assoc);
break;
case V_NULL:
break;
case V_FILE:
r = (v1->v_file != v2->v_file);
break;
@@ -2697,11 +2600,8 @@ sgnvalue(VALUE *vp, VALUE *vres)
*vres = objcall(OBJ_SGN, vp, NULL_VALUE, NULL_VALUE);
return;
default:
if (vp->v_type < 0) {
copyvalue(vp, vres);
return;
}
*vres = error_value(E_SGN);
if (vp->v_type > 0)
*vres = error_value(E_SGN);
return;
}
}
@@ -2855,7 +2755,7 @@ config_print(CONFIG *cfg)
*/
if (cfg == NULL || cfg->epsilon == NULL || cfg->prompt1 == NULL ||
cfg->prompt2 == NULL) {
math_error("CONFIG value is invaid");
math_error("CONFIG value is invalid");
/*NOTREACHED*/
}

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.2 $
* @(#) $Id: value.h,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $Revision: 29.3 $
* @(#) $Id: value.h,v 29.3 2000/07/17 15:35:49 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/value.h,v $
*
* Under source code control: 1993/07/30 19:42:47
@@ -191,7 +191,6 @@ extern void freevalue(VALUE *vp);
extern void copyvalue(VALUE *vp, VALUE *vres);
extern void negvalue(VALUE *vp, VALUE *vres);
extern void addvalue(VALUE *v1, VALUE *v2, VALUE *vres);
extern void addnumeric(VALUE *v1, VALUE *v2, VALUE *vres);
extern void subvalue(VALUE *v1, VALUE *v2, VALUE *vres);
extern void mulvalue(VALUE *v1, VALUE *v2, VALUE *vres);
extern void orvalue(VALUE *v1, VALUE *v2, VALUE *vres);

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

341
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.2 $
* @(#) $Id: zfunc.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $Revision: 29.3 $
* @(#) $Id: zfunc.c,v 29.3 2000/07/17 15:35:49 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 (zge24b(z)) {
if (zge31b(z)) {
math_error("Very large factorial");
/*NOTREACHED*/
}
@@ -108,7 +108,7 @@ zperm(ZVALUE z1, ZVALUE z2, ZVALUE *res)
math_error("Second arg larger than first in permutation");
/*NOTREACHED*/
}
if (zge24b(z2)) {
if (zge31b(z2)) {
math_error("Very large permutation");
/*NOTREACHED*/
}
@@ -127,58 +127,104 @@ zperm(ZVALUE z1, ZVALUE z2, ZVALUE *res)
*res = ans;
}
/*
* Compute the combinatorial function M! / ( N! * (M - N)! ).
* docomb evaluates binomial coefficient when z1 >= 0, z2 >= 0
*/
void
zcomb(ZVALUE z1, ZVALUE z2, ZVALUE *res)
static int
docomb(ZVALUE z1, ZVALUE z2, ZVALUE *res)
{
ZVALUE ans;
ZVALUE mul, div, temp;
FULL count, i;
#if BASEB == 16
HALF dh[2];
#else
HALF dh[1];
#endif
if (zisneg(z1) || zisneg(z2)) {
math_error("Negative argument for combinatorial");
/*NOTREACHED*/
}
if (zrel(z2, z1) > 0)
return 0;
zsub(z1, z2, &temp);
if (zisneg(temp)) {
if (zge31b(z2) && zge31b(temp)) {
zfree(temp);
math_error("Second arg larger than first for combinatorial");
/*NOTREACHED*/
return -2;
}
if (zge24b(z2) && zge24b(temp)) {
zfree(temp);
math_error("Very large combinatorial");
/*NOTREACHED*/
}
count = ztofull(z2);
i = ztofull(temp);
if (zge24b(z2) || (!zge24b(temp) && (i < count)))
count = i;
if (zrel(temp, z2) < 0)
count = ztofull(temp);
else
count = ztofull(z2);
zfree(temp);
mul = z1;
if (count == 0)
return 1;
if (count == 1)
return 2;
div.sign = 0;
div.v = dh;
ans = _one_;
for (i = 1; i <= count; i++) {
div.len = 1;
zcopy(z1, &mul);
zcopy(z1, &ans);
for (i = 2; i <= count; i++) {
#if BASEB == 16
dh[0] = (HALF)(i & BASE1);
dh[1] = (HALF)(i >> BASEB);
div.len = 1 + (dh[1] != 0);
#else
dh[0] = (HALF) i;
#endif
zsub(mul, _one_, &temp);
zfree(mul);
mul = temp;
zmul(ans, mul, &temp);
zfree(ans);
zquo(temp, div, &ans, 0);
zfree(temp);
zsub(mul, _one_, &temp);
if (mul.v != z1.v)
zfree(mul);
mul = temp;
}
if (mul.v != z1.v)
zfree(mul);
zfree(mul);
*res = ans;
return 3;
}
/*
* Compute the combinatorial function M! / ( N! * (M - N)! ).
* Returns 0 if result is 0
* 1 1
* 2 z1
* -1 -1
* -2 if too complicated
* 3 result stored at res
*/
int
zcomb(ZVALUE z1, ZVALUE z2, ZVALUE *res)
{
ZVALUE z3, z4;
int r;
if (z2.sign || (!z1.sign && zrel(z2, z1) > 0))
return 0;
if (zisone(z2))
return 2;
if (z1.sign) {
z1.sign = 0;
zsub(z1, _one_, &z3);
zadd(z3, z2, &z4);
zfree(z3);
r = docomb(z4, z2, res);
if (r == 2) {
*res = z4;
r = 3;
}
else
zfree(z4);
if (z2.v[0] & 1) {
if (r == 1)
r = -1;
if (r == 3)
res->sign = 1;
}
return r;
}
return docomb(z1, z2, res);
}
@@ -474,7 +520,7 @@ ztenpow(long power, ZVALUE *res)
/*
* Calculate modular inverse suppressing unnecessary divisions.
* This is based on the Euclidian algorithm for large numbers.
* This is based on the Euclidean algorithm for large numbers.
* (Algorithm X from Knuth Vol 2, section 4.5.2. and exercise 17)
* Returns TRUE if there is no solution because the numbers
* are not relatively prime.
@@ -1021,108 +1067,76 @@ zrelprime(ZVALUE z1, ZVALUE z2)
/*
* Compute the log of one number base another, to the closest integer.
* This is the largest integer which when the second number is raised to it,
* the resulting value is less than or equal to the first number.
* Compute the integer floor of the log of an integer to a specified base.
* The signs of the integers and base are ignored.
* Example: zlog(123456, 10) = 5.
*/
long
zlog(ZVALUE z1, ZVALUE z2)
zlog(ZVALUE z, ZVALUE base)
{
register ZVALUE *zp; /* current square */
ZVALUE *zp; /* current square */
long power; /* current power */
long worth; /* worth of current square */
ZVALUE val; /* current value of power */
ZVALUE temp; /* temporary */
ZVALUE squares[32]; /* table of squares of base */
/* ignore signs */
z.sign = 0;
base.sign = 0;
/*
* Make sure that the numbers are > 0 and the base is > 1
* Make sure that the numbers are nonzero and the base is > 1
*/
if (zislezero(z1) || zisleone(z2)) {
math_error("Bad arguments for log");
if (ziszero(z) || ziszero(base) || zisone(base)) {
math_error("Zero or too small argument argument for zlog!!!");
/*NOTREACHED*/
}
/*
* Reject trivial cases.
* Some trivial cases.
*/
if (z1.len < z2.len)
return 0;
if ((z1.len == z2.len) && (z1.v[z1.len-1] < z2.v[z2.len-1]))
return 0;
power = zrel(z1, z2);
power = zrel(z, base);
if (power <= 0)
return (power + 1);
/*
* Handle any power of two special.
*/
if (zisonebit(z2))
return (zhighbit(z1) / zlowbit(z2));
/*
* Handle base 10 special
*/
if ((z2.len == 1) && (*z2.v == 10))
return zlog10(z1);
/* base - power of two */
if (zisonebit(base))
return (zhighbit(z) / zlowbit(base));
/* base = 10 */
if (base.len == 1 && base.v[0] == 10)
return zlog10(z);
/*
* Now loop by squaring the base each time, and see whether or
* not each successive square is still smaller than the number.
*/
worth = 1;
zp = &squares[0];
*zp = z2;
while (((zp->len * 2) - 1) <= z1.len) { /* while square not too large */
*zp = base;
while (zp->len * 2 - 1 <= z.len && zrel(z, *zp) > 0) {
/* while square not too large */
zsquare(*zp, zp + 1);
zp++;
worth *= 2;
}
/*
* Now back down the squares, and multiply them together to see
* exactly how many times the base can be raised by.
* Now back down the squares,
*/
val = _one_;
power = 0;
/*
* We prevent the zp pointer from walking behind squares
* by stopping one short of the end and running the loop one
* more time.
*
* We could stop the loop with just zp >= squares, but stopping
* short and running the loop one last time manually helps make
* code checkers such as insure happy.
*/
for (; zp > squares; zp--, worth /= 2) {
if ((val.len + zp->len - 1) <= z1.len) {
zmul(val, *zp, &temp);
if (zrel(z1, temp) >= 0) {
zfree(val);
val = temp;
power += worth;
} else {
zfree(temp);
}
for (; zp > squares; zp--) {
if (zrel(z, *zp) >= 0) {
zquo(z, *zp, &temp, 0);
if (power)
zfree(z);
z = temp;
power++;
}
if (zp != squares)
zfree(*zp);
zfree(*zp);
power <<= 1;
}
/* run the loop manually one last time */
if (zp == squares) {
if ((val.len + zp->len - 1) <= z1.len) {
zmul(val, *zp, &temp);
if (zrel(z1, temp) >= 0) {
zfree(val);
val = temp;
power += worth;
} else {
zfree(temp);
}
}
if (zp != squares)
zfree(*zp);
}
zfree(val);
if (zrel(z, *zp) >= 0)
power++;
if (power > 1)
zfree(z);
return power;
}
@@ -1135,70 +1149,50 @@ zlog10(ZVALUE z)
{
register ZVALUE *zp; /* current square */
long power; /* current power */
long worth; /* worth of current square */
ZVALUE val; /* current value of power */
ZVALUE temp; /* temporary */
if (!zispos(z)) {
math_error("Non-positive number for log10");
if (ziszero(z)) {
math_error("Zero argument argument for zlog10");
/*NOTREACHED*/
}
/* Ignore sign of z */
z.sign = 0;
/*
* Loop by squaring the base each time, and see whether or
* not each successive square is still smaller than the number.
*/
worth = 1;
zp = &_tenpowers_[0];
*zp = _ten_;
while (((zp->len * 2) - 1) <= z.len) { /* while square not too large */
if (zp >= &_tenpowers_[TEN_MAX]) {
math_error("Maximum storable power of 10 reached!");
/*NOTREACHED*/
}
if (zp[1].len == 0)
zsquare(*zp, zp + 1);
zp++;
worth *= 2;
}
/*
* Now back down the squares, and multiply them together to see
* exactly how many times the base can be raised by.
*/
val = _one_;
power = 0;
/*
* We prevent the zp pointer from walking behind _tenpowers_
* by stopping one short of the end and running the loop one
* more time.
*
* We could stop the loop with just zp >= _tenpowers_, but stopping
* short and running the loop one last time manually helps make
* code checkers such as insure happy.
*/
for (; zp > _tenpowers_; zp--, worth /= 2) {
if ((val.len + zp->len - 1) <= z.len) {
zmul(val, *zp, &temp);
if (zrel(z, temp) >= 0) {
zfree(val);
val = temp;
power += worth;
} else {
zfree(temp);
}
for (; zp > _tenpowers_; zp--) {
if (zrel(z, *zp) >= 0) {
zquo(z, *zp, &temp, 0);
if (power)
zfree(z);
z = temp;
power++;
}
power <<= 1;
}
/* run the loop manually one last time */
if (zp == _tenpowers_) {
if ((val.len + zp->len - 1) <= z.len) {
zmul(val, *zp, &temp);
if (zrel(z, temp) >= 0) {
zfree(val);
val = temp;
power += worth;
} else {
zfree(temp);
}
}
}
zfree(val);
if (zrel(z, *zp) >= 0)
power++;
if (power > 1)
zfree(z);
return power;
}
@@ -1223,7 +1217,7 @@ zdivcount(ZVALUE z1, ZVALUE z2)
/*
* Remove all occurences of the specified factor from a number.
* Remove all occurrences of the specified factor from a number.
* Also returns the number of factors removed as a function return value.
* Example: zfacrem(540, 3, &x) returns 3 and sets x to 20.
*/
@@ -1357,29 +1351,47 @@ zfacrem(ZVALUE z1, ZVALUE z2, ZVALUE *rem)
/*
* Keep dividing a number by the gcd of it with another number until the
* result is relatively prime to the second number.
* result is relatively prime to the second number. Returns the number
* of divisions made, and if this is positive, stores result at res.
*/
void
long
zgcdrem(ZVALUE z1, ZVALUE z2, ZVALUE *res)
{
ZVALUE tmp1, tmp2;
long count, onecount;
long sh;
if (ziszero(z1) || ziszero(z2)) {
math_error("Zero argument in call to zgcdrem!!!");
/*NOTREACHED*/
}
/*
* Begin by taking the gcd for the first time.
* If the number is already relatively prime, then we are done.
*/
z1.sign = 0;
z2.sign = 0;
zgcd(z1, z2, &tmp1);
if (zisunit(tmp1) || ziszero(tmp1)) {
res->len = z1.len;
res->v = alloc(z1.len);
res->sign = 0;
zcopyval(z1, *res);
zfree(tmp1);
return;
if (zisone(z2))
return 0;
if (zisonebit(z2)) {
sh = zlowbit(z1);
if (sh == 0)
return 0;
zshift(z1, -sh, res);
return 1 + (sh - 1)/zlowbit(z2);
}
if (zisonebit(z1)) {
if (zisodd(z2))
return 0;
*res = _one_;
return zlowbit(z1);
}
zgcd(z1, z2, &tmp1);
if (zisunit(tmp1) || ziszero(tmp1))
return 0;
zequo(z1, tmp1, &tmp2);
count = 1;
z1 = tmp2;
z2 = tmp1;
/*
@@ -1387,15 +1399,18 @@ zgcdrem(ZVALUE z1, ZVALUE z2, ZVALUE *res)
* the gcd becomes one.
*/
while (!zisunit(z2)) {
(void) zfacrem(z1, z2, &tmp1);
zfree(z1);
z1 = tmp1;
onecount = zfacrem(z1, z2, &tmp1);
if (onecount) {
count += onecount;
zfree(z1);
z1 = tmp1;
}
zgcd(z1, z2, &tmp1);
zfree(z2);
z2 = tmp1;
}
zfree(z2);
*res = z1;
return count;
}
@@ -1820,7 +1835,7 @@ zroot(ZVALUE z1, ZVALUE z2, ZVALUE *dest)
old.len = ztry.len;
zcopyval(ztry, old);
}
/* average current try and quotent for the new try */
/* average current try and quotient for the new try */
zmul(ztry, k1, &temp);
zfree(ztry);
zadd(quo, temp, &temp2);

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.2 $
* @(#) $Id: zio.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $Revision: 29.3 $
* @(#) $Id: zio.c,v 29.3 2000/07/17 15:35:49 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.
*/
long
math_setdigits(long newdigits)
LEN
math_setdigits(LEN newdigits)
{
long olddigits;
LEN 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.2 $
* @(#) $Id: zmath.h,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $Revision: 29.3 $
* @(#) $Id: zmath.h,v 29.3 2000/07/17 15:35:49 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 void zcomb(ZVALUE z1, ZVALUE z2, ZVALUE *res);
extern int zcomb(ZVALUE z1, ZVALUE z2, ZVALUE *res);
extern FLAG zjacobi(ZVALUE z1, ZVALUE z2);
extern void zfib(ZVALUE z, ZVALUE *res);
extern void zpowi(ZVALUE z1, ZVALUE z2, ZVALUE *res);
@@ -344,7 +344,7 @@ extern long zlog(ZVALUE z1, ZVALUE z2);
extern long zlog10(ZVALUE z);
extern long zdivcount(ZVALUE z1, ZVALUE z2);
extern long zfacrem(ZVALUE z1, ZVALUE z2, ZVALUE *rem);
extern void zgcdrem(ZVALUE z1, ZVALUE z2, ZVALUE *res);
extern long zgcdrem(ZVALUE z1, ZVALUE z2, ZVALUE *res);
extern long zdigits(ZVALUE z1);
extern long zdigit(ZVALUE z1, long n);
extern FLAG zsqrt(ZVALUE z1, ZVALUE *dest, long R);
@@ -558,7 +558,7 @@ extern void math_divertio(void);
extern void math_cleardiversions(void);
extern char *math_getdivertedio(void);
extern int math_setmode(int mode);
extern long math_setdigits(long digits);
extern LEN math_setdigits(LEN digits);
extern void math_fmt(char *, ...);

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