Compare commits

..

40 Commits

Author SHA1 Message Date
Landon Curt Noll
85bfa30897 Release calc version 2.12.4.11 2017-05-21 15:38:58 -07:00
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
Landon Curt Noll
23a5fc3ede Release calc version 2.12.0.1 2017-05-21 15:38:46 -07:00
Landon Curt Noll
58d94b08d8 Release calc version 2.12.0 2017-05-21 15:38:45 -07:00
581 changed files with 43903 additions and 18270 deletions

238
BUGS
View File

@@ -72,37 +72,41 @@ Known bugs:
us know! See the above for details on how to report and were to
EMail your bug reports and hopefully patches to fix them.
* The following command:
=-=
calc 'read ellip; efactor(13*17*19)'
Problems that have known work-a-rounds:
will generate the following error:
efactor(iN,ia,B,force) defined
point_print(p) defined
point_mul(p1,p2) defined
point_square(p) defined
point_pow(p,pow) defined
A = 1
2 (1,1)
"point_square": line 165: Not initializing matrix, object or list
Error in commands
This is not an error in the ellip standard calc resource files.
It is a bug inside calc. Versions going back as far as version
2.11.4t2 in the year 2000 (and perhaps even further) all have
this bug.
Anyone want to track down and fix this bug?
* 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?
@@ -125,189 +129,7 @@ mis-features in calc:
will not.
=-=
Problems with old systems that have known work-a-rounds:
* The gcc as shipped with Redhat 7 perhaps other Linux distributions
has a bug causes calc to dump core on startup when calc is:
compiled optimized (-O, -O1, -O2 or -O3)
AND
compiled with debugging (-g or -g3)
AND
when calc is compiled with readline (see USE_READLINE,
READLINE_LIB and READLINE_INCLUDE in the Makefile)
This is known as the Redhat 7 readlne problem.
On Redhat, the gcc -v which has this problem is:
gcc version 2.96 20000731 (Red Hat Linux 7.1 2.96-85)
there may be other gcc versions that also suffer this fate.
The readlines associated with problem are:
readline-4.1-5
readline2.2.1-2.2.1-2
readline-devel-4.1-5
One work-a-round is to compile calc WITHOUT readline. In the
Makefile be sure that:
USE_READLINE=
READLINE_LIB=
READLINE_INCLUDE=
i.e., these Makefile vars are empty.
If you must use readline, then an alternate work-a-round is to
change the DEBUG Makefile variable to either:
compile for speed: -O3 (or -O2 if you do not have -O3)
compile to debug: -g3 (or -g if you do not have -g3)
but not both.
See RH bug #57889 for details:
http://bugzilla.redhat.com/bugzilla/show_bug.cgi?id=57889
* 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;
* Solaris cc somtimes barfs while compiling zrand.c. In particular, calc
barfs on on the SVAL macro. The work-a-round is to use the Solaric cc
Makefile set sets -DFORCE_STDC. I.e,:
CCWARN=
CCOPT= ${DEBUG} ${NO_SHARED}
CCMISC= -DFORCE_STDC
#
CFLAGS= ${CCWARN} ${CCOPT} ${CCMISC}
ICFLAGS= ${CCWARN} ${CCMISC}
#
LCFLAGS=
LDFLAGS= ${NO_SHARED} ${LD_NO_SHARED}
ILDFLAGS=
#
LCC= cc
CC= ${PURIFY} ${LCC}
* There is a bug in some versions of the Dec/Compaq cc for the Alpha
where the following:
#include <stdio.h>
#define SVAL(a,b) (unsigned long)(0x ## a ## b ## ULL)
main(){SVAL(b8a8aeb0,8168eadc);}
fails because it puts a space inside the concatenated hex. Calc
has code that is affected by this bug. This bug has been reported
to Compaq and may be fixed in the future. A work-a-round is to
compile with cc -std0 or to use a later version of their compiler.
* On a Digital UNIX V4.0F (Rev. 1229) on a 500 Mhz 21264, make check
dies a horrible death starting in test 600 and 622 gives 100s of
messages for calc version 2.11.0t9.4 using the Dec's cc with -O2:
600: Beginning test_bignums
601: muldivcheck 1
**** abc != acb: 602: muldivcheck 2
**** acb != bac: 602: muldivcheck 2
...
**** t4 != a4: 622: algcheck 1
**** t5 != a5: 622: algcheck 1
**** t6 != a6: 622: algcheck 1
**** t4 != a4: 622: algcheck 1
...
it finally hangs at test 2000.
The work-a-round is to compile calc without the optimizer. If this
happens to you, try compiling without -O and without -O2. I.e., in
the Makefile, set:
DEBUG= -g
* 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"
* Under BSDI v4, the warnings of the form:
/usr/include/ctype.h:147: warning: `__runetype' defined but not used
/usr/include/ctype.h:161: warning: `__isctype' defined but not used
/usr/include/ctype.h:170: warning: `toupper' defined but not used
/usr/include/ctype.h:177: warning: `tolower' defined but not used
are seen. These warnings are the result of mis-features in BSDI
include files. They do not have an impact on the operation
or performance. The work-a-round is to ignore these warnings
under BSDI.
## Copyright (C) 1999 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
@@ -321,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.22 $
## @(#) $Id: BUGS,v 29.22 2004/10/23 02:25:02 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

1414
CHANGES

File diff suppressed because it is too large Load Diff

39
COPYING
View File

@@ -6,17 +6,17 @@ 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.7 $
# @(#) $Id: COPYING,v 29.7 2003/02/26 16:54:59 chongo Exp $
# @(#) $Source: /usr/local/src/cmd/calc/RCS/COPYING,v $
# @(#) $Revision: 30.4 $
# @(#) $Id: COPYING,v 30.4 2013/09/01 20:14:30 chongo Exp $
# @(#) $Source: /usr/local/src/bin/calc/RCS/COPYING,v $
=-=
-=-
Calc is covered by the GNU Lesser General Public License
--------------------------------------------------------
@@ -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:
@@ -78,7 +78,7 @@ Calc is covered by the GNU Lesser General Public License
Feel free to follow the name line with additional EMail text as desired.
=-=
-=-
Calc bug reports and calc bug fixes should be sent to:
@@ -93,7 +93,7 @@ Calc is covered by the GNU Lesser General Public License
You may have additional words in your subject line.
=-=
-=-
Calc's relationship to the GNU Lesser General Public License
------------------------------------------------------------
@@ -149,7 +149,7 @@ Calc's relationship to the GNU Lesser General Public License
except for the exception files explicitly listed in the ``Calc
copyrights and exception files'' section below.
=-=
-=-
Calc copyrights and exception files
-----------------------------------
@@ -165,12 +165,12 @@ Calc copyrights and exception files
Copyright (C) year Ernest Bowen and Landon Curt Noll
Copyright (C) year Ernest Bowen
Copyright (C) year Petteri Kettunen and Landon Curt Noll
Copyright (C) year Christoph Zurnieden
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
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,15 +182,14 @@ 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
entire calc source may be freely used and distributed.
=-=
-=-
General Copyleft and License info
---------------------------------
@@ -204,7 +203,7 @@ General Copyleft and License info
http://www.gnu.org/copyleft/lesser.html
http://www.gnu.org/copyleft/lesser.txt
=-=
-=-
Why calc did not use the GNU General Public License
---------------------------------------------------

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,8 @@ 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 +501,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

5497
Makefile

File diff suppressed because it is too large Load Diff

5717
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

263
addop.c
View File

@@ -1,7 +1,7 @@
/*
* addop - add opcodes to a function being compiled
*
* Copyright (C) 1999-2004 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.5 $
* @(#) $Id: addop.c,v 29.5 2004/02/23 14:04:01 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 */
/*
@@ -184,7 +184,7 @@ void
endfunc(void)
{
register FUNC *fp; /* function just finished */
unsigned long size; /* size of just created function */
size_t size; /* size of just created function */
unsigned long index;
if (oldop != OP_RETURN) {
@@ -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);
@@ -211,7 +211,7 @@ endfunc(void)
if (newname[0] != '*' && (conf->traceflags & TRACE_FNCODES)) {
dumpnames = TRUE;
for (size = 0; size < fp->f_opcodecount; ) {
printf("%ld: ", (long)size);
printf("%ld: ", (unsigned long)size);
size += dumpop(&fp->f_opcodes[size]);
}
}
@@ -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) ||
@@ -451,124 +452,122 @@ addop(long op)
* slightly optimize the code depending on the various combinations.
*/
switch (op) {
case OP_GETVALUE:
switch (oldop) {
case OP_NUMBER:
case OP_ZERO:
case OP_ONE:
case OP_IMAGINARY:
case OP_GETEPSILON:
case OP_SETEPSILON:
case OP_STRING:
case OP_UNDEF:
case OP_GETCONFIG:
case OP_SETCONFIG:
return;
case OP_DUPLICATE:
diff = 1;
oldop = OP_DUPVALUE;
break;
case OP_FIADDR:
diff = 1;
oldop = OP_FIVALUE;
break;
case OP_GLOBALADDR:
diff = 1 + PTR_SIZE;
oldop = OP_GLOBALVALUE;
break;
case OP_LOCALADDR:
oldop = OP_LOCALVALUE;
break;
case OP_PARAMADDR:
oldop = OP_PARAMVALUE;
break;
case OP_ELEMADDR:
oldop = OP_ELEMVALUE;
break;
default:
cut = FALSE;
case OP_GETVALUE:
switch (oldop) {
case OP_NUMBER:
case OP_ZERO:
case OP_ONE:
case OP_IMAGINARY:
case OP_GETEPSILON:
case OP_SETEPSILON:
case OP_STRING:
case OP_UNDEF:
case OP_GETCONFIG:
case OP_SETCONFIG:
return;
case OP_DUPLICATE:
diff = 1;
oldop = OP_DUPVALUE;
break;
case OP_FIADDR:
diff = 1;
oldop = OP_FIVALUE;
break;
case OP_GLOBALADDR:
diff = 1 + PTR_SIZE;
oldop = OP_GLOBALVALUE;
break;
case OP_LOCALADDR:
oldop = OP_LOCALVALUE;
break;
case OP_PARAMADDR:
oldop = OP_PARAMVALUE;
break;
case OP_ELEMADDR:
oldop = OP_ELEMVALUE;
break;
default:
cut = FALSE;
}
if (cut) {
fp->f_opcodes[count - diff] = oldop;
return;
}
}
if (cut) {
fp->f_opcodes[count - diff] = oldop;
return;
}
break;
case OP_POP:
switch (oldop) {
case OP_ASSIGN:
fp->f_opcodes[count-1] = OP_ASSIGNPOP;
oldop = OP_ASSIGNPOP;
return;
case OP_NUMBER:
case OP_IMAGINARY:
q = constvalue(fp->f_opcodes[count-1]);
qfree(q);
break;
case OP_POP:
switch (oldop) {
case OP_ASSIGN:
fp->f_opcodes[count-1] = OP_ASSIGNPOP;
oldop = OP_ASSIGNPOP;
return;
case OP_NUMBER:
case OP_IMAGINARY:
q = constvalue(fp->f_opcodes[count-1]);
qfree(q);
break;
case OP_STRING:
sfree(findstring((long)fp->f_opcodes[count-1]));
break;
case OP_LOCALADDR:
case OP_PARAMADDR:
break;
case OP_GLOBALADDR:
diff = 1 + PTR_SIZE;
break;
case OP_UNDEF:
fp->f_opcodecount -= 1;
oldop = OP_NOP;
oldoldop = OP_NOP;
return;
default:
cut = FALSE;
}
if (cut) {
fp->f_opcodecount -= diff;
oldop = OP_NOP;
oldoldop = OP_NOP;
fprintf(stderr,
"Line %ld: unused value ignored\n",
linenumber());
return;
}
case OP_STRING:
sfree(findstring((long)fp->f_opcodes[count-1]));
break;
case OP_NEGATE:
if (oldop == OP_NUMBER) {
q = constvalue(fp->f_opcodes[count-1]);
fp->f_opcodes[count-1] = addqconstant(qneg(q));
qfree(q);
return;
}
case OP_LOCALADDR:
case OP_PARAMADDR:
break;
case OP_GLOBALADDR:
diff = 1 + PTR_SIZE;
break;
case OP_UNDEF:
fp->f_opcodecount -= 1;
oldop = OP_NOP;
oldoldop = OP_NOP;
return;
default:
cut = FALSE;
}
if (cut) {
fp->f_opcodecount -= diff;
oldop = OP_NOP;
oldoldop = OP_NOP;
warning("Constant before comma operator");
return;
}
break;
case OP_NEGATE:
if (oldop == OP_NUMBER) {
q = constvalue(fp->f_opcodes[count-1]);
fp->f_opcodes[count-1] = addqconstant(qneg(q));
qfree(q);
return;
}
}
if (oldop == OP_NUMBER) {
if (oldoldop == OP_NUMBER) {
q1 = constvalue(fp->f_opcodes[count - 3]);
q2 = constvalue(fp->f_opcodes[count - 1]);
switch (op) {
case OP_DIV:
if (qiszero(q2)) {
cut = FALSE;
break;
}
q = qqdiv(q1,q2);
break;
case OP_MUL:
q = qmul(q1,q2);
break;
case OP_ADD:
q = qqadd(q1,q2);
break;
case OP_SUB:
q = qsub(q1,q2);
break;
case OP_POWER:
if (qisfrac(q2) || qisneg(q2))
cut = FALSE;
else
q = qpowi(q1,q2);
break;
default:
case OP_DIV:
if (qiszero(q2)) {
cut = FALSE;
break;
}
q = qqdiv(q1,q2);
break;
case OP_MUL:
q = qmul(q1,q2);
break;
case OP_ADD:
q = qqadd(q1,q2);
break;
case OP_SUB:
q = qsub(q1,q2);
break;
case OP_POWER:
if (qisfrac(q2) || qisneg(q2))
cut = FALSE;
else
q = qpowi(q1,q2);
break;
default:
cut = FALSE;
}
if (cut) {
qfree(q1);

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;

167
blkcpy.c
View File

@@ -1,7 +1,7 @@
/*
* blkcpy - general values and related routines used by the calculator
*
* Copyright (C) 1999-2004 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.5 $
* @(#) $Id: blkcpy.c,v 29.5 2004/02/23 14:04:01 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"
/*
@@ -73,51 +73,51 @@ copystod(VALUE *svp, long ssi, long num, VALUE *dvp, long dsi)
* determine/check source type
*/
switch(svp->v_type) {
case V_NBLOCK:
if (svp->v_nblock->subtype & V_NOCOPYFROM)
return E_COPY15;
sblk = svp->v_nblock->blk;
if (sblk->data == NULL)
return E_COPY8;
break;
case V_BLOCK:
sblk = svp->v_block;
break;
case V_STR:
case V_OCTET:
case V_NUM:
case V_FILE:
case V_MAT:
case V_LIST:
break;
default:
return E_COPY9;
case V_NBLOCK:
if (svp->v_nblock->subtype & V_NOCOPYFROM)
return E_COPY15;
sblk = svp->v_nblock->blk;
if (sblk->data == NULL)
return E_COPY8;
break;
case V_BLOCK:
sblk = svp->v_block;
break;
case V_STR:
case V_OCTET:
case V_NUM:
case V_FILE:
case V_MAT:
case V_LIST:
break;
default:
return E_COPY9;
}
/*
* determine/check destination type
*/
switch(dvp->v_type) {
case V_NBLOCK:
if (dvp->v_nblock->subtype & V_NOCOPYTO)
return E_COPY16;
noreloc |=((dvp->v_nblock->subtype & V_NOREALLOC) != 0);
dblk = dvp->v_nblock->blk;
if (dblk->data == NULL)
return E_COPY10;
break;
case V_BLOCK:
noreloc = ((dvp->v_subtype & V_NOREALLOC) != 0);
dblk = dvp->v_block;
break;
case V_STR:
case V_NUM:
case V_FILE:
case V_MAT:
case V_LIST:
break;
default:
return E_COPY11;
case V_NBLOCK:
if (dvp->v_nblock->subtype & V_NOCOPYTO)
return E_COPY16;
noreloc |=((dvp->v_nblock->subtype & V_NOREALLOC) != 0);
dblk = dvp->v_nblock->blk;
if (dblk->data == NULL)
return E_COPY10;
break;
case V_BLOCK:
noreloc = ((dvp->v_subtype & V_NOREALLOC) != 0);
dblk = dvp->v_block;
break;
case V_STR:
case V_NUM:
case V_FILE:
case V_MAT:
case V_LIST:
break;
default:
return E_COPY11;
}
/*
@@ -280,7 +280,7 @@ copymat2mat(MATRIX *smat, long ssi, long num, MATRIX *dmat, long dsi)
VALUE *vp;
VALUE *vq;
VALUE *vtemp;
short subtype;
unsigned short subtype;
if (ssi > smat->m_size)
return E_COPY2;
@@ -311,7 +311,7 @@ copymat2mat(MATRIX *smat, long ssi, long num, MATRIX *dmat, long dsi)
subtype = vq->v_subtype;
freevalue(vq);
*vq = *vp;
vq->v_subtype = subtype;
vq->v_subtype |= subtype;
}
free(vtemp);
return 0;
@@ -329,7 +329,7 @@ copyblk2mat(BLOCK *blk, long ssi, long num, MATRIX *dmat, long dsi)
VALUE *vq;
VALUE *vtemp;
long i;
short subtype;
unsigned short subtype;
if (ssi > blk->datalen)
return E_COPY2;
@@ -363,7 +363,7 @@ copyblk2mat(BLOCK *blk, long ssi, long num, MATRIX *dmat, long dsi)
subtype = vq->v_subtype;
freevalue(vq);
*vq = *vp;
vq->v_subtype = subtype;
vq->v_subtype |= subtype;
}
free(vtemp);
return 0;
@@ -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;
@@ -429,6 +430,7 @@ copymat2list(MATRIX *smat, long ssi, long num, LIST *lp, long dsi)
LISTELEM *ep;
VALUE *vtemp;
long i;
unsigned short subtype;
if (ssi > smat->m_size)
return E_COPY2;
@@ -456,8 +458,10 @@ copymat2list(MATRIX *smat, long ssi, long num, LIST *lp, long dsi)
ep = listelement(lp, (long) dsi);
i = num;
while (i-- > 0) {
subtype = ep->e_value.v_subtype;
freevalue(&ep->e_value);
ep->e_value = *vq++;
ep->e_value.v_subtype |= subtype;
ep = ep->e_next;
}
free(vtemp);
@@ -476,7 +480,7 @@ copylist2mat(LIST *lp, long ssi, long num, MATRIX *dmat, long dsi)
LISTELEM *ep;
VALUE *vtemp;
long i;
short subtype;
unsigned short subtype;
if (ssi > lp->l_count)
return E_COPY2;
@@ -508,7 +512,7 @@ copylist2mat(LIST *lp, long ssi, long num, MATRIX *dmat, long dsi)
subtype = vq->v_subtype;
freevalue(vq);
*vq = *vp;
vq->v_subtype = subtype;
vq->v_subtype |= subtype;
}
free(vtemp);
return 0;
@@ -526,6 +530,7 @@ copylist2list(LIST *slp, long ssi, long num, LIST *dlp, long dsi)
LISTELEM *dep;
VALUE *vtemp;
VALUE *vp;
unsigned short subtype;
if (ssi > slp->l_count)
return E_COPY2;
@@ -555,8 +560,10 @@ copylist2list(LIST *slp, long ssi, long num, LIST *dlp, long dsi)
vp = vtemp;
i = num;
while (i-- > 0) {
subtype = dep->e_value.v_subtype;
freevalue(&dep->e_value);
dep->e_value = *vp++;
dep->e_value.v_subtype |= subtype;
dep = dep->e_next;
}
free(vtemp);
@@ -714,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;
@@ -756,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;
@@ -806,13 +815,13 @@ copystr2str(STRING *sstr, long ssi, long num, STRING *dstr, long dsi)
{
char *c, *c1;
if (num < 0 || ssi + num > sstr->s_len)
if (num < 0 || (size_t)(ssi + num) > sstr->s_len)
num = sstr->s_len - ssi;
if (num <= 0)
return 0; /* Nothing to be copied */
if (dsi < 0) /* default destination index */
dsi = 0;
if (dsi + num > dstr->s_len)
if ((size_t)(dsi + num) > dstr->s_len)
num = dstr->s_len - dsi;
c1 = sstr->s_str + ssi;
c = dstr->s_str + dsi;
@@ -838,7 +847,7 @@ copyblk2str(BLOCK *sblk, long ssi, long num, STRING *dstr, long dsi)
return 0; /* Nothing to be copied */
if (dsi < 0) /* default destination index */
dsi = 0;
if (dsi + num > dstr->s_len)
if ((size_t)(dsi + num) > dstr->s_len)
num = dstr->s_len - dsi;
c1 = sblk->data + ssi;
c = (USB8 *)dstr->s_str + dsi;
@@ -852,18 +861,18 @@ copyblk2str(BLOCK *sblk, long ssi, long num, STRING *dstr, long dsi)
int
copyostr2str(char *sstr, long ssi, long num, STRING *dstr, long dsi)
{
long len;
size_t len;
char *c, *c1;
len = (long)strlen(sstr);
len = strlen(sstr);
if (num < 0 || ssi + num > len)
if (num < 0 || (size_t)(ssi + num) > len)
num = len - ssi;
if (num <= 0) /* Nothing to be copied */
return 0;
if (dsi < 0)
dsi = 0; /* Default destination index */
if (dsi + num > dstr->s_len)
if ((size_t)(dsi + num) > dstr->s_len)
num = dstr->s_len - dsi;
c1 = sstr + ssi;
c = dstr->s_str + dsi;
@@ -879,16 +888,16 @@ copyostr2str(char *sstr, long ssi, long num, STRING *dstr, long dsi)
int
copyostr2blk(char *str,long ssi,long num,BLOCK *dblk,long dsi,BOOL noreloc)
{
int len;
int newlen;
int newsize;
size_t len;
size_t newlen;
size_t newsize;
USB8 *newdata;
len = strlen(str) + 1;
if (ssi > len)
if (ssi > 0 && (size_t)ssi > len)
return E_COPY2;
if (num < 0 || ssi + num > len)
if (num < 0 || (size_t)(ssi + num) > len)
num = len - ssi;
if (num <= 0) /* Nothing to be copied */
return 0;
@@ -897,7 +906,7 @@ copyostr2blk(char *str,long ssi,long num,BLOCK *dblk,long dsi,BOOL noreloc)
newlen = dsi + num;
if (newlen <= 0)
return E_COPY7;
if (newlen >= dblk->maxsize) {
if (newlen >= (size_t)dblk->maxsize) {
if (noreloc)
return E_COPY17;
newsize = (1 + newlen/dblk->blkchunk) * dblk->blkchunk;
@@ -910,7 +919,7 @@ copyostr2blk(char *str,long ssi,long num,BLOCK *dblk,long dsi,BOOL noreloc)
dblk->maxsize = newsize;
}
memmove(dblk->data + dsi, str + ssi, num);
if (newlen > dblk->datalen)
if (newlen > (size_t)dblk->datalen)
dblk->datalen = newlen;
return 0;
}
@@ -929,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
@@ -976,10 +985,11 @@ 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)
{
long newlen;
long newsize;
size_t newlen;
size_t newsize;
USB8 *newdata;
#if CALC_BYTE_ORDER == BIG_ENDIAN
ZVALUE *swnum; /* byte swapped numerator */
@@ -995,10 +1005,10 @@ copynum2blk(NUMBER *snum, long ssi, long num, BLOCK *dblk, long dsi, BOOL norelo
return E_COPY5;
if (dsi < 0)
dsi = dblk->datalen;
newlen = dsi + (long)(num*sizeof(HALF));
newlen = dsi + (num*sizeof(HALF));
if (newlen <= 0)
return E_COPY7;
if (newlen >= dblk->maxsize) {
if (newlen >= (size_t)dblk->maxsize) {
if (noreloc)
return E_COPY17;
newsize = (1 + newlen/dblk->blkchunk) * dblk->blkchunk;
@@ -1017,7 +1027,7 @@ copynum2blk(NUMBER *snum, long ssi, long num, BLOCK *dblk, long dsi, BOOL norelo
memmove(dblk->data+dsi, (char *)(swnum->v+ssi), num*sizeof(HALF));
zfree(*swnum);
#endif
if (newlen > dblk->datalen)
if (newlen > (size_t)dblk->datalen)
dblk->datalen = newlen;
return 0;
}
@@ -1027,9 +1037,10 @@ 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)
{
long newlen;
size_t newlen;
NUMBER *ret; /* cloned and modified numerator */
#if CALC_BYTE_ORDER == BIG_ENDIAN
HALF *swapped; /* byte swapped input data */
@@ -1048,7 +1059,7 @@ copyblk2num(BLOCK *sblk, long ssi, long num, NUMBER *dnum, long dsi, NUMBER **re
return E_COPY5;
if (dsi < 0)
dsi = dnum->num.len;
newlen = dsi + (long)((num+sizeof(HALF)-1)/sizeof(HALF));
newlen = dsi + ((num+sizeof(HALF)-1)/sizeof(HALF));
if (newlen <= 0)
return E_COPY7;

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__ */

26
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.2 $
* @(#) $Id: block.c,v 29.2 2000/06/07 14:02:13 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*);
/*
@@ -57,7 +57,7 @@ static void blkchk(BLOCK*);
*
* given:
* len - initial memory length of the block
* type - BLK_TYPE_XXX
* type - BLK_TYPE_XYZ
* chunk - allocation chunk size
*
* returns:
@@ -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.16 $
# @(#) $Id: Makefile,v 29.16 2005/12/12 06:42:30 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,20 +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
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
#
@@ -191,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
##
#
@@ -208,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; \
@@ -231,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; \
@@ -245,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

1015
cal/README

File diff suppressed because it is too large Load Diff

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
*
* 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.4 $
* @(#) $Id: bernpoly.cal,v 30.4 2013/08/18 20:01:53 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

258
cal/brentsolve.cal Normal file
View File

@@ -0,0 +1,258 @@
/*
* brentsolve - Root finding with the Brent-Dekker trick
*
* Copyright (C) 2013 Christoph Zurnieden
*
* 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.4 $
* @(#) $Id: brentsolve.cal,v 30.4 2013/08/18 20:01:53 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
*
* 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.4 $
* @(#) $Id: constants.cal,v 30.4 2013/08/18 20:01:53 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";
}

193
cal/dotest.cal Normal file
View File

@@ -0,0 +1,193 @@
/*
* dotest - test truth statements found in line tests of dotest_testline file
*
* This file was created by Ernest Bowen <ebowen at une dot edu dot au>
* and modified by Landon Curt Noll.
*
* This dotest_code has been placed in the public domain. Please do not
* copyright this dotest_code.
*
* ERNEST BOWEN AND LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO
* THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MER-
* CHANTABILITY AND FITNESS. IN NO EVENT SHALL LANDON CURT
* NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL
* DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
* NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
* CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
* @(#) $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.
*
* Under source dotest_code control: 2006/03/08 05:54:09
* File existed as early as: 2006
*/
/*
* dotest - perform tests from dotest_testline file
*
* given:
* dotest_file filename containing single test lines
* dotest_code regress.cal test number to use (def: 0)
* dotest_maxcond max error conditions allowed (def: <0 ==> 2^31-1)
*
* returns:
* number of line test failures
*
* NOTE: All variables used by the dotest() function start with "dotest_".
* The dotest_file and dotest_read should not use any variable
* that starts with "dotest_".
*/
define dotest(dotest_file, dotest_code = 0, dotest_maxcond = -1)
{
local dotest_f_file; /* open file containing test lines */
local dotest_testline; /* test line */
local dotest_testeval; /* eval value from dotest_testline test line */
local dotest_tmperrcnt; /* temp error count after line test */
local dotest_errcnt; /* total number of errors */
local dotest_failcnt; /* number of line tests failed */
local dotest_testnum; /* number of test lines evaluated */
local dotest_linenum; /* test line number */
local dotest_old_errmax; /* value of errmax() prior to calling */
local dotest_old_errcount; /* value of errcount() prior to calling */
/*
* preserve calling stats
*/
dotest_old_errmax = errmax();
dotest_old_errcount = errcount(0);
/*
* initialize test accounting
*/
dotest_errcnt = errcount();
dotest_failcnt = 0;
dotest_testnum = 0;
dotest_linenum = 0;
/*
* setup error accounting for dotest
*/
if (dotest_maxcond >= 0 && dotest_maxcond < 2147483647) {
errmax(dotest_maxcond + dotest_old_errcount + 1),;
} else {
errmax(2147483647),;
}
/*
* open the test line file
*/
printf("%d-: opening line file: %d", dotest_code, dotest_file);
dotest_f_file = fpathopen(dotest_file, "r");
if (!isfile(dotest_f_file)) {
printf("**** Unable to file or open file \"%s\"\n",
dotest_file);
quit;
}
printf('%d: testing "%s"\n', dotest_code, dotest_file);
/*
* perform dotest_testline test on each line of the file
*/
for (;;) {
/* get the next test line */
dotest_testline = fgets(dotest_f_file);
++dotest_linenum;
if (iserror(dotest_testline)) {
quit "**** Error while reading file";
} else if (isnull(dotest_testline)) {
/* EOF - end of test file */
break;
}
/* skip empty lines */
if (dotest_testline == "\n") {
continue;
}
/* evaluate the test line */
dotest_testeval = eval(dotest_testline);
/* ignore white space or comment lines */
if (isnull(dotest_testeval)) {
continue;
}
/* look for test line parse errors */
if (iserror(dotest_testeval)) {
printf("**** evaluation error: ");
++dotest_failcnt;
/* look for test line dotest_failcnt */
} else if (dotest_testeval != 1) {
printf("**** did not return 1: ");
++dotest_failcnt;
}
/* show the test line we just performed */
printf("%d-%d: %s", dotest_code, dotest_linenum, dotest_testline);
/* error accounting */
dotest_tmperrcnt = errcount() - dotest_errcnt;
if (dotest_tmperrcnt > 0) {
/* report any other errors */
if (dotest_tmperrcnt > 1) {
printf("%d-%d: NOTE: %d error conditions(s): %s\n",
dotest_code, dotest_linenum, dotest_tmperrcnt);
}
/* report the calc error string */
printf("%d-%d: NOTE: last error string: %s\n",
dotest_code, dotest_linenum, strerror());
/* new error count level */
dotest_errcnt = errcount();
if (dotest_maxcond >= 0 &&
dotest_old_errcount-dotest_errcnt > dotest_maxcond) {
printf("%d-%d: total error conditions: %d > %d\n",
dotest_code, dotest_linenum,
dotest_maxcond, dotest_old_errcount-dotest_errcnt);
}
}
}
/*
* test the close of the line file
*/
printf("%d-: detected %d error condition(s), many of which may be OK\n",
dotest_code, dotest_old_errcount-dotest_errcnt);
printf("%d-: closing line file: %d\n", dotest_code, dotest_file);
fclose(dotest_f_file);
/*
* test line file accounting
*/
if (dotest_failcnt > 0) {
printf("**** %d-: %d test failure(s) in %d line(s)\n",
dotest_code, dotest_failcnt, dotest_linenum);
} else {
printf("%d-: no failure(s) in %d line(s)\n",
dotest_code, dotest_linenum);
}
/*
* preppare to return to the caller environment
*
* We increase the caller's error count by the number
* of line tests that failed, not the number of internal
* errors that were noted.
*/
errmax(dotest_old_errmax),;
errcount(dotest_old_errcount + dotest_failcnt),;
/*
* All Done!!! -- Jessica Noll, Age 2
*/
return dotest_failcnt;
}

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: ellip.cal,v 29.2 2000/06/07 14:02: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;
}
@@ -141,18 +142,18 @@ define point_mul(p1, p2)
if (p2 == 1)
return p1;
if (p1 == p2)
return point_square(&p1);
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,10 +185,10 @@ define point_pow(p, pow)
if (isodd(pow))
r = p;
t = p;
for (bit = 2; ((bit <= pow) && (f == 0)); bit <<= 1) {
t = point_square(&t);
for (bit = 2; ((bit <= pow) && (ellip_f == 0)); bit <<= 1) {
t = point_square(`t);
if (bit & pow)
r = point_mul(&t, &r);
r = point_mul(`t, `r);
}
return 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
*
* 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.4 $
* @(#) $Id: factorial.cal,v 30.4 2013/08/18 20:01:53 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
*
* 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.4 $
* @(#) $Id: factorial2.cal,v 30.4 2013/08/18 20:01:53 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
*
* 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.4 $
* @(#) $Id: lambertw.cal,v 30.4 2013/08/18 20:01:53 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 @@
/*
* lnseries - special functions (e.g.: gamma, zeta, psi)
*
* Copyright (C) 2013 Christoph Zurnieden
*
* 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.4 $
* @(#) $Id: lnseries.cal,v 30.4 2013/08/18 20:01:53 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.2 $
* @(#) $Id: natnumset.cal,v 29.2 2000/06/07 14:02:25 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
@@ -471,7 +471,7 @@ define set_plus(a) = set_sum(a);
define interval(a, b)
{
local i, j, s;
static tail = str("\0\1\3\7\17\37\77\177\377");
static tail = "\0\1\3\7\17\37\77\177\377";
if (!isint(a) || !isint(b))
quit "Non-integer argument for interval";

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

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

61
cal/screen.cal Normal file
View File

@@ -0,0 +1,61 @@
/*
* screen - ANSI control sequences
*
* This file was created by Ernest Bowen <ebowen at une dot edu dot au>.
*
* This code has been placed in the public domain. Please do not
* copyright this code.
*
* ERNEST BOWEN DISCLAIMS ALL WARRANTIES WITH REGARD TO
* THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MER-
* CHANTABILITY AND FITNESS. IN NO EVENT SHALL LANDON CURT
* NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL
* DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
* NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
* CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
* @(#) $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.
*
* Under source code control: 2006/03/08 05:54:09
* File existed as early as: 2006
*/
up = CUU ="\e[A";
down = CUD = "\e[B}";
forward = CUF = "\e[C";
back = CUB = "\e[D";
save = SCP = "\e[s";
restore = RCP = "\e[u";
cls = "\e[2J";
home = "\e[F";
eraseline = "\e[K";
off = "\e[0m";
bold = "\e[1m";
faint = "\e[2m";
italic = "\e[3m";
blink = "\e[5m";
rapidblink = "\e[6m";
reverse = "\e[7m";
concealed = "\e[8m";
/* Lowercase indicates foreground, uppercase background" */
black = "\e[30m";
red = "\e[31m";
green = "\e[32m";
yellow = "\e[33m";
blue = "\e[34m";
magenta = "\e[35m";
cyan = "\e[36m";
white = "\e[37m";
Black = "\e[40m";
Red = "\e[41m";
Green = "\e[42m";
Yellow = "\e[43m";
Blue = "\e[44m";
Magenta = "\e[45m";
Cyan = "\e[46m";
White = "\e[47m";

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

77
cal/set8700.cal Normal file
View File

@@ -0,0 +1,77 @@
/*
* set8700 - environment for dotest line tests for the 8700 set of regress.cal
*
* Copyright (C) 2006 Ernest Bowen 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.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
*
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/
/*
* setup global variables for dotest() to use with set8700.set
*/
global set8700_A;
global set8700_B;
global set8700_M;
global set8700_M1;
global set8700_M2;
global set8700_L;
global set8700_L1;
global set8700_L2;
global set8700_O;
global set8700_P;
global set8700_P1;
global set8700_P2;
global set8700_Q;
global set8700_R;
global set8700_S;
global set8700_X;
global set8700_Y;
global set8700_x;
global set8700_y;
define set8700_getA1() = set8700_A;
define set8700_getA2() { return set8700_A; }
define set8700_getvar() {local a = 42; protect(a,256); return a;}
define set8700_f(set8700_x) = set8700_x^2;
define set8700_g(set8700_x)
{
if (isodd(set8700_x)) protect(set8700_x, 256);
return 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 };

429
cal/set8700.line Normal file
View File

@@ -0,0 +1,429 @@
##
## set8700 - dotest line tests for the 8700 set of regress.cal
##
## Copyright (C) 2006 Ernest Bowen 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.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
##
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
strcpy("", "") == ""
strcpy("", "xyz") == ""
strcpy("a", "xyz") == "x"
strcpy("ab", "xyz") == "xy"
strcpy("abc", "xyz") == "xyz"
strcpy("abcd", "xyz") == "xyz\0" ## Result will print as "xyz"
strcpy("abcde", "xyz") == "xyz\0e"
strcpy("abcdef", "xyz") == "xyz\0ef"
strcpy("abcdef", "x\0z") == "x\0z\0ef" ## Note z is copied
strcpy("abc", "") == "\0bc"
strncpy("abcdef", "xyz", 0) == "abcdef" ## No characters copied
strncpy("abcdef", "xyz", 1) == "xbcdef" ## One character copied, no '\0'
strncpy("abcdef", "xyz", 2) == "xycdef"
strncpy("abcdef", "xyz", 3) == "xyzdef"
strncpy("abcdef", "xyz", 4) == "xyz\0ef"
strncpy("abcdef", "xyz", 5) == "xyz\0\0f" ## Two nulls as in C
strncpy("abcdef", "xyz", 6) == "xyz\0\0\0"
strncpy("abcdef", "xyz", 7) == "xyz\0\0\0" ## Size of first string unchanged
strncpy("a\0cdef", "\0yz", 4) == "\0yz\0ef"
strncpy("ab", "xyz", 3) == "xy"
strcmp("", "") == 0
strcmp("", "a") == -1
strcmp("\n", "\n") == 0
strcmp("\0", "") == 1 ## '\0' treated like other characters
strcmp("ab", "") == 1
strcmp("ab", "a") == 1
strcmp("ab", "ab") == 0
strcmp("ab", "abc") == -1
strcmp("abc", "abb") == 1
strcmp("abc", "abc") == 0
strcmp("abc", "abd") == -1
strcmp("abc\0", "abc") == 1
strncmp("abc", "xyz", 0) == 0
strncmp("abc", "xyz", 1) == -1
strncmp("abc", "", 1) == 1
strncmp("abc", "a", 1) == 0
strncmp("", "", 2) == 0
strncmp("a", "a", 2) == 0
strncmp("a", "b", 2) == -1
strncmp("ab", "ab", 2) == 0
strncmp("ab", "ac", 2) == -1
strncmp("\0ac", "\0b", 2) == -1
strncmp("ab", "abc", 2) == 0
strncmp("abc", "abd", 2) == 0
strncmp("a", "a\0", 2) == -1
strncmp("a", "a", 3) == 0
strncmp("abc", "abd", 3) == -1
strncmp("\0\0\n", "\0\0\t", 3) == 1
str("abc") == "abc"
str("ab\0") == "ab"
str("a\0c") == "a"
str("\0bc") == ""
size("") == 0
size("a") == 1
size("\0") == 1
size("a\0") == 2
size("a\0b") == 3
strlen("\0") == 0
strlen("a\0") == 1
strlen("a\0b") == 1
0 * "abc" == ""
1 * "abc" == "abc"
2 * "abc" == "abcabc"
3 * "abc" == "abcabcabc"
1 * "" == ""
-1 * "abc" == "cba"
-2 * "abc" == "cbacba"
"abc" + "xyz" == "abcxyz"
"abc" - "xyz" == "abczyx"
substr("abcd",0,0) == ""
substr("abcd",0,1) == "a"
substr("abcd",0,2) == "ab"
substr("abcd",1,0) == ""
substr("abcd",1,1) == "a"
substr("abcd",1,2) == "ab"
substr("abcd",2,0) == ""
substr("abcd",2,1) == "b"
substr("abcd",2,2) == "bc";
substr("abcd",2,3) == "bcd";
substr("abcd",2,4) == "bcd";
substr("abcd",2,5) == "bcd"; ## substr stops at end of string
substr("abcd",4,0) == ""
substr("abcd",4,1) == "d"
substr("abcd",4,2) == "d"
substr("abcd",4,3) == "d"
substr("abcd",5,0) == ""
substr("abcd",5,1) == ""
substr("a\0c\0",2,2) == "\0c" ## '\0' treated like other characters
substr("a\0c\0",2,3) == "\0c\0"
#"" == 0 ## # operator counts number of bits
#"\0" == 0
# "a" == 3
# "ab" == 6 ## white space ignored
# "abc" == 10
# 27 == 4
# 0b1010111011 == 7
7 # 9 == 2 ## 7 # 9 = abs(7 - 9)
3/4 # 2/3 == 1/12
a = 5, a #= 2, a == 3
a #= 4, a == 1
## Binary # operator not defined for strings
protect(set8700_A) == 0
## Testing with one lvalue
isnull(protect(set8700_A,65))
protect(set8700_A) == 65
isnull(protect(set8700_A, -1))
protect(set8700_A) == 64
protect(set8700_A,-2), protect(set8700_A) == 64
protect(set8700_A,5), protect(set8700_A) == 69
protect(set8700_A,-4), protect(set8700_A) == 65
protect(set8700_A,0), protect(set8700_A) == 0
protect(set8700_A,1234), protect(set8700_A) == 1234
protect(set8700_A,-1234), protect(set8700_A) == 0
protect(set8700_A,65535), protect(set8700_A) == 65535
protect(set8700_A,-65535), protect(set8700_A) == 0
## Simple assignments
set8700_A = 42, protect(set8700_A,1024), set8700_B = set8700_A, protect(set8700_B) == 1024
set8700_A = 6 * 7, protect(set8700_A) == 1024
set8700_A == set8700_B
## Testing matrix protectioon
set8700_A = mat [3] = {1, 2, list(3,4)}; 1
protect(set8700_A, 65, 1), protect(set8700_A) == 1089
protect(set8700_A[0]) == 65
protect(set8700_A[2]) == 65
protect(set8700_A[2][1]) == 0
protect(set8700_A, 65, 2), protect(set8700_A[2][1]) == 65
protect(set8700_A,-1024), protect(set8700_A) == 65
protect(set8700_A, -1, 1), protect(set8700_A) == 64
protect(set8700_A[1]) == 64
protect(set8700_A[2]) == 64
protect(set8700_A[2][0]) == 65
protect(set8700_A,0), protect(set8700_A) == 0
protect(set8700_A[1]) == 64
protect(set8700_A, 0, 2), protect(set8700_A) == 0
protect(set8700_A[1]) == 0
protect(set8700_A[2][1]) == 0
protect(set8700_A,1024, 2), protect(set8700_A) == 1024
protect(set8700_A[2]) == 1024
protect(set8700_A[2][0], 512), protect(set8700_A[2][0]) == 1536
## Testing simple assignment of matrix
set8700_B = set8700_A, protect(set8700_B) == 1024 ## protect(set8700_A) copied
protect(set8700_B[2]) == 1024 ## protect(set8700_A[2]) copied
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
## copying matrix to list
set8700_B = list(5,6,7), protect(set8700_B) == 1024
protect(set8700_B[0]) == 0
protect(set8700_B[2]) == 0
protect(set8700_A,0), protect(set8700_A) == 0
copy(set8700_A,set8700_B), set8700_B[0] == 1 && set8700_B[1] == 2
set8700_B[2] == list(3,4)
protect(set8700_B) == 1024 ## protect(set8700_A) not copied
protect(set8700_B[0]) == 1024 ## protect(set8700_A[0]) copied
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
## copying matrix to matrix
set8700_B = mat[3], protect(set8700_B) == 1024
protect(set8700_B[2]) == 0
copy(set8700_A,set8700_B), set8700_B[0] == 1 && set8700_B[1] == 2
set8700_B[2] == list(3,4)
protect(set8700_B) == 1024 ## protect(set8700_A) not copied
protect(set8700_B[0]) == 1024 ## protect(set8700_A[0]) copied
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
## Testing list protection
set8700_A = list(1, 2, list(3,4)), 1
protect(set8700_A,1024, 2), protect(set8700_A) == 1024
protect(set8700_A[2]) == 1024
protect(set8700_A[2][0], 512), protect(set8700_A[2][0]) == 1536
## Simple assignment of list
set8700_B = set8700_A, protect(set8700_B) == 1024 ## protect(set8700_A) copied
protect(set8700_B[2]) == 1024 ## protect(set8700_A[2]) copied
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
## Copying list to list
set8700_B = list(5,6,7), protect(set8700_B) == 1024
protect(set8700_B[2]) == 0
copy(set8700_A,set8700_B), set8700_B[0] == 1 && set8700_B[1] == 2
set8700_B[2] == list(3,4)
protect(set8700_B) == 1024 ## protect(set8700_A) not copied
protect(set8700_B[0]) == 1024 ## protect(set8700_A[0]) copied
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
## Copying list to matrix
set8700_B = mat[3], protect(set8700_B) == 1024
protect(set8700_B[2]) == 0
copy(set8700_A,set8700_B), set8700_B[0] == 1 && set8700_B[1] == 2
set8700_B[2] == list(3,4)
protect(set8700_B) == 1024
protect(set8700_B[0]) == 1024 ## protect(set8700_A[0]) copied
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
## Protecting one element of a list
set8700_A = list(1,4,3,2), protect(set8700_A[1]) == 0
protect(set8700_A[1], 1024), protect(set8700_A[1]) == 1024
## Testing sort
set8700_A = sort(set8700_A), set8700_A == list(1,2,3,4)
protect(set8700_A[1]) == 0
protect(set8700_A[3]) == 1024 ## status of 4
## Testings reverse
set8700_A = reverse(set8700_A), set8700_A == list(4,3,2,1)
protect(set8700_A[0]) == 1024 ## status of 4
## Testing swap
swap(set8700_A[0], set8700_A[1]), set8700_A == list(3,4,2,1)
protect(set8700_A[0]) == 0 ## status moved
protect(set8700_A[1]) == 1024 ## 4 retains protection
## Testing list with protected list argument
protect(set8700_A, 0), protect(set8700_A) == 0
protect(set8700_A, 512), protect(set8700_A) == 512
protect(set8700_A[1]) == 1024
set8700_L = list(1,set8700_A,3), protect(set8700_L) == 0
protect(set8700_L[0]) == 0
protect(set8700_L[1]) == 512 ## protect(set8700_A) copied
protect(set8700_L[1][1]) == 1024 ## protect(set8700_A[1]) copied
## Testing list with "intialization"
set8700_L = list(1,2,3), protect(set8700_L) == 0
protect(set8700_L[0]) | protect(set8700_L[1]) | protect(set8700_L[2]) == 0 ## All zero
set8700_L = {1,set8700_A}, set8700_L[1] == set8700_A
protect(set8700_L[1]) == 512 ## protect(set8700_A) copied
protect(set8700_L[1][1]) == 1024 ## protect(set8700_A[1]) copied
set8700_L[1] = 2, protect(set8700_L[1]) == 512 ## Not changed
## Testing matrix with "initialization"
set8700_M = mat[3] = {1,set8700_A}, protect(set8700_M) == 0
protect(set8700_M[0]) == 0
protect(set8700_M[1]) == 512 ## protect(set8700_A) copied
protect(set8700_M[2]) == 0
protect(set8700_M[1][1]) == 1024 ## protect(set8700_A[1]) copied
## Testing push, pop, append, remove
set8700_A = list(1,2), protect(set8700_A,0,1), protect(set8700_A[0]) == 0
protect(set8700_A[0], 256), protect(set8700_A[0]) == 256
protect(set8700_A[1]) == 0
append(set8700_A, pop(set8700_A)), protect(set8700_A[0]) == 0
protect(set8700_A[1]) == 256
push(set8700_A, remove(set8700_A)), protect(set8700_A[0]) == 256
protect(set8700_A[1]) == 0
## Testing operation-assignments
set8700_A = 5, protect(set8700_A,1024), protect(set8700_A) == 1024
protect(set8700_A, 1024), set8700_A = 7, protect(set8700_A) == 1024
protect(set8700_A,1024), set8700_A += 2, protect(set8700_A) == 1024
protect(set8700_A,1024), set8700_A *= 2, protect(set8700_A) == 1024
protect(set8700_A,1024), set8700_A |= 2, protect(set8700_A) == 1024
protect(set8700_A,1024), set8700_A &= 2, protect(set8700_A) == 1024
protect(set8700_A,1024), set8700_A ^= 2, protect(set8700_A) == 1024
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
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)
protect(set8700_x, 1e6) == error(10235)
protect(set8700_x,1), (set8700_x = 2) == error(10366)
(set8700_x = 3 + 4) == error(10366)
protect(set8700_x,2), protect(set8700_x) == 3
protect(set8700_x,-1), protect(set8700_x) == 2
(set8700_x = 2) == error(10368)
(set8700_x = 3 + 4) == 7
protect(set8700_x,2), ++set8700_x == error(10379)
set8700_x == 7
--set8700_x == error(10382)
set8700_x == 7
set8700_x++ == error(10385)
set8700_x == 7
set8700_x-- == error(10388)
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
copy(set8700_B, set8700_A) == error(10226)
set8700_A == "abcdef" ## set8700_A not changed
protect(set8700_A,0), copy(set8700_B,set8700_A), set8700_A == "xyzdef"
protect(set8700_B,128), protect(set8700_B) == 128 ## No copy from set8700_B
copy(set8700_B,set8700_A,,,3) == error(10225)
set8700_A == "xyzdef"
protect(set8700_B,0), copy(set8700_B,set8700_A,,,3), set8700_A == "xyzxyz"
set8700_A = "abcdef", protect(set8700_A, 16), swap(set8700_A[0], set8700_A[5]) == error(10371)
set8700_A == "abcdef"
protect(set8700_A,0), isnull(swap(set8700_A[0], set8700_A[5]))
set8700_A == "fbcdea"
protect(set8700_A,2), ++set8700_A[0] == error(10377)
--set8700_A[1] == error(10380)
set8700_A[2]++ == error(10383)
set8700_A[3]-- == error(10386)
set8700_A == "fbcdea"
protect(set8700_A,0), ++set8700_A[0] == 'g'
--set8700_A[1] == 'a'
set8700_A[2]++ == ord('c')
set8700_A[3]-- == ord('d')
set8700_A == "gadcea"
protect(set8700_x,0), protect(set8700_y,0), protect(set8700_x,256), protect(set8700_y,512),1
quomod(11,4,set8700_x,set8700_y), set8700_x == 2 && set8700_y == 3
protect(set8700_x) == 256
protect(set8700_y) == 512
set8700_A = mat[3]; protect(set8700_A[0], 1024); protect(set8700_A[0]) == 1024
set8700_x = 7, protect(set8700_x,0), protect(set8700_x, 512), 1
set8700_A = {set8700_x,,set8700_x}, protect(set8700_A[0]) == 1536
protect(set8700_A[1]) == 0
protect(set8700_A[2]) == 512
protect(set8700_A,16), protect(set8700_A) == 16 ## No copy to
set8700_A == (mat[3] = {7,0,7})
set8700_A = {1,2,3}, errno() == 10390;
set8700_A == (mat[3] = {7,0,7})
protect(set8700_A,0), set8700_A = {1,2,3}, set8700_A == (mat[3] = {1,2,3})
protect(set8700_A[1],1), protect(set8700_A[1]) == 1
set8700_A = {4,5,6}, errno() == 10394
set8700_A == (mat[3] = {4,2,6})
modify(7, "set8700_f") == error(10405)
set8700_A = list(2,3,5), modify(set8700_A, 7) == error(10406)
protect(set8700_A,2), modify(set8700_A, "set8700_f") == error(10407)
protect(set8700_A,0), modify(set8700_A, "h") == error(10408)
set8700_B = 42, protect(set8700_B,0), modify(set8700_B, "set8700_f") == error(10409)
set8700_A == list(2,3,5) ## set8700_A not affected by failures
protect(set8700_A,0,1), modify(set8700_A, "set8700_f") == null()
set8700_A == list(4,9,25)
modify(set8700_A,"set8700_g") == null()
protect(set8700_A[0]) == 0
protect(set8700_A[1]) == 256 && protect(set8700_A[2]) == 256
set8700_A = 0, protect(set8700_A,0), set8700_A = pop(2), set8700_A == error(10181)
set8700_A = pop(list(1,2,3)), set8700_A == error(10181)
set8700_B = set8700_A = pop(2), set8700_B == error(10181)
set8700_A = 32, protect(set8700_A,8), (set8700_A = pop(2)) == error(10370)
set8700_A == 32
set8700_B = set8700_A = pop(2), set8700_B == error(10370)
## Testing copying of protected elements and initialization
set8700_M1 = mat[3], protect(set8700_M1,0), protect(set8700_M1[1],1), protect(set8700_M1[1]) == 1
set8700_M2 = mat[3], protect(set8700_M2,0), protect(set8700_M2[2],4), protect(set8700_M2[2]) == 4
set8700_L = list(set8700_M1, set8700_M2), protect(set8700_L[0][1]) == 1 && protect(set8700_L[1][2]) == 4
set8700_L = {{1,2,3},{'a','b','c'}}, set8700_L[0] == (mat[3] = {1,0,3})
set8700_L[1] == (mat[3] = {'a','b',0})
set8700_M = mat[2], protect(set8700_M,0), set8700_M = {1,2,3,4}, set8700_M == (mat[2] = {1,2})
set8700_x = 5, set8700_M = {set8700_x++, set8700_x++, set8700_x++, set8700_x++, set8700_x++}, set8700_M == (mat[2] = {5,6})
set8700_x == 10 ## All initialization terms evaluated
set8700_S = " ", set8700_S = {'a','b','c','d'}, set8700_S == "abc"
set8700_P = obj set8700_point = {1,2,3,4}, set8700_P.set8700_x == 1 && set8700_P.set8700_y == 2 && set8700_P.set8700_z == 3
protect(set8700_P,16), set8700_Q = set8700_P, set8700_Q = {5,6,7}, set8700_Q == set8700_P
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);

1469
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
*
* 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.4 $
* @(#) $Id: statistics.cal,v 30.4 2013/08/18 20:01:53 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

3120
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 @@
/*
* toomcook - implementation of Toom-Cook(3,4) multiplication algorithm
*
* Copyright (C) 2013 Christoph Zurnieden
*
* 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.4 $
* @(#) $Id: toomcook.cal,v 30.4 2013/08/18 20:01:53 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

116
cal/zeta2.cal Normal file
View File

@@ -0,0 +1,116 @@
/*
* zeta2 - Hurwitz Zeta function
*
* 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.4 $
* @(#) $Id: zeta2.cal,v 30.4 2013/08/18 20:01:53 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