Compare commits

..

37 Commits

Author SHA1 Message Date
Landon Curt Noll
17e3535595 Release calc version 2.12.4.10 2017-05-21 15:38:58 -07:00
Landon Curt Noll
7f125396c1 Release calc version 2.12.4.9 2017-05-21 15:38:57 -07:00
Landon Curt Noll
7cf611bca8 Release calc version 2.12.4.0 2017-05-21 15:38:57 -07:00
Landon Curt Noll
c9fce6a5bb Release calc version 2.12.4.1 2017-05-21 15:38:56 -07:00
Landon Curt Noll
a1c96f95a6 Release calc version 2.12.4.8 2017-05-21 15:38:56 -07:00
Landon Curt Noll
5e6b3cbd3f Release calc version 2.12.4.7 2017-05-21 15:38:55 -07:00
Landon Curt Noll
5bada5fefd Release calc version 2.12.4.6 2017-05-21 15:38:55 -07:00
Landon Curt Noll
0c20c96a7e Release calc version 2.12.4.4 2017-05-21 15:38:54 -07:00
Landon Curt Noll
e054ea87f2 Release calc version 2.12.4.3 2017-05-21 15:38:54 -07:00
Landon Curt Noll
e229393250 Release calc version 2.12.4.2 2017-05-21 15:38:53 -07:00
Landon Curt Noll
a407c7d197 Release calc version 2.12.3.3 2017-05-21 15:38:53 -07:00
Landon Curt Noll
9ea569152a Release calc version 2.12.3.2 2017-05-21 15:38:52 -07:00
Landon Curt Noll
cbcb5801fb Release calc version 2.12.3.1 2017-05-21 15:38:52 -07:00
Landon Curt Noll
bdf495150e Release calc version 2.12.3.0 2017-05-21 15:38:52 -07:00
Landon Curt Noll
b3648f030f Release calc version 2.12.2.2 2017-05-21 15:38:51 -07:00
Landon Curt Noll
71e88bdc91 Release calc version 2.12.2.1 2017-05-21 15:38:51 -07:00
Landon Curt Noll
ca0dd4560b Release calc version 2.12.2 2017-05-21 15:38:50 -07:00
Landon Curt Noll
f62d9fa1e6 Release calc version 2.12.1.13 2017-05-21 15:38:50 -07:00
Landon Curt Noll
253b47942f Release calc version 2.12.1.12 2017-05-21 15:38:50 -07:00
Landon Curt Noll
c773ee736f Release calc version 2.12.1.11 2017-05-21 15:38:50 -07:00
Landon Curt Noll
7d0cc52afe Release calc version 2.12.1.10 2017-05-21 15:38:49 -07:00
Landon Curt Noll
2441df7fdc Release calc version 2.12.1.9 2017-05-21 15:38:49 -07:00
Landon Curt Noll
5c565a7cea Release calc version 2.12.1.7 2017-05-21 15:38:49 -07:00
Landon Curt Noll
810e541281 Release calc version 2.12.1.8 2017-05-21 15:38:49 -07:00
Landon Curt Noll
ee30d787ea Release calc version 2.12.1.6 2017-05-21 15:38:48 -07:00
Landon Curt Noll
4e92927183 Release calc version 2.12.1.5 2017-05-21 15:38:48 -07:00
Landon Curt Noll
fb4a03c1f1 Release calc version 2.12.1.4 2017-05-21 15:38:48 -07:00
Landon Curt Noll
81a523043e Release calc version 2.12.1.3 2017-05-21 15:38:48 -07:00
Landon Curt Noll
2c0d0bbc1b Release calc version 2.12.1.2 2017-05-21 15:38:48 -07:00
Landon Curt Noll
a7147039ee Release calc version 2.12.1.1 2017-05-21 15:38:47 -07:00
Landon Curt Noll
6fa83e417e Release calc version 2.12.1 2017-05-21 15:38:47 -07:00
Landon Curt Noll
c335809b5f Release calc version 2.12.0.8 2017-05-21 15:38:47 -07:00
Landon Curt Noll
ee99adf8ca Release calc version 2.12.0.6 2017-05-21 15:38:47 -07:00
Landon Curt Noll
87570b56fe Release calc version 2.12.0.5 2017-05-21 15:38:47 -07:00
Landon Curt Noll
afe37ec851 Release calc version 2.12.0.4 2017-05-21 15:38:46 -07:00
Landon Curt Noll
bd3086138b Release calc version 2.12.0.3 2017-05-21 15:38:46 -07:00
Landon Curt Noll
9d62873a02 Release calc version 2.12.0.2 2017-05-21 15:38:46 -07:00
581 changed files with 33946 additions and 13180 deletions

111
BUGS
View File

@@ -68,22 +68,45 @@ of a context diff patch).
Known bugs:
The stoponerror() facility does not seem to work, or perhaps
the stoponerror help file is incorrect. The stoponerror help file
lacks examples because of this problem.
We are sure some more bugs exist. When you find them, please let
us know! See the above for details on how to report and were to
EMail your bug reports and hopefully patches to fix them.
=-=
Problems that have known work-a-rounds:
* There is a bug in gcc v4.1.0 that causes calc to fail the regression
test. The work-a-round is to compile with gcc v4.1.1 or later. This
problems was observed on Fedora 5.
=-=
mis-features in calc:
Some problems are not bugs but rarther mis-features / things that could
Some problems are not bugs but rather mis-features / things that could
work better. The following is a list of mis-features that should be
addressed and improved someday.
* When statement is of the form { ... }, the leading { MUST BE ON
THE SAME LINE as the if, for, while or do keyword.
This works as expected:
if (expr) {
...
}
However this WILL NOT WORK AS EXPECTED:
if (expr)
{
...
}
This needs to be changed. See also "help statement", "help unexpected",
and "help todo".
* The chi.cal resource file does not work well with odd degrees
of freedom. Can someone improve this algorithm?
@@ -106,75 +129,7 @@ mis-features in calc:
will not.
=-=
Problems with old systems that have known work-a-rounds:
* There is a bug in gcc-2.95 that causes calc, when compiled with -O2,
to fail the regression test. The work-a-round is to compile with -O
or to use gcc-2.96 or later.
This bug has been observed on the Sparc and the PowerPC machine.
On the PowerPC with gcc-2.95 when compiled with -O2, the following
patch seems to help:
*** zfunc.c.orig Fri Feb 23 18:18:39 2001
--- zfunc.c Fri Feb 23 18:39:33 2001
***************
*** 1481,1487 ****
{
HALF *a, *A, *b, *a0, u;
int i, j, j1, j2, k, k1, m, m0, m1, n, n0, o;
! FULL d, e, f, g, h, s, t, x, topbit;
int remsign;
BOOL up, onebit;
ZVALUE sqrt;
--- 1481,1488 ----
{
HALF *a, *A, *b, *a0, u;
int i, j, j1, j2, k, k1, m, m0, m1, n, n0, o;
! volatile FULL d;
! FULL e, f, g, h, s, t, x, topbit;
int remsign;
BOOL up, onebit;
ZVALUE sqrt;
*** zmath.c 2000/06/07 14:02:13 29.2
--- zmath.c 2001/03/13 19:47:03
***************
*** 1608,1614 ****
void
zbitvalue(long n, ZVALUE *res)
{
! ZVALUE z;
if (n < 0) n = 0;
z.sign = 0;
--- 1608,1614 ----
void
zbitvalue(long n, ZVALUE *res)
{
! volatile ZVALUE z;
if (n < 0) n = 0;
z.sign = 0;
* There are problems compiling calc on the sparcv9 under 64 bit
Solaris. On that platform, gcc-2.96 is able to compile calc, but
calc dumps core very early on in startup. It is said that sparcv9
support in gcc-2.96 is very unofficial and thus there is no
work-a-round for gcc-2-96.
There is a work-a-round for this architecture us one is using the
Solaris CC on the sparcv9. It has been reported that setting the
following Makefile variables will produce a working version of
calc on the sparcv9 under 64 bit Solaris:
LCC="cc -xarch=v9"
CCWARN="-DFORCE_STDC -w"
DEBUG="-fast -xarch=v9"
## Copyright (C) 1999-2006 Landon Curt Noll
## Copyright (C) 1999-2013 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
@@ -188,11 +143,11 @@ Problems with old systems that have known work-a-rounds:
## 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.
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
##
## @(#) $Revision: 29.24 $
## @(#) $Id: BUGS,v 29.24 2006/05/21 07:54:13 chongo Exp $
## @(#) $Source: /usr/local/src/cmd/calc/RCS/BUGS,v $
## @(#) $Revision: 30.2 $
## @(#) $Id: BUGS,v 30.2 2013/08/11 01:09:27 chongo Exp $
## @(#) $Source: /usr/local/src/bin/calc/RCS/BUGS,v $
##
## Under source code control: 1994/03/18 14:06:13
## File existed as early as: 1994

1249
CHANGES

File diff suppressed because it is too large Load Diff

26
COPYING
View File

@@ -6,15 +6,15 @@ This file is Copyrighted
This file is covered under the following Copyright:
Copyright (C) 1999 Landon Curt Noll
Copyright (C) 1999-2008 Landon Curt Noll
All rights reserved.
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
# @(#) $Revision: 29.8 $
# @(#) $Id: COPYING,v 29.8 2006/05/01 19:16:57 chongo Exp $
# @(#) $Source: /usr/local/src/cmd/calc/RCS/COPYING,v $
# @(#) $Revision: 30.2 $
# @(#) $Id: COPYING,v 30.2 2008/10/24 10:46:52 chongo Exp $
# @(#) $Source: /usr/local/src/bin/calc/RCS/COPYING,v $
=-=
@@ -45,12 +45,12 @@ Calc is covered by the GNU Lesser General Public License
Public License by the calc command: help copying-lgpl
You should have received a copy of the version 2.1 GNU Lesser General
Public License with calc; if not, write to:
Public License with calc; if not, write to the following address:
Free Software Foundation, Inc.
59 Temple Place
Suite 330
Boston, MA 02111-1307
51 Franklin Street
Fifth Floor
Boston, MA 02110-1301
USA
The contact addresses for calc is as follows:
@@ -168,9 +168,8 @@ Calc copyrights and exception files
These files are not covered under one of the Copyrights listed above:
shs1.c shs1.h shs.c shs.h
md5.c md5.h COPYING COPYING-LGPL
cal/qtime.cal cal/screen.cal
sha1.c sha1.h COPYING
COPYING-LGPL cal/qtime.cal cal/screen.cal
The file COPYING-LGPL, which contains a copy of the version 2.1
GNU Lesser General Public License, is itself Copyrighted by the
@@ -182,9 +181,8 @@ 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. Other files are under a
LGPL Copyright but have different authors.
Some of these exception files are in the public domain. Other files
are under the LGPL but have different authors that those listed above.
In all cases one may use and distribute these exception files freely.
And because one may freely distribute the LGPL covered files, the

View File

@@ -1,8 +1,8 @@
GNU LESSER GENERAL PUBLIC LICENSE
Version 2.1, February 1999
GNU LESSER GENERAL PUBLIC LICENSE
Version 2.1, February 1999
Copyright (C) 1991, 1999 Free Software Foundation, Inc.
59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
@@ -10,7 +10,7 @@
as the successor of the GNU Library Public License, version 2, hence
the version number 2.1.]
Preamble
Preamble
The licenses for most software are designed to take away your
freedom to share and change it. By contrast, the GNU General Public
@@ -112,7 +112,7 @@ modification follow. Pay close attention to the difference between a
former contains code derived from the library, whereas the latter must
be combined with the library in order to run.
GNU LESSER GENERAL PUBLIC LICENSE
GNU LESSER GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License Agreement applies to any software library or other
@@ -146,7 +146,7 @@ such a program is covered only if its contents constitute a work based
on the Library (independent of the use of the Library in a tool for
writing it). Whether that is true depends on what the Library does
and what the program that uses the Library does.
1. You may copy and distribute verbatim copies of the Library's
complete source code as you receive it, in any medium, provided that
you conspicuously and appropriately publish on each copy an
@@ -432,7 +432,7 @@ decision will be guided by the two goals of preserving the free status
of all derivatives of our free software and of promoting the sharing
and reuse of software generally.
NO WARRANTY
NO WARRANTY
15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
@@ -455,7 +455,7 @@ FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
DAMAGES.
END OF TERMS AND CONDITIONS
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Libraries
@@ -476,7 +476,7 @@ convey the exclusion of warranty; and each file should have at least the
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
version 2.1 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -485,7 +485,7 @@ convey the exclusion of warranty; and each file should have at least the
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
Also add information on how to contact you by electronic and paper mail.
@@ -500,5 +500,3 @@ necessary. Here is a sample; alter the names:
Ty Coon, President of Vice
That's all there is to it!

View File

@@ -1,4 +1,4 @@
Installing calc from the gziped tarball in 4 easy steps:
Installing calc from the bzip2-ed tarball in 4 easy steps:
0) If your platform supports i686 RPMs, you may want to go to:
@@ -17,16 +17,30 @@ Installing calc from the gziped tarball in 4 easy steps:
The following 4 steps apply to calc source tree that comes from either:
gunzip -c calc-*.tar.gz | tar -xvf -
bunzip2 -c calc-*.tar.bz2 | tar -xvf -
or from:
rpm -ivh calc-*.src.rpm
cd /var/tmp
gunzip -c /usr/src/redhat/SOURCES/calc-*.tar.gz | tar -xvf -
bunzip2 -c /usr/src/redhat/SOURCES/calc-*.tar.bz2 | tar -xvf -
1) Look at the makefile, and adjust it to suit your needs.
The top level Makefile and the custom/Makefile require a GNU
Make (such as gmake) or an equivalently advanced make. On many
targets, the default make is sufficent. On FreeBSD for example,
one must use gmake instead of make.
If your target system does not have GNU Make (or equivalent), then
you should try using the Makefile.simple and custom/Makefile.simple
files:
mv Makefile Makefile.gmake
cp Makefile.simple Makefile
mv custom/Makefile custom/Makefile.gmake
cp custom/Makefile.simple custom/Makefile
The Makefile, as shipped, is suitable for installation under
Linux and Un*x-like environments. For the most part, the default
values should work. If in doubt, follow the 'When in doubt'
@@ -52,14 +66,14 @@ Installing calc from the gziped tarball in 4 easy steps:
CALC_INCDIR where the calc include files are installed
CUSTOMCALDIR where custom *.cal files are installed
CUSTOMHELPDIR where custom help files are installed
CUSTOMINCPDIR where custom .h files are installed
CUSTOMINCDIR where custom .h files are installed
SCRIPTDIR where calc shell scripts are installed
If you want to install calc files under a top level directory,
then set the T value:
The calc install is performed under $T, the calc build is
performed under /. The purpose for $T is to allow someone
The calc install is performed under ${T}, the calc build is
performed under /. The purpose for ${T} is to allow someone
to install calc somewhere other than into the system area.
For example, if:
@@ -79,10 +93,10 @@ Installing calc from the gziped tarball in 4 easy steps:
calc help, .cal ...: /var/tmp/testing/usr/share/calc
... etc ... /var/tmp/testing/...
If $T is empty, calc is installed under /, which is the same
top of tree for which it was built. If $T is non-empty, then
calc is installed under $T, as if one had to chroot under
$T for calc to operate.
If ${T} is empty, calc is installed under /, which is the same
top of tree for which it was built. If ${T} is non-empty, then
calc is installed under ${T}, as if one had to chroot under
${T} for calc to operate.
Look for the section that starts:
@@ -126,12 +140,36 @@ Installing calc from the gziped tarball in 4 easy steps:
2) build calc:
The top level Makefile and the custom/Makefile require a GNU
Make (such as gmake) or an equivalently advanced make. On many
targets, the default make is sufficent. On FreeBSD for example,
one must use gmake instead of make.
If your target system does not have GNU Make (or equivalent), then
you should try using the Makefile.simple and custom/Makefile.simple
files:
mv Makefile Makefile.gmake
cp Makefile.simple Makefile
mv custom/Makefile custom/Makefile.gmake
cp custom/Makefile.simple custom/Makefile
make all
==> We are interested in any compiler warnings (and errors) that
you may find. See the BUGS file if you find any compiler
warning or errors.
NOTE: You can force calc to build with only static libs:
make clobber
make calc-static-only BLD_TYPE=calc-static-only
or force calc to build with only dynamic libs:
make clobber
make calc-dynamic-only BLD_TYPE=calc-dynamic-only
3) test calc:
make check
@@ -139,6 +177,10 @@ Installing calc from the gziped tarball in 4 easy steps:
==> If you run into problems, read the BUGS file and follow
the instructions found in there.
NOTE: For a quiet check which only prints if something goes wrong:
make chk
4) install calc:
make install
@@ -146,7 +188,7 @@ Installing calc from the gziped tarball in 4 easy steps:
We suggest that you might want to read the README file and look at
the calc help subsystem. See the README file for details.
## Copyright (C) 1999 Landon Curt Noll
## Copyright (C) 1999-2007 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
@@ -160,11 +202,11 @@ the calc help subsystem. See the README file for 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.
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
##
## @(#) $Revision: 29.7 $
## @(#) $Id: HOWTO.INSTALL,v 29.7 2003/04/15 03:38:34 chongo Exp $
## @(#) $Source: /usr/local/src/cmd/calc/RCS/HOWTO.INSTALL,v $
## @(#) $Revision: 30.6 $
## @(#) $Id: HOWTO.INSTALL,v 30.6 2007/10/16 12:22:22 chongo Exp $
## @(#) $Source: /usr/local/src/bin/calc/RCS/HOWTO.INSTALL,v $
##
## Under source code control: 1999/09/27 20:48:44
## File existed as early as: 1999

253
LIBRARY
View File

@@ -58,13 +58,18 @@ External programs most likely want to use the installed calc header
files under ${INCDIRCALC}. External programs most likely NOT want
to define CALC_SRC.
You need to include the following file to get the symbols and variables
related to error handling:
lib_calc.h
External programs may want to compile with:
-L${LIBDIR} -lcalc
-I${INCDIR} -L${LIBDIR} -lcalc
If custom functions are also used, they may want to compile with:
-L${LIBDIR} -lcalc -lcustcalc
-I${INCDIR} -L${LIBDIR} -lcalc -lcustcalc
The CALC_SRC symbol should NOT be defined by default. However if you are
feeling pedantic you may want to force CALC_SRC to be undefined:
@@ -73,71 +78,215 @@ feeling pedantic you may want to force CALC_SRC to be undefined:
as well.
--------------
ERROR HANDLING
--------------
-------------------
MATH ERROR HANDLING
-------------------
Your program MUST provide a function called math_error. This is called by
the math routines on an error condition, such as malloc failures or a
division by zero. The routine is called in the manner of printf, with a
format string and optional arguments. (However, none of the low level math
routines currently uses formatting, so if you are lazy you can simply use
the first argument as a simple error string.) For example, one of the
error calls you might expect to receive is:
The math_error() function is called by the math routines on an error
condition, such as malloc failures, division by zero, or some form of
an internal computation error. The routine is called in the manner of
printf, with a format string and optional arguments:
math_error("Division by zero");
void math_error(char *fmt, ...);
Your program can handle errors in basically one of two ways. Firstly, it
can simply print the error message and then exit. Secondly, you can make
use of setjmp and longjmp in your program. Use setjmp at some appropriate
level in your program, and use longjmp in the math_error routine to return
to that level and so recover from the error. This is what the calc program
does.
Your program must handle math errors in one of three ways:
For convenience, the link library libcalc.a contains a math_error routine.
By default, this routine simply prints a message to stderr and then exits.
By simply linking in this link library, any calc errors will result in a
error message on stderr followed by an exit.
1) Print the error message and then exit
External programs that wish to use this math_error may want to compile with:
There is a math_error() function supplied with the calc library.
By default, this routine simply prints a message to stderr and
then exits. By simply linking in this link library, any calc
errors will result in a error message on stderr followed by
an exit.
-I${LIBDIR} -L${LIBDIR} -lcalc
2) Use setjmp and longjmp in your program
If one sets up calc_jmp_buf, and then sets calc_jmp to non-zero then
this routine will longjmp back (with the value of calc_jmp) instead.
In addition, the last calc error message will be found in calc_error;
this error is not printed to stderr. The calc error message will
not have a trailing newline.
Use setjmp at some appropriate level in your program, and let
the longjmp in math_error() return to that level and to allow you
to recover from the error. This is what the calc program does.
For example:
If one sets up calc_matherr_jmpbuf, and then sets
calc_use_matherr_jmpbuf to non-zero then math_error() will
longjmp back with the return value of calc_use_matherr_jmpbuf.
In addition, the last calc error message will be found in
calc_err_msg; this error is not printed to stderr. The calc
error message will not have a trailing newline.
#include <setjmp.h>
For example:
extern jmp_buf calc_jmp_buf;
extern int calc_jmp;
extern char *calc_error;
int error;
#include <setjmp.h>
#include "lib_calc.h"
...
int error;
if ((error = setjmp(calc_jmp_buf)) != 0) {
...
/* reinitialize calc after a longjmp */
reinitialize();
if ((error = setjmp(calc_matherr_jmpbuf)) != 0) {
/* report the error */
printf("Ouch: %s\n", calc_err_msg);
/* reinitialize calc after the longjmp */
reinitialize();
}
calc_use_matherr_jmpbuf = 1;
If calc_use_matherr_jmpbuf is non-zero, then the jmp_buf value
calc_matherr_jmpbuf must be initialized by the setjmp() function
or your program will crash.
3) Supply your own math_error function:
void math_error(char *fmt, ...);
Your math_error() function may exit or transfer control to outside
of the calc library, but it must never return or calc will crash.
External programs can obtain the appropriate calc symbols by compiling with:
-I${INCDIR} -L${LIBDIR} -lcalc
-------------------------
PARSE/SCAN ERROR HANDLING
-------------------------
The scanerror() function is called when calc encounters a parse/scan
error. For example, scanerror() is called when calc is given code
with a syntax error.
The variable, calc_print_scanerr_msg, controls if calc prints to stderr,
any parse/scan errors. By default, this variable it set to 1 and so
parse/scan errors are printed to stderr. By setting this value to zero,
parse/scan errors are not printed:
#include "lib_calc.h"
/* do not print parse/scan errors to stderr */
calc_print_scanerr_msg = 0;
The last calc math error or calc parse/scan error message is kept
in the NUL terminated buffer:
char calc_err_msg[MAXERROR+1];
The value of calc_print_scanerr_msg does not change the use
of the calc_err_msg[] buffer. Messages are stored in that
buffer regardless of the calc_print_scanerr_msg value.
The calc_print_scanerr_msg and the calc_err_msg[] buffer are declared
lib_calc.h include file. The initialized storage for these variables
comes from the calc library. The MAXERROR symbol is also declared in
the lib_calc.h include file.
Your program must handle parse/scan errors in one of two ways:
1) exit on error
If you do not setup the calc_scanerr_jmpbuf, then when calc
encounters a parse/scan error, a message will be printed to
stderr and calc will exit.
2) Use setjmp and longjmp in your program
Use setjmp at some appropriate level in your program, and let
the longjmp in scanerror() return to that level and to allow you
to recover from the error. This is what the calc program does.
If one sets up calc_scanerr_jmpbuf, and then sets
calc_use_scanerr_jmpbuf to non-zero then scanerror() will longjmp
back with the return with a non-zero code. In addition, the last
calc error message will be found in calc_err_msg[]; this error is
not printed to stderr. The calc error message will not have a
trailing newline.
For example:
#include <setjmp.h>
#include "lib_calc.h"
int scan_error;
...
/* delay the printing of the parse/scan error */
calc_use_scanerr_jmpbuf = 0; /* this is optional */
if ((scan_error = setjmp(calc_scanerr_jmpbuf)) != 0) {
/* report the parse/scan */
if (calc_use_scanerr_jmpbuf == 0) {
printf("parse error: %s\n", calc_err_msg);
}
/* initialize calc after the longjmp */
initialize();
}
calc_use_scanerr_jmpbuf = 1;
If calc_use_scanerr_jmpbuf is non-zero, then the jmp_buf value
calc_scanerr_jmpbuf must be initialized by the setjmp() function
or your program will crash.
External programs can obtain the appropriate calc symbols by compiling with:
-I${INCDIR} -L${LIBDIR} -lcalc
---------------------------
PARSE/SCAN WARNING HANDLING
---------------------------
Calc parse/scan warning message are printed to stderr by the warning()
function. The routine is called in the manner of printf, with a format
string and optional arguments:
void warning(char *fmt, ...);
The variable, calc_print_scanwarn_msg, controls if calc prints to stderr,
any parse/scan warnings. By default, this variable it set to 1 and so
parse/scan warnings are printed to stderr. By setting this value to zero,
parse/scan warnings are not printed:
#include "lib_calc.h"
/* do not print parse/scan warnings to stderr */
calc_print_scanwarn_msg = 0;
The last calc calc parse/scan warning message is kept in the NUL
terminated buffer:
char calc_warn_msg[MAXERROR+1];
The value of calc_print_scanwarn_msg does not change the use
of the calc_warn_msg[] buffer. Messages are stored in that
buffer regardless of the calc_print_scanwarn_msg value.
Your program must handle parse/scan warnings in one of two ways:
1) print the warning to stderr and continue
The warning() from libcalc prints warning messages to
stderr and returns. The flow of execution is not changed.
This is what calc does by default.
2) Supply your own warning function:
void warning(char *fmt, ...);
Your warning function should simply return when it is finished.
External programs can obtain the appropriate calc symbols by compiling with:
-I${INCDIR} -L${LIBDIR} -lcalc
/* report the error */
printf("Ouch: %s\n", calc_error);
}
calc_jmp = 1;
---------------
OUTPUT ROUTINES
---------------
The output from the routines in the link library normally goes to stdout. You
can divert that output to either another FILE handle, or else to a string.
Read the routines in zio.c to see what is available. Diversions can be
nested.
The output from the routines in the link library normally goes to stdout.
You can divert that output to either another FILE handle, or else
to a string. Read the routines in zio.c to see what is available.
Diversions can be nested.
You use math_setfp to divert output to another FILE handle. Calling
math_setfp with stdout restores output to stdout.
@@ -487,11 +636,11 @@ need call libcalc_call_me_last() only once.
## 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.
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
##
## @(#) $Revision: 29.5 $
## @(#) $Id: LIBRARY,v 29.5 2001/06/08 22:57:35 chongo Exp $
## @(#) $Source: /usr/local/src/cmd/calc/RCS/LIBRARY,v $
## @(#) $Revision: 30.1 $
## @(#) $Id: LIBRARY,v 30.1 2007/03/16 11:09:46 chongo Exp $
## @(#) $Source: /usr/local/src/bin/calc/RCS/LIBRARY,v $
##
## Under source code control: 1993/07/30 19:44:49
## File existed as early as: 1993

5306
Makefile

File diff suppressed because it is too large Load Diff

5713
Makefile.simple Normal file

File diff suppressed because it is too large Load Diff

8
README
View File

@@ -132,11 +132,11 @@ The calc web site is located at:
## 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.
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
##
## @(#) $Revision: 29.3 $
## @(#) $Id: README,v 29.3 2001/06/01 11:26:53 chongo Exp $
## @(#) $Source: /usr/local/src/cmd/calc/RCS/README,v $
## @(#) $Revision: 30.1 $
## @(#) $Id: README,v 30.1 2007/03/16 11:09:46 chongo Exp $
## @(#) $Source: /usr/local/src/bin/calc/RCS/README,v $
##
## Under source code control: 1995/10/25 05:27:59
## File existed as early as: 1995

View File

@@ -10,6 +10,63 @@ NOTE: The main developers do not have access to a Windoz based platform.
Of course you are welcome to send us any patches that fix your
Windoz build environment.
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
=-= compiling with Cygwin =-=
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
An effort is being made to allow windows users to compile calc using the
Cygwin project (http://sources.redhat.com/cygwin/) with the GCC compiler
and Un*x tools for Windows.
The major porting work for Cygwin was performed by Thomas Jones-Low
(tjoneslo at softstart dot com).
In March 2009, Michael Penk (mpenk at wuska dot com) reported success in
installs under Cygwin:
On my fairly complete Cygwin installs, everything compiles,
checks, and installs correctly. My Cygwin is configured
in a very standard way (out of the box, using all of Cygwin's
defaults). The install worked on 5 different machines with
Cygwin on them: one XP home, one XP professional, and three
Vista professionals.
Using the calc Makefile, he did the following:
make all target=Cygwin
make check
make install
He also reports:
Of course, one should be logged in as an Administrator when
one builds and installs calc.
He was compiling calc 2.12.4.0 with Cygwin version 1.5.25-15.
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
=-= If all else fails, for Cygwin =-=
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Much earlier (2001?) Thomas Jones-Low (tjoneslo at softstart dot com)
recommended that you generate by hand all of the header files that
by the Makefile. This has been done for you via the makefile rule:
make win32_hsrc
which uses the Makefile variables in win32.mkdef to form these header
files under win32 directory.
You will find generated versions of these files located in the win32
sub-directory. These files may be appropriate for your Cygwin building
needs.
In particular:
Just copy the win32/*.[ch] files up into the top level calc
source directory, edit them (if needed) and build using the
Cygwin GCC compiler and Cygwin build environment.
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
=-= compiling under DJGPP =-=
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
@@ -56,7 +113,7 @@ recommends the following settings:
CALCPATH= .;./cal;~/.cal;${CALC_SHAREDIR};${CUSTOMCALDIR}
CALCRC= ${CALC_SHAREDIR}/startup;~/.calcrc;./.calcinit
CALCPAGER= less.exe -ci
DEBUG= -O2 -gstabs+
DEBUG= -O2 -gstabs+ -DWINDOZ
The 'Linux set' or 'gcc set' (see the Select your compiler type section)
should work for DJGPP systems if you set the above Makefile variables.
@@ -68,81 +125,8 @@ Look for Makefile comments of the form:
Follow those recommendations. In cases where they conflict with
the above Makefile list, follow the recommendation in the Makefile.
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
=-= compiling with Cygwin =-=
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
An effort is being made to allow windows users to compile calc using the
Cygwin project (http://sources.redhat.com/cygwin/) with the GCC compiler
and Un*x tools for Windows.
The major porting work was performed by Thomas Jones-Low
(tjoneslo at softstart dot com). He said:
I had previous stated to this group that I have successfully managed
to port a version of Calc to Windows, and promised some point to
post what was required, so here it is.
One obvious manner of doing this port is to get the latest version
of the Cygwin project (http://sources.redhat.com/cygwin/) with the
GCC compiler and Un*x tools for Windows and recompile.
I built my working version using Calc ... I am using Visual C++
version 7.0, which is an older version of the Microsoft development
tools. The make file provided with Calc is not compatible with
NMAKE, so I used the Visual Studio tools to generate another one
(not included). Calc is built in two parts, calc.dll, which is the
library, and calc.exe which is the command line interface.
He recommended that you generate by hand all of the header files that
by the Makefile. This has been done for you via the makefile rule:
make win32_hsrc
which uses the Makefile variables in win32.mkdef to form these header
files under win32 directory.
You will find generated versions of these files located in the win32
sub-directory. These files may be appropriate for your Cygwin building
needs.
In particular:
Just copy the win32/*.[ch] files up into the top level calc
source directory, edit them (if needed) and build using the
Cygwin GCC compiler and Cygwin build environment.
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
=-=-= calc maintenance folk =-=-=
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
People who maintain calc need to keep in mind the following:
The following was added to opcodes.h, config.h, zmath.h and value.h:
#if defined(_WIN32)
#ifdef _EXPORTING
#define DLL __declspec(dllexport)
#else
#define DLL __declspec(dllimport)
#endif
#else /* Windoz free systems */
#define DLL
#endif /* Windoz free systems */
Then DLL was added in front of all the exported functions. For example:
extern int configtype(char*);
was changed to:
DLL extern int configtype(char*);
## Copyright (C) 2002 Landon Curt Noll and Thomas Jones-Low
## Copyright (C) 2002-2009 Landon Curt Noll and Thomas Jones-Low
##
## 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
@@ -156,11 +140,11 @@ was changed to:
## 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.
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
##
## @(#) $Revision: 29.12 $
## @(#) $Id: README.WINDOWS,v 29.12 2004/07/28 12:52:01 chongo Exp $
## @(#) $Source: /usr/local/src/cmd/calc/RCS/README.WINDOWS,v $
## @(#) $Revision: 30.2 $
## @(#) $Id: README.WINDOWS,v 30.2 2009/03/14 02:29:31 chongo Exp $
## @(#) $Source: /usr/local/src/bin/calc/RCS/README.WINDOWS,v $
##
## Under source code control: 2001/02/25 14:00:05
## File existed as early as: 2001

49
addop.c
View File

@@ -1,7 +1,7 @@
/*
* addop - add opcodes to a function being compiled
*
* Copyright (C) 1999-2006 David I. Bell and Ernest Bowen
* Copyright (C) 1999-2007 David I. Bell and Ernest Bowen
*
* Primary author: David I. Bell
*
@@ -17,11 +17,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.9 $
* @(#) $Id: addop.c,v 29.9 2006/05/22 19:04:45 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/addop.c,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: addop.c,v 30.1 2007/03/16 11:09:46 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/RCS/addop.c,v $
*
* Under source code control: 1990/02/15 01:48:10
* File existed as early as: before 1990
@@ -33,7 +33,7 @@
#include <stdio.h>
#include "calc.h"
#include "opcodes.h"
#include "string.h"
#include "str.h"
#include "func.h"
#include "token.h"
#include "label.h"
@@ -44,17 +44,17 @@
#define OPCODEALLOCSIZE 100 /* reallocate size for opcodes in functions */
static unsigned long maxopcodes;/* number of opcodes available */
static long newindex; /* index of new function */
static char *newname; /* name of new function */
static long oldop; /* previous opcode */
static long oldoldop; /* opcode before previous opcode */
static long debugline; /* line number of latest debug opcode */
static long funccount; /* number of functions */
static long funcavail; /* available number of functions */
static FUNC *functemplate; /* function definition template */
static FUNC **functions; /* table of functions */
static STRINGHEAD funcnames; /* function names */
STATIC unsigned long maxopcodes;/* number of opcodes available */
STATIC long newindex; /* index of new function */
STATIC char *newname; /* name of new function */
STATIC long oldop; /* previous opcode */
STATIC long oldoldop; /* opcode before previous opcode */
STATIC long debugline; /* line number of latest debug opcode */
STATIC long funccount; /* number of functions */
STATIC long funcavail; /* available number of functions */
STATIC FUNC *functemplate; /* function definition template */
STATIC FUNC **functions; /* table of functions */
STATIC STRINGHEAD funcnames; /* function names */
/*
@@ -195,8 +195,8 @@ endfunc(void)
checklabels();
if (errorcount) {
printf("\"%s\": %ld error%s\n", newname, errorcount,
((errorcount == 1) ? "" : "s"));
scanerror(T_NULL,"Compilation of \"%s\" failed: %ld error(s)",
newname, errorcount);
return;
}
size = funcsize(curfunc->f_opcodecount);
@@ -280,12 +280,13 @@ rmuserfunc(char *name)
index = findstr(&funcnames, name);
if (index < 0) {
fprintf(stderr, "%s() has never been defined\n",
name);
warning("No function named \"%s\" to be undefined", name);
return;
}
if (functions[index] == NULL)
if (functions[index] == NULL) {
warning("No defined function \"%s\" to be undefined", name);
return;
}
freenumbers(functions[index]);
free(functions[index]);
if ((inputisterminal() && conf->resource_debug & RSCDBG_STDIN_FUNC) ||
@@ -526,9 +527,7 @@ addop(long op)
fp->f_opcodecount -= diff;
oldop = OP_NOP;
oldoldop = OP_NOP;
fprintf(stderr,
"Line %ld: unused value ignored\n",
linenumber());
warning("Constant before comma operator");
return;
}
break;

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: align32.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/align32.c,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: align32.c,v 30.1 2007/03/16 11:09:46 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/RCS/align32.c,v $
*
* Under source code control: 1995/11/23 05:18:06
* File existed as early as: 1995

67
alloc.h
View File

@@ -1,7 +1,7 @@
/*
* alloc - storage allocation and storage debug macros
*
* Copyright (C) 1999 David I. Bell
* Copyright (C) 1999-2007 David I. Bell
*
* 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
@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.4 $
* @(#) $Id: alloc.h,v 29.4 2001/06/08 21:00:58 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/alloc.h,v $
* @(#) $Revision: 30.3 $
* @(#) $Id: alloc.h,v 30.3 2013/08/11 08:41:38 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/RCS/alloc.h,v $
*
* Under source code control: 1990/02/15 01:48:29
* File existed as early as: before 1990
@@ -33,54 +33,42 @@
#if defined(CALC_SRC) /* if we are building from the calc source tree */
# include "have_malloc.h"
# include "have_newstr.h"
# include "have_string.h"
# include "have_memmv.h"
#else
# include <calc/have_malloc.h>
# include <calc/have_newstr.h>
# include <calc/have_string.h>
# include <calc/have_memmv.h>
#endif
#ifdef HAVE_MALLOC_H
# include <malloc.h>
#else
#if defined(FORCE_STDC) || (defined(__STDC__) && __STDC__ != 0) || defined(__cplusplus)
extern void *malloc();
extern void *realloc();
extern void free();
# else
extern char *malloc();
extern char *realloc();
extern void free();
# endif
#endif
#ifdef HAVE_STRING_H
# include <string.h>
#else
#if defined(_WIN32) && defined(NOTCYGWIN)
#include <stdio.h>
#endif
# if defined(HAVE_NEWSTR)
extern void *memcpy();
extern void *memset();
#if defined(FORCE_STDC) || (defined(__STDC__) && __STDC__ != 0) || defined(__cplusplus)
extern size_t strlen();
E_FUNC void *memcpy();
E_FUNC void *memset();
#if defined(FORCE_STDC) || \
(defined(__STDC__) && __STDC__ != 0) || defined(__cplusplus)
E_FUNC size_t strlen();
# else
extern long strlen();
E_FUNC long strlen();
# endif
# else /* HAVE_NEWSTR */
extern void bcopy();
extern void bfill();
extern char *index();
E_FUNC void bcopy();
E_FUNC void bfill();
E_FUNC char *index();
# endif /* HAVE_NEWSTR */
extern char *strchr();
extern char *strcpy();
extern char *strncpy();
extern char *strcat();
extern int strcmp();
E_FUNC char *strchr();
E_FUNC char *strcpy();
E_FUNC char *strncpy();
E_FUNC char *strcat();
E_FUNC int strcmp();
#endif
@@ -94,13 +82,14 @@ extern int strcmp();
#endif /* HAVE_NEWSTR */
#if !defined(HAVE_MEMMOVE)
# undef CALC_SIZE_T
#if defined(FORCE_STDC) || (defined(__STDC__) && __STDC__ != 0) || defined(__cplusplus)
# define CALC_SIZE_T size_t
# undef MEMMOVE_SIZE_T
#if defined(FORCE_STDC) || \
(defined(__STDC__) && __STDC__ != 0) || defined(__cplusplus)
# define MEMMOVE_SIZE_T size_t
# else
# define CALC_SIZE_T long
# define MEMMOVE_SIZE_T long
# endif
extern void *memmove(void *s1, const void *s2, CALC_SIZE_T n);
E_FUNC void *memmove(void *s1, CONST void *s2, MEMMOVE_SIZE_T n);
#endif
#endif /* !__ALLOC_H__ */

View File

@@ -1,7 +1,7 @@
/*
* assocfunc - association table routines
*
* Copyright (C) 1999 David I. Bell
* Copyright (C) 1999-2007 David I. Bell
*
* 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
@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: assocfunc.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/assocfunc.c,v $
* @(#) $Revision: 30.2 $
* @(#) $Id: assocfunc.c,v 30.2 2013/08/11 08:41:38 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/RCS/assocfunc.c,v $
*
* Under source code control: 1993/07/20 23:04:27
* File existed as early as: 1993
@@ -46,10 +46,10 @@
#define ELEMSIZE(n) (sizeof(ASSOCELEM) + (sizeof(VALUE) * ((n) - 1)))
static ASSOCELEM *elemindex(ASSOC *ap, long index);
static BOOL compareindices(VALUE *v1, VALUE *v2, long dim);
static void resize(ASSOC *ap, long newsize);
static void assoc_elemfree(ASSOCELEM *ep);
S_FUNC ASSOCELEM *elemindex(ASSOC *ap, long index);
S_FUNC BOOL compareindices(VALUE *v1, VALUE *v2, long dim);
S_FUNC void resize(ASSOC *ap, long newsize);
S_FUNC void assoc_elemfree(ASSOCELEM *ep);
/*
@@ -69,7 +69,7 @@ associndex(ASSOC *ap, BOOL create, long dim, VALUE *indices)
{
ASSOCELEM **listhead;
ASSOCELEM *ep;
static VALUE val;
STATIC VALUE val;
QCKHASH hash;
int i;
@@ -200,7 +200,7 @@ assocrsearch(ASSOC *ap, VALUE *vp, long i, long j, ZVALUE *index)
* ap association to index into
* index index of desired element
*/
static ASSOCELEM *
S_FUNC ASSOCELEM *
elemindex(ASSOC *ap, long index)
{
ASSOCELEM *ep;
@@ -332,7 +332,8 @@ assoccopy(ASSOC *oldap)
oldep = oldep->e_next) {
ep = (ASSOCELEM *) malloc(ELEMSIZE(oldep->e_dim));
if (ep == NULL) {
math_error("Cannot allocate association element");
math_error("Cannot allocate "
"association element");
/*NOTREACHED*/
}
ep->e_dim = oldep->e_dim;
@@ -340,7 +341,8 @@ assoccopy(ASSOC *oldap)
ep->e_value.v_type = V_NULL;
ep->e_value.v_subtype = V_NOSUBTYPE;
for (i = 0; i < ep->e_dim; i++)
copyvalue(&oldep->e_indices[i], &ep->e_indices[i]);
copyvalue(&oldep->e_indices[i],
&ep->e_indices[i]);
copyvalue(&oldep->e_value, &ep->e_value);
listhead = &ap->a_table[ep->e_hash % ap->a_size];
ep->e_next = *listhead;
@@ -356,7 +358,7 @@ assoccopy(ASSOC *oldap)
* This is only actually done if the growth from the previous size is
* enough to make this worthwhile.
*/
static void
S_FUNC void
resize(ASSOC *ap, long newsize)
{
ASSOCELEM **oldtable;
@@ -400,7 +402,7 @@ resize(ASSOC *ap, long newsize)
/*
* Free an association element, along with any contained values.
*/
static void
S_FUNC void
assoc_elemfree(ASSOCELEM *ep)
{
int i;
@@ -520,7 +522,7 @@ assocprint(ASSOC *ap, long max_print)
* Compare two lists of index values to see if they are identical.
* Returns TRUE if they are the same.
*/
static BOOL
S_FUNC BOOL
compareindices(VALUE *v1, VALUE *v2, long dim)
{
int i;

View File

@@ -1,7 +1,7 @@
/*
* blkcpy - general values and related routines used by the calculator
*
* Copyright (C) 1999-2006 Landon Curt Noll and Ernest Bowen
* Copyright (C) 1999-2007 Landon Curt Noll and Ernest Bowen
*
* Primary author: Landon Curt Noll
*
@@ -17,11 +17,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.9 $
* @(#) $Id: blkcpy.c,v 29.9 2006/05/20 08:43:55 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/blkcpy.c,v $
* @(#) $Revision: 30.2 $
* @(#) $Id: blkcpy.c,v 30.2 2013/08/11 08:41:38 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/RCS/blkcpy.c,v $
*
* Under source code control: 1997/04/18 20:41:26
* File existed as early as: 1997
@@ -36,7 +36,7 @@
#include "value.h"
#include "file.h"
#include "blkcpy.h"
#include "string.h"
#include "str.h"
/*
@@ -374,7 +374,8 @@ copyblk2mat(BLOCK *blk, long ssi, long num, MATRIX *dmat, long dsi)
* copymat2blk - copy matrix to block
*/
int
copymat2blk(MATRIX *smat, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc)
copymat2blk(MATRIX *smat, long ssi, long num, BLOCK *dblk, long dsi,
BOOL noreloc)
{
long i;
long newlen;
@@ -720,7 +721,8 @@ copystr2file(STRING *str, long ssi, long num, FILEID id, long dsi)
* copyblk2blk - copy block to block
*/
int
copyblk2blk(BLOCK *sblk, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc)
copyblk2blk(BLOCK *sblk, long ssi, long num, BLOCK *dblk, long dsi,
BOOL noreloc)
{
long newlen;
long newsize;
@@ -762,7 +764,8 @@ copyblk2blk(BLOCK *sblk, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc
* copystr2blk - copy string to block
*/
int
copystr2blk(STRING *str, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc)
copystr2blk(STRING *str, long ssi, long num, BLOCK *dblk, long dsi,
BOOL noreloc)
{
long len;
long newlen;
@@ -935,7 +938,7 @@ copyostr2blk(char *str,long ssi,long num,BLOCK *dblk,long dsi,BOOL noreloc)
* s1
*/
void *
memmove(void *s1, const void *s2, CALC_SIZE_T n)
memmove(void *s1, CONST void *s2, MEMMOVE_SIZE_T n)
{
/*
* firewall
@@ -982,7 +985,8 @@ memmove(void *s1, const void *s2, CALC_SIZE_T n)
* copynum2blk - copy number numerator to block
*/
int
copynum2blk(NUMBER *snum, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc)
copynum2blk(NUMBER *snum, long ssi, long num, BLOCK *dblk, long dsi,
BOOL noreloc)
{
size_t newlen;
size_t newsize;
@@ -1033,7 +1037,8 @@ copynum2blk(NUMBER *snum, long ssi, long num, BLOCK *dblk, long dsi, BOOL norelo
* copyblk2num - copy block to number
*/
int
copyblk2num(BLOCK *sblk, long ssi, long num, NUMBER *dnum, long dsi, NUMBER **res)
copyblk2num(BLOCK *sblk, long ssi, long num, NUMBER *dnum, long dsi,
NUMBER **res)
{
size_t newlen;
NUMBER *ret; /* cloned and modified numerator */

View File

@@ -1,7 +1,7 @@
/*
* blkcpy - general values and related routines used by the calculator
*
* Copyright (C) 1999 Landon Curt Noll and Ernest Bowen
* Copyright (C) 1999-2007 Landon Curt Noll and Ernest Bowen
*
* Primary author: Landon Curt Noll
*
@@ -17,11 +17,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: blkcpy.h,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/blkcpy.h,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: blkcpy.h,v 30.1 2007/03/16 11:09:46 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/RCS/blkcpy.h,v $
*
* Under source code control: 1997/04/18 20:41:25
* File existed as early as: 1997
@@ -36,27 +36,27 @@
/*
* the main copy gateway function
*/
extern int copystod(VALUE *, long, long, VALUE *, long);
E_FUNC int copystod(VALUE *, long, long, VALUE *, long);
/*
* specific copy functions
*/
extern int copyblk2blk(BLOCK *, long, long, BLOCK *, long, BOOL);
extern int copyblk2file(BLOCK *, long, long, FILEID, long);
extern int copyblk2mat(BLOCK *, long, long, MATRIX *, long);
extern int copyblk2num(BLOCK *, long, long, NUMBER *, long, NUMBER **);
extern int copyblk2str(BLOCK *, long, long, STRING *, long);
extern int copyfile2blk(FILEID, long, long, BLOCK *, long, BOOL);
extern int copylist2list(LIST *, long, long, LIST *, long);
extern int copylist2mat(LIST *, long, long, MATRIX *, long);
extern int copymat2blk(MATRIX *, long, long, BLOCK *, long, BOOL);
extern int copymat2list(MATRIX *, long, long, LIST *, long);
extern int copymat2mat(MATRIX *, long, long, MATRIX *, long);
extern int copynum2blk(NUMBER *, long, long, BLOCK *, long, BOOL);
extern int copyostr2blk(char *, long, long, BLOCK *, long, BOOL);
extern int copyostr2str(char *, long, long, STRING *, long);
extern int copystr2blk(STRING *, long, long, BLOCK *, long, BOOL);
extern int copystr2file(STRING *, long, long, FILEID, long);
extern int copystr2str(STRING *, long, long, STRING *, long);
E_FUNC int copyblk2blk(BLOCK *, long, long, BLOCK *, long, BOOL);
E_FUNC int copyblk2file(BLOCK *, long, long, FILEID, long);
E_FUNC int copyblk2mat(BLOCK *, long, long, MATRIX *, long);
E_FUNC int copyblk2num(BLOCK *, long, long, NUMBER *, long, NUMBER **);
E_FUNC int copyblk2str(BLOCK *, long, long, STRING *, long);
E_FUNC int copyfile2blk(FILEID, long, long, BLOCK *, long, BOOL);
E_FUNC int copylist2list(LIST *, long, long, LIST *, long);
E_FUNC int copylist2mat(LIST *, long, long, MATRIX *, long);
E_FUNC int copymat2blk(MATRIX *, long, long, BLOCK *, long, BOOL);
E_FUNC int copymat2list(MATRIX *, long, long, LIST *, long);
E_FUNC int copymat2mat(MATRIX *, long, long, MATRIX *, long);
E_FUNC int copynum2blk(NUMBER *, long, long, BLOCK *, long, BOOL);
E_FUNC int copyostr2blk(char *, long, long, BLOCK *, long, BOOL);
E_FUNC int copyostr2str(char *, long, long, STRING *, long);
E_FUNC int copystr2blk(STRING *, long, long, BLOCK *, long, BOOL);
E_FUNC int copystr2file(STRING *, long, long, FILEID, long);
E_FUNC int copystr2str(STRING *, long, long, STRING *, long);
#endif /* !__BLKCPY_H__ */

24
block.c
View File

@@ -1,7 +1,7 @@
/*
* block - fixed, dynamic, fifo and circular memory blocks
*
* Copyright (C) 1999 Landon Curt Noll and Ernest Bowen
* Copyright (C) 1999-2007 Landon Curt Noll and Ernest Bowen
*
* Primary author: Landon Curt Noll
*
@@ -17,11 +17,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.3 $
* @(#) $Id: block.c,v 29.3 2006/05/01 19:16:57 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/block.c,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: block.c,v 30.1 2007/03/16 11:09:46 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/RCS/block.c,v $
*
* Under source code control: 1997/02/27 00:29:40
* File existed as early as: 1997
@@ -37,19 +37,19 @@
#include "config.h"
#include "block.h"
#include "nametype.h"
#include "string.h"
#include "str.h"
#include "calcerr.h"
#define NBLOCKCHUNK 16
static long nblockcount = 0;
static long maxnblockcount = 0;
static STRINGHEAD nblocknames;
static NBLOCK **nblocks;
STATIC long nblockcount = 0;
STATIC long maxnblockcount = 0;
STATIC STRINGHEAD nblocknames;
STATIC NBLOCK **nblocks;
/* forward declarations */
static void blkchk(BLOCK*);
S_FUNC void blkchk(BLOCK*);
/*
@@ -154,7 +154,7 @@ blk_free(BLOCK *blk)
* if all is ok, otherwise math_error() is called and this
* function does not return
*/
static void
S_FUNC void
blkchk(BLOCK *blk)
{

44
block.h
View File

@@ -1,7 +1,7 @@
/*
* block - fixed, dynamic, fifo and circular memory blocks
*
* Copyright (C) 1999 Landon Curt Noll and Ernest Bowen
* Copyright (C) 1999-2007 Landon Curt Noll and Ernest Bowen
*
* Primary author: Landon Curt Noll
*
@@ -17,11 +17,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: block.h,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/block.h,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: block.h,v 30.1 2007/03/16 11:09:46 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/RCS/block.h,v $
*
* Under source code control: 1997/02/21 05:03:39
* File existed as early as: 1997
@@ -160,7 +160,7 @@ typedef struct nblock NBLOCK;
/*
* block debug
*/
extern int blk_debug; /* 0 => debug off */
EXTERN int blk_debug; /* 0 => debug off */
/*
@@ -204,22 +204,22 @@ typedef USB8 OCTET;
/*
* external functions
*/
extern BLOCK *blkalloc(int, int);
extern void blk_free(BLOCK*);
extern BLOCK *blkrealloc(BLOCK*, int, int);
extern void blktrunc(BLOCK*);
extern BLOCK *blk_copy(BLOCK*);
extern int blk_cmp(BLOCK*, BLOCK*);
extern void blk_print(BLOCK*);
extern void nblock_print(NBLOCK *);
extern NBLOCK *createnblock(char *, int, int);
extern NBLOCK *reallocnblock(int, int, int);
extern int removenblock(int);
extern int findnblockid(char *);
extern NBLOCK *findnblock(int);
extern BLOCK *copyrealloc(BLOCK*, int, int);
extern int countnblocks(void);
extern void shownblocks(void);
E_FUNC BLOCK *blkalloc(int, int);
E_FUNC void blk_free(BLOCK*);
E_FUNC BLOCK *blkrealloc(BLOCK*, int, int);
E_FUNC void blktrunc(BLOCK*);
E_FUNC BLOCK *blk_copy(BLOCK*);
E_FUNC int blk_cmp(BLOCK*, BLOCK*);
E_FUNC void blk_print(BLOCK*);
E_FUNC void nblock_print(NBLOCK *);
E_FUNC NBLOCK *createnblock(char *, int, int);
E_FUNC NBLOCK *reallocnblock(int, int, int);
E_FUNC int removenblock(int);
E_FUNC int findnblockid(char *);
E_FUNC NBLOCK *findnblock(int);
E_FUNC BLOCK *copyrealloc(BLOCK*, int, int);
E_FUNC int countnblocks(void);
E_FUNC void shownblocks(void);
#endif /* !__BLOCK_H__ */

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: byteswap.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/byteswap.c,v $
* @(#) $Revision: 30.2 $
* @(#) $Id: byteswap.c,v 30.2 2013/08/11 08:41:38 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/RCS/byteswap.c,v $
*
* Under source code control: 1995/10/11 04:44:01
* File existed as early as: 1995
@@ -102,7 +102,8 @@ swap_b8_in_ZVALUE(ZVALUE *dest, ZVALUE *src, BOOL all)
*/
dest = malloc(sizeof(ZVALUE));
if (dest == NULL) {
math_error("swap_b8_in_ZVALUE: swap_b8_in_ZVALUE: Not enough memory");
math_error("swap_b8_in_ZVALUE: swap_b8_in_ZVALUE: "
"Not enough memory");
/*NOTREACHED*/
}

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.4 $
* @(#) $Id: byteswap.h,v 29.4 2001/06/08 21:00:58 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/byteswap.h,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: byteswap.h,v 30.1 2007/03/16 11:09:46 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/RCS/byteswap.h,v $
*
* Under source code control: 1995/10/11 04:44:01
* File existed as early as: 1995

View File

@@ -2,7 +2,7 @@
#
# cal - makefile for calc standard resource files
#
# Copyright (C) 1999 Landon Curt Noll
# Copyright (C) 1999-2006 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
@@ -16,11 +16,11 @@
# 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.
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
#
# @(#) $Revision: 29.18 $
# @(#) $Id: Makefile,v 29.18 2006/05/20 19:32:40 chongo Exp $
# @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/Makefile,v $
# @(#) $Revision: 30.7 $
# @(#) $Id: Makefile,v 30.7 2013/08/11 09:07:26 chongo Exp $
# @(#) $Source: /usr/local/src/bin/calc/cal/RCS/Makefile,v $
#
# Under source code control: 1991/07/21 05:00:54
# File existed as early as: 1991
@@ -33,14 +33,31 @@
# required vars
#
SHELL = /bin/sh
MAKE_FILE = Makefile
SHELL= /bin/sh
####
# Normally, the upper level makefile will set these values. We provide
# a default here just in case you want to build from this directory.
####
# Normally certain files depend on the Makefile. If the Makefile is
# changed, then certain steps should be redone. If MAKE_FILE is
# set to Makefile, then these files will depend on Makefile. If
# MAKE_FILE is empty, then they wont.
#
# If in doubt, set MAKE_FILE to Makefile
#
MAKE_FILE= Makefile
# Controlling file makefile basename (without the path)
#
# This is the basename same of the makefile that may/does/will drive
# this makefile.
#
# If in doubt, set TOP_MAKE_FILE to Makefile
#
TOP_MAKE_FILE= Makefile
# Where the system include (.h) files are kept
#
# For DJGPP, select:
@@ -62,9 +79,9 @@ INCDIR= /usr/include
# ${LIBDIR} where calc link library (*.a) files are installed
# ${CALC_SHAREDIR} where to install calc help, .cal, startup, config files
#
# NOTE: The install rule prepends installation paths with $T, which
# by default is empty. If $T is non-empty, then installation
# locations will be relative to the $T directory.
# NOTE: The install rule prepends installation paths with ${T}, which
# by default is empty. If ${T} is non-empty, then installation
# locations will be relative to the ${T} directory.
#
# For DJGPP, select:
#
@@ -94,35 +111,26 @@ CALC_SHAREDIR= /usr/share/calc
# ---------------------------------------------------------------
# ${HELPDIR} where the help directory is installed
# ${CALC_INCDIR} where the calc include files are installed
# ${CUSTOMCALDIR} where custom *.cal files are installed
# ${CUSTOMHELPDIR} where custom help files are installed
# ${CUSTOMINCPDIR} where custom .h files are installed
# ${SCRIPTDIR} where calc shell scripts are installed
#
# NOTE: The install rule prepends installation paths with $T, which
# by default is empty. If $T is non-empty, then installation
# locations will be relative to the $T directory.
# NOTE: The install rule prepends installation paths with ${T}, which
# by default is empty. If ${T} is non-empty, then installation
# locations will be relative to the ${T} directory.
#
# If in doubt, set:
#
# HELPDIR= ${CALC_SHAREDIR}/help
# CALC_INCDIR= ${INCDIR}/calc
# CUSTOMCALDIR= ${CALC_SHAREDIR}/custom
# CUSTOMHELPDIR= ${CALC_SHAREDIR}/custhelp
# CUSTOMINCDIR= ${CALC_INCDIR}/custom
# SCRIPTDIR= ${BINDIR}/cscript
#
HELPDIR= ${CALC_SHAREDIR}/help
CALC_INCDIR= ${INCDIR}/calc
CUSTOMCALDIR= ${CALC_SHAREDIR}/custom
CUSTOMHELPDIR= ${CALC_SHAREDIR}/custhelp
CUSTOMINCDIR= ${CALC_INCDIR}/custom
SCRIPTDIR= ${BINDIR}/cscript
# T - top level directory under which calc will be installed
#
# The calc install is performed under $T, the calc build is
# performed under /. The purpose for $T is to allow someone
# The calc install is performed under ${T}, the calc build is
# performed under /. The purpose for ${T} is to allow someone
# to install calc somewhere other than into the system area.
#
# For example, if:
@@ -142,10 +150,10 @@ SCRIPTDIR= ${BINDIR}/cscript
# calc help, .cal ...: /var/tmp/testing/usr/share/calc
# ... etc ... /var/tmp/testing/...
#
# If $T is empty, calc is installed under /, which is the same
# top of tree for which it was built. If $T is non-empty, then
# calc is installed under $T, as if one had to chroot under
# $T for calc to operate.
# If ${T} is empty, calc is installed under /, which is the same
# top of tree for which it was built. If ${T} is non-empty, then
# calc is installed under ${T}, as if one had to chroot under
# ${T} for calc to operate.
#
# If in doubt, use T=
#
@@ -163,21 +171,32 @@ Q=@
#
CHMOD= chmod
CMP= cmp
RM= rm
MKDIR= mkdir
RMDIR= rmdir
CP= cp
MV= mv
CO= co
TRUE= true
TOUCH= touch
# The calc files to install
#
CALC_FILES= README bigprime.cal deg.cal ellip.cal lucas.cal lucas_chk.cal \
lucas_tbl.cal mersenne.cal mod.cal pell.cal pi.cal pix.cal \
pollard.cal poly.cal psqrt.cal quat.cal regress.cal solve.cal \
sumsq.cal surd.cal unitfrac.cal varargs.cal chrem.cal mfactor.cal \
bindings randmprime.cal test1700.cal randrun.cal linear.cal \
randbitrun.cal bernoulli.cal test2300.cal test2600.cal \
test2700.cal test3100.cal test3300.cal test3400.cal prompt.cal \
test3500.cal seedrandom.cal test4000.cal test4100.cal test4600.cal \
beer.cal hello.cal test5100.cal test5200.cal randombitrun.cal \
randomrun.cal repeat.cal xx_print.cal natnumset.cal qtime.cal \
test8400.cal test8500.cal test8600.cal chi.cal intfile.cal screen.cal \
dotest.cal set8700.cal set8700.line
CALC_FILES= alg_config.cal beer.cal bernoulli.cal bernpoly.cal \
bigprime.cal bindings brentsolve.cal chi.cal chrem.cal constants.cal \
deg.cal dms.cal dotest.cal ellip.cal factorial2.cal factorial.cal \
gvec.cal hello.cal hms.cal intfile.cal lambertw.cal linear.cal \
lnseries.cal lucas.cal lucas_chk.cal lucas_tbl.cal mersenne.cal \
mfactor.cal mod.cal natnumset.cal pell.cal pi.cal pix.cal pollard.cal \
poly.cal prompt.cal psqrt.cal qtime.cal quat.cal randbitrun.cal \
randmprime.cal randombitrun.cal randomrun.cal randrun.cal README \
regress.cal repeat.cal screen.cal seedrandom.cal set8700.cal \
set8700.line solve.cal specialfunctions.cal statistics.cal sumsq.cal \
sumtimes.cal surd.cal test1700.cal test2300.cal test2600.cal \
test2700.cal test3100.cal test3300.cal test3400.cal test3500.cal \
test4000.cal test4100.cal test4600.cal test5100.cal test5200.cal \
test8400.cal test8500.cal test8600.cal test8900.cal toomcook.cal \
unitfrac.cal varargs.cal xx_print.cal zeta2.cal
# These files are found (but not built) in the distribution
#
@@ -192,8 +211,8 @@ all: ${CALC_FILES} ${MAKE_FILE} .all
# used by the upper level Makefile to determine of we have done all
#
.all:
rm -f .all
touch .all
${RM} -f .all
${TOUCH} .all
##
#
@@ -209,17 +228,17 @@ all: ${CALC_FILES} ${MAKE_FILE} .all
##
distlist: ${DISTLIST}
${Q}for i in ${DISTLIST} /dev/null; do \
${Q} for i in ${DISTLIST} /dev/null; do \
if [ X"$$i" != X"/dev/null" ]; then \
echo cal/$$i; \
fi; \
done
distdir:
${Q}echo cal
${Q} echo cal
calcliblist:
${Q}for i in ${CALCLIBLIST} /dev/null; do \
${Q} for i in ${CALCLIBLIST} /dev/null; do \
if [ X"$$i" != X"/dev/null" ]; then \
echo cal/$$i; \
fi; \
@@ -232,7 +251,7 @@ calcliblist:
##
echo_inst_files:
${Q}for i in ${CALC_FILES} /dev/null; do \
${Q} for i in ${CALC_FILES} /dev/null; do \
if [ X"$$i" != X"/dev/null" ]; then \
echo __file__ ${CALC_SHAREDIR}/$$i; \
fi; \
@@ -246,33 +265,62 @@ echo_inst_files:
clean:
clobber:
rm -f .all
clobber: clean
${RM} -f .all
# install everything
#
# NOTE: Keep the uninstall rule in reverse order to the install rule
#
install: all
-${Q}if [ ! -d $T${CALC_SHAREDIR} ]; then \
echo mkdir $T${CALC_SHAREDIR}; \
mkdir $T${CALC_SHAREDIR}; \
if [ ! -d "$T${CALC_SHAREDIR}" ]; then \
echo mkdir -p "$T${CALC_SHAREDIR}"; \
mkdir -p "$T${CALC_SHAREDIR}"; \
-${Q} if [ ! -d ${T}${CALC_SHAREDIR} ]; then \
echo ${MKDIR} ${T}${CALC_SHAREDIR}; \
${MKDIR} ${T}${CALC_SHAREDIR}; \
if [ ! -d "${T}${CALC_SHAREDIR}" ]; then \
echo ${MKDIR} -p "${T}${CALC_SHAREDIR}"; \
${MKDIR} -p "${T}${CALC_SHAREDIR}"; \
fi; \
echo ${CHMOD} 0755 $T${CALC_SHAREDIR}; \
${CHMOD} 0755 $T${CALC_SHAREDIR}; \
echo ${CHMOD} 0755 ${T}${CALC_SHAREDIR}; \
${CHMOD} 0755 ${T}${CALC_SHAREDIR}; \
else \
true; \
${TRUE}; \
fi
${Q}for i in ${CALC_FILES} /dev/null; do \
${Q} for i in ${CALC_FILES} /dev/null; do \
if [ "$$i" = "/dev/null" ]; then \
continue; \
fi; \
if ${CMP} -s $$i $T${CALC_SHAREDIR}/$$i; then \
true; \
if ${CMP} -s $$i ${T}${CALC_SHAREDIR}/$$i; then \
${TRUE}; \
else \
rm -f $T${CALC_SHAREDIR}/$$i.new; \
cp -f $$i $T${CALC_SHAREDIR}/$$i.new; \
${CHMOD} 0444 $T${CALC_SHAREDIR}/$$i.new; \
mv -f $T${CALC_SHAREDIR}/$$i.new $T${CALC_SHAREDIR}/$$i; \
echo "installed $T${CALC_SHAREDIR}/$$i"; \
${RM} -f ${T}${CALC_SHAREDIR}/$$i.new; \
${CP} -f $$i ${T}${CALC_SHAREDIR}/$$i.new; \
${CHMOD} 0444 ${T}${CALC_SHAREDIR}/$$i.new; \
${MV} -f ${T}${CALC_SHAREDIR}/$$i.new ${T}${CALC_SHAREDIR}/$$i;\
echo "installed ${T}${CALC_SHAREDIR}/$$i"; \
fi; \
done
# Try to remove everything that was installed
#
# NOTE: Keep the uninstall rule in reverse order to the install rule
#
uninstall:
-${Q} for i in ${CALC_FILES} /dev/null; do \
if [ "$$i" = "/dev/null" ]; then \
continue; \
fi; \
if [ -f "${T}${CALC_SHAREDIR}/$$i" ]; then \
${RM} -f "${T}${CALC_SHAREDIR}/$$i"; \
if [ -f "${T}${CALC_SHAREDIR}/$$i" ]; then \
echo "cannot uninstall ${T}${CALC_SHAREDIR}/$$i"; \
else \
echo "uninstalled ${T}${CALC_SHAREDIR}/$$i"; \
fi; \
fi; \
done
-${Q} for i in ${CALC_SHAREDIR}; do \
if [ -d "${T}$$i" ]; then \
${RMDIR} "${T}$$i" 2>/dev/null; \
echo "cleaned up ${T}$$i"; \
fi; \
done

View File

@@ -75,7 +75,7 @@ have meanings are as follows:
is displayed.
2 Show func will display more information about a functions
arguments as well as more argument sdummary information.
arguments as well as more argument summary information.
3 During execution, allow calc standard resource files
to output additional debugging information.
@@ -103,7 +103,7 @@ either of the bottom 2 bits set:
print "funcB(size, mass, ...) defined";
}
If your the resource file needs to output special debugging informatin,
If your the resource file needs to output special debugging information,
we recommend that you check for bit 3 of the config("resource_debug")
before printing the debug statement:
@@ -117,12 +117,69 @@ The following is a brief description of some of the calc resource files
that are shipped with calc. See above for example of how to read in
and execute these files.
alg_config.cal
global test_time
mul_loop(repeat,x) defined
mul_ratio(len) defined
best_mul2() defined
sq_loop(repeat,x) defined
sq_ratio(len) defined
best_sq2() defined
pow_loop(repeat,x,ex) defined
pow_ratio(len) defined
best_pow2() defined
These functions search for an optimal value of config("mul2"),
config("sq2"), and config("pow2"). The calc default values of these
configuration values were set by running this resource file on a
1.8GHz AMD 32-bit CPU of ~3406 BogoMIPS.
The best_mul2() function returns the optimal value of config("mul2").
The best_sq2() function returns the optimal value of config("sq2").
The best_pow2() function returns the optimal value of config("pow2").
The other functions are just support functions.
By design, best_mul2(), best_sq2(), and best_pow2() take a few
minutes to run. These functions increase the number of times a
given computational loop is executed until a minimum amount of CPU
time is consumed. To watch these functions progress, one can set
the config("user_debug") value.
Here is a suggested way to use this resource file:
; read alg_config
; config("user_debug",2),;
; best_mul2(); best_sq2(); best_pow2();
; best_mul2(); best_sq2(); best_pow2();
; best_mul2(); best_sq2(); best_pow2();
NOTE: It is perfectly normal for the optimal value returned to differ
slightly from run to run. Slight variations due to inaccuracy in
CPU timings will cause the best value returned to differ slightly
from run to run.
One can use a calc startup file to change the initial values of
config("mul2"), config("sq2"), and config("pow2"). For example one
can place into ~/.calcrc these lines:
config("mul2", 1780),;
config("sq2", 3388),;
config("pow2", 176),;
to automatically and silently change these config values.
See help/config and CALCRC in help/environment for more information.
beer.cal
Calc's contribution to the 99 Bottles of Beer web page:
This calc resource is calc's contribution to the 99 Bottles of Beer
web page:
http://www.ionet.net/~timtroyr/funhouse/beer.html#calc
NOTE: This resource produces a lot of output. :-)
bernoulli.cal
@@ -132,7 +189,19 @@ bernoulli.cal
NOTE: There is now a bernoulli() builtin function. This file is
left here for backward compatibility and now simply returns
the buildin function.
the builtin function.
bernpoly.cal
bernpoly(n,z)
Computes the nth Bernoulli polynomial at z for arbitrary n,z. See:
http://en.wikipedia.org/wiki/Bernoulli_polynomials
http://mathworld.wolfram.com/BernoulliPolynomial.html
for further information
bigprime.cal
@@ -142,6 +211,34 @@ bigprime.cal
A prime test, base a, on p*2^x+1 for even x>m.
brentsolve.cal
brentsolve(low, high,eps)
A root-finder implementwed with the Brent-Dekker trick.
brentsolve2(low, high,which,eps)
The second function, brentsolve2(low, high,which,eps) has some lines
added to make it easier to hardcode the name of the helper function
different from the obligatory "f".
See:
http://en.wikipedia.org/wiki/Brent%27s_method
http://mathworld.wolfram.com/BrentsMethod.html
to find out more about the Brent-Dekker method.
constants.cal
e()
G()
An implementation of different constants to arbitrary precision.
chi.cal
Z(x[, eps])
@@ -153,9 +250,9 @@ chi.cal
The chi_prob() function does not work well with odd degrees of freedom.
It is reasonable with even degrees of freedom, although one must give
a sifficently small error term as the degress gets large (>100).
a sufficiently small error term as the degrees gets large (>100).
The Z(x) and P(x) are internal statistical funcions.
The Z(x) and P(x) are internal statistical functions.
eps is an optional epsilon() like error term.
@@ -170,14 +267,37 @@ chrem.cal
deg.cal
deg(deg, min, sec)
deg_add(a, b)
deg_neg(a)
deg_sub(a, b)
deg_mul(a, b)
deg_print(a)
Calculate in degrees, minutes, and seconds. For a more functional
version see dms.cal.
dms.cal
dms(deg, min, sec)
dms_add(a, b)
dms_neg(a)
dms_sub(a, b)
dms_mul(a, b)
dms_print(a)
dms_abs(a)
dms_norm(a)
dms_test(a)
dms_int(a)
dms_frac(a)
dms_rel(a,b)
dms_cmp(a,b)
dms_inc(a)
dms_dec(a)
Calculate in degrees, minutes, and seconds.
Calculate in degrees, minutes, and seconds. Unlike deg.cal, increments
are on the arc second level. See also hms.cal.
dotest.cal
@@ -212,6 +332,166 @@ dotest.cal
dotest("set8700.line");
factorial.cal
factorial(n)
Calculates the product of the positive integers up to and including n.
See:
http://en.wikipedia.org/wiki/Factorial
for information on the factorial. This function depends on the script
toomcook.cal.
primorial(a,b)
Calculates the product of the primes between a and b. If a is not prime
the next higher prime is taken as the starting point. If b is not prime
the next lower prime is taking as the end point b. The end point b must
not exceed 4294967291. See:
http://en.wikipedia.org/wiki/Primorial
for information on the primorial.
factorial2.cal
This file contents a small variety of integer functions that can, with
more or less pressure, be related to the factorial.
doublefactorial(n)
Calculates the double factorial n!! with different algorithms for
- n odd
- n even and positive
- n (real|complex) sans the negative half integers
See:
http://en.wikipedia.org/wiki/Double_factorial
http://mathworld.wolfram.com/DoubleFactorial.html
for information on the double factorial. This function depends on
the script toomcook.cal, factorial.cal and specialfunctions.cal.
binomial(n,k)
Calculates the binomial coefficients for n large and k = k \pm
n/2. Defaults to the built-in function for smaller and/or different
values. Meant as a complete replacement for comb(n,k) with only a
very small overhead. See:
http://en.wikipedia.org/wiki/Binomial_coefficient
for information on the binomial. This function depends on the script
toomcook.cal factorial.cal and specialfunctions.cal.
bigcatalan(n)
Calculates the n-th Catalan number for n large. It is usefull
above n~50,000 but defaults to the builtin function for smaller
values.Meant as a complete replacement for catalan(n) with only a
very small overhead. See:
http://en.wikipedia.org/wiki/Catalan_number
http://mathworld.wolfram.com/CatalanNumber.html
for information on Catalan numbers. This function depends on the scripts
toomcook.cal, factorial.cal and specialfunctions.cal.
stirling1(n,m)
Calculates the Stirling number of the first kind. It does so with
building a list of all of the smaller results. It might be a good
idea, though, to run it once for the highest n,m first if many
Stirling numbers are needed at once, for example in a series. See:
http://en.wikipedia.org/wiki/Stirling_numbers_of_the_first_kind
http://mathworld.wolfram.com/StirlingNumberoftheFirstKind.html
Algorithm 3.17, Donald Kreher and Douglas Simpson, "Combinatorial
Algorithms", CRC Press, 1998, page 89.
for information on Stirling numbers of the first kind.
stirling2(n,m)
stirling2caching(n,m)
Calculate the Stirling number of the second kind.
The first function stirling2(n,m) does it with the sum
m
====
1 \ n m - k
-- > k (- 1) binomial(m, k)
m! /
====
k = 0
The other function stirling2caching(n,m) does it by way of the
reccurence relation and keeps all earlier results. This function
is much slower for computing a single value than stirling2(n,m) but
is very usefull if many Stirling numbers are needed, for example in
a series. See:
http://en.wikipedia.org/wiki/Stirling_numbers_of_the_second_kind
http://mathworld.wolfram.com/StirlingNumberoftheSecondKind.html
Algorithm 3.17, Donald Kreher and Douglas Simpson, "Combinatorial
Algorithms", CRC Press, 1998, page 89.
for information on Stirling numbers of the second kind.
bell(n)
Calculate the n-th Bell number. This may take some time for large n.
See:
http://oeis.org/A000110
http://en.wikipedia.org/wiki/Bell_number
http://mathworld.wolfram.com/BellNumber.html
for information on Bell numbers.
subfactorial(n)
Calculate the n-th subfactorial or derangement. This may take some
time for large n. See:
http://mathworld.wolfram.com/Derangement.html
http://en.wikipedia.org/wiki/Derangement
for information on subfactorials.
risingfactorial(x,n)
Calculates the rising factorial or Pochammer symbol of almost arbitrary
x,n. See:
http://en.wikipedia.org/wiki/Pochhammer_symbol
http://mathworld.wolfram.com/PochhammerSymbol.html
for information on rising factorials.
fallingfactorial(x,n)
Calculates the rising factorial of almost arbitrary x,n. See:
http://en.wikipedia.org/wiki/Pochhammer_symbol
http://mathworld.wolfram.com/PochhammerSymbol.html
for information on falling factorials.
ellip.cal
efactor(iN, ia, B, force)
@@ -219,6 +499,13 @@ ellip.cal
Attempt to factor using the elliptic functions: y^2 = x^3 + a*x + b.
gvec.cal
gvec(function, vector)
Vectorize any single-input function or trailing operator.
hello.cal
Calc's contribution to the Hello World! page:
@@ -226,6 +513,29 @@ hello.cal
http://www.latech.edu/~acm/HelloWorld.shtml
http://www.latech.edu/~acm/helloworld/calc.html
NOTE: This resource produces a lot of output. :-)
hms.cal
hms(hour, min, sec)
hms_add(a, b)
hms_neg(a)
hms_sub(a, b)
hms_mul(a, b)
hms_print(a)
hms_abs(a)
hms_norm(a)
hms_test(a)
hms_int(a)
hms_frac(a)
hms_rel(a,b)
hms_cmp(a,b)
hms_inc(a)
hms_dec(a)
Calculate in hours, minutes, and seconds. See also dmscal.
intfile.cal
@@ -254,6 +564,37 @@ intfile.cal
of the integer become the last octets of the file.
lambertw.cal
lambertw(z,branch)
Computes Lambert's W-function at "z" at branch "branch". See
http://en.wikipedia.org/wiki/Lambert_W_function
http://mathworld.wolfram.com/LambertW-Function.html
https://cs.uwaterloo.ca/research/tr/1993/03/W.pdf
http://arxiv.org/abs/1003.1628
to get more information.
This file includes also an implementation for the series described in
Corless et al. (1996) eq. 4.22 (W-pdf) and Verebic (2010) (arxive link)
eqs.35-37.
The series has been implemented to get a different algorithm
for checking the results. This was necessary because the results
of the implementation in Maxima, the only program with a general
lambert-w implementation at hand at that time, differed slightly. The
Maxima versions tested were: Maxima 5.21.1 and 5.29.1. The current
version of this code concurs with the results of Mathematica`s(tm)
ProductLog[branch,z] with the tested values.
The series is only valid for the branches 0,-1, real z, converges
for values of z _very_ near the branchpoint -exp(-1) only, and must
be given the branches explicitly. See the code in lambertw.cal
for further information.
linear.cal
linear(x0, y0, x1, y1, x)
@@ -262,6 +603,24 @@ linear.cal
Requires x0 != y0.
lnseries.cal
lnseries(limit)
lnfromseries(n)
deletelnseries()
Calculates a series of n natural logarithms at 1,2,3,4...n. It
does so by computing the prime factorization of all of the number
sequence 1,2,3...n, calculates the natural logarithms of the primes
in 1,2,3...n and uses the above factorization to build the natural
logarithms of the rest of the sequence by sadding the logarithms of
the primes in the factorization. This is faster for high precision
of the logarithms and/or long sequences.
The sequence need to be initiated by running either lnseries(n) or
lnfromseries(n) once with n the upper limit of the sequence.
lucas.cal
lucas(h, n)
@@ -307,6 +666,7 @@ mfactor.cal
fastest even thought the initial startup overhead is larger than
for p_elim == 13.
mod.cal
lmod(a)
@@ -396,6 +756,7 @@ pi.cal
Lambert Meertens. See also the ABC Programmer's Handbook, by Geurts,
Meertens & Pemberton, published by Prentice-Hall (UK) Ltd., 1990.
pix.cal
pi_of_x(x)
@@ -478,10 +839,10 @@ randmprime.cal
randmprime(bits, seed [,dbg])
Find a prime of the form h*2^n-1 >= 2^bits for some given x. The initial
search points for 'h' and 'n' are selected by a cryptographic pseudo-random
number generator. The optional argument, dbg, if set to 1, 2 or 3
turn on various debugging print statements.
Find a prime of the form h*2^n-1 >= 2^bits for some given x. The
initial search points for 'h' and 'n' are selected by a cryptographic
pseudo-random number generator. The optional argument, dbg, if set
to 1, 2 or 3 turn on various debugging print statements.
randombitrun.cal
@@ -533,8 +894,8 @@ repeat.cal
regress.cal
Test the correct execution of the calculator by reading this resource file.
Errors are reported with '****' messages, or worse. :-)
Test the correct execution of the calculator by reading this resource
file. Errors are reported with '****' messages, or worse. :-)
screen.cal
@@ -580,15 +941,17 @@ screen.cal
Cyan
White
Define ANSI control sequences providing (i.e., cursor movement, changing
foreground or background color, etc.) for VT100 terminals and terminal
window emulators (i.e., xterm, Apple OS/X Terminal, etc.) that support them.
Define ANSI control sequences providing (i.e., cursor movement,
changing foreground or background color, etc.) for VT100 terminals
and terminal window emulators (i.e., xterm, Apple OS/X Terminal,
etc.) that support them.
For example:
read screen
print green:"This is green. ":red:"This is red.":black
seedrandom.cal
seedrandom(seed1, seed2, bitsize [,trials])
@@ -630,8 +993,247 @@ solve.cal
solve(low, high, epsilon)
Solve the equation f(x) = 0 to within the desired error value for x.
The function 'f' must be defined outside of this routine, and the low
and high values are guesses which must produce values with opposite signs.
The function 'f' must be defined outside of this routine, and the
low and high values are guesses which must produce values with
opposite signs.
specialfunctions.cal
beta(a,b)
Calculates the value of the beta function. See:
https://en.wikipedia.org/wiki/Beta_function
http://mathworld.wolfram.com/BetaFunction.html
http://dlmf.nist.gov/5.12
for information on the beta function.
betainc(a,b,z)
Calculates the value of the regularized incomplete beta function. See:
https://en.wikipedia.org/wiki/Beta_function
http://mathworld.wolfram.com/RegularizedBetaFunction.html
http://dlmf.nist.gov/8.17
for information on the regularized incomplete beta function.
expoint(z)
Calculates the value of the exponential integral Ei(z) function at z.
See:
http://en.wikipedia.org/wiki/Exponential_integral
http://www.cs.utah.edu/~vpegorar/research/2011_JGT/
for information on the exponential integral Ei(z) function.
erf(z)
Calculates the value of the error function at z. See:
http://en.wikipedia.org/wiki/Error_function
for information on the error function function.
erfc(z)
Calculates the value of the complementary error function at z. See:
http://en.wikipedia.org/wiki/Error_function
for information on the complementary error function function.
erfi(z)
Calculates the value of the imaginary error function at z. See:
http://en.wikipedia.org/wiki/Error_function
for information on the imaginary error function function.
erfinv(x)
Calculates the inverse of the error function at x. See:
http://en.wikipedia.org/wiki/Error_function
for information on the inverse of the error function function.
faddeeva(z)
Calculates the value of the complex error function at z. See:
http://en.wikipedia.org/wiki/Faddeeva_function
for information on the complex error function function.
gamma(z)
Calculates the value of the Euler gamma function at z. See:
http://en.wikipedia.org/wiki/Gamma_function
http://dlmf.nist.gov/5
for information on the Euler gamma function.
gammainc(a,z)
Calculates the value of the lower incomplete gamma function for
arbitrary a, z. See:
http://en.wikipedia.org/wiki/Incomplete_gamma_function
for information on the lower incomplete gamma function.
gammap(a,z)
Calculates the value of the regularized lower incomplete gamma
function for a, z with a not in -N. See:
http://en.wikipedia.org/wiki/Incomplete_gamma_function
for information on the regularized lower incomplete gamma function.
gammaq(a,z)
Calculates the value of the regularized upper incomplete gamma
function for a, z with a not in -N. See:
http://en.wikipedia.org/wiki/Incomplete_gamma_function
for information on the regularized upper incomplete gamma function.
heavisidestep(x)
Computes the Heaviside stepp function (1+sign(x))/2
harmonic(limit)
Calculates partial values of the harmonic series up to limit. See:
http://en.wikipedia.org/wiki/Harmonic_series_(mathematics)
http://mathworld.wolfram.com/HarmonicSeries.html
for information on the harmonic series.
lnbeta(a,b)
Calculates the natural logarithm of the beta function. See:
https://en.wikipedia.org/wiki/Beta_function
http://mathworld.wolfram.com/BetaFunction.html
http://dlmf.nist.gov/5.12
for information on the beta function.
lngamma(z)
Calculates the value of the logarithm of the Euler gamma function
at z. See:
http://en.wikipedia.org/wiki/Gamma_function
http://dlmf.nist.gov/5.15
for information on the derivatives of the the Euler gamma function.
polygamma(m,z)
Calculates the value of the m-th derivative of the Euler gamma
function at z. See:
http://en.wikipedia.org/wiki/Polygamma
http://dlmf.nist.gov/5
for information on the n-th derivative ofthe Euler gamma function. This
function depends on the script zeta2.cal.
psi(z)
Calculates the value of the first derivative of the Euler gamma
function at z. See:
http://en.wikipedia.org/wiki/Digamma_function
http://dlmf.nist.gov/5
for information on the first derivative of the Euler gamma function.
zeta(s)
Calculates the value of the Rieman Zeta function at s. See:
http://en.wikipedia.org/wiki/Riemann_zeta_function
http://dlmf.nist.gov/25.2
for information on the Riemann zeta function. This function depends
on the script zeta2.cal.
statistics.cal
gammaincoctave(z,a)
Computes the regularized incomplete gamma function in a way to
correspond with the function in Octave.
invbetainc(x,a,b)
Computes the inverse of the regularized beta function. Does so the
brute-force way wich makes it a bit slower.
betapdf(x,a,b)
betacdf(x,a,b)
betacdfinv(x,a,b)
betamedian(a,b)
betamode(a,b)
betavariance(a,b)
betalnvariance(a,b)
betaskewness(a,b)
betakurtosis(a,b)
betaentropy(a,b)
normalpdf(x,mu,sigma)
normalcdf(x,mu,sigma)
probit(p)
normalcdfinv(p,mu,sigma)
normalmean(mu,sigma)
normalmedian(mu,sigma)
normalmode(mu,sigma)
normalvariance(mu,sigma)
normalskewness(mu,sigma)
normalkurtosis(mu,sigma)
normalentropy(mu,sigma)
normalmgf(mu,sigma,t)
normalcf(mu,sigma,t)
chisquaredpdf(x,k)
chisquaredpcdf(x,k)
chisquaredmean(x,k)
chisquaredmedian(x,k)
chisquaredmode(x,k)
chisquaredvariance(x,k)
chisquaredskewness(x,k)
chisquaredkurtosis(x,k)
chisquaredentropy(x,k)
chisquaredmfg(k,t)
chisquaredcf(k,t)
Calculates a bunch of (hopefully) aptly named statistical functions.
sumsq.cal
@@ -643,6 +1245,27 @@ sumsq.cal
4N+1, and always impossible for primes of the form 4N-1.
sumtimes.cal
timematsum(N)
timelistsum(N)
timematsort(N)
timelistsort(N)
timematreverse(N)
timelistreverse(N)
timematssq(N)
timelistssq(N)
timehmean(N,M)
doalltimes(N)
Give the user CPU time for various ways of evaluating sums, sums of
squares, etc, for large lists and matrices. N is the size of
the list or matrix to use. The doalltimes() function will run
all fo the sumtimes tests. For example:
doalltimes(1e6);
surd.cal
surd(a, b)
@@ -672,7 +1295,8 @@ test1700.cal
value
This resource 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
@@ -697,8 +1321,8 @@ test2600.cal
checkresult(x, y, z, a)
test2600(verbose, tnum)
This resource files is used by regress.cal to test some of builtin functions
in terms of accuracy and roundoff.
This resource files is used by regress.cal to test some of builtin
functions in terms of accuracy and roundoff.
test2700.cal
@@ -735,7 +1359,8 @@ test3100.cal
res_inv(a)
res(x)
This resource file is used by regress.cal to test determinants of a matrix
This resource file is used by regress.cal to test determinants of
a matrix.
test3300.cal
@@ -746,8 +1371,9 @@ test3300.cal
testr(str, n, N, verbose)
test3300(verbose, tnum)
This resource file is used by regress.cal to provide for more determinant
tests.
This resource file is used by regress.cal to provide for more
determinant tests.
test3400.cal
@@ -778,6 +1404,7 @@ test3500.cal
This resource file is used by regress.cal to test the functions frem,
fcnt, gcdrem.
test4000.cal
global defaultverbose
@@ -810,6 +1437,7 @@ test4000.cal
This resource file is used by regress.cal to test ptest, nextcand and
prevcand builtins.
test4100.cal
global defaultverbose
@@ -829,6 +1457,7 @@ test4100.cal
This resource file is used by regress.cal to test REDC operations.
test4600.cal
stest(str [, verbose]) defined
@@ -840,6 +1469,7 @@ test4600.cal
This resource file is used by regress.cal to test searching in files.
test5100.cal
global a5100
@@ -849,6 +1479,7 @@ test5100.cal
This resource file is used by regress.cal to test the new code generator
declaration scope and order.
test5200.cal
global a5200
@@ -860,6 +1491,7 @@ test5200.cal
This resource file is used by regress.cal to test the fix of a
global/static bug.
test8400.cal
test8400() defined
@@ -867,6 +1499,7 @@ test8400.cal
This resource file is used by regress.cal to check for quit-based
memory leaks.
test8500.cal
global err_8500
@@ -879,6 +1512,7 @@ test8500.cal
This resource file is used by regress.cal to the // and % operators.
test8600.cal
global min_8600
@@ -889,6 +1523,25 @@ test8600.cal
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.
test8900.cal
This function tests a number of calc resource functions contributed
by Christoph Zurnieden. These include:
bernpoly.cal
brentsolve.cal
constants.cal
factorial2.cal
factorial.cal
lambertw.cal
lnseries.cal
specialfunctions.cal
statistics.cal
toomcook.cal
zeta2.cal
unitfrac.cal
unitfrac(x)
@@ -896,6 +1549,29 @@ unitfrac.cal
Represent a fraction as sum of distinct unit fractions.
toomcook.cal
toomcook3(a,b)
toomcook4(a,b)
Toom-Cook multiplication algorithm. Multiply two integers a,b by
way of the Toom-Cook algorithm. See:
http://en.wikipedia.org/wiki/Toom%E2%80%93Cook_multiplication
toomcook3square(a)
toomcook4square(a)
Square the integer a by way of the Toom-Cook algorithm. See:
http://en.wikipedia.org/wiki/Toom%E2%80%93Cook_multiplication
The function toomCook4(a,b) calls the function toomCook3(a,b) which
calls built-in multiplication at a specific cut-off point. The
squaring functions act in the same way.
varargs.cal
sc(a, b, ...)
@@ -903,6 +1579,7 @@ varargs.cal
Example program to use 'varargs'. Program to sum the cubes of all
the specified numbers.
xx_print.cal
is_octet(a) defined
@@ -917,6 +1594,19 @@ xx_print.cal
Demo for the xx_print object routines.
zeta2.cal
hurwitzzeta(s,a)
Calculate the value of the Hurwitz Zeta function. See:
http://en.wikipedia.org/wiki/Hurwitz_zeta_function
http://dlmf.nist.gov/25.11
for information on this special zeta function.
## Copyright (C) 2000 David I. Bell and Landon Curt Noll
##
## Primary author: Landon Curt Noll
@@ -933,10 +1623,10 @@ xx_print.cal
## 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.
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
##
## @(#) $Revision: 29.12 $
## @(#) $Id: README,v 29.12 2006/05/21 04:41:09 chongo Exp $
## @(#) $Revision: 30.5 $
## @(#) $Id: README,v 30.5 2013/08/11 03:26:46 chongo Exp $
## @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/README,v $
##
## Under source code control: 1990/02/15 01:50:32

1259
cal/alg_config.cal Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: beer.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/beer.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: beer.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/beer.cal,v $
*
* Under source code control: 1996/11/13 13:21:05
* File existed as early as: 1996

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $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 $
* @(#) $Revision: 30.1 $
* @(#) $Id: bernoulli.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/bernoulli.cal,v $
*
* Under source code control: 1991/09/30 11:18:41
* File existed as early as: 1991

59
cal/bernpoly.cal Normal file
View File

@@ -0,0 +1,59 @@
/*
* bernpoly- Bernoully polynomials B_n(z) for arbitrary n,z..
*
* Copyright (C) 2013 Christoph Zurnieden
*
* bernpoly 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.
*
* bernpoly 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 30.3 $
* @(#) $Id: bernpoly.cal,v 30.3 2013/08/11 08:41:38 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/bernpoly.cal,v $
*
* Under source code control: 2013/08/11 01:31:28
* File existed as early as: 2013
*/
static resource_debug_level;
resource_debug_level = config("resource_debug", 0);
read -once zeta2
/* Idea by Don Zagier */
define bernpoly(n,z){
local h s c k;
if(isint(n) && n>=0){
h=0;s=0;c=-1;
for(k=1;k<=n+1;k++){
c*=1-(n+2)/k;
s+=z^n;
z++;
h+=c*s/k;
}
return h;
}
else return -n*hurwitzzeta(1-n,z);
}
/*
* restore internal function from resource debugging
*/
config("resource_debug", resource_debug_level),;
if (config("resource_debug") & 3) {
print "bernpoly(n,z)";
}

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: bigprime.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/bigprime.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: bigprime.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/bigprime.cal,v $
*
* Under source code control: 1991/05/22 21:56:32
* File existed as early as: 1991

View File

@@ -14,11 +14,11 @@
# 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.
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
#
# @(#) $Revision: 29.2 $
# @(#) $Id: bindings,v 29.2 2000/06/07 14:02:25 chongo Exp $
# @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/bindings,v $
# @(#) $Revision: 30.1 $
# @(#) $Id: bindings,v 30.1 2007/03/16 11:09:54 chongo Exp $
# @(#) $Source: /usr/local/src/bin/calc/cal/RCS/bindings,v $
#
# Under source code control: 1993/05/02 20:09:19
# File existed as early as: 1993

257
cal/brentsolve.cal Normal file
View File

@@ -0,0 +1,257 @@
/*
* brentsolve- Root finding with the Brent-Dekker trick.
*
* Copyright (C) 2013 Christoph Zurnieden
*
* brentsolve 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.
*
* brentsolve 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 30.3 $
* @(#) $Id: brentsolve.cal,v 30.3 2013/08/11 08:41:38 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/brentsolve.cal,v $
*
* Under source code control: 2013/08/11 01:31:28
* File existed as early as: 2013
*/
static resource_debug_level;
resource_debug_level = config("resource_debug", 0);
/*
A short explanation is at http://en.wikipedia.org/wiki/Brent%27s_method
I tried to follow the description at wikipedia as much as possible to make
the slight changes I did more visible.
You may give http://people.sc.fsu.edu/~jburkardt/cpp_src/brent/brent.html a
short glimpse (Brent's originl Fortran77 versions and some translations of
it).
*/
static true = 1;
static false = 0;
define brentsolve(low, high,eps){
local a b c d fa fb fc fa2 fb2 fc2 s fs tmp tmp2 mflag i places;
a = low;
b = high;
c = 0;
if(isnull(eps))
eps = epsilon(epsilon()*1e-3);
places = highbit(1 + int( 1/epsilon() ) ) + 1;
d = 1/eps;
fa = f(a);
fb = f(b);
fc = 0;
s = 0;
fs = 0;
if(fa * fb >= 0){
if(fa < fb){
epsilon(eps);
return a;
}
else{
epsilon(eps);
return b;
}
}
if(abs(fa) < abs(fb)){
tmp = a; a = b; b = tmp;
tmp = fa; fa = fb; fb = tmp;
}
c = a;
fc = fa;
mflag = 1;
i = 0;
while(!(fb==0) && (abs(a-b) > eps)){
if((fa != fc) && (fb != fc)){
/* Inverse quadratic interpolation*/
fc2 = fc^2;
fa2 = fa^2;
s = bround(((fb^2*((fc*a)-(c*fa)))+(fb*((c*fa2)-(fc2*a)))+(b*((fc2*fa)
-(fc*fa2))))/((fc - fb)*(fa - fb)*(fc - fa)),places++);
}
else{
/* Secant Rule*/
s =bround( b - fb * (b - a) / (fb - fa),places++);
}
tmp2 = (3 * a + b) / 4;
if( (!( ((s > tmp2) && (s < b))||((s < tmp2) && (s > b))))
|| (mflag && (abs(s - b) >= (abs(b - c) / 2)))
|| (!mflag && (abs(s - b) >= (abs(c - d) / 2)))) {
s = (a + b) / 2;
mflag = true;
}
else{
if( (mflag && (abs(b - c) < eps))
|| (!mflag && (abs(c - d) < eps))) {
s = (a + b) / 2;
mflag = true;
}
else
mflag = false;
}
fs = f(s);
c = b;
fc = fb;
if (fa * fs < 0){
b = s;
fb = fs;
}
else {
a = s;
fa = fs;
}
if (abs(fa) < abs(fb)){
tmp = a; a = b; b = tmp;
tmp = fa; fa = fb; fb = tmp;
}
i++;
if (i > 1000){
epsilon(eps);
return newerror("brentsolve: does not converge");
}
}
epsilon(eps);
return b;
}
/*
A variation of the solver to accept functions named differently from "f". The
code should explain it.
*/
define brentsolve2(low, high,which,eps){
local a b c d fa fb fc fa2 fb2 fc2 s fs tmp tmp2 mflag i places;
a = low;
b = high;
c = 0;
switch(param(0)){
case 0:
case 1: return newerror("brentsolve2: not enough argments");
case 2: eps = epsilon(epsilon()*1e-2);
which = 0;break;
case 3: eps = epsilon(epsilon()*1e-2);break;
default: break;
};
places = highbit(1 + int(1/epsilon())) + 1;
d = 1/eps;
switch(which){
case 1: fa = __CZ__invbeta(a);
fb = __CZ__invbeta(b); break;
case 2: fa = __CZ__invincgamma(a);
fb = __CZ__invincgamma(b); break;
default: fa = f(a);fb = f(b); break;
};
fc = 0;
s = 0;
fs = 0;
if(fa * fb >= 0){
if(fa < fb)
return a;
else
return b;
}
if(abs(fa) < abs(fb)){
tmp = a; a = b; b = tmp;
tmp = fa; fa = fb; fb = tmp;
}
c = a;
fc = fa;
mflag = 1;
i = 0;
while(!(fb==0) && (abs(a-b) > eps)){
if((fa != fc) && (fb != fc)){
/* Inverse quadratic interpolation*/
fc2 = fc^2;
fa2 = fa^2;
s = bround(((fb^2*((fc*a)-(c*fa)))+(fb*((c*fa2)-(fc2*a)))+(b*((fc2*fa)
-(fc*fa2))))/((fc - fb)*(fa - fb)*(fc - fa)),places);
places++;
}
else{
/* Secant Rule*/
s =bround( b - fb * (b - a) / (fb - fa),places);
places++;
}
tmp2 = (3 * a + b) / 4;
if( (!( ((s > tmp2) && (s < b))||((s < tmp2) && (s > b))))
|| (mflag && (abs(s - b) >= (abs(b - c) / 2)))
|| (!mflag && (abs(s - b) >= (abs(c - d) / 2)))) {
s = (a + b) / 2;
mflag = true;
}
else{
if( (mflag && (abs(b - c) < eps))
|| (!mflag && (abs(c - d) < eps))) {
s = (a + b) / 2;
mflag = true;
}
else
mflag = false;
}
switch(which){
case 1: fs = __CZ__invbeta(s); break;
case 2: fs = __CZ__invincgamma(s); break;
default: fs = f(s); break;
};
c = b;
fc = fb;
if (fa * fs < 0){
b = s;
fb = fs;
}
else {
a = s;
fa = fs;
}
if (abs(fa) < abs(fb)){
tmp = a; a = b; b = tmp;
tmp = fa; fa = fb; fb = tmp;
}
i++;
if (i > 1000){
return newerror("brentsolve2: does not converge");
}
}
return b;
}
/*
* restore internal function from resource debugging
*/
config("resource_debug", resource_debug_level),;
if (config("resource_debug") & 3) {
print "brentsolve(low, high,eps)";
print "brentsolve2(low, high,which,eps)";
}

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: chi.cal,v 29.2 2001/04/08 10:21:23 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/chi.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: chi.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/chi.cal,v $
*
* Under source code control: 2001/03/27 14:10:11
* File existed as early as: 2001

View File

@@ -17,11 +17,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: chrem.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/chrem.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: chrem.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/chrem.cal,v $
*
* Under source code control: 1992/09/26 01:00:47
* File existed as early as: 1992

104
cal/constants.cal Normal file
View File

@@ -0,0 +1,104 @@
/*
* constants - implementation of different constants to arbitrary precision
*
* Copyright (C) 2013 Christoph Zurnieden
*
* constants 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.
*
* constants 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 30.3 $
* @(#) $Id: constants.cal,v 30.3 2013/08/11 08:41:38 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/constants.cal,v $
*
* Under source code control: 2013/08/11 01:31:28
* File existed as early as: 2013
*/
static resource_debug_level;
resource_debug_level = config("resource_debug", 0);
static __CZ__euler_mascheroni = 0;
static __CZ__euler_mascheroni_prec = 0;
define e(){
local k temp1 temp2 ret eps factor upperlimit prec;
prec = digits(1/epsilon());
if(__CZ__euler_mascheroni != 0 && __CZ__euler_mascheroni_prec >= prec)
return __CZ__euler_mascheroni;
if(prec<=20) return 2.718281828459045235360287471;
if(prec<=1800){
__CZ__euler_mascheroni = exp(1);
__CZ__euler_mascheroni_prec = prec;
}
eps=epsilon(1e-20);
factor = 1;
k = 0;
upperlimit = prec * ln(10);
while(k<upperlimit){
k += ln(factor);
factor++;
}
epsilon(eps);
temp1 = 0;
ret = 1;
for(k=3;k<=factor;k++){
temp2 = temp1;
temp1 = ret;
ret = (k-1) *(temp1 + temp2);
}
ret = inverse( ret * inverse(factorial(factor) ) ) ;
__CZ__euler_mascheroni = ret;
__CZ__euler_mascheroni_prec = prec;
return ret;
}
/* Lupas' series */
static __CZ__catalan = 0;
static __CZ__catalan_prec = 0;
define G(){
local eps a s t n;
eps = epsilon(epsilon()*1e-10);
if(__CZ__catalan != 0 && __CZ__catalan >= log(1/eps))
return __CZ__catalan;
a = 1;
s = 0;
t = 1;
n = 1;
while(abs(t)> eps){
a *= 32 * n^3 * (2*n-1);
a /=((3-16*n+16*n^2)^2);
t = a * (-1)^(n-1) * (40*n^2-24*n+3) / (n^3 * (2*n-1));
s += t;
n += 1;
}
s = s/64;
__CZ__catalan = s;
__CZ__catalan_prec = log(1/eps);
epsilon(eps);
return s;
}
config("resource_debug", resource_debug_level),;
if (config("resource_debug") & 3) {
print "e()";
print "G()";
}

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.4 $
* @(#) $Id: deg.cal,v 29.4 2003/01/26 19:32:41 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/deg.cal,v $
* @(#) $Revision: 30.2 $
* @(#) $Id: deg.cal,v 30.2 2010/09/02 06:01:14 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/deg.cal,v $
*
* Under source code control: 1990/02/15 01:50:33
* File existed as early as: before 1990
@@ -28,9 +28,9 @@
*/
obj dms {deg, min, sec};
obj deg {deg, min, sec};
define dms(deg, min, sec)
define deg(deg, min, sec)
{
local ans;
@@ -38,18 +38,18 @@ define dms(deg, min, sec)
sec = 0;
if (isnull(min))
min = 0;
obj dms ans;
obj deg ans;
ans.deg = deg;
ans.min = min;
ans.sec = sec;
fixdms(ans);
fixdeg(ans);
return ans;
}
define dms_add(a, b)
define deg_add(a, b)
{
local obj dms ans;
local obj deg ans;
ans.deg = 0;
ans.min = 0;
@@ -66,14 +66,14 @@ define dms_add(a, b)
ans.sec += b.sec;
} else
ans.deg += b;
fixdms(ans);
fixdeg(ans);
return ans;
}
define dms_neg(a)
define deg_neg(a)
{
local obj dms ans;
local obj deg ans;
ans.deg = -a.deg;
ans.min = -a.min;
@@ -82,15 +82,15 @@ define dms_neg(a)
}
define dms_sub(a, b)
define deg_sub(a, b)
{
return a - b;
}
define dms_mul(a, b)
define deg_mul(a, b)
{
local obj dms ans;
local obj deg ans;
if (istype(a, ans) && istype(b, ans))
quit "Cannot multiply degrees together";
@@ -103,24 +103,24 @@ define dms_mul(a, b)
ans.min = b.min * a;
ans.sec = b.sec * a;
}
fixdms(ans);
fixdeg(ans);
return ans;
}
define dms_print(a)
define deg_print(a)
{
print a.deg : 'd' : a.min : 'm' : a.sec : 's' :;
}
define dms_abs(a)
define deg_abs(a)
{
return a.deg + a.min / 60 + a.sec / 3600;
}
define fixdms(a)
define fixdeg(a)
{
a.min += frac(a.deg) * 60;
a.deg = int(a.deg);
@@ -134,5 +134,5 @@ define fixdms(a)
}
if (config("resource_debug") & 3) {
print "obj dms {deg, min, sec} defined";
print "obj deg {deg, min, sec} defined";
}

384
cal/dms.cal Normal file
View File

@@ -0,0 +1,384 @@
/*
* dms - calculate in degrees, minutes, and seconds (based on deg)
*
* Copyright (C) 1999,2010 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
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 30.2 $
* @(#) $Id: dms.cal,v 30.2 2010/09/02 06:14:16 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/dms.cal,v $
*
* Under source code control: 1990/02/15 01:50:33
* File existed as early as: before 1990
*
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/
obj dms {deg, min, sec};
define dms(deg, min, sec)
{
local obj dms ans; /* return value */
/* default missing args to 0 */
if (isnull(sec)) {
sec = 0;
}
if (isnull(min)) {
min = 0;
}
/* load object */
ans.deg = deg;
ans.min = min;
ans.sec = sec;
/* return properly formed object */
ans = fixdms(ans);
return ans;
}
define dms_add(a, b)
{
local obj dms ans; /* return value */
/* initalize value to 1st arg */
if (istype(a, ans)) {
/* 1st arg is dms object, load it */
ans.deg = a.deg;
ans.min = a.min;
ans.sec = a.sec;
} else {
/* 1st arg is not dms, assume scalar degrees */
ans.deg = a;
ans.min = 0;
ans.sec = 0;
}
/* add value of 2nd arg */
if (istype(b, ans)) {
/* 2nd arg is dms object, add it */
ans.deg += b.deg;
ans.min += b.min;
ans.sec += b.sec;
} else {
/* 2nd arg is not dms, add scalar degrees */
ans.deg += b;
}
/* return normalized result */
ans = fixdms(ans);
return ans;
}
define dms_neg(a)
{
local obj dms ans; /* return value */
/* negate argument */
if (istype(a, ans)) {
/* 1st arg is dms object, load it */
ans.deg = -a.deg;
ans.min = -a.min;
ans.sec = -a.sec;
} else {
/* 2nd arg is not dms, negate scalar degrees */
ans.deg = -a;
ans.min = 0;
ans.sec = 0;
}
/* return normalized result */
ans = fixdms(ans);
return ans;
}
define dms_sub(a, b)
{
local obj dms ans; /* return value */
/* initalize value to 1st arg */
if (istype(a, ans)) {
/* 1st arg is dms object, load it */
ans.deg = a.deg;
ans.min = a.min;
ans.sec = a.sec;
} else {
/* 1st arg is not dms, assume scalar degrees */
ans.deg = a;
ans.min = 0;
ans.sec = 0;
}
/* subtract value of 2nd arg */
if (istype(b, ans)) {
/* 2nd arg is dms object, subtract it */
ans.deg -= b.deg;
ans.min -= b.min;
ans.sec -= b.sec;
} else {
/* 2nd arg is not dms, subtract scalar degrees */
ans.deg -= b;
}
/* return normalized result */
ans = fixdms(ans);
return ans;
}
define dms_mul(a, b)
{
local obj dms ans; /* return value */
/* dms object multiplication */
if (istype(a, ans) && istype(b, ans)) {
ans.deg = dms_abs(a) * dms_abs(b);
ans.min = 0;
ans.sec = 0;
/* scalar multiplication */
} else if (istype(a, ans)) {
ans.deg = a.deg * b;
ans.min = a.min * b;
ans.sec = a.sec * b;
} else {
ans.deg = b.deg * a;
ans.min = b.min * a;
ans.sec = b.sec * a;
}
/* return normalized result */
ans = fixdms(ans);
return ans;
}
define dms_print(a)
{
local obj dms ans; /* temp object for dms type testing */
/* firewall - arg must be a dms object */
if (! istype(a, ans)) {
quit "dms_print called with non dms object";
}
/* print in dms form */
print a.deg : 'd' : a.min : 'm' : a.sec : 's' :;
}
define dms_abs(a)
{
local obj dms ans; /* temp object for dms type testing */
local deg; /* return scalar value */
/* firewall - just absolute value non dms objects */
if (! istype(a, ans)) {
return abs(a);
}
/* compute degrees */
deg = a.deg + a.min / 60 + a.sec / 3600;
/* return degrees */
return deg;
}
define dms_norm(a)
{
local obj dms ans; /* temp object for dms type testing */
local deg; /* degrees */
/* firewall - arg must be a dms object */
if (! istype(a, ans)) {
quit "dms_norm called with non dms object";
}
/* square degrees (norm is the square of absolute value */
deg = dms_abs(a);
/* return degrees */
return deg*deg;
}
define dms_test(a)
{
local obj dms ans; /* temp value */
/* firewall - arg must be a dms object */
if (! istype(a, ans)) {
quit "dms_test called with non dms object";
}
/* return false of non-zero */
ans = fixdms(a);
if (ans.deg == 0 && ans.min == 0 && ans.sec == 0) {
/* false */
return 0;
}
/* true */
return 1;
}
define dms_int(a)
{
local obj dms ans; /* return value */
/* firewall - arg must be a dms object */
if (! istype(a, ans)) {
quit "dms_int called with non dms object";
}
/* normalize the argument */
ans = fixdms(a);
/* truncate to the nearest second */
ans.sec = int(ans.sec);
/* return value to the nearest second */
return ans;
}
define dms_frac(a)
{
local obj dms ans; /* return value */
/* firewall - arg must be a dms object */
if (! istype(a, ans)) {
quit "dms_frac called with non dms object";
}
/* normalize the argument */
ans = fixdms(a);
/* remove all but fractional seconds */
ans.deg = 0;
ans.min = 0;
ans.sec = frac(ans.sec);
/* return value to the second fraction */
return ans;
}
define dms_rel(a,b)
{
local abs_a, abs_b; /* scalars of the arguments */
/* compute scalars of the arguments */
abs_a = dms_abs(a);
abs_b = dms_abs(b);
/* return the comparison */
return cmp(abs_a, abs_b);
}
define dms_cmp(a,b)
{
local abs_a, abs_b; /* scalars of the arguments */
/* compute scalars of the arguments */
abs_a = dms_abs(a);
abs_b = dms_abs(b);
/* return the equality comparison */
return (abs_a == abs_b);
}
define dms_inc(a)
{
local obj dms ans; /* return value */
/* increment a dms object */
if (istype(a, ans)) {
ans = a;
++ans.sec;
/* return normalized result */
ans = fixdms(ans);
return ans;
}
/* increment a scalar */
return a+1;
}
define dms_dec(a)
{
local obj dms ans; /* return value */
/* decrement a dms object */
if (istype(a, ans)) {
ans = a;
--ans.sec;
/* return normalized result */
ans = fixdms(ans);
return ans;
}
/* decrement a scalar */
return a-1;
}
define fixdms(a)
{
local obj dms ans; /* temp value */
/* firewall */
if (! istype(a, ans)) {
quit "attempt to fix a non dms object";
}
/* force minutes to be intergral */
a.min += frac(a.deg) * 60;
a.deg = int(a.deg);
/* force degrees to be intergral */
a.sec += frac(a.min) * 60;
a.min = int(a.min);
/* carry excess seconds into minutes */
a.min += a.sec // 60;
a.sec %= 60;
/* carry excess minutes into degrees */
a.deg += a.min // 60;
a.min %= 60;
/* round degrees :-) */
a.deg %= 360;
/* return normalized result */
return a;
}
if (config("resource_debug") & 3) {
print "obj dms {deg, min, sec} defined";
}

View File

@@ -16,9 +16,9 @@
* NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
* CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: dotest.cal,v 29.2 2006/05/21 00:55:27 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/dotest.cal,v $
* @(#) $Revision: 30.2 $
* @(#) $Id: dotest.cal,v 30.2 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/dotest.cal,v $
*
* This file is not covered under version 2.1 of the GNU LGPL.
*

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.3 $
* @(#) $Id: ellip.cal,v 29.3 2006/03/07 22:16:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/ellip.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: ellip.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/ellip.cal,v $
*
* Under source code control: 1990/02/15 01:50:33
* File existed as early as: before 1990
@@ -28,16 +28,17 @@
*/
/*
* Attempt to factor numbers using elliptic functions.
* y^2 = x^3 + a*x + b (mod N).
* Attempt to factor numbers using elliptic functions:
*
* Many points (x,y) (mod N) are found that solve the above equation,
* y^2 = x^3 + a*x + b (mod ellip_N).
*
* Many points (x,y) (mod ellip_N) are found that solve the above equation,
* starting from a trivial solution and 'multiplying' that point together
* to generate high powers of the point, looking for such a point whose
* order contains a common factor with N. The order of the group of points
* varies almost randomly within a certain interval for each choice of a
* and b, and thus each choice provides an independent opportunity to
* factor N. To generate a trivial solution, a is chosen and then b is
* order contains a common factor with ellip_N. The order of the group of
* points varies almost randomly within a certain interval for each choice of
* a and b, and thus each choice provides an independent opportunity to
* factor ellip_N. To generate a trivial solution, a is chosen and then b is
* selected so that (1,1) is a solution. The multiplication is done using
* the basic fact that the equation is a cubic, and so if a line hits the
* curve in two rational points, then the third intersection point must
@@ -45,9 +46,9 @@
* the number of rational solutions can be made very large. When modular
* arithmetic is used, solving for the third point requires the taking of a
* modular inverse (instead of division), and if this fails, then the GCD
* of the failing value and N provides a factor of N. This description is
* only an approximation, read "A Course in Number Theory and Cryptography"
* by Neal Koblitz for a good explanation.
* of the failing value and ellip_N provides a factor of ellip_N.
* This description is only an approximation, read "A Course in Number
* Theory and Cryptography" by Neal Koblitz for a good explanation.
*
* efactor(iN, ia, B, force)
* iN is the number to be factored.
@@ -81,15 +82,15 @@
*
* If a factor is found, it is returned and is also saved in the global
* variable f. The number being factored is also saved in the global
* variable N.
* variable ellip_N.
*/
obj point {x, y};
global N; /* number to factor */
global a; /* first coefficient */
global b; /* second coefficient */
global f; /* found factor */
global ellip_N; /* number to factor */
global ellip_a; /* first coefficient */
global ellip_b; /* second coefficient */
global ellip_f; /* found factor */
define efactor(iN, ia, B, force)
@@ -103,28 +104,28 @@ define efactor(iN, ia, B, force)
if (isnull(ia))
ia = 1;
obj point x;
a = ia;
b = -ia;
N = iN;
C = isqrt(N);
ellip_a = ia;
ellip_b = -ia;
ellip_N = iN;
C = isqrt(ellip_N);
C = 2 * C + 2 * isqrt(C) + 1;
f = 0;
while (f == 0) {
print "A =", a;
ellip_f = 0;
while (ellip_f == 0) {
print "A =", ellip_a;
x.x = 1;
x.y = 1;
print 2, x;
x = x ^ (2 ^ (highbit(C) + 1));
for (p = 3; ((p < B) && (f == 0)); p += 2) {
for (p = 3; ((p < B) && (ellip_f == 0)); p += 2) {
if (!ptest(p, 1))
continue;
print p, x;
x = x ^ (p ^ ((highbit(C) // highbit(p)) + 1));
}
a++;
b--;
ellip_a++;
ellip_b--;
}
return f;
return ellip_f;
}
@@ -143,16 +144,16 @@ define point_mul(p1, p2)
if (p1 == p2)
return point_square(`p1);
obj point r;
m = (minv(p2.x - p1.x, N) * (p2.y - p1.y)) % N;
m = (minv(p2.x - p1.x, ellip_N) * (p2.y - p1.y)) % ellip_N;
if (m == 0) {
if (f == 0)
f = gcd(p2.x - p1.x, N);
if (ellip_f == 0)
ellip_f = gcd(p2.x - p1.x, ellip_N);
r.x = 1;
r.y = 1;
return r;
}
r.x = (m^2 - p1.x - p2.x) % N;
r.y = ((m * (p1.x - r.x)) - p1.y) % N;
r.x = (m^2 - p1.x - p2.x) % ellip_N;
r.y = ((m * (p1.x - r.x)) - p1.y) % ellip_N;
return r;
}
@@ -162,16 +163,16 @@ define point_square(p)
local r, m;
obj point r;
m = ((3 * p.x^2 + a) * minv(p.y << 1, N)) % N;
m = ((3 * p.x^2 + ellip_a) * minv(p.y << 1, ellip_N)) % ellip_N;
if (m == 0) {
if (f == 0)
f = gcd(p.y << 1, N);
if (ellip_f == 0)
ellip_f = gcd(p.y << 1, ellip_N);
r.x = 1;
r.y = 1;
return r;
}
r.x = (m^2 - p.x - p.x) % N;
r.y = ((m * (p.x - r.x)) - p.y) % N;
r.x = (m^2 - p.x - p.x) % ellip_N;
r.y = ((m * (p.x - r.x)) - p.y) % ellip_N;
return r;
}
@@ -184,7 +185,7 @@ define point_pow(p, pow)
if (isodd(pow))
r = p;
t = p;
for (bit = 2; ((bit <= pow) && (f == 0)); bit <<= 1) {
for (bit = 2; ((bit <= pow) && (ellip_f == 0)); bit <<= 1) {
t = point_square(`t);
if (bit & pow)
r = point_mul(`t, `r);

204
cal/factorial.cal Normal file
View File

@@ -0,0 +1,204 @@
/*
* factorial - implementation of different algorithms for the factorial
*
* Copyright (C) 2013 Christoph Zurnieden
*
* factorial 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.
*
* factorial 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 30.3 $
* @(#) $Id: factorial.cal,v 30.3 2013/08/11 08:41:38 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/factorial.cal,v $
*
* Under source code control: 2013/08/11 01:31:28
* File existed as early as: 2013
*/
/*
* hide internal function from resource debugging
*/
static resource_debug_level;
resource_debug_level = config("resource_debug", 0);
/*
get dependencies
*/
read -once toomcook;
/* A simple list to keep things...uhm...simple?*/
static __CZ__primelist = list();
/* Helper for primorial: fill list with primes in range a,b */
define __CZ__fill_prime_list(a,b)
{
local k;
k=a;
if(isprime(k))k--;
while(1){
k = nextprime(k);
if(k > b) break;
append(__CZ__primelist,k );
}
}
/* Helper for factorial: how often prime p divides the factorial of n */
define __CZ__prime_divisors(n,p)
{
local q,m;
q = n;
m = 0;
if (p > n) return 0;
if (p > n/2) return 1;
while (q >= p) {
q = q//p;
m += q;
}
return m;
}
/*
Wrapper. Please set cut-offs to own taste and hardware.
*/
define factorial(n){
local prime result shift prime_list k k1 k2 expo_list pix cut primorial;
result = 1;
prime = 2;
if(!isint(n)) {
return newerror("factorial(n): n is not an integer"); ## or gamma(n)?
}
if(n < 0) return newerror("factorial(n): n < 0");
if(n < 9000 && !isdefined("test8900")) {
## builtin is implemented with splitting but only with
## Toom-Cook 2 (by Karatsuba (the father))
return n!;
}
shift = __CZ__prime_divisors(n,prime);
prime = 3;
cut = n//2;
pix = pix(cut);
prime_list = mat[pix];
expo_list = mat[pix];
k = 0;
/*
Peter Borwein's algorithm
@Article{journals/jal/Borwein85,
author = {Borwein, Peter B.},
title = {On the Complexity of Calculating Factorials.},
journal = {J. Algorithms},
year = {1985},
number = {3},
url = {http://dblp.uni-trier.de/db/journals/jal/jal6.html#Borwein85}
*/
do {
prime_list[k] = prime;
expo_list[k++] = __CZ__prime_divisors(n,prime);
prime = nextprime(prime);
}while(prime <= cut);
/* size of the largest exponent in bits */
k1 = highbit(expo_list[0]);
k2 = size(prime_list)-1;
for(;k1>=0;k1--){
/*
the cut-off for T-C-4 ist still to low, using T-C-3 here
TODO: check cutoffs
*/
result = toomcook3square(result);
/*
almost all time is spend in this loop, so cutting of the
upper half of the primes makes sense
*/
for(k=0; k<=k2; k++) {
if((expo_list[k] & (1 << k1)) != 0) {
result *= prime_list[k];
}
}
}
primorial = primorial( cut, n);
result *= primorial;
result <<= shift;
return result;
}
/*
Helper for primorial: do the product with binary splitting
TODO: do it without the intermediate list
*/
define __CZ__primorial__lowlevel( a, b ,p)
{
local c;
if( b == a) return p ;
if( b-a > 1){
c= (b + a) >> 1;
return __CZ__primorial__lowlevel( a , c , __CZ__primelist[a] )
* __CZ__primorial__lowlevel( c+1 , b , __CZ__primelist[b] ) ;
}
return __CZ__primelist[a] * __CZ__primelist[b];
}
/*
Primorial, Product of consecutive primes in range a,b
Originally meant to do primorials with a start different from 2, but
found out that this is faster at about a=1,b>=10^5 than the builtin
function pfact(). With the moderately small list a=1,b=10^6 (78498
primes) it is 3 times faster. A quick look-up showed what was already
guessed: pfact() does it linearly. (BTW: what is the time complexity
of the primorial with the naive algorithm?)
*/
define primorial(a,b)
{
local C1 C2;
if(!isint(a)) return newerror("primorial(a,b): a is not an integer");
else if(!isint(b)) return newerror("primorial(a,b): b is not an integer");
else if(a < 0) return newerror("primorial(a,b): a < 0");
else if( b < 2 ) return newerror("primorial(a,b): b < 2");
else if( b < a) return newerror("primorial(a,b): b < a");
else{
/* last prime < 2^32 is also max. prime for nextprime()*/
if(b >= 4294967291) return newerror("primorial(a,b): max. prime exceeded");
if(b == 2) return 2;
/*
Can be extended by way of pfact(b)/pfact(floor(a-1/2)) for small a
*/
if(a<=2 && b < 10^5) return pfact(b);
/* TODO: use pix() and a simple array (mat[])instead*/
__CZ__primelist = list();
__CZ__fill_prime_list(a,b);
C1 = size(__CZ__primelist)-1;
return __CZ__primorial__lowlevel( 0, C1,1)
}
}
/*
* restore internal function from resource debugging
* report important interface functions
*/
config("resource_debug", resource_debug_level),;
if (config("resource_debug") & 3) {
print "factorial(n)";
print "primorial(a, b)";
}

723
cal/factorial2.cal Normal file
View File

@@ -0,0 +1,723 @@
/*
* factorial2 - implementation of different factorial related functions
*
* Copyright (C) 2013 Christoph Zurnieden
*
* factorial2 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.
*
* factorial2 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 factorial2 under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 30.3 $
* @(#) $Id: factorial2.cal,v 30.3 2013/08/11 08:41:38 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/factorial2.cal,v $
*
* Under source code control: 2013/08/11 01:31:28
* File existed as early as: 2013
*/
/*
* hide internal function from resource debugging
*/
static resource_debug_level;
resource_debug_level = config("resource_debug", 0);
/*
get dependencies
*/
read -once factorial toomcook specialfunctions;
/*
Factorize a factorial and put the result in a 2-column matrix with pi(n) rows
mat[ primes , exponent ]
Result can be restricted to start at a prime different from 2 with the second
argument "start". That arguments gets taken at face value if it prime and
smaller than n, otherwise the next larger prime is taken if that prime is
smaller than n.
*/
define __CZ__factor_factorial(n,start){
local prime prime_list k pix stop;
if(!isint(n)) return
newerror("__CZ__factor_factorial(n,start): n is not integer");
if(n < 0) return newerror("__CZ__factor_factorial(n,start): n < 0");
if(n == 1) return newerror("__CZ__factor_factorial(n,start): n == 1");
if(start){
if(!isint(start) && start < 0 && start > n)
return newerror("__CZ__factor_factorial(n,start): value of "
"parameter 'start' out of range");
if(start == n && isprime(n)){
prime_list = mat[1 , 2];
prime_list[0,0] = n;
prime_list[0,1] = 1;
}
else if(!isprime(start) && nextprime(start) >n)
return newerror("__CZ__factor_factorial(n,start): value of parameter "
"'start' out of range");
else{
if(!isprime(start)) prime = nextprime(start);
else prime = start;
}
}
else
prime = 2;
pix = pix(n);
if(start){
pix -= pix(prime) -1;
}
prime_list = mat[pix , 2];
k = 0;
do {
prime_list[k ,0] = prime;
prime_list[k++,1] = __CZ__prime_divisors(n,prime);
prime = nextprime(prime);
}while(prime <= n);
return prime_list;
}
/*
subtracts exponents of n_1! from exponents of n_2! with n_1<=n_2
Does not check for size or consecutiveness of the primes or a carry
*/
define __CZ__subtract_factored_factorials(matrix_2n,matrix_n){
local k ret len1,len2,tmp count p e;
len1 = size(matrix_n)/2;
len2 = size(matrix_2n)/2;
if(len2<len1){
swap(len1,len2);
tmp = matrix_n;
matrix_n = matrix_2n;
matrix_2n = tmp;
}
tmp = mat[len1,2];
k = 0;
for(;k<len1;k++){
p = matrix_2n[k,0];
e = matrix_2n[k,1] - matrix_n[k,1];
if(e!=0){
tmp[count ,0] = p;
tmp[count++,1] = e;
}
}
ret = mat[count + (len2-len1),2];
for(k=0;k<count;k++){
ret[k,0] = tmp[k,0];
ret[k,1] = tmp[k,1];
}
free(tmp);
for(k=len1;k<len2;k++){
ret[count,0] = matrix_2n[k,0];
ret[count++,1] = matrix_2n[k,1];
}
return ret;
}
/*
adds exponents of n_1! to exponents of n_2! with n_1<=n_2
Does not check for size or consecutiveness of the primes or a carry
*/
define __CZ__add_factored_factorials(matrix_2n,matrix_n){
local k ret len1,len2,tmp;
len1 = size(matrix_n)/2;
len2 = size(matrix_2n)/2;
if(len2<len1){
swap(len1,len2);
tmp = matrix_n;
matrix_n = matrix_2n;
matrix_2n = tmp;
}
ret = mat[len2,2];
k = 0;
for(;k<len1;k++){
ret[k,0] = matrix_2n[k,0];
ret[k,1] = matrix_2n[k,1] + matrix_n[k,1];
}
for(;k<len2;k++){
ret[k,0] = matrix_2n[k,0];
ret[k,1] = matrix_2n[k,1];
}
return ret;
}
/*
Does not check if all exponents are positive
timings
this comb comb-this rel. k/n
; benchmark_binomial(10,13)
n=2^13 k=2^10 0.064004 0.016001 + 0.76923076923076923077
n=2^13 k=2^11 0.064004 0.048003 + 0.84615384615384615385
n=2^13 k=2^12 0.068004 0.124008 - 0.92307692307692307692
; benchmark_binomial(10,15)
n=2^15 k=2^10 0.216014 0.024001 + 0.66666666666666666667
n=2^15 k=2^11 0.220014 0.064004 + 0.73333333333333333333
n=2^15 k=2^12 0.228014 0.212014 + 0.8
n=2^15 k=2^13 0.216013 0.664042 - 0.86666666666666666667
n=2^15 k=2^14 0.240015 1.868117 - 0.93333333333333333333
; benchmark_binomial(11,15)
n=2^15 k=2^11 0.216014 0.068004 + 0.73333333333333333333
n=2^15 k=2^12 0.236015 0.212013 + 0.8
n=2^15 k=2^13 0.216013 0.656041 - 0.86666666666666666667
n=2^15 k=2^14 0.244016 1.872117 - 0.93333333333333333333
; benchmark_binomial(11,18)
n=2^18 k=2^11 1.652103 0.100006 + 0.61111111111111111111
n=2^18 k=2^12 1.608101 0.336021 + 0.66666666666666666667
n=2^18 k=2^13 1.700106 1.140071 + 0.72222222222222222222
n=2^18 k=2^14 1.756109 3.924245 - 0.77777777777777777778
n=2^18 k=2^15 2.036127 13.156822 - 0.83333333333333333333
n=2^18 k=2^16 2.172135 41.974624 - 0.88888888888888888889
n=2^18 k=2^17 2.528158 121.523594 - 0.94444444444444444444
; benchmark_binomial(15,25)
n=2^25 k=2^15 303.790985 38.266392 + 0.6
; benchmark_binomial(17,25)
n=2^25 k=2^17 319.127944 529.025062 - 0.68
*/
define benchmark_binomial(s,limit){
local ret k A B T1 T2 start end N K;
N = 2^(limit);
for(k=s;k<limit;k++){
K = 2^k;
start=usertime();A=binomial(N,K);end=usertime();
T1 = end-start;
start=usertime();B=comb(N,K);end=usertime();
T2 = end-start;
print "n=2^"limit,"k=2^"k," ",T1," ",T2,T1<T2?"-":"+"," "k/limit;
if(A!=B){
print "false";
break;
}
}
}
define __CZ__multiply_factored_factorial(matrix,stop){
local prime result shift prime_list k k1 k2 expo_list pix count start;
local hb flag;
result = 1;
shift = 0;
if(!ismat(matrix))
return newerror("__CZ__multiply_factored_factorial(matrix): "
"argument matrix not a matrix ");
if(!matrix[0,0])
return
newerror("__CZ__multiply_factored_factorial(matrix): "
"matrix[0,0] is null/0");
if(!isnull(stop))
pix = stop;
else
pix = size(matrix)/2-1;
if(matrix[0,0] == 2 && matrix[0,1] > 0){
shift = matrix[0,1];
if(pix-1 == 0)
return 2^matrix[0,1];
}
/*
This is a more general way to do the multiplication, so any optimization
must have been done by the caller.
*/
k = 0;
/*
The size of the largest exponent in bits is calculated dynamically.
Can be done more elegantly and saves one run over the whole array if done
inside the main loop.
*/
hb =0;
for(k=0;k<pix;k++){
k1=highbit(matrix[k,1]);
if(hb < k1)hb=k1;
}
k2 = pix;
start = 0;
if(shift) start++;
for(k1=hb;k1>=0;k1--){
/*
the cut-off for T-C-4 ist still too low, using T-C-3 here
TODO: check cutoffs
*/
result = toomcook3square(result);
for(k=start; k<=k2; k++) {
if((matrix[k,1] & (1 << k1)) != 0) {
result *= matrix[k,0];
}
}
}
result <<= shift;
return result;
}
/*
Compute binomial coeficients n!/(k!(n-k)!)
One of the rare cases where a formula once meant to ease manual computation
is actually the (aymptotically) fastest way to do it (in July 2013) for
the extreme case binomial(2N,N) but for a high price, the memory
needed is pi(N)--theoretically.
*/
define binomial(n,k){
local ret factored_n factored_k factored_nk denom num quot K prime_list prime;
local pix diff;
if(!isint(n) || !isint(k))
return newerror("binomial(n,k): input is not integer");
if(n<0 || k<0)
return newerror("binomial(n,k): input is not >= 0"); ;
if(n<k ) return 0;
if(n==k) return 1;
if(k==0) return 1;
if(k==1) return n;
if(n-k==1) return n;
/*
cut-off depends on real size of n,k and size of n/k
The current cut-off is to small for large n, e.g.:
for 2n=2^23, k=n-n/2 the quotient is q=2n/k=0.25. Empirical tests showed
that 2n=2^23 and k=2^16 with q=0.0078125 are still faster than the
builtin function.
The symmetry (n,k) = (n,n-k) is of not much advantage here. One way
might be to get closer to k=n/2 if k<n-k but only if the difference
is small and n very large.
*/
if(n<2e4 && !isdefined("test8900")) return comb(n,k);
if(n<2e4 && k< n-n/2 && !isdefined("test8900")) return comb(n,k);
/*
This should be done in parallel to save some memory, e.g. no temporary
arrays are needed, all can be done inline.
The theoretical memory needed is pi(k).
Which is still a lot.
*/
prime = 2;
pix = pix(n);
prime_list = mat[pix , 2];
K = 0;
do {
prime_list[K ,0] = prime;
diff = __CZ__prime_divisors(n,prime)-
( __CZ__prime_divisors(n-k,prime)+__CZ__prime_divisors(k,prime));
if(diff != 0)
prime_list[K++,1] = diff;
prime = nextprime(prime);
}while(prime <= k);
do {
prime_list[K ,0] = prime;
diff = __CZ__prime_divisors(n,prime)-__CZ__prime_divisors(n-k,prime);
if(diff != 0)
prime_list[K++,1] = diff;
prime = nextprime(prime);
}while(prime <= n-k);
do {
prime_list[K ,0] = prime;
prime_list[K++,1] = __CZ__prime_divisors(n,prime);
prime = nextprime(prime);
}while(prime <= n);
##print K,pix(k),pix(n-k),pix(n);
##factored_k = __CZ__factor_factorial(k,1);
##factored_nk = __CZ__factor_factorial(n-k,1);
##denom = __CZ__add_factored_factorials(factored_k,factored_nk);
##free(factored_k,factored_nk);
##num = __CZ__factor_factorial(n,1);
##quot = __CZ__subtract_factored_factorials( num , denom );
##free(num,denom);
ret = __CZ__multiply_factored_factorial(`prime_list,K-1);
return ret;
}
/*
Compute large catalan numbers C(n) = binomial(2n,n)/(n+1) with
cut-off: (n>5e4)
Needs a lot of memory.
*/
define bigcatalan(n){
if(!isint(n) )return newerror("bigcatalan(n): n is not integer");
if( n<0) return newerror("bigcatalan(n): n < 0");
if( n<5e4 && !isdefined("test8900") ) return catalan(n);
return binomial(2*n,n)/(n+1);
}
/*
df(-111) = -1/3472059605858239446587523014902616804783337112829102414124928
7753332469144201839599609375
df(-3+1i) = 0.12532538977287649201-0.0502372106177184607i
df(2n + 1) = (2*n)!/(n!*2^n)
*/
define __CZ__double_factorial(n){
local n1 n2 diff prime pix K prime_list k;
prime = 3;
pix = pix(2*n)+1;
prime_list = mat[pix , 2];
K = 0;
do {
prime_list[K ,0] = prime;
diff = __CZ__prime_divisors(2*n,prime)-( __CZ__prime_divisors(n,prime));
if(diff != 0)
prime_list[K++,1] = diff;
prime = nextprime(prime);
}while(prime <= n);
do {
prime_list[K ,0] = prime;
prime_list[K++,1] = __CZ__prime_divisors(2*n,prime);
prime = nextprime(prime);
}while(prime <= 2*n);
return __CZ__multiply_factored_factorial(prime_list,K);
/*
n1=__CZ__factor_factorial(2*n,1);
n1[0,1] = n1[0,1]-n;
n2=__CZ__factor_factorial(n,1);
diff=__CZ__subtract_factored_factorials( n1 , n2 );
return __CZ__multiply_factored_factorial(diff);
*/
}
##1, 1, 3, 15, 105, 945, 10395, 135135, 2027025, 34459425, 654729075,
##13749310575, 316234143225, 7905853580625, 213458046676875,
##6190283353629375, 191898783962510625, 6332659870762850625,
##221643095476699771875, 8200794532637891559375
## 1, 2, 8, 48, 384, 3840, 46080, 645120, 10321920, 185794560,
##3715891200, 81749606400, 1961990553600, 51011754393600,
##1428329123020800, 42849873690624000, 1371195958099968000,
##46620662575398912000, 1678343852714360832000, 63777066403145711616000
define doublefactorial(n){
local n1 n2 diff eps ret;
if(!isint(n) ){
/*
Probably one of the not-so-good ideas. See result of
http://www.wolframalpha.com/input/?i=doublefactorial%28a%2Bbi%29
*/
eps=epsilon(epsilon()*1e-2);
ret = 2^(n/2-1/4 * cos(pi()* n)+1/4) * pi()^(1/4 *
cos(pi()* n)-1/4)* gamma(n/2+1);
epsilon(eps);
return ret;
}
if(n==2) return 2;
if(n==3) return 3;
switch(n){
case -1:
case 0 : return 1;break;
case 2 : return 2;break;
case 3 : return 3;break;
case 4 : return 8;break;
default: break;
}
if(isodd(n)){
/*
TODO: find reasonable cutoff
df(2n + 1) = (2*n)!/(n!*2^n)
*/
if(n>0){
n = (n+1)//2;
return __CZ__double_factorial(n);
}
else{
if(n == -3 ) return -1;
n = ((-n)-1)/2;
return ((-1)^-n)/__CZ__double_factorial(n);
}
}
else{
/*
I'm undecided here. The formula for complex n is valid for the negative
integers, too.
*/
n = n>>1;
if(n>0){
if(!isdefined("test8900"))
return factorial(n)<<n;
else
return n!<<n;
}
else
return newerror("doublefactorial(n): even(n) < 0");
}
}
/*
Algorithm 3.17,
Donald Kreher and Douglas Simpson,
Combinatorial Algorithms,
CRC Press, 1998, page 89.
*/
static __CZ__stirling1;
static __CZ__stirling1_n = -1;
static __CZ__stirling1_m = -1;
define stirling1(n,m){
local i j k;
if(n<0)return newerror("stirling1(n,m): n <= 0");
if(m<0)return newerror("stirling1(n,m): m < 0");
if(n<m) return 0;
if(n==m) return 1;
if(m==0 || n==0) return 0;
/* We always use the list */
/*
if(m=1){
if(iseven(n)) return -factorial(n-1);
else return factorial(n-1);
}
if(m == n-1){
if(iseven(n)) return -binomial(n,2);
else return -binomial(n,2);
}
*/
if(__CZ__stirling1_n >= n && __CZ__stirling1_m >= m){
return __CZ__stirling1[n,m];
}
else{
__CZ__stirling1 = mat[n+1,m+1];
__CZ__stirling1[0,0] = 1;
for(i=1;i<=n;i++)
__CZ__stirling1[i,0] = 0;
for(i=1;i<=n;i++){
for(j=1;j<=m;j++){
if(j<=i){
__CZ__stirling1[i, j] = __CZ__stirling1[i - 1, j - 1] - (i - 1)\
* __CZ__stirling1[i - 1, j];
}
else{
__CZ__stirling1[i, j] = 0;
}
}
}
__CZ__stirling1_n = n;
__CZ__stirling1_m = m;
return __CZ__stirling1[n,m];
}
}
define stirling2(n,m){
local k sum;
if(n<0)return newerror("stirling2(n,m): n < 0");
if(m<0)return newerror("stirling2(n,m): m < 0");
if(n<m) return 0;
if(n==0 && n!=m) return 0;
if(n==m) return 1;
if(m==0 )return 0;
if(m==1) return 1;
if(m==2) return 2^(n-1)-1;
/*
There are different methods to speed up alternating sums.
This one doesn't.
*/
if(isdefined("test8900")){
for(k=0;k<=m;k++){
sum += (-1)^(m-k)*comb(m,k)*k^n;
}
return sum/(m!);
}
else{
for(k=0;k<=m;k++){
sum += (-1)^(m-k)*binomial(m,k)*k^n;
}
return sum/factorial(m);
}
}
static __CZ__stirling2;
static __CZ__stirling2_n = -1;
static __CZ__stirling2_m = -1;
define stirling2caching(n,m){
local nm i j ;
if(n<0)return newerror("stirling2iter(n,m): n < 0");
if(m<0)return newerror("stirling2iter(n,m): m < 0");
/* no shortcuts here */
if(n<m) return 0;
if(n==0 && n!=m) return 0;
if(n==m) return 1;
if(m==0 )return 0;
if(m==1) return 1;
if(m==2) return 2^(n-1)-1;
nm = n-m;
if(__CZ__stirling2_n >= n && __CZ__stirling2_m >= m){
return __CZ__stirling2[n,m];
}
else{
__CZ__stirling2 = mat[n+1,m+1];
__CZ__stirling2[0,0] = 1;
for(i=1;i<=n;i++){
__CZ__stirling2[i,0] = 0;
for(j=1;j<=m;j++){
if(j<=i){
__CZ__stirling2[i, j] = __CZ__stirling2[i -1, j -1] + (j )\
* __CZ__stirling2[i - 1, j];
}
else{
__CZ__stirling2[i, j] = 0;
}
}
}
}
__CZ__stirling2_n = (n);
__CZ__stirling2_m = (m);
return __CZ__stirling2[n,m];
}
define bell(n){
local sum s2list k A;
if(!isint(n)) return newerror("bell(n): n is not integer");
if(n < 0) return newerror("bell(n): n is not positive");
/* place some more shortcuts here?*/
if(n<=15){
mat A[16] = {
1, 1, 2, 5, 15, 52, 203, 877, 4140, 21147, 115975, 678570,
4213597, 27644437, 190899322, 1382958545
};
return A[n];
}
/* Start by generating the list of stirling numbers of the second kind */
s2list = stirling2caching(n,n//2);
if(iserror(s2list))
return newerror("bell(n): could not build stirling num. list");
sum = 0;
for(k=1;k<=n;k++){
sum += stirling2caching(n,k);
}
return sum;
}
define subfactorialrecursive(n){
if(n==0) return 1;
if(n==1) return 0;
if(n==2) return 1;
return n * subfactorialrecursive(n-1) + (-1)^n;
}
/* This is, quite amusingely, faster than the very same algorithm in
PARI/GP + GMP*/
define subfactorialiterative(n){
local k temp1 temp2 ret;
if(n==0) return 1;
if(n==1) return 0;
if(n==2) return 1;
temp1 = 0;
ret = 1;
for(k=3;k<=n;k++){
temp2 = temp1;
temp1 = ret;
ret = (k-1) *(temp1 + temp2);
}
return ret;
}
define subfactorial(n){
local epsilon eps ret lnfact;
if(!isint(n))return newerror("subfactorial(n): n is not integer.");
if(n < 0)return newerror("subfactorial(n): n < 0");
return subfactorialiterative(n);
}
define risingfactorial(x,n){
local num denom quot ret;
if(n == 1) return x;
if(x==0) return newerror("risingfactorial(x,n): x == 0");
if(!isint(x) || !isint(n)){
return gamma(x+n)/gamma(x);
}
if(x<1)return newerror("risingfactorial(x,n): integer x and x < 1");
if(x+n < 1)return newerror("risingfactorial(x,n): integer x+n and x+n < 1");
if(x<9000&&n<9000){
return (x+n-1)!/(x-1)!;
}
else{
num = __CZ__factor_factorial(x+n-1,1);
denom = __CZ__factor_factorial(x-1,1);
quot = __CZ__subtract_factored_factorials( num , denom );
free(num,denom);
ret = __CZ__multiply_factored_factorial(quot);
return ret;
}
}
define fallingfactorial(x,n){
local num denom quot ret;
if(n == 0) return 1;
if(!isint(x) || !isint(n)){
if(x == n) return gamma(x+1);
return gamma(x+1)/gamma(x-n+1);
}
else{
if(x<0 || x-n < 0)
return newerror("fallingfactorial(x,n): integer x<0 or x-n < 0");
if(x == n) return factorial(x);
if(x<9000&&n<9000){
return (x)!/(x-n)!;
}
else{
num = __CZ__factor_factorial(x,1);
denom = __CZ__factor_factorial(x-n,1);
quot = __CZ__subtract_factored_factorials( num , denom );
free(num,denom);
ret = __CZ__multiply_factored_factorial(quot);
return ret;
}
}
}
/*
* restore internal function from resource debugging
* report important interface functions
*/
config("resource_debug", resource_debug_level),;
if (config("resource_debug") & 3) {
print "binomial(n,k)";
print "bigcatalan(n)";
print "doublefactorial(n)";
print "subfactorial(n)";
print "stirling1(n,m)";
print "stirling2(n,m)";
print "stirling2caching(n,m)";
print "bell(n)";
print "subfactorial(n)";
print "risingfactorial(x,n)";
print "fallingfactorial(x,n)";
}

107
cal/gvec.cal Normal file
View File

@@ -0,0 +1,107 @@
/*
* gvec - vectorize any single-input function or trailing operator
*
* This version accepts arbitrary number of arguments, but of course
* they must all be same length vectors.
*
* The gvec function is for use in either a two-arg function or a two-arg
* operation "function" must be first; calc doesn't care how many more
* arguments there actually are.
*
* @(#) $Revision: 30.3 $
* @(#) $Id: gvec.cal,v 30.3 2011/05/23 23:00:55 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/gvec.cal,v $
*
* Under source code control: 2011/03/31 17:54:55
* File existed as early as: 2010
*
* By Carl Witthoft carl at witthoft dot com
*/
define gvec(function, vector)
{
local xlen,y,foo;
local precx = 1e-50; /* default for now */
local argc = param(0)-1;
local old_tilde; /* previous config("tilde") */
/*
* parse args
*/
local plist = mat[argc];
if (config("resource_debug") & 8) {
print "plist=", plist;
print "argc=", argc;
}
for(local i = 0; i< argc; i++) {
local ii = i + 2;
if (config("resource_debug") & 8) {
print "ii=", ii;
print "param(" : ii : "}=", param(ii);
print "size(param(" : ii : ")=", size(param(ii));
}
plist[i] = size(param(ii));
}
local slist=sort(plist);
if (config("resource_debug") & 8) {
print "plist=", plist;
}
local argm = argc-1;
if (config("resource_debug") & 8) {
print "argm=", argm;
}
if (slist[0] != slist[argm]) {
quit "lengths don't match";
}
xlen = size(vector);
y = mat[xlen];
/*
* We can't do str(vector[j]) outside loop, eval() petulantly refuses to
* look at local variables.
*
* Also we need to config("tilde",0) to turn off lead tilde
* (so str(vector[j]) looks like a number.
*/
old_tilde = config("tilde",0);
/*
* Ok, now check to see if "function" is a function. If not, it's an
* operation and it's up to user to make it valid
*/
if (isdefined(function)) {
/* yep, it's a function, either builtin or user-defined */
for (local j=0; j<xlen; j++) {
/* build the function call */
foo = strcat(function, "(");
for (local jj = 0; jj<argc; jj++) {
foo = strcat(foo , str(param(jj+2)[j]), ",");
}
foo = strcat(foo, str(precx), ")");
if (config("resource_debug") & 8) {
print "foo=", foo;
}
y[j] = eval(foo);
}
/*
* it is an operator -- multi-argument operator makes no sense
*/
} else {
if (argc > 1) {
quit "Error: operator can accept only one argument";
}
for (j=0; j<xlen; j++) {
foo = strcat(str(vector[j]), function);
y[j] = eval(foo);
}
}
/* restore tilde mode if needed */
config("tilde", old_tilde);
/* return result */
return y;
}

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: hello.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/hello.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: hello.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/hello.cal,v $
*
* Under source code control: 1996/11/13 13:25:43
* File existed as early as: 1996

384
cal/hms.cal Normal file
View File

@@ -0,0 +1,384 @@
/*
* hms - calculate in hours, minutes, and seconds
*
* Copyright (C) 2010 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 30.2 $
* @(#) $Id: hms.cal,v 30.2 2010/09/02 06:14:16 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/hms.cal,v $
*
* Under source code control: 2010/09/01 17:14:55
* File existed as early as: 2010
*
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/
obj hms {hour, min, sec};
define hms(hour, min, sec)
{
local obj hms ans; /* return value */
/* default missing args to 0 */
if (isnull(sec)) {
sec = 0;
}
if (isnull(min)) {
min = 0;
}
/* load object */
ans.hour = hour;
ans.min = min;
ans.sec = sec;
/* return properly formed object */
ans = fixhms(ans);
return ans;
}
define hms_add(a, b)
{
local obj hms ans; /* return value */
/* initalize value to 1st arg */
if (istype(a, ans)) {
/* 1st arg is hms object, load it */
ans.hour = a.hour;
ans.min = a.min;
ans.sec = a.sec;
} else {
/* 1st arg is not hms, assume scalar hours */
ans.hour = a;
ans.min = 0;
ans.sec = 0;
}
/* add value of 2nd arg */
if (istype(b, ans)) {
/* 2nd arg is hms object, add it */
ans.hour += b.hour;
ans.min += b.min;
ans.sec += b.sec;
} else {
/* 2nd arg is not hms, add scalar hours */
ans.hour += b;
}
/* return normalized result */
ans = fixhms(ans);
return ans;
}
define hms_neg(a)
{
local obj hms ans; /* return value */
/* negate argument */
if (istype(a, ans)) {
/* 1st arg is hms object, load it */
ans.hour = -a.hour;
ans.min = -a.min;
ans.sec = -a.sec;
} else {
/* 2nd arg is not hms, negate scalar hours */
ans.hour = -a;
ans.min = 0;
ans.sec = 0;
}
/* return normalized result */
ans = fixhms(ans);
return ans;
}
define hms_sub(a, b)
{
local obj hms ans; /* return value */
/* initalize value to 1st arg */
if (istype(a, ans)) {
/* 1st arg is hms object, load it */
ans.hour = a.hour;
ans.min = a.min;
ans.sec = a.sec;
} else {
/* 1st arg is not hms, assume scalar hours */
ans.hour = a;
ans.min = 0;
ans.sec = 0;
}
/* subtract value of 2nd arg */
if (istype(b, ans)) {
/* 2nd arg is hms object, subtract it */
ans.hour -= b.hour;
ans.min -= b.min;
ans.sec -= b.sec;
} else {
/* 2nd arg is not hms, subtract scalar hours */
ans.hour -= b;
}
/* return normalized result */
ans = fixhms(ans);
return ans;
}
define hms_mul(a, b)
{
local obj hms ans; /* return value */
/* hms object multiplication */
if (istype(a, ans) && istype(b, ans)) {
ans.hour = hms_abs(a) * hms_abs(b);
ans.min = 0;
ans.sec = 0;
/* scalar multiplication */
} else if (istype(a, ans)) {
ans.hour = a.hour * b;
ans.min = a.min * b;
ans.sec = a.sec * b;
} else {
ans.hour = b.hour * a;
ans.min = b.min * a;
ans.sec = b.sec * a;
}
/* return normalized result */
ans = fixhms(ans);
return ans;
}
define hms_print(a)
{
local obj hms ans; /* temp object for hms type testing */
/* firewall - arg must be a hms object */
if (! istype(a, ans)) {
quit "hms_print called with non hms object";
}
/* print in hms form */
print a.hour : ':' : a.min : ':' : a.sec :;
}
define hms_abs(a)
{
local obj hms ans; /* temp object for hms type testing */
local hour; /* return scalar value */
/* firewall - just absolute value non hms objects */
if (! istype(a, ans)) {
return abs(a);
}
/* compute hours */
hour = a.hour + a.min / 60 + a.sec / 3600;
/* return hours */
return hour;
}
define hms_norm(a)
{
local obj hms ans; /* temp object for hms type testing */
local hour; /* hours */
/* firewall - arg must be a hms object */
if (! istype(a, ans)) {
quit "hms_norm called with non hms object";
}
/* square hours (norm is the square of absolute value */
hour = hms_abs(a);
/* return hours */
return hour*hour;
}
define hms_test(a)
{
local obj hms ans; /* temp value */
/* firewall - arg must be a hms object */
if (! istype(a, ans)) {
quit "hms_test called with non hms object";
}
/* return false of non-zero */
ans = fixhms(a);
if (ans.hour == 0 && ans.min == 0 && ans.sec == 0) {
/* false */
return 0;
}
/* true */
return 1;
}
define hms_int(a)
{
local obj hms ans; /* return value */
/* firewall - arg must be a hms object */
if (! istype(a, ans)) {
quit "hms_int called with non hms object";
}
/* normalize the argument */
ans = fixhms(a);
/* truncate to the nearest second */
ans.sec = int(ans.sec);
/* return value to the nearest second */
return ans;
}
define hms_frac(a)
{
local obj hms ans; /* return value */
/* firewall - arg must be a hms object */
if (! istype(a, ans)) {
quit "hms_frac called with non hms object";
}
/* normalize the argument */
ans = fixhms(a);
/* remove all but fractional seconds */
ans.hour = 0;
ans.min = 0;
ans.sec = frac(ans.sec);
/* return value to the second fraction */
return ans;
}
define hms_rel(a,b)
{
local abs_a, abs_b; /* scalars of the arguments */
/* compute scalars of the arguments */
abs_a = hms_abs(a);
abs_b = hms_abs(b);
/* return the comparison */
return cmp(abs_a, abs_b);
}
define hms_cmp(a,b)
{
local abs_a, abs_b; /* scalars of the arguments */
/* compute scalars of the arguments */
abs_a = hms_abs(a);
abs_b = hms_abs(b);
/* return the equality comparison */
return (abs_a == abs_b);
}
define hms_inc(a)
{
local obj hms ans; /* return value */
/* increment a hms object */
if (istype(a, ans)) {
ans = a;
++ans.sec;
/* return normalized result */
ans = fixhms(ans);
return ans;
}
/* increment a scalar */
return a+1;
}
define hms_dec(a)
{
local obj hms ans; /* return value */
/* decrement a hms object */
if (istype(a, ans)) {
ans = a;
--ans.sec;
/* return normalized result */
ans = fixhms(ans);
return ans;
}
/* decrement a scalar */
return a-1;
}
define fixhms(a)
{
local obj hms ans; /* temp value */
/* firewall */
if (! istype(a, ans)) {
quit "attempt to fix a non hms object";
}
/* force minutes to be intergral */
a.min += frac(a.hour) * 60;
a.hour = int(a.hour);
/* force hours to be intergral */
a.sec += frac(a.min) * 60;
a.min = int(a.min);
/* carry excess seconds into minutes */
a.min += a.sec // 60;
a.sec %= 60;
/* carry excess minutes into hours */
a.hour += a.min // 60;
a.min %= 60;
/* round hours by day */
a.hour %= 24;
/* return normalized result */
return a;
}
if (config("resource_debug") & 3) {
print "obj hms {hour, min, sec} defined";
}

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.5 $
* @(#) $Id: intfile.cal,v 29.5 2001/04/10 22:09:34 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/intfile.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: intfile.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/intfile.cal,v $
*
* Under source code control: 2001/03/31 08:13:11
* File existed as early as: 2001

288
cal/lambertw.cal Normal file
View File

@@ -0,0 +1,288 @@
/*
* lambertw- Lambert's W-function
*
* Copyright (C) 2013 Christoph Zurnieden
*
* lambertw 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.
*
* lambertw 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 30.3 $
* @(#) $Id: lambertw.cal,v 30.3 2013/08/11 08:41:38 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/lambertw.cal,v $
*
* Under source code control: 2013/08/11 01:31:28
* File existed as early as: 2013
*/
static resource_debug_level;
resource_debug_level = config("resource_debug", 0);
/*
R. M. Corless and G. H. Gonnet and D. E. G. Hare and D. J. Jeffrey and
D. E. Knuth, "On the Lambert W Function", Advances n Computational
Mathematics, 329--359, (1996)
http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.112.6117
D. J. Jeffrey, D. E. G. Hare, R. M. Corless, "Unwinding the branches of the
Lambert W function", The Mathematical Scientist, 21, pp 1-7, (1996)
http://www.apmaths.uwo.ca/~djeffrey/Offprints/wbranch.pdf
Darko Verebic, "Having Fun with Lambert W(x) Function"
arXiv:1003.1628v1, March 2010, http://arxiv.org/abs/1003.1628
Winitzki, S. "Uniform Approximations for Transcendental Functions",
In Part 1 of Computational Science and its Applications - ICCSA 2003,
Lecture Notes in Computer Science, Vol. 2667, Springer-Verlag,
Berlin, 2003, 780-789. DOI 10.1007/3-540-44839-X_82
A copy may be found by Google.
*/
static true = 1;
static false = 0;
/* Branch 0, Winitzki (2003) , the well known Taylor series*/
define __CZ__lambertw_0(z,eps){
local a=2.344e0, b=0.8842e0, c=0.9294e0, d=0.5106e0, e=-1.213e0;
local y=sqrt(2*exp(1)*z+2);
return (2*ln(1+b*y)-ln(1+c*ln(1+d*y))+e)/(1+1/(2*ln(1+b*y)+2*a));
}
/* branch -1 */
define __CZ__lambertw_m1(z,eps){
local wn k;
/* Cut-off found in Maxima */
if(z < 0.3) return __CZ__lambertw_app(z,eps);
wn = z;
/* Verebic (2010) eqs. 16-18*/
for(k=0;k<10;k++){
wn = ln(-z)-ln(-wn);
}
return wn;
}
/*
generic approximation
series for 1+W((z-2)/(2 e))
Corless et al (1996) (4.22)
Verebic (2010) eqs. 35-37; more coefficients given at the end of sect. 3.1
or online
http://www.wolframalpha.com/input/?
i=taylor+%28+1%2Bproductlog%28+%28z-2%29%2F%282*e%29+%29+%29
or by using the function lambertw_series_print() after running
lambertw_series(z,eps,branch,terms) at least once with the wanted number of
terms and z = 1 (which might throw an error because the series will not
converge in anybodies lifetime for something that far from the branchpoint).
*/
define __CZ__lambertw_app(z,eps){
local b0=-1, b1=1, b2=-1/3, b3=11/72;
local y=sqrt(2*exp(1)*z+2);
return b0 + ( y * (b1 + (y * (b2 + (b3 * y)))));
}
static __CZ__Ws_a;
static __CZ__Ws_c;
static __CZ__Ws_len=0;
define lambertw_series_print(){
local k;
for(k=0;k<__CZ__Ws_len;k++){
print num(__CZ__Ws_c[k]):"/":den(__CZ__Ws_c[k]):"*p^":k;
}
}
/*
The series is fast but only if _very_ close to the branchpoint
The exact branch must be given explicitly, e.g.:
; lambertw(-exp(-1)+.001)-lambertw_series(-exp(-1)+.001,epsilon()*1e-10,0)
-0.14758879113205794065490184399030194122136720202792-
0.00000000000000000000000000000000000000000000000000i
; lambertw(-exp(-1)+.001)-lambertw_series(-exp(-1)+.001,epsilon()*1e-10,1)
0.00000000000000000000000000000000000000000000000000-
0.00000000000000000000000000000000000000000000000000i
*/
define lambertw_series(z,eps,branch,terms){
local k l limit tmp sum A C P PP epslocal;
if(!isnull(terms))
limit = terms;
else
limit = 100;
if(isnull(eps))
eps = epsilon(epsilon()*1e-10);
epslocal = epsilon(eps);
P = sqrt(2*(exp(1)*z+1));
if(branch != 0) P = -P;
tmp=0;sum=0;PP=P;
__CZ__Ws_a = mat[limit+1];
__CZ__Ws_c = mat[limit+1];
__CZ__Ws_len = limit;
/*
c0 = -1; c1 = 1
a0 = 2; a1 =-1
*/
__CZ__Ws_c[0] = -1; __CZ__Ws_c[1] = 1;
__CZ__Ws_a[0] = 2; __CZ__Ws_a[1] = -1;
sum += __CZ__Ws_c[0];
sum += __CZ__Ws_c[1] * P;
PP *= P;
for(k=2;k<limit;k++){
for(l=2;l<k;l++){
__CZ__Ws_a[k] += __CZ__Ws_c[l]*__CZ__Ws_c[k+1-l];
}
__CZ__Ws_c[k] = (k-1) * ( __CZ__Ws_c[k-2]/2
+__CZ__Ws_a[k-2]/4)/
(k+1)-__CZ__Ws_a[k]/2-__CZ__Ws_c[k-1]/(k+1);
tmp = __CZ__Ws_c[k] * PP;
sum += tmp;
if(abs(tmp) <= eps){
epsilon(epslocal);
return sum;
}
PP *= P;
}
epsilon(epslocal);
return
newerror(strcat("lambertw_series: does not converge in ",
str(limit)," terms" ));
}
/* */
define lambertw(z,branch){
local eps epslarge ret branchpoint bparea w we ew w1e wn k places m1e;
local closeness;
eps = epsilon();
if(branch == 0){
if(!im(z)){
if(abs(z) <= eps) return 0;
if(abs(z-exp(1)) <= eps) return 1;
if(abs(z - (-ln(2)/2)) <= eps ) return -ln(2);
if(abs(z - (-pi()/2)) <= eps ) return 1i*pi()/2;
}
}
branchpoint = -exp(-1);
bparea = .2;
if(branch == 0){
if(!im(z) && abs(z-branchpoint) == 0) return -1;
ret = __CZ__lambertw_0(z,eps);
/* Yeah, C&P, I know, sorry */
##ret = ln(z) + 2*pi()*1i*branch - ln(ln(z)+2*pi()*1i*branch);
}
else if(branch == 1){
if(im(z)<0 && abs(z-branchpoint) <= bparea)
ret = __CZ__lambertw_app(z,eps);
/* Does calc have a goto? Oh, it does! */
ret =ln(z) + 2*pi()*1i*branch - ln(ln(z)+2*pi()*1i*branch);
}
else if(branch == -1){##print "-1";
if(!im(z) && abs(z-branchpoint) == 0) return -1;
if(!im(z) && z>branchpoint && z < 0){##print "0";
ret = __CZ__lambertw_m1(z,eps);}
if(im(z)>=0 && abs(z-branchpoint) <= bparea){##print "1";
ret = __CZ__lambertw_app(z,eps);}
ret =ln(z) + 2*pi()*1i*branch - ln(ln(z)+2*pi()*1i*branch);
}
else
ret = ln(z) + 2*pi()*1i*branch - ln(ln(z)+2*pi()*1i*branch);
/*
Such a high precision is only needed _very_ close to the branchpoint
and might even be insufficient if z has not been computed with
sufficient precision itself (M below was calculated by Mathematica and also
with the series above with epsilon(1e-200)):
; epsilon(1e-50)
0.00000000000000000001
; display(50)
20
; M=-0.9999999999999999999999997668356018402875796636464119050387
; lambertw(-exp(-1)+1e-50,0)-M
-0.00000000000000000000000002678416515423276355643684
; epsilon(1e-60)
0.0000000000000000000000000000000000000000000000000
; A=-exp(-1)+1e-50
; epsilon(1e-50)
0.00000000000000000000000000000000000000000000000000
; lambertw(A,0)-M
-0.00000000000000000000000000000000000231185460220585
; lambertw_series(A,epsilon(),0)-M
-0.00000000000000000000000000000000000132145133161626
; epsilon(1e-100)
0.00000000000000000000000000000000000000000000000001
; A=-exp(-1)+1e-50
; epsilon(1e-65)
0.00000000000000000000000000000000000000000000000000
; lambertw_series(A,epsilon(),0)-M
0.00000000000000000000000000000000000000000000000000
; lambertw_series(-exp(-1)+1e-50,epsilon(),0)-M
-0.00000000000000000000000000000000000000002959444084
; epsilon(1e-74)
0.00000000000000000000000000000000000000000000000000
; lambertw_series(-exp(-1)+1e-50,epsilon(),0)-M
-0.00000000000000000000000000000000000000000000000006
*/
closeness = abs(z-branchpoint);
if( closeness< 1){
if(closeness != 0)
eps = epsilon(epsilon()*( closeness));
else
eps = epsilon(epsilon()^2);
}
else
eps = epsilon(epsilon()*1e-2);
epslarge =epsilon();
places = highbit(1 + int(1/epslarge)) + 1;
w = ret;
for(k=0;k<100;k++){
ew = exp(w);
we = w*ew;
if(abs(we-z)<= 4*epslarge*abs(z))break;
w1e = (1+w)*ew;
wn = bround(w- ((we - z) / ( w1e - ( (w+2)*(we-z) )/(2*w+2) ) ),places++) ;
if( abs(wn - w) <= epslarge*abs(wn)) break;
else w = wn;
}
if(k==100){
epsilon(eps);
return newerror("lambertw: Halley iteration does not converge");
}
/* The Maxima coders added a check if the iteration converged to the correct
branch. This coder deems it superfluous. */
epsilon(eps);
return wn;
}
config("resource_debug", resource_debug_level),;
if (config("resource_debug") & 3) {
print "lambertw(z,branch)";
print "lambertw_series(z,eps,branch,terms)";
print "lambertw_series_print()";
}

View File

@@ -1,3 +1,33 @@
/*
* linear - perform a simple two point 2D linear interpolation
*
* Copyright (C) 2005-2007 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 30.2 $
* @(#) $Id: linear.cal,v 30.2 2007/03/17 05:57:42 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/linear.cal,v $
*
* Under source code control: 2005/12/12 06:41:50
* File existed as early as: 2005
*
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/
/*
* linear - perform a simple two point 2D linear interpolation
*

112
cal/lnseries.cal Normal file
View File

@@ -0,0 +1,112 @@
/*
* special_functions - special functions (e.g.: gamma, zeta, psi)
*
* Copyright (C) 2013 Christoph Zurnieden
*
* lnseries.cal 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.
*
* lnseries.cal 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 30.3 $
* @(#) $Id: lnseries.cal,v 30.3 2013/08/11 08:41:38 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/lnseries.cal,v $
*
* Under source code control: 2013/08/11 01:31:28
* File existed as early as: 2013
*/
/*
* hide internal function from resource debugging
*/
static resource_debug_level;
resource_debug_level = config("resource_debug", 0);
static __CZ__int_logs;
static __CZ__int_logs_limit;
static __CZ__int_logs_prec;
define deletelnseries(){
free(__CZ__int_logs,__CZ__int_logs_limit,__CZ__int_logs_prec);
}
define lnfromseries(n){
if( isnull(__CZ__int_logs)
|| __CZ__int_logs_limit < n
|| __CZ__int_logs_prec < log(1/epsilon())){
lnseries(n+1);
}
return __CZ__int_logs[n,0];
}
define lnseries(limit){
local k j eps ;
if( isnull(__CZ__int_logs)
|| __CZ__int_logs_limit < limit
|| __CZ__int_logs_prec < log(1/epsilon())){
__CZ__int_logs = mat[limit+1,2];
__CZ__int_logs_limit = limit;
__CZ__int_logs_prec = log(1/epsilon());
/* probably still too much */
eps = epsilon(epsilon()*10^(-(5+log(limit))));
k =2;
while(1){
/* the prime itself, compute logarithm */
__CZ__int_logs[k,0] = ln(k);
__CZ__int_logs[k,1] = k;
for(j = 2*k;j<=limit;j+=k){
/* multiples of prime k, add logarithm of k computed earlier */
__CZ__int_logs[j,0] += __CZ__int_logs[k,0];
/* First hit, set counter to number */
if(__CZ__int_logs[j,1] ==0)
__CZ__int_logs[j,1]=j;
/* reduce counter by prime added */
__CZ__int_logs[j,1] //= __CZ__int_logs[k,1];
}
k++;
if(k>=limit) break;
/* Erastothenes-sieve: look for next prime. */
while(__CZ__int_logs[k,0]!=0){
k++;
if(k>=limit) break;
}
}
/* Second run to include the last factor */
for(k=1;k<=limit;k++){
if(__CZ__int_logs[k,1] != k){
__CZ__int_logs[k,0] +=__CZ__int_logs[ __CZ__int_logs[k,1],0];
__CZ__int_logs[k,1] = 0;
}
}
epsilon(eps);
}
return 1;
}
/*
* restore internal function from resource debugging
*/
config("resource_debug", resource_debug_level),;
if (config("resource_debug") & 3) {
print "lnseries(limit)";
print "lnfromseries(n)";
print "deletelnseries()";
}

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.6 $
* @(#) $Id: lucas.cal,v 29.6 2002/07/10 09:43:46 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/lucas.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: lucas.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/lucas.cal,v $
*
* Under source code control: 1990/05/03 16:49:51
* File existed as early as: 1990

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.3 $
* @(#) $Id: lucas_chk.cal,v 29.3 2001/03/31 13:31:34 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/lucas_chk.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: lucas_chk.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/lucas_chk.cal,v $
*
* Under source code control: 1991/01/11 05:41:43
* File existed as early as: 1991

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: lucas_tbl.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/lucas_tbl.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: lucas_tbl.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/lucas_tbl.cal,v $
*
* Under source code control: 1991/01/26 02:43:43
* File existed as early as: 1991

View File

@@ -17,11 +17,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: mersenne.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/mersenne.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: mersenne.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/mersenne.cal,v $
*
* Under source code control: 1991/05/22 21:56:36
* File existed as early as: 1991

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: mfactor.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/mfactor.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: mfactor.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/mfactor.cal,v $
*
* Under source code control: 1996/07/06 06:09:40
* File existed as early as: 1996
@@ -261,7 +261,7 @@ define mfactor(n, start_k, rept_loop, p_elim)
} else {
/* report this loop */
printf("at 2*%d*%d+1, cpu: %f\n",
(q-1)/(2*n), n, runtime());
(q-1)/(2*n), n, usertime());
fflush(files(1));
loop = 0;
}
@@ -274,7 +274,7 @@ define mfactor(n, start_k, rept_loop, p_elim)
if (rept_loop <= ++loop) {
/* report this loop */
printf("at 2*%d*%d+1, cpu: %f\n",
(q-1)/(2*n), n, runtime());
(q-1)/(2*n), n, usertime());
fflush(files(1));
loop = 0;
}

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: mod.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/mod.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: mod.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/mod.cal,v $
*
* Under source code control: 1990/02/15 01:50:34
* File existed as early as: before 1990

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.3 $
* @(#) $Id: natnumset.cal,v 29.3 2006/05/01 19:19:46 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/natnumset.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: natnumset.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/natnumset.cal,v $
*
* Under source code control: 1997/09/07 23:53:51
* File existed as early as: 1997

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: pell.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/pell.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: pell.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/pell.cal,v $
*
* Under source code control: 1990/02/15 01:50:34
* File existed as early as: before 1990

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.5 $
* @(#) $Id: pi.cal,v 29.5 2004/02/23 14:04:01 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/pi.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: pi.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/pi.cal,v $
*
* Under source code control: 1991/05/22 21:56:37
* File existed as early as: 1991

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: pix.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/pix.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: pix.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/pix.cal,v $
*
* Under source code control: 1996/07/09 03:14:14
* File existed as early as: 1996

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: pollard.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/pollard.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: pollard.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/pollard.cal,v $
*
* Under source code control: 1991/05/22 21:56:37
* File existed as early as: 1991

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: poly.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/poly.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: poly.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/poly.cal,v $
*
* Under source code control: 1990/02/15 01:50:35
* File existed as early as: before 1990

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: prompt.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/prompt.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: prompt.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/prompt.cal,v $
*
* Under source code control: 1995/12/18 04:43:25
* File existed as early as: 1995
@@ -101,7 +101,7 @@ define adder() {
}
}
global x;
global prompt_x;
define showvalues(str) {
local s;
@@ -109,8 +109,8 @@ define showvalues(str) {
s = prompt("? ");
if (s == "end")
break;
x = eval(s);
if (!isnum(x)) {
prompt_x = eval(s);
if (!isnum(prompt_x)) {
print "Please enter a number";
continue;
}

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: psqrt.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/psqrt.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: psqrt.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/psqrt.cal,v $
*
* Under source code control: 1990/02/15 01:50:35
* File existed as early as: before 1990

View File

@@ -18,11 +18,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.4 $
* @(#) $Id: qtime.cal,v 29.4 2000/12/18 10:18:40 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/qtime.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: qtime.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/qtime.cal,v $
*
* Under source code control: 1999/10/13 04:10:33
* File existed as early as: 1999

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: quat.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/quat.cal,v $
* @(#) $Revision: 30.2 $
* @(#) $Id: quat.cal,v 30.2 2013/08/11 08:41:38 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/quat.cal,v $
*
* Under source code control: 1990/02/15 01:50:35
* File existed as early as: before 1990
@@ -55,7 +55,8 @@ define quat(a,b,c,d)
define quat_print(a)
{
print "quat(" : a.s : ", " : a.v[0] : ", " : a.v[1] : ", " : a.v[2] : ")" :;
print "quat(" : a.s : ", " : a.v[0] : ", " :
a.v[1] : ", " : a.v[2] : ")" :;
}

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: randbitrun.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/randbitrun.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: randbitrun.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/randbitrun.cal,v $
*
* Under source code control: 1995/02/13 03:43:11
* File existed as early as: 1995

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: randmprime.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/randmprime.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: randmprime.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/randmprime.cal,v $
*
* Under source code control: 1994/03/14 23:11:21
* File existed as early as: 1994
@@ -88,8 +88,8 @@ randmprime(bits, seed, dbg)
* loop until we find a prime
*/
if (dbg >= 1) {
start = runtime();
init = runtime();
start = usertime();
init = usertime();
plush = 0;
print "DEBUG1: testing (h+" : plush : ")*2^" : n : "-1";
}
@@ -97,7 +97,7 @@ randmprime(bits, seed, dbg)
/* bump h, and n if needed */
if (dbg >= 2) {
stop = runtime();
stop = usertime();
print "DEBUG2: last test:", stop-start, " total time:", stop-init;
}
if (dbg >= 1) {
@@ -116,7 +116,7 @@ randmprime(bits, seed, dbg)
/* found a prime */
if (dbg >= 2) {
stop = runtime();
stop = usertime();
print "DEBUG2: last test:", stop-start, " total time:", stop-init;
print "DEBUG3: " : h : "*2^" : n : "-1 is prime";
}

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: randombitrun.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/randombitrun.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: randombitrun.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/randombitrun.cal,v $
*
* Under source code control: 1995/02/13 03:43:11
* File existed as early as: 1995

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: randomrun.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/randomrun.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: randomrun.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/randomrun.cal,v $
*
* Under source code control: 1997/02/19 03:35:59
* File existed as early as: 1997

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: randrun.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/randrun.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: randrun.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/randrun.cal,v $
*
* Under source code control: 1995/02/12 20:00:06
* File existed as early as: 1995

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.25 $
* @(#) $Id: regress.cal,v 29.25 2006/05/21 00:58:31 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/regress.cal,v $
* @(#) $Revision: 30.8 $
* @(#) $Id: regress.cal,v 30.8 2013/08/11 08:41:38 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/regress.cal,v $
*
* Under source code control: 1990/02/15 01:50:36
* File existed as early as: before 1990
@@ -201,7 +201,6 @@ define test_variables()
local x1, x2, x3;
global g1, g2;
local t;
global globalvar;
local x;
print '350: Beginning test_variables';
@@ -404,14 +403,14 @@ define test_config()
'512: config("trace") == 0');
vrfy(config("maxprint") == 16,
'513: config("maxprint") == 16');
vrfy(config("mul2") == 20,
'514: config("mul2") == 20');
vrfy(config("sq2") == 20,
'515: config("sq2") == 20');
vrfy(config("pow2") == 40,
'516: config("pow2") == 40');
vrfy(config("redc2") == 50,
'517: config("redc2") == 50');
vrfy(config("mul2") == 1780,
'514: config("mul2") == 1780');
vrfy(config("sq2") == 3388,
'515: config("sq2") == 3388');
vrfy(config("pow2") == 176,
'516: config("pow2") == 176');
vrfy(config("redc2") == 220,
'517: config("redc2") == 220');
vrfy(config("tilde"),
'518: config("tilde")');
vrfy(config("tab"),
@@ -498,7 +497,33 @@ define test_config()
vrfy(config("mode2") == "off",
'556: config("mode2") == "off"');
print '557: Ending test_config';
/* hz is numeric */
vrfy(isint(config("hz")), '557: isint(config("hz"))');
/* compile_custom is simple */
vrfy(issimple(config("compile_custom")),
'558: issimple(config("compile_custom"))');
/* allow_custom is simple */
vrfy(issimple(config("allow_custom")),
'559: issimple(config("allow_custom"))');
/* allow_custom is simple */
vrfy(issimple(config("allow_custom")),
'559: issimple(config("allow_custom"))');
/* baseb is numeric */
vrfy(isint(config("baseb")), '560: isint(config("baseb"))');
/* redecl_warn is simple */
vrfy(issimple(config("redecl_warn")),
'561: issimple(config("redecl_warn"))');
/* dupvar_warn is simple */
vrfy(issimple(config("dupvar_warn")),
'562: issimple(config("rdupvar_warn"))');
print '563: Ending test_config';
}
print '010: parsed test_config()';
@@ -571,12 +596,18 @@ print '012: parsed squarecheck(a, b, str)';
define powercheck(a, p1, p2, str)
{
local a1, a2, a3;
local b1, b2, b3;
a1 = (a^p1)^p2;
a2 = (a^p2)^p1;
a3 = a^(p1*p2);
b1 = (a**p1)**p2;
b2 = (a**p2)**p1;
b3 = a**(p1*p2);
if (a1 != a2) {print '**** (a^p1)^p2 != (a^p2)^p1:', str; ++prob;}
if (a1 != a3) {print '**** (a^p1)^p2 != a^(p1*p2):', str; ++prob;}
if (b1 != b2) {print '**** (b^p1)^p2 != (b^p2)^p1:', str; ++prob;}
if (b1 != b3) {print '**** (b^p1)^p2 != b^(p1*p2):', str; ++prob;}
print str;
}
print '013: parsed powercheck(a, p1, p2, str)';
@@ -744,6 +775,7 @@ define test_functions()
local pi;
local h, n, r, m, v;
local n2, m2, v2;
local t;
print '700: Beginning test_functions';
@@ -1317,7 +1349,103 @@ define test_functions()
*/
vrfy(isstr(calcpath()), '1155: isstr(calcpath())');
print '1156: Ending test_functions';
/*
* ssq use of lists
*/
vrfy(ssq(1,2, list(3,4,list(5,6)), list(), 7, 8) == 204,
'1156: ssq(1,2, list(3,4,list(5,6)), list(), 7, 8) == 204');
/*
* quomod 5th argument rounding tests
*/
vrfy(quomod(10,-3,a,b,0) == 1, '1157: vrfy(quomod(10,-3,a,b,0) == 1');
vrfy(a == -4, '1158: a == -4');
vrfy(b == -2, '1159: b == -2');
vrfy(quomod(-10,-3,a,b,1) == 1, '1160: vrfy(quomod(-10,-3,a,b,1) == 1');
vrfy(a == 4, '1161: a == 4');
vrfy(b == 2, '1162: b == 2');
vrfy(quomod(10,3,a,b,2) == 1, '1163: vrfy(quomod(10,3,a,b,2) == 1');
vrfy(a == 3, '1164: a == 3');
vrfy(b == 1, '1165: b == 1');
vrfy(quomod(-10,3,a,b,3) == 1, '1166: vrfy(quomod(-10,3,a,b,3) == 1');
vrfy(a == -4, '1167: a == -4');
vrfy(b == 2, '1168: b == 2');
vrfy(quomod(10,-3,a,b,4) == 1, '1169: vrfy(quomod(10,-3,a,b,4) == 1');
vrfy(a == -3, '1170: a == -3');
vrfy(b == 1, '1171: b == 1');
vrfy(quomod(-10,-3,a,b,5) == 1, '1172: vrfy(quomod(-10,-3,a,b,5) == 1');
vrfy(a == 3, '1173: a == 3');
vrfy(b == -1, '1174: b == -1');
vrfy(quomod(10,3,a,b,6) == 1, '1175: vrfy(quomod(10,3,a,b,6) == 1');
vrfy(a == 3, '1176: a == 3');
vrfy(b == 1, '1177: b == 1');
vrfy(quomod(-10,3,a,b,7) == 1, '1178: vrfy(quomod(-10,3,a,b,7) == 1');
vrfy(a == -4, '1179: a == -4');
vrfy(b == 2, '1180: b == 2');
vrfy(quomod(10,-3,a,b,8) == 1, '1181: vrfy(quomod(10,-3,a,b,8) == 1');
vrfy(a == -4, '1182: a == -4');
vrfy(b == -2, '1183: b == -2');
vrfy(quomod(-10,-3,a,b,9) == 1, '1184: vrfy(quomod(-10,-3,a,b,9) == 1');
vrfy(a == 3, '1185: a == 3');
vrfy(b == -1, '1186: b == -1');
vrfy(quomod(10,3,a,b,10) == 1, '1187: vrfy(quomod(10,3,a,b,10) == 1');
vrfy(a == 4, '1188: a == 4');
vrfy(b == -2, '1189: b == -2');
vrfy(quomod(-10,3,a,b,11) == 1, '1190: vrfy(quomod(-10,3,a,b,11) == 1');
vrfy(a == -4, '1191: a == -4');
vrfy(b == 2, '1192: b == 2');
vrfy(quomod(10,-3,a,b,12) == 1, '1193: vrfy(quomod(10,-3,a,b,12) == 1');
vrfy(a == -3, '1194: a == -3');
vrfy(b == 1, '1195: b == 1');
vrfy(quomod(-10,-3,a,b,13) == 1,
'1196: vrfy(quomod(-10,-3,a,b,13) == 1');
vrfy(a == 4, '1197: a == 4');
vrfy(b == 2, '1198: b == 2');
vrfy(quomod(10,3,a,b,14) == 1, '1199: vrfy(quomod(10,3,a,b,14) == 1');
vrfy(a == 4, '1200: a == 4');
vrfy(b == -2, '1201: b == -2');
vrfy(quomod(-10,3,a,b,15) == 1, '1202: vrfy(quomod(-10,3,a,b,15) == 1');
vrfy(a == -4, '1203: a == -4');
vrfy(b == 2, '1204: b == 2');
/* runtime(), systime(), usertime() return numeric values */
vrfy(isnum(runtime()), '1205: isnum(runtime())');
vrfy(isnum(systime()), '1206: isnum(systime())');
vrfy(isnum(usertime()), '1207: isnum(usertime())');
/* more jacobi tests */
vrfy(jacobi(987897,987) == 0, '1208: jacobi(987897,987) == 0');
vrfy(jacobi(897,987) == 0, '1209: jacobi(897,987) == 0');
vrfy(jacobi(987,897) == 0, '1210: jacobi(987,897) == 0');
vrfy(jacobi(90,897) == 0, '1211: jacobi(90,897) == 0');
vrfy(jacobi(45,897) == 0, '1212: jacobi(45,897) == 0');
vrfy(jacobi(897,45) == 0, '1213: jacobi(897,45) == 0');
vrfy(jacobi(42,45) == 0, '1214: jacobi(42,45) == 0');
vrfy(jacobi(21,45) == 0, '1215: jacobi(21,45) == 0');
vrfy(jacobi(45,21) == 0, '1216: jacobi(45,21) == 0');
vrfy(jacobi(3,21) == 0, '1217: jacobi(3,21) == 0');
vrfy(jacobi(0,21) == 0, '1218: jacobi(0,21) == 0');
vrfy(jacobi(0,20003) == 0, '1219: jacobi(0,20003) == 0');
vrfy(jacobi(1,20003) == 1, '1220: jacobi(1,20003) == 1');
vrfy(jacobi(1236,20003) == 1, '1221: jacobi(1236,20003) == 1');
vrfy(jacobi(618,20003) == -1, '1222: jacobi(618,20003) == -1');
vrfy(jacobi(309,20003) == 1, '1223: jacobi(309,20003) == 1');
vrfy(jacobi(227,309) == 1, '1224: jacobi(227,309) == 1');
vrfy(jacobi(82,227) == 1, '1225: jacobi(82,227) == 1');
vrfy(jacobi(41,227) == -1, '1226: jacobi(41,227) == -1');
vrfy(jacobi(22,41) == -1, '1227: jacobi(22,41) == -1');
vrfy(jacobi(11,41) == -1, '1228: jacobi(11,41) == -1');
vrfy(jacobi(8,11) == -1, '1229: jacobi(8,11) == -1');
vrfy(jacobi(4,11) == 1, '1230: jacobi(4,11) == 1');
vrfy(jacobi(2,11) == -1, '1231: jacobi(2,11) == -1');
vrfy(jacobi(1,11) == 1, '1232: jacobi(1,11) == 1');
vrfy(jacobi(0,11) == 0, '1233: jacobi(0,11) == 0');
vrfy(jacobi(0,0) == 0, '1234: jacobi(0,0) == 0');
vrfy(jacobi(-1,0) == 0, '1235: jacobi(-1,0) == 0');
vrfy(jacobi(-1,-1) == 0, '1236: jacobi(-1,-1) == 0');
vrfy(jacobi(0,-1) == 0, '1237: jacobi(0,-1) == 0');
print '1238: Ending test_functions';
}
print '017: parsed test_functions()';
@@ -1334,14 +1462,14 @@ define _test_underscore()
local _a = 27;
local __a = 23209;
print "1200: Beginning _test_underscore";
print "1290: Beginning _test_underscore";
vrfy(_a == 27, '1201: _a == 27');
vrfy(_ == 49, '1202: _ == 49');
vrfy(__ == 63, '1203: __ == 63');
vrfy(__a == 23209, '1204: __a == 23209');
vrfy(_a == 27, '1291: _a == 27');
vrfy(_ == 49, '1292: _ == 49');
vrfy(__ == 63, '1293: __ == 63');
vrfy(__a == 23209, '1294: __a == 23209');
print "1205: Ending _test_underscore";
print "1295: Ending _test_underscore";
}
print '020: parsed _test_underscore';
@@ -1382,8 +1510,10 @@ define test_assoc()
vrfy(isnull(search(a,16)), '1312: isnull(search(a,16))');
a["curds","whey"] = "spider";
print '1313: a["curds","whey"] = "spider"';
vrfy(a["curds","whey"] == "spider", '1314: a["curds","whey"] == "spider"');
vrfy(a[[rsearch(a,"spider")]] == "spider", '1315: a[[rsearch(a,"spider")]] == "spider"');
vrfy(a["curds","whey"] == "spider",
'1314: a["curds","whey"] == "spider"');
vrfy(a[[rsearch(a,"spider")]] == "spider",
'1315: a[[rsearch(a,"spider")]] == "spider"');
b = a;
print '1316: b = a';
vrfy(b[17] == 19, '1317: b[17] == 19');
@@ -2611,11 +2741,24 @@ define test_2600()
vrfy(log(1e127) == 127,
strcat(str(tnum++), ': log(1e127)) == 127'));
vrfy(round(log(17^47),10) == 57.8310993048,
strcat(str(tnum++),
': round(log(17^47),10) == 57.8310993048'));
strcat(str(tnum++),
': round(log(17^47),10) == 57.8310993048'));
vrfy(round(log(127),10) == 2.103803721,
strcat(str(tnum++),
': round(log(127),10) == 2.103803721'));
strcat(str(tnum++),
': round(log(127),10) == 2.103803721'));
vrfy(round(log(0.25,0.00001),5) == -0.60206,
strcat(str(tnum++),
': round(log(0.25,0.00001),5) == -0.60206'));
vrfy(round(log(0.25,1e-10),10) == -0.6020599913,
strcat(str(tnum++),
': round(log(0.25,1e-10),10) == -0.6020599913'));
vrfy(round( log(1.2+1.2i,1e-5),5) == 0.2297+0.34109i,
strcat(str(tnum++),
': round(log(1.2+1.2i,1e-5),5) == 0.2297+0.34109i'));
vrfy(round( log(1.2+1.2i,1e-10),10) == 0.2296962439+0.3410940885i,
strcat(str(tnum++),
': round(log(1.2+1.2i,1e-10),10) == ',
'0.2296962439+0.3410940885i'));
epsilon(i),;
print tnum++: ': epsilon(i),;';
@@ -3170,7 +3313,7 @@ define test_error()
'3654: scale(3,2^31) == error(10034)');
vrfy("x" ^ 3 == error(10035), '3655: "x" ^ 3 == error(10035)');
vrfy(2 ^ "x" == error(10036), '3656: 2 ^ "x" == error(10036)');
vrfy(2 ^ 2.5 == error(10036), '3657: 2 ^ 2.5 == error(10036)');
vrfy(2 ^ "2" == error(10036), '3657: 2 ^ "2" == error(10036)');
vrfy(power("x",2.1) == error(10037),
'3658: power("x",2.1) == error(10037)');
vrfy(power(2,"x") == error(10038),
@@ -3404,11 +3547,12 @@ print '070: parsed test_redc()';
*/
define test_fileops()
{
local a, b, c, f, m, n, p, r, x, y, z;
local a, b, c, f, m, n, p, r, s, x, y, z;
local L = "Landon";
local C = "Curt";
local N = "Noll";
local LCN = "Landon\nCurt\nNoll\n";
local long = "0123456789abcdef0123456789abcdef";
print '4200: Beginning test_fileops';
@@ -3511,16 +3655,55 @@ define test_fileops()
*/
vrfy(!iserror(p=fpathopen("junk4200","r",".")),
'4260: !iserror(p=fparhopen("junk4200","r","."))');
vrfy(!iserror(fclose(p)), '4261: !iserror(fclose(p))');
vrfy(!iserror(r=fpathopen("regress.cal","r")),
'4261: !iserror(r=fparhopen("regress.cal","r","."))');
'4262: !iserror(r=fparhopen("regress.cal","r","."))');
vrfy(!iserror(fclose(r)), '4263: !iserror(fclose(r))');
/*
* verify non-stack overflow on long filenames
*/
long = long + long + long + long;
print '4264: long = long + long + long + long;';
long = long + long + long + long;
print '4265: long = long + long + long + long;';
vrfy(strlen(long) == 512, '4266: strlen(long) == 512');
/* bump ecnt up by 1 */
++ecnt;
print '4267: ++ecnt;';
vrfy(isfile(p=fopen(long,"r")) == 0,
'4268: isfile(p=fopen(long,"r")) == 0');
/*
* test fgetfile() and fgetline()
*/
vrfy(!iserror(p=fopen("tmp4200","w")),
'4269: !iserror(p=fopen("tmp4200","w"))');
vrfy(!iserror(fputs(p,"chongo\n")),
'4270: !iserror(fputs(p,"chongo\n"))');
vrfy(!iserror(fputs(p,"w\0a\0s\n")),
'4271: !iserror(fputs(p,"w\0a\0s\n"))');
vrfy(!iserror(fputs(p,"here\n")),
'4272: !iserror(fputs(p,"here\n"))');
vrfy(!iserror(fclose(p)), '4273: !iserror(fclose(p))');
vrfy(!iserror(p=fopen("tmp4200","r")),
'4274: !iserror(p=fopen("tmp4200","r"))');
vrfy(!iserror(s=fgetline(p)), '4275: !iserror(s=fgetline(p))');
vrfy(strcmp(s,"chongo") == 0, '4276: strcmp(s,"chongo") == 0');
vrfy(!iserror(s=fgetfile(p)), '4277: !iserror(s=fgetfile(p))');
vrfy(strcmp(s,"w\0a\0s\nhere\n") == 0,
'4278: strcmp(s,"w\0a\0s\nhere\n") == 0');
vrfy(!iserror(fclose(p)), '4279: !iserror(fclose(p))');
/*
* cleanup
*/
x = rm("junk4200");
print '4262: x = rm("junk4200")';
print '4280: x = rm("junk4200")';
x = rm("tmp4200");
print '4281: x = rm("tmp4200")';
print '4263: Ending test_fileops';
print '4282: Ending test_fileops';
}
print '071: parsed test_fileops()';
@@ -3955,7 +4138,7 @@ print '088: parsed test_fileop()';
/*
* global and static assignment tests
*/
global a = 10, b, c d = 20, e, f;
global a = 10, b, c d = 20, e;
print '089: global a = 10, b, c d = 20, e, f';
vrfy(a == 10, '090: a == 10');
vrfy(b == 0, '091: b == 0');
@@ -4655,13 +4838,11 @@ print '137: parsed test_random()';
/*
* test_newsyn - test new command completion syntax and scope rules
*/
for (s5500 = 0, i = 0; i < 5; i++)
s5500 += i;
for (s5500 = 0, i = 0; i < 5; i++) s5500 += i;
print "138: for (s5500 = 0, i = 0; i < 5; i++) s5500 += i;";
vrfy(s5500 == 10, '139: s5500 == 10');
vrfy(i == 5, '140: i == 5');
for (s5500 = 0, i = 0; i < 9; i++)
{
for (s5500 = 0, i = 0; i < 9; i++) {
s5500 += i;
}
print "141: for (s5500 = 0, i = 0; i < 9; i++) { s5500 += i; }";
@@ -4709,13 +4890,13 @@ define test_newsyn()
vrfy(i == 3, '5509: i == 3');
/**/
{
local i;
for (s5500 = 0, i = 0; i < 11; i++)
s5500 += i;
vrfy(s5500 == 55, '5510: s5500 == 45');
vrfy(i == 11, '5511: i == 11');
}
print "5512: { local i; for (s5500 = 0, i = 0; i < 10; i++) s5500 += i; ... }";
print "5512: { local i; for (s5500 = 0, i = 0; i < 10; i++) ":
"s5500 += i; ... }";
vrfy(s5500 == 55, '5513: s5500 == 55');
vrfy(i == 11, '5514: i == 11');
@@ -5121,8 +5302,6 @@ print '156: parsed test_size()';
/*
* test_assign - test assignment of constants and variables
*/
global A, B; /* A, B for "constants" */
print '157: global A, B';
global X5800, Y5800; /* X5800, Y5800 for "variables" */
print '158: global X5800, Y5800';
obj xy5800 {x, y};
@@ -5196,7 +5375,7 @@ define test_is()
local nerr; /* new error value */
local odd; /* odd integer */
local even; /* even integer that is 10 times odd */
local hash; /* sha hash value */
local hash; /* sha1 hash value */
local id; /* identity matrix */
local list; /* list value */
local matrix; /* non-identity matrix */
@@ -5209,6 +5388,11 @@ define test_is()
local square; /* square of an odd prime */
local string; /* string */
local com; /* complex value */
local rndint; /* a random integer */
local rndexp; /* a random exponent */
local rndval; /* rndint ^ rndexp */
local i; /* integer value */
local ok; /* 1 ==> issq() tests were OK, 0 ==> failure */
print '5900: Beginning test_is';
@@ -5246,8 +5430,8 @@ define test_is()
print '5911: odd = 23209';
even = odd*10;
print '5912: even = odd*10';
hash = sha();
print '5913: hash = sha()';
hash = sha1();
print '5913: hash = sha1()';
mat id[3,3] = {1,0,0,0,1,0,0,0,1};
print '5914: id[3,3] = {1,0,0,0,1,0,0,0,1}';
list = list(2,3,4);
@@ -5570,7 +5754,7 @@ define test_is()
vrfy(ishash(nerr) == 0, '6178: ishash(nerr) == 0');
vrfy(ishash(odd) == 0, '6179: ishash(odd) == 0');
vrfy(ishash(even) == 0, '6180: ishash(even) == 0');
vrfy(ishash(hash) == 1, '6181: ishash(hash) == 1');
vrfy(ishash(hash) == 2, '6181: ishash(hash) == 2');
vrfy(ishash(id) == 0, '6182: ishash(id) == 0');
vrfy(ishash(list) == 0, '6183: ishash(list) == 0');
vrfy(ishash(matrix) == 0, '6184: ishash(matrix) == 0');
@@ -6146,15 +6330,75 @@ define test_is()
vrfy(istype(matrix,odd) == 0, '6661: istype(matrix,odd) == 0');
vrfy(istype(a,odd) == 0, '6662: istype(a,odd) == 0');
/*
* perform more extensive issq() testing
*/
ok = 1;
for (i=0; i < 256; ++i) {
/* rndval will be a square - even powers>0 of x>1 */
rndexp = random(1, 16) * 2;
rndint = random(2, 4294967296);
if (issq(rndint)) {
++rndint;
}
rndval = rndint ^ rndexp;
if (issq(rndval) == 0) {
prob(strprintf("issq(%d^%d) returned 0",
rndint, rndexp));
ok = 0;
}
}
if (ok) {
print '6663: issq() on 256 squares';
} else {
print '****: failure(s): 6663: faiissq() on 256 squares';
}
for (i=0; i < 256; ++i) {
/* rndval will not be a square - 1 + even powers>0 of x>1 */
rndexp = random(1, 16) * 2;
rndint = random(2, 4294967296);
rndval = rndint ^ rndexp;
if (issq(rndval+1) != 0) {
prob(strprintf("issq(%d^%d)+1 returned non-zero",
rndint, rndexp));
ok = 0;
}
}
if (ok) {
print '6664: issq() on 256 squares+1';
} else {
print '****: failure(s): 6664: issq() on 256 squares+1';
}
print '6664: issq() on 256 squares+1';
for (i=0; i < 256; ++i) {
/* rndval will not be a square - odd powers>0 of x>1 */
rndexp = (random(1, 16) * 2) + 1;
rndint = random(2, 4294967296);
if (issq(rndint)) {
++rndint;
}
rndval = rndint ^ rndexp;
if (issq(rndval) != 0) {
prob(strprintf("issq(%d^%d) returned non-zero",
rndint, rndexp));
ok = 0;
}
}
if (ok) {
print '6665: issq() on 256 non-squares';
} else {
print '****: failure(s): 6665: issq() on 256 non-squares';
}
/*
* cleanup
*/
blkfree("blk5900");
print '6663: blkfree("blk5900")';
print '6666: blkfree("blk5900")';
fclose(ofd);
print '6664: fclose(ofd)';
print '6667: fclose(ofd)';
print '6665: Ending test_is';
print '6668: Ending test_is';
}
print '168: test_is()';
@@ -6266,7 +6510,8 @@ define test_blk()
/* A second named block */
B1 = blk("+++6700", 15, 10) = {1,2,3,4,5};
print '6746: B1 = blk("+++6700", 15 , 10) = {1,2,3,4,5};';
print
'6746: B1 = blk("+++6700", 15 , 10) = {1,2,3,4,5};';
vrfy(size(B1) == 15, '6747: size(B1) == 15');
vrfy(sizeof(B1) == 20, '6748: sizeof(B1) == 20');
vrfy(test(B1) == 1, '6749: test(B1) == 1');
@@ -6603,108 +6848,6 @@ define test_blkprintf()
print '172: parsed test_blkprintf()';
/*
* test_sha - test the sha hash
*/
define test_sha()
{
local a, b, c, d, e, f, x, y, z, L, M, B1, B2, B;
print '7100: Beginning test_sha';
y = sha();
print '7101: y = sha();';
z = sha();
print '7102: z = sha();';
vrfy(y == z, '7103: y == z');
vrfy(sha("") == y, '7104: sha("") == y');
y = sha(y,1);
print '7105: y = sha(y,1);';
vrfy(y == sha(1), '7106: y == sha(1)');
vrfy(sha(y,2) == sha(1,2), '7107: sha(y,2) == sha(1,2)');
vrfy(sha(sha()) == 0xf96cea198ad1dd5617ac084a3d92c6107708c0ef,
'7108: sha(sha()) == 0xf96cea198ad1dd5617ac084a3d92c6107708c0ef');
vrfy(sha(sha("a"))==0x37f297772fae4cb1ba39b6cf9cf0381180bd62f2,
'7109: sha(sha("a"))==0x37f297772fae4cb1ba39b6cf9cf0381180bd62f2');
vrfy(sha(sha("ab"))==0x488373d362684af3d3f7a6a408b59dfe85419e09,
'7110: sha(sha("ab"))==0x488373d362684af3d3f7a6a408b59dfe85419e09');
vrfy(sha(sha("abc"))==0x0164b8a914cd2a5e74c4f7ff082c4d97f1edf880,
'7111: sha(sha("abc"))==0x0164b8a914cd2a5e74c4f7ff082c4d97f1edf880');
vrfy(sha(sha("abcd"))==0x082c73b06f71185d840fb4b28eb3abade67714bc,
'7112: sha(sha("abcd"))==0x082c73b06f71185d840fb4b28eb3abade67714bc');
vrfy(sha(sha("abcde"))==0xd624e34951bb800f0acae773001df8cffe781ba8,
'7113: sha(sha("abcde"))==0xd624e34951bb800f0acae773001df8cffe781ba8');
vrfy(sha(sha("abcdef"))==0x2a589f7750598dc0ea0a608719e04327f609279a,
'7114: sha(sha("abcdef"))==0x2a589f7750598dc0ea0a608719e04327f609279a');
vrfy(sha(sha("abcdefg"))==0x5bdf01f9298e9d19d3f8d15520fd74eed600b497,
'7115: sha(sha("abcdefg"))==0x5bdf01f9298e9d19d3f8d15520fd74eed600b497');
vrfy(sha(sha("abcdefgh"))==0x734ba8b31975d0dbae4d6e249f4e8da270796c94,
'7116: sha(sha("abcdefgh"))==0x734ba8b31975d0dbae4d6e249f4e8da270796c94');
vrfy(sha(sha(1)) == 0x864c8d09e828c7c31d62693736a5a9302c282777,
'7117: sha(sha(1)) == 0x864c8d09e828c7c31d62693736a5a9302c282777');
vrfy(sha(sha(2)) == 0x2c0b59c512cb20fad6bb0883b69c9f5a46545808,
'7118: sha(sha(2)) == 0x2c0b59c512cb20fad6bb0883b69c9f5a46545808');
vrfy(sha(sha(22/7))==0x7ddb7f8a7e9d70757f157744fddea7a6c6a6bcc6,
'7119: sha(sha(22/7)==0x7ddb7f8a7e9d70757f157744fddea7a6c6a6bcc6');
vrfy(sha(sha(isqrt(2e1000))) ==
0x6db8d9cf0b018b8f9cbbf5aa1edb8066d19e1bb0,
'7120: sha(sha(isqrt(2e1000)==0x6db8d9cf0b018b8f9cbbf5aa1edb8066d19e1bb0');
vrfy(sha("x", "y", "z") == sha("xyz"),
'7121: sha("x", "y", "z") == sha("xyz")');
vrfy(sha(sha("this is", 7^19-8, "a composit", 3i+4.5, "hash")) ==
0x21e42319a26787046c2b28b7ae70f1b54bf0ba2a,
'7122: sha(sha("this is", 7^19-8, ..., "hash")) == 0x21e4...');
z = sha(list(1,2,3), "curds and whey", 2^21701-1, pi(1e-100));
print '7123: z = sha(list(1,2,3), "curds and whey", 2^21701-1, pi(1e-100));';
vrfy(sha(z) == 257075527903934749824451356785709876382198951165,
'7124: sha(z) == 257075527903934749824451356785709876382198951165');
y = sha();
print '7125: y = sha()';
y = sha(y, list(1,2,3), "curds and whey");
print '7126: y = sha(y, list(1,2,3), "curds and whey")';
y = sha(y, 2^21701-1);
print '7127: y = sha(y, 2^21701-1)';
y = sha(y, pi(1e-100));
print '7128: y = sha(y, pi(1e-100))';
vrfy(y == z, '7129: y == z');
B = blk() = {"a", "b", "c"};
print '7130: B = blk() = {"a", "b", "c"};';
vrfy(sha(B) == sha("abc"), '7131: sha(B) == sha("abc")');
B1 = blk() = {1,2,3,4};
print '7132: B1 = blk() = {1,2,3,4};';
B2 = blk() = {5,6,7,8};
print '7133: B2 = blk() = {5,6,7,8};';
B = blk() = {1,2,3,4,5,6,7,8};
print '7134: B = blk() = {1,2,3,4,5,6,7,8};';
vrfy(sha(B1, B2) == sha(B), '7135: sha(B1, B2) == sha(B)');
vrfy(sha(B[1], B[3], B[5]) == sha("\02\04\06"),
'7136: sha(B[1], B[3], B[5]) == sha("\02\04\06")');
L = list(1,2,3);
print '7137: L = list(1,2,3)';
mat M[3] = {4,5,6};
print '7138: mat M[3] = {4,5,6}';
vrfy(sha(sha(L), M, B) == sha(L, M, B),
'7139: sha(sha(L), M, B) == sha(L, M, B)');
vrfy(sha(sha(L,M), B) == sha(L, M, B),
'7140: sha(sha(L, M), B) == sha(L, M, B)');
print '7141: Ending test_sha';
}
print '173: parsed test_sha()';
/*
* test_sha1 - test the sha1 hash
*/
@@ -6733,7 +6876,8 @@ define test_sha1()
z = sha1(list(1,2,3), "curds and whey", 2^21701-1, pi(1e-100));
print '7210: z = sha1(list(1,2,3), "curds and whey", 2^21701-1, pi(1e-100));';
print '7210: z = sha1(list(1,2,3), "curds and whey",',
'2^21701-1, pi(1e-100));';
vrfy(sha1(z) == 0x158cc87deeb9dd478ca14e3ab359205b0fb15b83,
'7211: sha1(z) == 0x158cc87deeb9dd478ca14e3ab359205b0fb15b83');
@@ -6790,88 +6934,6 @@ define test_sha1()
print '174: parsed test_sha1()';
/*
* test_md5 - test the md5 hash
*/
define test_md5()
{
local a, b, c, d, e, f, x, y, z, L, M, B;
print '7300: Beginning test_md5';
y = md5();
print '7301: y = md5();';
z = md5();
print '7302: z = md5();';
vrfy(y == z, '7303: y == z');
y = md5(y,1);
print '7304: y = md5(y,1);';
z = md5(1);
print '7305: z = md5(1);';
vrfy(y == z, '7306: y == z');
vrfy(md5(z,2) == md5(1,2), '7307: md5(z,2) == md5(1,2)');
vrfy(md5(md5()) == 0xd41d8cd98f00b204e9800998ecf8427e,
'7308: md5(md5()) == 0xd41d8cd98f00b204e9800998ecf8427e');
vrfy(md5("x", "y", "z") == md5("xyz"),
'7309: md5("x", "y", "z") == md5("xyz")');
vrfy(md5(md5("this is", 7^19-8, "a composit", 3i+4.5, "hash")) ==
0x39a5a8e24a2eb65a51af462c8bdd5e3,
'7310: md5(md5("this is", 7^19-8, "a composit", 3i+4.5, "hash")) == ...');
z = md5(list(1,2,3), "curds and whey", 2^21701-1, pi(1e-100));
print '7311: z = md5(list(1,2,3), "curds and whey", 2^21701-1, pi(1e-100));';
vrfy(md5(z) == 0x487462e577eabef0302dd13af6632546,
'7312: md5(z) == 0x487462e577eabef0302dd13af6632546');
y = md5();
print '7313: y = md5();';
y = md5(y, list(1,2,3), "curds and whey");
print '7314: y = md5(y, list(1,2,3), "curds and whey")';
y = md5(y, 2^21701-1);
print '7315: y = md5(y, 2^21701-1);';
y = md5(y, pi(1e-100));
print '7316: y = md5(y, pi(1e-100));';
vrfy(y == z, '7317: y == z');
vrfy(md5(md5("a")) == 0x0cc175b9c0f1b6a831c399e269772661,
'7318: md5(md5("a")) == 0x0cc175b9c0f1b6a831c399e269772661');
vrfy(md5(md5("ab")) == 0x187ef4436122d1cc2f40dc2b92f0eba0,
'7319: md5(md5("ab")) == 0x187ef4436122d1cc2f40dc2b92f0eba0');
vrfy(md5(md5("abc")) == 0x900150983cd24fb0d6963f7d28e17f72,
'7320: md5(md5("abc")) == 0x900150983cd24fb0d6963f7d28e17f72');
vrfy(md5(md5("abcd")) == 0xe2fc714c4727ee9395f324cd2e7f331f,
'7321: md5(md5("abcd")) == 0xe2fc714c4727ee9395f324cd2e7f331f');
vrfy(md5(md5("abcde")) == 0xab56b4d92b40713acc5af89985d4b786,
'7322: md5(md5("abcde")) == 0xab56b4d92b40713acc5af89985d4b786');
vrfy(md5(md5("abcdef")) == 0xe80b5017098950fc58aad83c8c14978e,
'7323: md5(md5("abcdef")) == 0xe80b5017098950fc58aad83c8c14978e');
vrfy(md5(md5("abcdefg")) == 0x7ac66c0f148de9519b8bd264312c4d64,
'7324: md5(md5("abcdefg")) == 0x7ac66c0f148de9519b8bd264312c4d64');
vrfy(md5(md5("abcdefgh")) == 0xe8dc4081b13434b45189a720b77b6818,
'7325: md5(md5("abcdefgh")) == 0xe8dc4081b13434b45189a720b77b6818');
vrfy(md5(md5(1)) == 0x44fe7987067ac45311c88772038f60d1,
'7326: md5(md5(1)) == 0x44fe7987067ac45311c88772038f60d1');
vrfy(md5(md5(22/7)) == 0x9274b951e1dfb9cba22af1c127daa8e7,
'7327: md5(md5(22/7) == 0x9274b951e1dfb9cba22af1c127daa8e7');
vrfy(md5(md5(isqrt(2e1000))) == 0xe56ac4b8cad869e738a04fedc97058f3,
'7328: md5(md5(isqrt(2e1000))) == 0xe56ac4b8cad869e738a04fedc97058f3');
L = list(1,2,3);
print '7329: L = list(1,2,3)';
mat M[3] = {4,5,6};
print '7330: mat M[3] = {4,5,6}';
B = blk() = {7,8,9};
print '7331: B = blk() = {7,8,9}';
vrfy(md5(md5(L), M, B) == md5(L, M, B),
'7332: md5(md5(L), M, B) == md5(L, M, B)');
vrfy(md5(md5(L,M), B) == md5(L, M, B),
'7333: md5(md5(L, M), B) == md5(L, M, B)');
print '7334: Ending test_md5';
}
print '175: parsed test_md5()';
/*
* The 7400's contain tests for saveval and dot. These tests are
* done inline near the bottom.
@@ -7404,6 +7466,85 @@ define test_somenew()
print '190: parsed test_somenew()';
/*
* test_exponentiation - test new exponentiation functionaltiy
*/
define test_exponentiation()
{
local a;
print '8800: Starting test_somenew';
/* unexpected help file cases */
vrfy(2^3 == 8, '8801: 2^3 == 8');
vrfy(2.5 ^ 3.5 == power(2.5, 3.5),
'8802: 2.5 ^ 3.5 == power(2.5, 3.5)');
vrfy(2.5 ^ 2.718i == power(2.5, 2.718i),
'8803: 2.5 ^ 2.718i == power(2.5, 2.718i)');
vrfy(3i^4 == 81, '8804: 3i^4 == 81');
vrfy(0.5i ^ 0.25 == power(0.5i, 0.25),
'8804: 0.5i ^ 0.25 == power(0.5i, 0.25)');
vrfy(3.13145i^0.30103i == power(3.13145i, 0.30103i),
'8806: 3.13145i^0.30103i == power(3.13145i, 0.30103i)');
/* deal with some corner error cases */
ecnt += 12;
print '8807: ecnt += 2';
vrfy((1/0) ^ -1 == 0, '8808: (1/0) ^ -1 == 0');
vrfy((1/0) ^ -2 == 0, '8809: (1/0) ^ -2 == 0');
vrfy((1/0) ^ 0 == error(10001), '8810: (1/0) ^ 0 == error(10001)');
vrfy((1/0) ^ 3 == error(10001), '8811: (1/0) ^ 3 == error(10001)');
vrfy(0 ^ -2 == error(10001), '8812: 0 ^ -2 == error(10001)');
vrfy((1/0) ^ 1i == error(10001),'8813: (1/0) ^ 1i == error(10001)');
vrfy((1/0) ^ 0i == error(10001),'8814: (1/0) ^ 0i == error(10001)');
/* real ^ real */
vrfy(5^6 == 15625, '8815: 5^6 == 15625');
vrfy(10^31 == 1e31, '8816: 10^31 == 1e31');
vrfy(10 ^ (127/31) == power(10, 127/31),
'8817: 10 ^ (127/31) == power(10, 127/31)');
vrfy((10^31) ^ 10 == 1e310, '8818: (10^31) ^ 10 == 1e310');
/* complex ^ real */
vrfy(10i ^ 10 == -1e10, '8819: 10i ^ 10 == -1e10');
vrfy((-10i) ^ 10 == -1e10, '8820: (-10i) ^ 10 == -1e10');
vrfy((1+1i) ^ 4 == -4, '8821: (1+1i) ^ 4 == -4');
vrfy((1+1i) ^ 65536 == 2^32768, '8822: (1+1i) ^ 65536 == 2^32768');
vrfy((1+1i) ^ (2^20) == 2^(2^19),
'8823: (1+1i) ^ (2^20) == 2^(2^19)');
vrfy((31+17i) ^ pi() == power(31+17i, pi()),
'8824: (31+17i) ^ pi() == power(31+17i, pi()');
vrfy((5+7i) ^ exp(5) == power(5+7i, exp(5)),
'8825: (5+7i) ^ exp(5) == power(5+7i, exp(5))');
/* real ^ complex */
vrfy(10 ^ 1i == power(10, 1i), '8826: 10 ^ 1i == power(10, 1i)');
vrfy(10 ^ (2+3i) == power(10, 2+3i),
'8827: 10 ^ (2+3i) == power(10, 2+3i)');
vrfy(pi() ^ (2+3i) == power(pi(), 2+3i),
'8828: pi() ^ (2+3i) == power(pi(), 2+3i)');
vrfy(exp(64) ^ (2+3i) == power(exp(64), 2+3i),
'8828: exp(64) ^ (2+3i) == power(exp(64), 2+3i)');
vrfy(pi() ^ (257+127i) == power(pi(), 257+127i),
'8829: pi() ^ (257+127i) == power(pi(), 257+127i)');
vrfy(pi() ^ asin(-2) == power(pi(), asin(-2)),
'8830: pi() ^ asin(-2) == power(pi(), asin(-2)');
/* complex ^ complex */
vrfy((3+4i) ^ (2+3i) == power(3+4i, 2+3i),
'8831: (3+4i) ^ (2+3i) == power(3+4i, 2+3i)');
vrfy(ln(-10) ^ (2+3i) == power(ln(-10), 2+3i),
'8832: ln(-10) ^ (2+3i) == power(ln(-10), 2+3i)');
vrfy((pi()*1i) ^ asin(-2) == power(pi()*1i, asin(-2)),
'8833: (pi()*1i) ^ asin(-2) == power(pi()*1i, asin(-2))');
vrfy((exp(1)+pi()*1i) ^ asin(-2) == power(exp(1)+pi()*1i, asin(-2)),
'8834: (exp(1)+pi()*1i) ^ asin(-2) == power(exp(1)+pi()*1i, asin(-2))');
print '8835: Ending test_somenew';
}
print '191: parsed test_exponentiation()';
/*
* test_quit - test the QUIT functionality
*/
@@ -7631,12 +7772,8 @@ return test_name();
print;
return test_blkprintf();
print;
return test_sha();
print;
return test_sha1();
print;
return test_md5();
print;
print '7400: Beginning test_savedot';
print '7401: saveval(1);';
@@ -7736,7 +7873,27 @@ read -once "test8500";
print;
print '8600: Starting test of up to 1024 args'
read -once "test8600";
/* 86xx: Ending test of up to 1024 args is printed by test8600.cal */
/* 860x: Ending test of up to 1024 args is printed by test8600.cal */
/*
* dupvar_warn and redecl_warn testing
*/
print;
print '8650: Starting test of dupvar_warn and redecl_warn config parameters';
vrfy(config("redecl_warn",0), '8651: config("redecl_warn",0)');
vrfy(config("dupvar_warn",0), '8652: config("dupvar_warn",0)');
vrfy(u_glob == 6, '8653: u_glob == 6');
global u_glob = 555;
print '8654: reclare u_glob';
vrfy(u_glob == 555, '8655: u_glob == 555');
define func_8650(u_glob) { local u_glob; return u_glob; }
print '8656: u_glob as both local and parameter';
define func_8650a(u_glob) { static u_glob; return u_glob; }
print '8657: u_glob as both static and parameter';
vrfy(config("redecl_warn",1)==0, '8658: config("redecl_warn",1)==0');
vrfy(config("dupvar_warn",1)==0, '8659: config("dupvar_warn",1)==0');
/* 865x: Ending test of up to 1024 args is printed by test8600.cal */
/*
@@ -7744,6 +7901,7 @@ read -once "test8600";
*
* We use the dotest driver to evaluate test-97xx data files.
*/
print;
print '8700: Starting dotest runs'
print '8701: read -once "dotest"';
read -once "dotest";
@@ -7753,6 +7911,27 @@ vrfy(dotest("set8700.line", 8703) == 0,
'8703: dotest("set8700.line", 8703) == 0');
/* 87xx: Ending dotest runs is printed by set8700.test */
/*
* new exponentiation functionaltiy
*/
print;
return test_exponentiation();
/* 88xx: test exponentiation */
/*
* calc resource functions by Christoph Zurnieden
*/
print;
print '8900: Starting test of calc resource functions by Christoph Zurnieden';
print '8901: read -once "test8900"';
read -once "test8900";
print '8902: about to run test8900(1,,8903)';
testnum = test8900(1,,8903);
/* 89xx: test calc resource functions by Christoph Zurnieden */
/*
* read various calc resource files
*
@@ -7830,7 +8009,32 @@ read -once varargs;
print '9827: read -once varargs';
read -once qtime;
print '9828: read -once qtime';
print '9829: Ending read of selected calc resource files';
read -once chi;
print '9829: read -once chi';
read -once intfile;
print '9830: read -once intfile';
read -once lucas;
print '9831: read -once lucas';
read -once lucas_tbl;
print '9832: read -once lucas_tbl';
read -once natnumset;
print '9833: read -once natnumset';
read -once repeat;
print '9834: read -once repeat';
read -once screen;
print '9835: read -once screen';
read -once linear;
print '9836: read -once linear';
print '9837: skipping read -once beer.cal because it is an infinite loop';
print '9838: skipping read -once hello.cal because it is an infinite loop';
print '9839: skipping read -once xx_print.cal because it is a printing demo';
read -once sumtimes;
print '9840: read -once sumtimes';
read -once dms;
print '9841: read -once dms';
read -once hms;
print '9842: read -once hms';
print '9843: Ending read of selected calc resource files';
/*

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.4 $
* @(#) $Id: repeat.cal,v 29.4 2003/01/26 19:42:03 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/repeat.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: repeat.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/repeat.cal,v $
*
* Under source code control: 2003/01/05 00:00:01
* File existed as early as: 2003

View File

@@ -15,9 +15,9 @@
* NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
* CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: screen.cal,v 29.2 2006/05/01 19:21:18 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/screen.cal,v $
* @(#) $Revision: 30.2 $
* @(#) $Id: screen.cal,v 30.2 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/screen.cal,v $
*
* This file is not covered under version 2.1 of the GNU LGPL.
*

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.3 $
* @(#) $Id: seedrandom.cal,v 29.3 2001/03/31 13:31:34 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/seedrandom.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: seedrandom.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/seedrandom.cal,v $
*
* Under source code control: 1996/01/01 08:21:00
* File existed as early as: 1996

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.1 $
* @(#) $Id: set8700.cal,v 29.1 2006/05/20 19:35:33 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/set8700.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: set8700.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/set8700.cal,v $
*
* Under source code control: 2006/05/20 14:10:11
* File existed as early as: 2006
@@ -70,3 +70,8 @@ define set8700_g(set8700_x)
obj set8700_point {
set8700_x, set8700_y, set8700_z
}
global mat set8700_c[] = { 1, 2+3i, -5+4i, 5i+6, -7i };
global mat set8700_e[] = { 0, 1, 0, 0, 2, -3/2, 2, -1/2,
-3, 0.5, -1.0, 0.5, 1.0, 0.0, 0.0, 0.0 };

View File

@@ -15,11 +15,11 @@
## 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.
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
##
## @(#) $Revision: 29.1 $
## @(#) $Id: set8700.line,v 29.1 2006/05/20 19:35:33 chongo Exp $
## @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/set8700.line,v $
## @(#) $Revision: 30.1 $
## @(#) $Id: set8700.line,v 30.1 2007/03/16 11:09:54 chongo Exp $
## @(#) $Source: /usr/local/src/bin/calc/cal/RCS/set8700.line,v $
##
## Under source code control: 2006/05/20 14:10:11
## File existed as early as: 2006
@@ -143,7 +143,7 @@ a #= 4, a == 1
## Binary # operator not defined for strings
global set8700_A; protect(set8700_A) == 0
protect(set8700_A) == 0
## Testing with one lvalue
isnull(protect(set8700_A,65))
protect(set8700_A) == 65
@@ -302,7 +302,7 @@ protect(set8700_B,0), set8700_B = set8700_getA1(), protect(set8700_B) == 1024
protect(set8700_B,0), set8700_B = set8700_getA2(), protect(set8700_B) == 1024
set8700_B = set8700_getvar(), protect(set8700_B) == 1024 + 256
global set8700_x, set8700_y; set8700_x = 7, protect(set8700_x) == 0
set8700_x = 7, protect(set8700_x) == 0
protect(7,2) == error(10234)
protect(set8700_x,2.5) == error(10235)
protect(set8700_x,"abc") == error(10235)
@@ -322,7 +322,6 @@ set8700_x++ == error(10385)
set8700_x == 7
set8700_x-- == error(10388)
global set8700_A, set8700_B; 1
protect(set8700_A,0), protect(set8700_A,16), 1
set8700_A = "abcdef", protect(set8700_A) == 16 ## No copy to set8700_A
protect(set8700_B,0), set8700_B = "xyz", protect(set8700_B) == 0
@@ -403,3 +402,28 @@ set8700_P == (obj set8700_point = {1,2,3})
set8700_L = list(mat[1] = {set8700_P}), protect(set8700_L[0][0]) == 16
set8700_L = {{{4,5,6}}}, set8700_L[0][0] == set8700_P
protect(set8700_L,0,2), set8700_L = {{{4,5,6}}}, set8700_L[0][0] == (obj set8700_point = {4,5,6})
## Testing quomod
quomod(14,5,3,4) == error(10374)
global set8700_a,set8700_b; quomod("abc", 4, set8700_a, set8700_b) == error(10375)
quomod(14,5,set8700_a,set8700_b,0) == 1 && set8700_a == 2 && set8700_b == 4
quomod(14,5,set8700_a,set8700_b,1) == 1 && set8700_a == 3 && set8700_b == -1
quomod("abc",2,set8700_a,set8700_b) == error(10375)
set8700_a = "abc"; quomod(14,5,set8700_a,set8700_b) == error(10375)
set8700_a = null(); quomod(14,5,set8700_a,set8700_b,24) == 1; set8700_a == 3 && set8700_b == -1
quomod(14,5,set8700_a,set8700_a) == error(10374)
quomod(14,5,set8700_a,set8700_b,-1) == error(10375)
protect(set8700_a,1); quomod(17,2,set8700_a,set8700_b) == error(10376)
protect(set8700_a,0); quomod(17,2,set8700_a,set8700_b); set8700_a == 8 && set8700_b == 1
set8700_p = &set8700_a, set8700_q = &set8700_b; quomod(14,5,*set8700_p,*set8700_q); *set8700_p == 2 && *set8700_q == 4
## Testing estr
base(1/3) == 10
strcmp(estr(null()), "\"\"") == 0
strcmp(estr(bernoulli(48)), "-5609403368997817686249127547/46410") == 0
strcmp(estr(sin(3i)), "1001787492740990189897i/100000000000000000000") == 0
base(10) == 1/3
strcmp(estr("fizzbin"), "\"fizzbin\"") == 0
strcmp(estr(set8700_c), "mat[5]={1,2+3i,-5+4i,6+5i,-7i}") == 0
strcmp(estr(set8700_e), "mat[16]={0,1,0,0,2,-3/2,2,-1/2,-3,1/2,-1,1/2,1,0,0,0}") == 0
strcmp(estr(list(2,3,5)), "list(2,3,5)") == 0

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: solve.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/solve.cal,v $
* @(#) $Revision: 30.3 $
* @(#) $Id: solve.cal,v 30.3 2013/08/11 08:41:38 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/solve.cal,v $
*
* Under source code control: 1990/02/15 01:50:37
* File existed as early as: before 1990
@@ -47,12 +47,13 @@ define solve(low, high, epsilon)
if (abs(flow) < epsilon)
return low;
fhigh = f(high);
if (abs(flow) < epsilon)
if (abs(fhigh) < epsilon)
return high;
if (sgn(flow) == sgn(fhigh))
quit "Non-opposite signs";
while (1) {
mid = bround(high - fhigh * (high - low) / (fhigh - flow), places);
mid = bround(high - fhigh * (high - low) / (fhigh - flow),
places);
if ((mid == low) || (mid == high))
places++;
fmid = f(mid);

1394
cal/specialfunctions.cal Normal file

File diff suppressed because it is too large Load Diff

502
cal/statistics.cal Normal file
View File

@@ -0,0 +1,502 @@
/*
* statistics - Some assorted statistics functions.
*
* Copyright (C) 2013 Christoph Zurnieden
*
* statistics 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.
*
* statistics 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 30.3 $
* @(#) $Id: statistics.cal,v 30.3 2013/08/11 08:41:38 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/statistics.cal,v $
*
* Under source code control: 2013/08/11 01:31:28
* File existed as early as: 2013
*/
static resource_debug_level;
resource_debug_level = config("resource_debug", 0);
/*
get dependencies
*/
read -once factorial2 brentsolve
/*******************************************************************************
*
*
* Continuous distributions
*
*
******************************************************************************/
/* regularized incomplete gamma function like in Octave, hence the name */
define gammaincoctave(z,a){
local tmp;
tmp = gamma(z);
return (tmp-gammainc(a,z))/tmp;
}
/* Inverse incomplete beta function. Old and slow. */
static __CZ__invbeta_a;
static __CZ__invbeta_b;
static __CZ__invbeta_x;
define __CZ__invbeta(x){
return __CZ__invbeta_x-__CZ__ibetaas63(x,__CZ__invbeta_a,__CZ__invbeta_b);
}
define invbetainc_slow(x,a,b){
local flag ret eps;
/* place checks and balances here */
eps = epsilon();
if(.5 < x){
__CZ__invbeta_x = 1 - x;
__CZ__invbeta_a = b;
__CZ__invbeta_b = a;
flag = 1;
}
else{
__CZ__invbeta_x = x;
__CZ__invbeta_a = a;
__CZ__invbeta_b = b;
flag = 0;
}
ret = brentsolve2(0,1,1);
if(flag == 1)
ret = 1-ret;
epsilon(eps);
return ret;
}
/* Inverse incomplete beta function. Still old but not as slow as the function
above. */
/*
Purpose:
invbetainc computes inverse of the incomplete Beta function.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
10 August 2013
Author:
Original FORTRAN77 version by GW Cran, KJ Martin, GE Thomas.
C version by John Burkardt.
Calc version by Christoph Zurnieden
Reference:
GW Cran, KJ Martin, GE Thomas,
Remark AS R19 and Algorithm AS 109:
A Remark on Algorithms AS 63: The Incomplete Beta Integral
and AS 64: Inverse of the Incomplete Beta Integeral,
Applied Statistics,
Volume 26, Number 1, 1977, pages 111-114.
Parameters:
Input, P, Q, the parameters of the incomplete
Beta function.
Input, BETA, the logarithm of the value of
the complete Beta function.
Input, ALPHA, the value of the incomplete Beta
function. 0 <= ALPHA <= 1.
Output, the argument of the incomplete
Beta function which produces the value ALPHA.
Local Parameters:
Local, SAE, the most negative decimal exponent
which does not cause an underflow.
*/
define invbetainc(x,a,b){
return __CZ__invbetainc(a,b,lnbeta(a,b),x);
}
define __CZ__invbetainc(p,q,beta,alpha){
local a acu adj fpu g h iex indx pp prev qq r s sae sq t tx value;
local w xin y yprev places eps;
/* Dirty trick, don't try at home */
eps= epsilon(epsilon()^2);
sae = -((log(1/epsilon())/log(2))//2);
fpu = 10.0^sae;
places = highbit(1 + int(1/epsilon())) + 1;
value = alpha;
if( p <= 0.0 ){
epsilon(eps);
return newerror("invbeta: argument p <= 0");
}
if( q <= 0.0 ){
epsilon(eps);
return newerror("invbeta: argument q <= 0");
}
if( alpha < 0.0 || 1.0 < alpha ){
epsilon(eps);
return newerror("invbeta: argument alpha out of domain");
}
if( alpha == 0.0 ){
epsilon(eps);
return 0;
}
if( alpha == 1.0 ){
epsilon(eps);
return 1;
}
if ( 0.5 < alpha ){
a = 1.0 - alpha;
pp = q;
qq = p;
indx = 1;
}
else{
a = alpha;
pp = p;
qq = q;
indx = 0;
}
r = sqrt ( - ln ( a * a ) );
y = r-(2.30753+0.27061*r)/(1.0+(0.99229+0.04481*r)*r);
if ( 1.0 < pp && 1.0 < qq ){
r = ( y * y - 3.0 ) / 6.0;
s = 1.0 / ( pp + pp - 1.0 );
t = 1.0 / ( qq + qq - 1.0 );
h = 2.0 / ( s + t );
w = y*sqrt(h+r)/h-(t-s)*(r+5.0/6.0-2.0/(3.0*h));
value = pp / ( pp + qq * exp ( w + w ) );
}
else{
r = qq + qq;
t = 1.0 / ( 9.0 * qq );
t = r * ( 1.0 - t + y * sqrt ( t )^ 3 );
if ( t <= 0.0 ){
value = 1.0 - exp ( ( ln ( ( 1.0 - a ) * qq ) + beta ) / qq );
}
else{
t = ( 4.0 * pp + r - 2.0 ) / t;
if ( t <= 1.0 ) {
value = exp ( ( ln ( a * pp ) + beta ) / pp );
}
else{
value = 1.0 - 2.0 / ( t + 1.0 );
}
}
}
r = 1.0 - pp;
t = 1.0 - qq;
yprev = 0.0;
sq = 1.0;
prev = 1.0;
if ( value < 0.0001 )
value = 0.0001;
if ( 0.9999 < value )
value = 0.9999;
acu = 10^sae;
for ( ; ; ){
y = bround(__CZ__ibetaas63( value, pp, qq, beta),places);
xin = value;
y = bround(exp(ln(y-a)+(beta+r*ln(xin)+t*ln(1.0- xin ) )),places);
if ( y * yprev <= 0.0 ) {
prev = max ( sq, fpu );
}
g = 1.0;
for ( ; ; ){
for ( ; ; ){
adj = g * y;
sq = adj * adj;
if ( sq < prev ){
tx = value - adj;
if ( 0.0 <= tx && tx <= 1.0 ) break;
}
g = g / 3.0;
}
if ( prev <= acu ){
if ( indx )
value = 1.0 - value;
epsilon(eps);
return value;
}
if ( y * y <= acu ){
if ( indx )
value = 1.0 - value;
epsilon(eps);
return value;
}
if ( tx != 0.0 && tx != 1.0 )
break;
g = g / 3.0;
}
if ( tx == value ) break;
value = tx;
yprev = y;
}
if ( indx )
value = 1.0 - value;
epsilon(eps);
return value;
}
/*******************************************************************************
*
*
* Beta distribution
*
*
******************************************************************************/
define betapdf(x,a,b){
if(x<0 || x>1) return newerror("betapdf: parameter x out of domain");
if(a<=0) return newerror("betapdf: parameter a out of domain");
if(b<=0) return newerror("betapdf: parameter b out of domain");
return 1/beta(a,b) *x^(a-1)*(1-x)^(b-1);
}
define betacdf(x,a,b){
if(x<0 || x>1) return newerror("betacdf: parameter x out of domain");
if(a<=0) return newerror("betacdf: parameter a out of domain");
if(b<=0) return newerror("betacdf: parameter b out of domain");
return betainc(x,a,b);
}
define betacdfinv(x,a,b){
return invbetainc(x,a,b);
}
define betamedian(a,b){
local t106 t104 t103 t105 approx ret;
if(a == b) return 1/2;
if(a == 1 && b > 0) return 1-(1/2)^(1/b);
if(a > 0 && b == 1) return (1/2)^(1/a);
if(a == 3 && b == 2){
/* Yes, the author is not ashamed to ask Maxima for the exact solution
of a quartic equation. */
t103 = ( (2^(3/2))/27 +4/27 )^(1/3);
t104 = sqrt( ( 9*t103^2 + 4*t103 + 2 )/(t103) )/3;
t105 = -t103-2/(9*t103) +8/9;
t106 = sqrt( (27*t104*t105+16)/(t104) )/(2*3^(3/2));
return -t106+t104/2+1/3;
}
if(a == 2 && b == 3){
t103 = ( (2^(3/2))/27 +4/27 )^(1/3);
t104 = sqrt( ( 9*t103^2 + 4*t103 + 2 )/(t103) )/3;
t105 = -t103-2/(9*t103) +8/9;
t106 = sqrt( (27*t104*t105+16)/(t104) )/(2*3^(3/2));
return 1-(-t106+t104/2+1/3);
}
return invbetainc(1/2,a,b);
}
define betamode(a,b){
if(a + b == 2) return newerror("betamod: a + b = 2 = division by zero");
return (a-1)/(a+b-2);
}
define betavariance(a,b){
return (a*b)/( (a+b)^2*(a+b+1) );
}
define betalnvariance(a,b){
return polygamma(1,a)-polygamma(a+b);
}
define betaskewness(a,b){
return (2*(b-a)*sqrt(a+b+1))/( (a+b+1)*sqrt(a*b) );
}
define betakurtosis(a,b){
local num denom;
num = 6*( (a-b)^2*(a+b+1)-a*b*(a+b+2));
denom = a*b*(a+b+2)*(a+b+3);
return num/denom;
}
define betaentropy(a,b){
return lnbeta(a,b)-(a-1)*psi(a)-(b-1)*psi(b)+(a+b+1)*psi(a+b);
}
/*******************************************************************************
*
*
* Normal (Gaussian) distribution
*
*
******************************************************************************/
define normalpdf(x,mu,sigma){
return 1/(sqrt(2*pi()*sigma^2))*exp( ( (x-mu)^2 )/( 2*sigma^2 ) );
}
define normalcdf(x,mu,sigma){
return 1/2*(1+erf( ( x-mu )/( sqrt(2*sigma^2) ) ) );
}
define probit(p){
if(p<0 || p > 1) return newerror("probit: p out of domain 0<=p<=1");
return sqrt(2)*ervinv(2*p-1);
}
define normalcdfinv(p,mu,sigma){
if(p<0 || p > 1) return newerror("normalcdfinv: p out of domain 0<=p<=1");
return mu+ sigma*probit(p);
}
define normalmean(mu,sigma){return mu;}
define normalmedian(mu,sigma){return mu;}
define normalmode(mu,sigma){return mu;}
define normalvariance(mu,sigma){return sigma^2;}
define normalskewness(mu,sigma){return 0;}
define normalkurtosis(mu,sigma){return 0;}
define normalentropy(mu,sigma){
return 1/3*ln( 2*pi()*exp(1)*sigma^2 );
}
/* moment generating f. */
define normalmgf(mu,sigma,t){
return exp(mu*t+1/2*sigma^2*t^2);
}
/* characteristic f. */
define normalcf(mu,sigma,t){
return exp(mu*t-1/2*sigma^2*t^2);
}
/*******************************************************************************
*
*
* Chi-squared distribution
*
*
******************************************************************************/
define chisquaredpdf(x,k){
if(!isint(k) || k<0) return newerror("chisquaredpdf: k not in N");
if(im(x) || x<0) return newerror("chisquaredpdf: x not in +R");
/* The gamma function does not check for half integers, do it here? */
return 1/(2^(k/2)*gamma(k/2))*x^((k/2)-1)*exp(-x/2);
}
define chisquaredpcdf(x,k){
if(!isint(k) || k<0) return newerror("chisquaredcdf: k not in N");
if(im(x) || x<0) return newerror("chisquaredcdf: x not in +R");
return 1/(gamma(k/2))*gammainc(k/2,x/2);
}
define chisquaredmean(x,k){return k;}
define chisquaredmedian(x,k){
/* TODO: implement a FAST inverse incomplete gamma-{q,p} function */
return k*(1-2/(9*k))^3;
}
define chisquaredmode(x,k){return max(k-2,0);}
define chisquaredvariance(x,k){return 2*k;}
define chisquaredskewness(x,k){return sqrt(8/k);}
define chisquaredkurtosis(x,k){return 12/k;}
define chisquaredentropy(x,k){
return k/2+ln(2*gamma(k/2)) + (1-k/2)*psi(k/2);
}
define chisquaredmfg(k,t){
if(t>=1/2)return newerror("chisquaredmfg: t >= 1/2");
return (1-2*t)^(k/2);
}
define chisquaredcf(k,t){
return (1-2*1i*t)^(k/2);
}
/*
* restore internal function from resource debugging
*/
config("resource_debug", resource_debug_level),;
if (config("resource_debug") & 3) {
print "gammaincoctave(z,a)";
print "invbetainc(x,a,b)";
print "betapdf(x,a,b)";
print "betacdf(x,a,b)";
print "betacdfinv(x,a,b)";
print "betamedian(a,b)";
print "betamode(a,b)";
print "betavariance(a,b)";
print "betalnvariance(a,b)";
print "betaskewness(a,b)";
print "betakurtosis(a,b)";
print "betaentropy(a,b)";
print "normalpdf(x,mu,sigma)";
print "normalcdf(x,mu,sigma)";
print "probit(p)";
print "normalcdfinv(p,mu,sigma)";
print "normalmean(mu,sigma)";
print "normalmedian(mu,sigma)";
print "normalmode(mu,sigma)";
print "normalvariance(mu,sigma)";
print "normalskewness(mu,sigma)";
print "normalkurtosis(mu,sigma)";
print "normalentropy(mu,sigma)";
print "normalmgf(mu,sigma,t)";
print "normalcf(mu,sigma,t)";
print "chisquaredpdf(x,k)";
print "chisquaredpcdf(x,k)";
print "chisquaredmean(x,k)";
print "chisquaredmedian(x,k)";
print "chisquaredmode(x,k)";
print "chisquaredvariance(x,k)";
print "chisquaredskewness(x,k)";
print "chisquaredkurtosis(x,k)";
print "chisquaredentropy(x,k)";
print "chisquaredmfg(k,t)";
print "chisquaredcf(k,t)";
}

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: sumsq.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/sumsq.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: sumsq.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/sumsq.cal,v $
*
* Under source code control: 1990/02/15 01:50:37
* File existed as early as: before 1990

186
cal/sumtimes.cal Normal file
View File

@@ -0,0 +1,186 @@
/*
* sumtimes - runtimes evaluating sums & squares of large lists and mats
*
* Copyright (C) 2006 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 30.1 $
* @(#) $Id: sumtimes.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/sumtimes.cal,v $
*
* Under source code control: 2006/06/22 17:29
* File existed as early as: 2006
*
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/
global sumtimes_t0, sumtimes_t1, sumtimes_t2, sumtimes_t3;
global sumtimes_A, sumtimes_B;
config("tilde", 0),;
define timematsum(N) {
local n, s, p, ptop;
sumtimes_A = mat[N];
for (n = 0; n < N; n++) sumtimes_A[n] = rand(N);
ptop = &sumtimes_A[n-1];
sumtimes_t0 = usertime();
for (s = n = 0; n < N; n++) s += sumtimes_A[n];
sumtimes_t1 = usertime();
for (s = 0, p = &sumtimes_A[0]; p <= ptop; p++) s += *p;
sumtimes_t2 = usertime();
s = matsum(sumtimes_A);
sumtimes_t3 = usertime();
print "Matrix sum runtimes";
printf('\tStandard "for" loop:\t\t%.4f\n', sumtimes_t1 - sumtimes_t0);
printf('\t"For" loop using pointers:\t\t%.4f\n', sumtimes_t2 - sumtimes_t1);
printf('\tUsing builtin "matsum":\t\t%.4f\n', sumtimes_t3 - sumtimes_t2);
}
define timelistsum(N) {
local n, s;
sumtimes_A = makelist(N);
for (n = 0; n < N; n++) sumtimes_A[n] = rand(N);
sumtimes_t0 = usertime();
for (s = n = 0; n < N; n++) s += sumtimes_A[n];
sumtimes_t1 = usertime();
s = sum(sumtimes_A);
sumtimes_t2 = usertime();
print "List sum runtimes";
printf('\tStandard "for" loop:\t\t%.4f\n', sumtimes_t1 - sumtimes_t0);
printf('\tUsing builtin "sum":\t\t%.4f\n', sumtimes_t2 - sumtimes_t1);
}
define timematsort(N) {
local n;
sumtimes_A = mat[N];
for (n = 0; n < N; n++) sumtimes_A[n] = rand(N);
sumtimes_t0 = usertime();
sort(sumtimes_A);
sumtimes_t1 = usertime();
printf('\tMatrix sort runtime:\t\t%.4f\n', sumtimes_t1 - sumtimes_t0);
}
define timelistsort(N) {
local n;
sumtimes_A = makelist(N);
for (n = 0; n < N; n++) sumtimes_A[n] = rand(N);
sumtimes_t0 = usertime();
sort(sumtimes_A);
sumtimes_t1 = usertime();
printf('\tList sort runtime:\t\t%.4f\n', sumtimes_t1 - sumtimes_t0);
}
define timematreverse(N) {
local n;
sumtimes_A = mat[N];
for (n = 0; n < N; n++) sumtimes_A[n] = rand(N);
sumtimes_t0 = usertime();
reverse(sumtimes_A);
sumtimes_t1 = usertime();
printf('\tMatrix reverse runtime %.4f\n', sumtimes_t1 - sumtimes_t0);
}
define timelistreverse(N) {
local n;
sumtimes_A = makelist(N);
for (n = 0; n < N; n++) sumtimes_A[n] = rand(N);
sumtimes_t0 = usertime();
reverse(sumtimes_A);
sumtimes_t1 = usertime();
printf('\tList reverse runtime:\t\t%.4f\n', sumtimes_t1 - sumtimes_t0);
}
define timematssq(N) {
local n, s, p, ptop;
sumtimes_A = mat[N];
for (n = 0; n < N; n++) sumtimes_A[n] = rand(N);
ptop = &sumtimes_A[n-1];
sumtimes_t0 = usertime();
for (s = n = 0; n < N; n++) s += sumtimes_A[n]^2;
sumtimes_t1 = usertime();
for (s = 0, p = &sumtimes_A[0]; p <= ptop; p++) s += (*p)^2;
sumtimes_t2 = usertime();
print "Matrix sum of squares runtimes";
printf('\tStandard "for" loop:\t\t%.4f\n', sumtimes_t1 - sumtimes_t0);
printf('\t"For" loop using pointers:\t\t%.4f\n', sumtimes_t2 - sumtimes_t1);
}
define timelistssq(N) {
local n, s;
sumtimes_A = makelist(N);
for (n = 0; n < N; n++) sumtimes_A[n] = rand(N);
sumtimes_t0 = usertime();
for (s = n = 0; n < N; n++) s += sumtimes_A[n]^2;
sumtimes_t1 = usertime();
s = ssq(sumtimes_A);
sumtimes_t2 = usertime();
print "List sum of squares runtimes";
printf('\tStandard "for" loop:\t\t%.4f\n', sumtimes_t1 - sumtimes_t0);
printf('\tUsing builtin "ssq":\t\t%.4f\n', sumtimes_t2 - sumtimes_t1);
}
define timehmean(N, M = 10) {
local n, s, v1, v2;
sumtimes_A = makelist(N);
for (n = 0; n < N; n++) sumtimes_A[n] = rand(1, M);
sumtimes_t0 = usertime();
for (s = n = 0; n < N; n++) s += 1/sumtimes_A[n];
v1 = N/s;
sumtimes_t1 = usertime();
v2 = hmean(sumtimes_A);
sumtimes_t2 = usertime();
print v1, v2;
print "List harmonic meanruntimes";
printf('\tStandard "for" loop:\t\t%.4f\n', sumtimes_t1 - sumtimes_t0);
printf('\tUsing builtin "hmean":\t\t%.4f\n', sumtimes_t2 - sumtimes_t1);
}
define doalltimes(N) {
timematsum(N);
print;
timelistsum(N);
print;
timematssq(N);
print;
timelistssq(N);
print;
timematsort(N);
timelistsort(N);
timematreverse(N);
timelistreverse(N);
print;
}

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: surd.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/surd.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: surd.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/surd.cal,v $
*
* Under source code control: 1990/02/15 01:50:38
* File existed as early as: before 1990

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test1700.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test1700.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: test1700.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test1700.cal,v $
*
* Under source code control: 1994/03/14 23:12:51
* File existed as early as: 1994

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test2300.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test2300.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: test2300.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test2300.cal,v $
*
* Under source code control: 1995/07/09 06:12:13
* File existed as early as: 1995

View File

@@ -17,11 +17,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test2600.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test2600.cal,v $
* @(#) $Revision: 30.3 $
* @(#) $Id: test2600.cal,v 30.3 2013/08/11 08:41:38 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test2600.cal,v $
*
* Under source code control: 1995/10/13 00:13:14
* File existed as early as: 1995
@@ -91,7 +91,8 @@ define testismult(str, n, verbose)
if (!ismult(c,a)) {
m++;
if (verbose > 1) {
printf("*** Failure with:\na = %d\nb = %d\n", a,b);
printf("*** Failure with:\na = %d\nb = %d\n",
a,b);
}
}
}
@@ -133,7 +134,8 @@ define testsqrt(str, n, eps, verbose)
if (abs(c) > 1) {
m++;
if (verbose > 1) {
printf("*** Failure with:\na = %d\neps = %d\n", a,eps);
printf("*** Failure with:\na = %d\neps = %d\n",
a,eps);
}
}
}
@@ -178,7 +180,8 @@ define testexp(str, n, eps, verbose)
if (abs(c) > 0.02) {
m++;
if (verbose > 1) {
printf("*** Failure with:\na = %d\neps = %d\n", a,eps);
printf("*** Failure with:\na = %d\neps = %d\n",
a,eps);
}
}
}
@@ -235,7 +238,8 @@ define testln(str, n, eps, verbose)
if (abs(c) > 0.5) {
m++;
if (verbose > 1) {
printf("*** Failure with:\na = %d\neps = %d\n", a,eps);
printf("*** Failure with:\na = %d\neps = %d\n",
a,eps);
}
}
}
@@ -313,6 +317,102 @@ define testpower(str, n, b, eps, verbose)
}
define testpower2(str, n, eps, verbose)
{
local i, a, c, m, min, max;
local b;
local num;
local c2;
local oldeps;
if (isnull(verbose)) verbose = 2;
if (verbose > 0) {
print str:":",:;
}
if (isnull(eps))
eps = epsilon();
oldeps = epsilon(eps);
epsilon(eps),;
if (!isnum(b))
quit "Second argument (exponent) to be a number";
min = 1000;
max = -1000;
for (i = 1; i <= n; i++) {
if (verbose > 2) print i,:;
/* real ^ real */
a = rand(1,1e20);
a = a / (int(a/2)+rand(1,1e20));
b = rand(1,1e20);
b = b / (int(b/2)+rand(1,1e20));
c = a ^ b;
c2 = power(a, b);
if (c != c2) {
m++;
if (verbose > 1) {
printf("*** real^real failure for a = %d\n", a);
}
}
/* complex ^ real */
a = rand(1,1e20);
a = a / (int(a/2)+rand(1,1e20));
b = rand(1,1e20);
b = b / (int(b/2)+rand(1,1e20));
c = (a*1i) ^ b;
c2 = power(a*1i, b);
if (c != c2) {
m++;
if (verbose > 1) {
printf("*** comp^real failure for a = %d\n", a);
}
}
/* real ^ complex */
a = rand(1,1e20);
a = a / (int(a/2)+rand(1,1e20));
b = rand(1,1e20);
b = b / (int(b/2)+rand(1,1e20));
c = a ^ (b*1i);
c2 = power(a, b*1i);
if (c != c2) {
m++;
if (verbose > 1) {
printf("*** real^comp failure for a = %d\n", a);
}
}
/* complex ^ complex */
a = rand(1,1e20);
a = a / (int(a/2)+rand(1,1e20));
b = rand(1,1e20);
b = b / (int(b/2)+rand(1,1e20));
c = (a*1i) ^ (b*1i);
c2 = power(a*1i, b*1i);
if (c != c2) {
m++;
if (verbose > 1) {
printf("*** comp^comp failure for a = %d\n", a);
}
}
}
epsilon(oldeps),;
if (verbose > 0) {
if (m) {
printf("*** %d error(s)\n", m);
printf(" %s: rem/eps min=%d, max=%d\n",
str, min, max);
} else {
printf("no errors\n");
}
}
if (verbose > 1) {
printf(" %s: rem/eps min=%0.4d, max=%0.4d\n", str, min, max);
}
return m;
}
define cpow(a, b, eps) /* Find rem/eps for power(a,b,eps) */
{
local v, v1, c, n, d, h;
@@ -504,6 +604,7 @@ define test2600(verbose, tnum)
err += testsqrt(strcat(str(tnum++),": sqrt",str(i)), n*10,
ep, verbose);
}
err += testpower2(strcat(str(tnum++),": power"), n*4, ep, verbose);
if (verbose > 1) {
if (err) {
print "***", err, "error(s) found in test2600";

View File

@@ -17,11 +17,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test2700.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test2700.cal,v $
* @(#) $Revision: 30.2 $
* @(#) $Id: test2700.cal,v 30.2 2013/08/11 08:41:38 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test2700.cal,v $
*
* Under source code control: 1995/11/01 22:52:25
* File existed as early as: 1995
@@ -41,8 +41,7 @@
*/
global defaultverbose = 1;
global err;
defaultverbose = 1;
define mknonnegreal() {
switch(rand(8)) {
@@ -89,11 +88,11 @@ define mkfrac() = rand(2) ? mkposfrac() : -mkposfrac();
define mksquarereal() = mknonnegreal()^2;
/*
* XXX - Should be able to do better than the following. For nonsquare
* positive integer less than 1e6, could use
* We might be able to do better than the following. For nonsquare
* positive integer less than 1e6, could use:
* x = rand(1, 1000);
* return rand(x^2 + 1, (x + 1)^2);
* Maybe could do
* Maybe could do:
* do
* x = mkreal_2700();
* while
@@ -128,7 +127,8 @@ define testcsqrt(str, n, verbose)
if (p) {
if (verbose > 0)
printf(
"*** Type %d failure for x = %r, y = %r, z = %d\n",
"*** Type %d failure for x = %r, "
"y = %r, z = %d\n",
p, x, y, z);
m++;
}

View File

@@ -17,11 +17,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test3100.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test3100.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: test3100.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test3100.cal,v $
*
* Under source code control: 1995/11/28 11:56:57
* File existed as early as: 1995

View File

@@ -17,11 +17,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test3300.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test3300.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: test3300.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test3300.cal,v $
*
* Under source code control: 1995/12/02 04:27:41
* File existed as early as: 1995
@@ -30,8 +30,7 @@
*/
global defaultverbose = 1; /* default verbose value */
global err;
defaultverbose = 1; /* default verbose value */
define testi(str, n, N, verbose)
{
@@ -82,9 +81,9 @@ define testr(str, n, N, verbose)
for (i = 0; i < n; i++)
for (j = 0; j < n; j++)
A[i,j] = rand(-(N^2), N^2)/rand(1, N);
t = runtime();
t = usertime();
d1 = det(A);
t = runtime() - t;
t = usertime() - t;
d2 = det(A^2);
if (d2 != d1^2) {
if (verbose > 0) {

View File

@@ -17,11 +17,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test3400.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test3400.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: test3400.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test3400.cal,v $
*
* Under source code control: 1995/12/02 05:20:11
* File existed as early as: 1995
@@ -54,8 +54,7 @@
*/
global defaultverbose = 1; /* default verbose value */
global err;
defaultverbose = 1; /* default verbose value */
global pi1k = pi(1e-1000);

View File

@@ -17,11 +17,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test3500.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test3500.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: test3500.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test3500.cal,v $
*
* Under source code control: 1995/12/18 22:50:46
* File existed as early as: 1995
@@ -53,8 +53,7 @@
*/
global defaultverbose = 1; /* default verbose value */
global err;
defaultverbose = 1; /* default verbose value */
define testfrem(x,y,verbose)
{

View File

@@ -17,11 +17,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test4000.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test4000.cal,v $
* @(#) $Revision: 30.2 $
* @(#) $Id: test4000.cal,v 30.2 2013/08/11 08:41:38 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test4000.cal,v $
*
* Under source code control: 1996/03/13 02:38:45
* File existed as early as: 1996
@@ -75,8 +75,7 @@
*/
global defaultverbose = 1; /* default verbose value */
global err;
defaultverbose = 1; /* default verbose value */
/*
* test defaults
@@ -146,7 +145,7 @@ define ptimes(str, N, n, count, skip, verbose)
mat A[n];
for (i = 0; i < n; i++)
A[i] = plen(N);
t = runtime();
t = usertime();
for (i = 0; i < n; i++) {
p = ptest(A[i], count, skip);
if (!p) {
@@ -160,7 +159,7 @@ define ptimes(str, N, n, count, skip, verbose)
if (m) {
printf("*** %d error(s)\n", m);
} else {
t = round(runtime() - t, 4);
t = round(usertime() - t, 4);
if (verbose > 1) {
printf("%d probable primes: time = %d\n", n, t);
} else {
@@ -195,12 +194,13 @@ define ctimes(str, N, n, count, skip, verbose)
mat A[n];
for (i = 0; i < n; i++)
A[i] = clen(N);
t = runtime();
t = usertime();
for (i = 0; i < n; i++) {
p = ptest(A[i], count, skip);
if (p) {
if (verbose > 0) {
printf("*** Error, what should be rare has occurred for x = %d \n", A[i]);
printf("*** Error, what should be rare "
"has occurred for x = %d \n", A[i]);
m++;
}
}
@@ -209,7 +209,7 @@ define ctimes(str, N, n, count, skip, verbose)
if (m) {
printf("*** %d error(s)\n", m);
} else {
t = round(runtime() - t, 4);
t = round(usertime() - t, 4);
if (verbose > 1) {
printf("%d probable primes: time = %d\n", n, t);
} else {
@@ -243,7 +243,7 @@ define crtimes(str, a, b, n, count, skip, verbose)
A[i] = rand(a,b);
P[i] = ptest(A[i], 20, 0);
}
t = runtime();
t = usertime();
for (i = 0; i < n; i++) {
p = ptest(A[i], count, skip);
if (p != P[i]) {
@@ -258,7 +258,7 @@ define crtimes(str, a, b, n, count, skip, verbose)
if (m) {
printf("*** %d error(s)?\n", m);
} else {
t = round(runtime() - t, 4);
t = round(usertime() - t, 4);
if (verbose > 1) {
printf("%d probable primes: time = %d\n", n, t);
} else {
@@ -296,18 +296,19 @@ define ntimes(str, N, n, count, skip, residue, modulus, verbose)
mat A[n];
for (i = 0; i < n; i++)
A[i] = rlen(N);
t = runtime();
t = usertime();
for (i = 0; i < n; i++) {
p = nextcand(A[i], count, skip, residue, modulus);
}
tnext = round(runtime() - t, 4);
t = runtime();
tnext = round(usertime() - t, 4);
t = usertime();
for (i = 0; i < n; i++) {
p = prevcand(A[i], count, skip, residue, modulus);
}
tprev = round(runtime() - t, 4);
tprev = round(usertime() - t, 4);
if (verbose > 0) {
printf("%d evaluations, nextcand: %d, prevcand: %d\n", n, tnext, tprev);
printf("%d evaluations, nextcand: %d, "
"prevcand: %d\n", n, tnext, tprev);
}
}

View File

@@ -17,11 +17,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test4100.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test4100.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: test4100.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test4100.cal,v $
*
* Under source code control: 1996/03/13 03:53:22
* File existed as early as: 1996
@@ -70,18 +70,16 @@
*/
global defaultverbose = 1; /* default verbose value */
global err;
defaultverbose = 1; /* default verbose value */
/*
* test defaults
*/
global K1 = 2^17;
global K2 = 2^12;
global BASEB = 16;
global BASE = 2^BASEB;
global test4100_K1 = 2^17;
global test4100_K2 = 2^12;
global test4100_BASE = 2^config("baseb");
define rlen_4100(N) = rand(BASE^(N-1), BASE^N);
define rlen_4100(N) = rand(test4100_BASE^(N-1), test4100_BASE^N);
define olen(N)
{
@@ -234,7 +232,7 @@ define times(str,N,n,verbose)
m = olen(N);
m2 = m^2;
if (isnull(n)) {
n = ceil(K1/power(N,1.585));
n = ceil(test4100_K1/power(N,1.585));
if (verbose > 1)
printf("n = %d\n", n);
}
@@ -247,38 +245,38 @@ define times(str,N,n,verbose)
C[i] = rand(m2);
}
z = rcin(0,m); /* to initialize redc and maybe lastmod information */
t = runtime();
t = usertime();
for (i = 0; i < n; i++)
z = rcin(A[i],m);
trcin = round(runtime() - t, 3);
t = runtime();
trcin = round(usertime() - t, 3);
t = usertime();
for (i = 0; i < n; i++)
z = rcout(A[i],m);
trcout = round(runtime() - t, 3);
t = runtime();
trcout = round(usertime() - t, 3);
t = usertime();
for (i = 0; i < n; i++)
z = rcmul(A[i],B[i],m);
trcmul = round(runtime() - t, 3);
t = runtime();
trcmul = round(usertime() - t, 3);
t = usertime();
for (i = 0; i < n; i++)
z = rcsq(A[i],m);
trcsq = round(runtime() - t, 3);
t = runtime();
trcsq = round(usertime() - t, 3);
t = usertime();
for (i = 0; i < n; i++)
z = A[i] * B[i];
tmul = round(runtime() - t, 3);
t = runtime();
tmul = round(usertime() - t, 3);
t = usertime();
for (i = 0; i < n; i++)
z = A[i]^2;
tsq = round(runtime() - t, 3);
t = runtime();
tsq = round(usertime() - t, 3);
t = usertime();
for (i = 0; i < n; i++)
z = C[i] % A[i];
tmod = round(runtime() - t, 3);
t = runtime();
tmod = round(usertime() - t, 3);
t = usertime();
for (i = 0; i < n; i++)
quomod(C[i], A[i], x, y);
tquomod = round(runtime() - t,3);
tquomod = round(usertime() - t,3);
if (verbose > 1) {
printf("rcin: %d, rcout: %d, rcmul: %d, rcsq: %d\n",
@@ -308,7 +306,7 @@ define powtimes(str, N1, N2, n, verbose)
N2 = 1;
if (isnull(n)) {
n = ceil(K2/power(N1, 1.585)/N2);
n = ceil(test4100_K2/power(N1, 1.585)/N2);
printf ("n = %d\n", n);
}
mat A[n];
@@ -316,8 +314,8 @@ define powtimes(str, N1, N2, n, verbose)
mat B[n];
v = olen(N1);
cp = config("pow2", 1);
crc = config("redc2", 1);
cp = config("pow2", 2);
crc = config("redc2", 2);
/* initialize redc and lastmod info */
@@ -328,29 +326,29 @@ define powtimes(str, N1, N2, n, verbose)
Ar[i] = rcin(A[i], v);
B[i] = rlen_4100(N2);
}
t = runtime();
t = usertime();
for (i = 0; i < n; i++)
z1 += pmod(A[i], B[i], v);
tbignum = round(runtime() - t, 4);
tbignum = round(usertime() - t, 4);
config("pow2", 1e6);
t = runtime();
t = usertime();
for (i = 0; i < n; i++)
z2 += pmod(A[i], B[i], v);
tnormal = round(runtime() - t, 4);
tnormal = round(usertime() - t, 4);
config("redc2",1e6);
t = runtime();
t = usertime();
for (i = 0; i < n; i++)
z3 += pmod(A[i], B[i], v);
tsmall = round(runtime() - t, 4);
t = runtime();
tsmall = round(usertime() - t, 4);
t = usertime();
for (i = 0; i < n; i++)
z4 += rcpow(Ar[i], B[i], v);
trcsmall = round(runtime() - t, 4);
config("redc2", 1);
t = runtime();
trcsmall = round(usertime() - t, 4);
config("redc2", 2);
t = usertime();
for (i = 0; i < n; i++)
z5 += rcpow(Ar[i], B[i], v);
trcbig = round(runtime() - t, 4);
trcbig = round(usertime() - t, 4);
if (z1 != z2) {
++m;
@@ -408,7 +406,7 @@ define inittimes(str,N,n,verbose)
}
m = 0;
if (isnull(n)) {
n = ceil(K1/N^2);
n = ceil(test4100_K1/N^2);
if (verbose > 1) {
printf ("n = %d\n", n);
}
@@ -421,13 +419,13 @@ define inittimes(str,N,n,verbose)
M[i] = olen(N);
A[i] = rand(M[i]);
}
t = runtime();
t = usertime();
for (i = 0; i < n; i++)
R[i] = rcin(A[i], M[i]);
trcin = round(runtime() - t, 4);
trcin = round(usertime() - t, 4);
for (i = 0; i < n; i++)
B[i] = rcout(R[i], M[i]);
trcout = round(runtime() - t, 4);
trcout = round(usertime() - t, 4);
for (i = 0; i < n; i++) {
if (B[i] != A[i]) {
++m;

View File

@@ -17,11 +17,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.4 $
* @(#) $Id: test4600.cal,v 29.4 2001/04/10 22:09:02 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test4600.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: test4600.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test4600.cal,v $
*
* Under source code control: 1996/07/02 20:04:40
* File existed as early as: 1996
@@ -30,8 +30,7 @@
*/
global defaultverbose = 1 /* default verbose value */
global err;
defaultverbose = 1; /* default verbose value */
/*
* test globals

View File

@@ -17,11 +17,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test5100.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test5100.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: test5100.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test5100.cal,v $
*
* Under source code control: 1996/12/02 23:57:10
* File existed as early as: 1996
@@ -30,8 +30,7 @@
*/
global defaultverbose = 1; /* default verbose value */
global err;
defaultverbose = 1; /* default verbose value */
/*
* We test the new code generator declaration scope and order.

View File

@@ -17,11 +17,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test5200.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test5200.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: test5200.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test5200.cal,v $
*
* Under source code control: 1997/02/07 02:48:10
* File existed as early as: 1997
@@ -30,8 +30,7 @@
*/
global defaultverbose = 1; /* default verbose value */
global err;
defaultverbose = 1; /* default verbose value */
/*
* test the fix of a global/static bug

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test8400.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test8400.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: test8400.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test8400.cal,v $
*
* Under source code control: 1999/10/31 01:00:03
* File existed as early as: 1999

View File

@@ -17,11 +17,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test8500.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test8500.cal,v $
* @(#) $Revision: 30.2 $
* @(#) $Id: test8500.cal,v 30.2 2013/08/11 08:41:38 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test8500.cal,v $
*
* Under source code control: 1999/11/12 20:59:59
* File existed as early as: 1999
@@ -134,8 +134,8 @@ define onetest_8500(a,b,rnd) {
* The rounding parameter is randomly chosen.
*
* After a run of divmod_8500 the a, b, rnd values which gave failure are
* stored in the list L_8500. L_8500[0], L_8500[1], L_8500[2] are a, b, rnd for the first
* test, etc.
* stored in the list L_8500. L_8500[0], L_8500[1], L_8500[2] are a, b,
* rnd for the first* test, etc.
*/
define divmod_8500(N = 10, M1 = 2^128, M2 = 2^64, testnum = 0)
{

View File

@@ -17,11 +17,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.1 $
* @(#) $Id: test8600.cal,v 29.1 2000/12/04 19:57:02 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test8600.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: test8600.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test8600.cal,v $
*
* Under source code control: 2000/12/04 19:57:02
* File existed as early as: 2000

1641
cal/test8900.cal Normal file

File diff suppressed because it is too large Load Diff

362
cal/toomcook.cal Normal file
View File

@@ -0,0 +1,362 @@
/*
* Toom-Cook - implementation of Toom-Cook(3,4) multiplication algorithm
*
* Copyright (C) 2013 Christoph Zurnieden
*
* Toom-Cook 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.
*
* Toom-Cook 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 30.3 $
* @(#) $Id: toomcook.cal,v 30.3 2013/08/11 08:41:38 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/toomcook.cal,v $
*
* Under source code control: 2013/08/11 01:31:28
* File existed as early as: 2013
*/
/*
* hide internal function from resource debugging
*/
static resource_debug_level;
resource_debug_level = config("resource_debug", 0);
/* */
define toomcook3(a,b){
local alen blen a0 a1 a2 b0 b1 b2 m ret sign mask;
local S0 S1 S2 S3 S4 T1 T2;
if(!isint(a) || !isint(b))
return newerror("toomcook3(a,b): a and/or b is not an integer");
alen = digits(a,2);
blen = digits(b,2);
sign = sgn(a) * sgn(b);
/* sgn(x) returns 0 if x = 0 */
if(sign == 0) return 0;
m = min(alen,blen)//3;
mask = ~-(1<<m);
/*
Cut-off at about 4,000 dec. digits
TODO: check
*/
if(isdefined("test8900")){
if(m < 20) return a*b;
}
else{
if(m < 4096 ) return a*b;
}
a = abs(a);
b = abs(b);
a0 = a & mask;
a1 = (a>>m) & mask;
a2 = (a>>(2*m));
b0 = b & mask;
b1 = (b>>m) & mask;
b2 = (b>>(2*m));
/*
Zimmermann
*/
S0 = toomcook3(a0 , b0);
S1 = toomcook3((a2+a1+a0) , (b2+b1+b0));
S2 = toomcook3(((a2<<2)+(a1<<1)+a0) , ((b2<<2)+(b1<<1)+b0));
S3 = toomcook3((a2-a1+a0) , (b2-b1+b0));
S4 = toomcook3(a2,b2);
T1 = (S3<<1) + S2;
T1 /= 3;
T1 += S0;
T1 >>= 1;
T1 -= S4<<1;
T2 = (S1 + S3)>>1;
S1 -= T1;
S2 = T2 - S0 - S4;
S3 = T1 - T2;
ret = (S4<<(4*m)) + (S3<<(3*m)) + (S2<<(2*m)) + (S1<<(1*m)) + S0;
ret = sign *ret;
return ret;
}
define toomcook3square(a){
local alen a0 a1 a2 m tmp tmp2 ret sign S0 S1 S2 S3 S4 T1 mask;
if(!isint(a))return newerror("toomcook3square(a): a is not integer");
alen = digits(a,2);
sign = sgn(a) * sgn(a);
if(sign == 0) return 0;
m = alen//3;
mask = ~-(1<<m);
/*
Cut-off at about 5,000 dec. digits
TODO: check
*/
if(isdefined("test8900")){
if(m < 20) return a^2;
}
else{
if(m < 5000 ) return a^2;
}
a = abs(a);
a0 = a & mask;
a1 = (a>>m) & mask;
a2 = (a>>(2*m));
/*
Bodrato/Zanoni
*/
S0 = toomcook3square(a0);
S1 = toomcook3square(a2+a1+a0);
S2 = toomcook3square(a2-a1+a0);
S3 = toomcook3(a1<<1,a2);
S4 = toomcook3square(a2);
T1 = (S1 + S2)>>1;
S1 = S1 - T1 - S3;
S2 = T1 - S4 -S0;
S1 = S1<<(1*m);
S2 = S2<<(2*m);
S3 = S3<<(3*m);
S4 = S4<<(4*m);
ret = S0 + S1 + S2 + S3 + S4;
ret = sign *ret;
return ret;
}
define toomcook4(a,b)
{
local a0 a1 a2 a3 b0 b1 b2 b3 b4 ret tmp tmp2 tmp3 sign;
local m alen blen mask;
local w1, w2, w3, w4, w5, w6, w7;
if(!isint(a) || !isint(b))
return newerror("toomcook4(a,b): a and/or b is not integer");
alen = digits(a,2);
blen = digits(b,2);
sign = sgn(a) * sgn(b);
if(sign == 0) return 0;
m = min(alen//4,blen//4);
mask = ~-(1<<m);
if(isdefined("test8900")){
if(m < 100) return toomcook3(a,b);
}
else{
if(m < 256*3072) return toomcook3(a,b);
}
a = abs(a);
b = abs(b);
a0 = a & mask;
a1 = (a>>m) & mask;
a2 = (a>>(2*m)) & mask;
a3 = (a>>(3*m));
b0 = b & mask;
b1 = (b>>m) & mask;
b2 = (b>>(2*m)) & mask;
b3 = (b>>(3*m));
/*
Bodrato / Zanoni
*/
w3 = a3 + (a1 + (a2 + a0));
w7 = b3 + (b1 + (b2 + b0));
w4 = -a3 + (-a1 + (a2 + a0));
w5 = -b3 + (-b1 + (b2 + b0));
w3 = toomcook4(w3, w7);
w4 = toomcook4(w4, w5);
w5 = a3 + ((a1<<2) + ((a2<<1) + (a0<<3)));
w2 = b3 + ((b1<<2) + ((b2<<1) + (b0<<3)));
w6 = -a3 + (-(a1<<2) + ((a2<<1) + (a0<<3)));
w7 = -b3 + (-(b1<<2) + ((b2<<1) + (b0<<3)));
w5 = toomcook4(w5, w2);
w6 = toomcook4(w6, w7);
w2 = (a3<<3) + ((a1<<1) + ((a2<<2) + a0));
w7 = (b3<<3) + ((b1<<1) + ((b2<<2) + b0));
w2 = toomcook4(w2, w7);
w1 = toomcook4(a3, b3);
w7 = toomcook4(a0, b0);
w2 = w2 + w5;
w6 = w5 - w6;
w4 = w3 - w4;
w5 = w5 - w1;
w5 -= w7 << 6;
w4 = w4>>1;
w3 = w3 - w4;
w5 = w5<<1;
w5 = w5 - w6;
w2 -= w3 * 65;
w3 = w3 - w7;
w3 = w3 - w1;
w2 += w3 * 45;
w5 -= w3<<3;
w5 = w5//24;
w6 = w6 - w2;
w2 -= w4<<4;
w2 = w2//18;
w3 = w3 - w5;
w4 = w4 - w2;
w6 += w2 * 30;
w6 = w6//60;
w2 = w2 - w6;
ret = w7 + (w6<<m) + (w5<<(2*m)) + (w4<<(3*m))+ (w3<<(4*m))+
(w2<<(5*m))+ (w1<<(6*m));
ret = sign *ret;
return ret;
}
define toomcook4square(a){
local a0 a1 a2 a3 ret S0 S1 S2 S3 S4 S5 S6 S7 tmp tmp2 tmp3;
local sign m alen mask;
local T0 T1 T2 T3 T4 T5 T6 T7 T8;
if(!isint(a) )return newerror("toomcook3square(a): a is not integer");
alen = digits(a,2);
sign = sgn(a) * sgn(a);
/* sgn(x) returns 0 if x = 0 */
if(sign == 0) return 0;
m = (alen)//4;
mask = ~-( 1 << m );
/*
cut-off at about 2 mio. dec. digits
TODO: check!
*/
if(isdefined("test8900")){
if(m < 100) return toomcook3square(a);
}
else{
if(m < 512*3072) return toomcook3square(a);
}
a = abs(a);
a0 = a & mask;
a1 = (a>>m) & mask;
a2 = (a>>(2*m)) & mask;
a3 = (a>>(3*m)) ;
/*
Bodrato / Zanoni
*/
S1 = toomcook4square(a0);
S2 = toomcook4(a0<<1,a1);
S3 = toomcook4((a0 + a1 - a2 - a3 ) , (a0 - a1 - a2 + a3 ));
S4 = toomcook4square(a0 + a1 + a2 + a3 );
S5 = toomcook4( (a0 - a2 )<<1 , (a1 - a3 ));
S6 = toomcook4(a3<<1 , a2);
S7 = toomcook4square(a3);
T1 = S3 + S4;
T2 = (T1 + S5 )>>1;
T3 = S2 + S6;
T4 = T2 - T3;
T5 = T3 - S5;
T6 = T4 - S3;
T7 = T4 - S1;
T8 = T6 - S7;
ret = (S7<<(6*m)) + (S6<<(5*m)) + (T7<<(4*m))
+ (T5<<(3*m)) + (T8<<(2*m)) + (S2<<(1*m)) + S1;
ret = sign *ret;
return ret;
}
/*
TODO: Implement the asymmetric variations
*/
/*
produce_long_random_number(n) returns large pseudorandom numbers. Really large
numbers, e.g.:
produce_long_random_number(16)
is ca 4,128,561 bits (ca 1,242,821 dec. digits) large. Exact length is not
predeterminable because of the chaotic output of the function random().
*/
define __CZ__produce_long_random_number(n)
{
local ret k;
ret = 1;
if(!isint(n) || n<1)
return newerror("__CZ__produce_long_random_number(n): "
"n is not an integer >=1");
for(k=0;k<n;k++){
ret += random();
ret = toomcook4square(ret);
}
return ret;
}
/*
* restore internal function from resource debugging
* report important interface functions
*/
config("resource_debug", resource_debug_level),;
if (config("resource_debug") & 3) {
print "toomcook3(a,b)";
print "toomcook3square(a)";
print "toomcook4(a,b)";
print "toomcook4square(a)";
}

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: unitfrac.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/unitfrac.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: unitfrac.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/unitfrac.cal,v $
*
* Under source code control: 1990/02/15 01:50:38
* File existed as early as: before 1990

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: varargs.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/varargs.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: varargs.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/varargs.cal,v $
*
* Under source code control: 1991/05/22 21:56:34
* File existed as early as: 1991

View File

@@ -15,11 +15,11 @@
* 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.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: xx_print.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/xx_print.cal,v $
* @(#) $Revision: 30.1 $
* @(#) $Id: xx_print.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/xx_print.cal,v $
*
* Under source code control: 1997/04/17 00:08:50
* File existed as early as: 1997

114
cal/zeta2.cal Normal file
View File

@@ -0,0 +1,114 @@
/*
* zeta2 - Hurwitz Zeta function
* Copyright (C) 2013 Christoph Zurnieden
* Version: 0.0.1
* Licence: GPL
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* This program 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 General Public License for more details.
*
* @(#) $Revision: 30.3 $
* @(#) $Id: zeta2.cal,v 30.3 2013/08/11 08:41:38 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/zeta2.cal,v $
*
* Under source code control: 2013/08/11 01:31:28
* File existed as early as: 2013
*/
/*
* hide internal function from resource debugging
*/
static resource_debug_level;
resource_debug_level = config("resource_debug", 0);
define hurwitzzeta(s,a){
local realpart_a imagpart_s tmp tmp1 tmp2 tmp3;
local sum1 sum2 sum3 i k n precision result limit;
local limit_function offset offset_squared rest_sum eps;
/*
According to Linas Vepstas' "An efficient algorithm for accelerating
the convergence of oscillatory series, useful for computing the
polylogarithm and Hurwitz zeta functions" the Euler-Maclaurin series
is the fastest in most cases.
With a lot of help of the PARI/GP implementation by Prof. Henri Cohen,
hence the different license.
*/
eps=epsilon( epsilon() * 1e-3);
realpart_a=re(a);
if(realpart_a>1.5){
tmp=floor(realpart_a-0.5);
sum1 = 0;
for( i = 1 ; i <= tmp ; i++){
sum1 += ( a - i )^( -s );
}
epsilon(eps);
return (hurwitzzeta(s,a-tmp)-sum1);
}
if(realpart_a<=0){
tmp=ceil(-realpart_a+0.5);
for( i = 0 ; i <= tmp-1 ; i++){
sum2 += ( a + i )^( -s );
}
epsilon(eps);
return (hurwitzzeta(s,a+tmp)+sum2);
}
precision=digits(1/epsilon());
realpart_a=re(s);
imagpart_s=im(s);
epsilon(1e-9);
result=s-1.;
if(abs(result)<0.1){
result=-1;
}
else
result=ln(result);
limit=(precision*ln(10)-re((s-.5)*result)+(1.*realpart_a)*ln(2.*pi()))/2;
limit=max(2,ceil(max(limit,abs(s*1.)/2)));
limit_function=ceil(sqrt((limit+realpart_a/2-.25)^2+(imagpart_s*1.)^2/4)/
pi());
if (config("user_debug") > 0) {
print "limit_function = " limit_function;
print "limit = " limit;
print "prec = " precision;
}
/* Full precison plus 5 digits angstzuschlag*/
epsilon( (10^(-precision)) * 1e-5);
tmp3=(a+limit_function+0.)^(-s);
sum3 = tmp3/2;
for(n=0;n<=limit_function-1;n++){
sum3 += (a+n)^(-s);
}
result=sum3;
offset=a+limit_function;
offset_squared=1./(offset*offset);
tmp1=2*s-1;
tmp2=s*(s-1);
rest_sum=bernoulli(2*limit);
for(k=2*limit-2;k>=2;k-=2){
rest_sum=bernoulli(k)+offset_squared*
(k*k+tmp1*k+tmp2)*rest_sum/((k+1)*(k+2));
}
rest_sum=offset*(1+offset_squared*tmp2*rest_sum/2);
result+=rest_sum*tmp3/(s-1);
epsilon(eps);
return result;
}
/*
* restore internal function from resource debugging
* report important interface functions
*/
config("resource_debug", resource_debug_level),;
if (config("resource_debug") & 3) {
print "hurwitzzeta(s,a)";
}

Some files were not shown because too many files have changed in this diff Show More