mirror of
https://github.com/lcn2/calc.git
synced 2025-08-19 01:13:27 +03:00
Compare commits
142 Commits
Author | SHA1 | Date | |
---|---|---|---|
|
1cdb5172d8 | ||
|
54a7a3f7bc | ||
|
2ea77e6151 | ||
|
5cfa6199e5 | ||
|
da6ccc146f | ||
|
fcfe237375 | ||
|
5fb3db4558 | ||
|
c8705c1198 | ||
|
0558bafcb6 | ||
|
f58277f53d | ||
|
e555a718c0 | ||
|
b29fcf2dd5 | ||
|
4f86703843 | ||
|
07d8bf0f3e | ||
|
b4cd692bae | ||
|
83c898cc2b | ||
|
c585d7aa78 | ||
|
f42a003d04 | ||
|
8da0471f07 | ||
|
1c20261b93 | ||
|
aeb9a9d473 | ||
|
66883b390d | ||
|
ea533659ce | ||
|
9e81971f25 | ||
|
cbbd866535 | ||
|
bf23f82c29 | ||
|
ec5c584785 | ||
|
6bbb8c0e42 | ||
|
438554b0ed | ||
|
61ba4bc5c8 | ||
|
0145883396 | ||
|
f91bfaab70 | ||
|
36ab4fdc1b | ||
|
1cd89398ad | ||
|
bd3a381783 | ||
|
618f42c960 | ||
|
1363b58060 | ||
|
2c659f40ff | ||
|
4c243a69fe | ||
|
f80eee7a09 | ||
|
a044b9325b | ||
|
c028ea478f | ||
|
62bdba6d22 | ||
|
4d9511243c | ||
|
188fd372ea | ||
|
44ffb0eec9 | ||
|
beb13bf89f | ||
|
a31078bbec | ||
|
7ae4f4009c | ||
|
40fc854006 | ||
|
8dd7a3cd2a | ||
|
2726ae9d23 | ||
|
d25186fc52 | ||
|
28d1e35362 | ||
|
1ae2f953d3 | ||
|
ed4b56d1ec | ||
|
cc2f6f7b85 | ||
|
57a22a6f39 | ||
|
85bfa30897 | ||
|
17e3535595 | ||
|
7f125396c1 | ||
|
7cf611bca8 | ||
|
c9fce6a5bb | ||
|
a1c96f95a6 | ||
|
5e6b3cbd3f | ||
|
5bada5fefd | ||
|
0c20c96a7e | ||
|
e054ea87f2 | ||
|
e229393250 | ||
|
a407c7d197 | ||
|
9ea569152a | ||
|
cbcb5801fb | ||
|
bdf495150e | ||
|
b3648f030f | ||
|
71e88bdc91 | ||
|
ca0dd4560b | ||
|
f62d9fa1e6 | ||
|
253b47942f | ||
|
c773ee736f | ||
|
7d0cc52afe | ||
|
2441df7fdc | ||
|
5c565a7cea | ||
|
810e541281 | ||
|
ee30d787ea | ||
|
4e92927183 | ||
|
fb4a03c1f1 | ||
|
81a523043e | ||
|
2c0d0bbc1b | ||
|
a7147039ee | ||
|
6fa83e417e | ||
|
c335809b5f | ||
|
ee99adf8ca | ||
|
87570b56fe | ||
|
afe37ec851 | ||
|
bd3086138b | ||
|
9d62873a02 | ||
|
23a5fc3ede | ||
|
58d94b08d8 | ||
|
7165fa17c7 | ||
|
64a732b678 | ||
|
a6a37f9cad | ||
|
42b089a87c | ||
|
8c5e9e62fa | ||
|
29e956819c | ||
|
66c3d26611 | ||
|
b4952bd44f | ||
|
0d06d90751 | ||
|
e1a3dfda0b | ||
|
8db4e7af47 | ||
|
bb5c624382 | ||
|
8aedcf801a | ||
|
b60eec99bb | ||
|
383290a844 | ||
|
7e40db44e3 | ||
|
a57ee19ca5 | ||
|
a6e226fa80 | ||
|
86e0f98c8f | ||
|
e4dcbf7ecf | ||
|
10c0bd2d95 | ||
|
ad44f1e3ab | ||
|
fd436d7c15 | ||
|
d2cb9c81d5 | ||
|
a0aba073a6 | ||
|
59837e385c | ||
|
bea726fc16 | ||
|
fc0a3dd183 | ||
|
63d9b22067 | ||
|
fc85ac3791 | ||
|
3d55811205 | ||
|
296aa50ac7 | ||
|
5e098d2adf | ||
|
ae2a752314 | ||
|
61dd47526f | ||
|
417ffb6ab5 | ||
|
121b8f72c6 | ||
|
9968a69f50 | ||
|
1ea579d929 | ||
|
0521ed202f | ||
|
6f5e8bf1b6 | ||
|
f3913609ea | ||
|
0514dc0de9 | ||
|
94e35d9b07 |
100
.gitignore
vendored
Normal file
100
.gitignore
vendored
Normal file
@@ -0,0 +1,100 @@
|
||||
# files and directories created during the building of calc and other Makefile actions
|
||||
#
|
||||
# NOTE: While many of these might be part of a released calc tarball, they are
|
||||
# not consider development source. Some other file(s) and/or programs
|
||||
# generate these files.
|
||||
#
|
||||
.dynamic
|
||||
.hsrc
|
||||
Makefile.simple
|
||||
NOTES
|
||||
align32.h
|
||||
args.h
|
||||
cal/.all
|
||||
calc
|
||||
calc.1
|
||||
calc.usage
|
||||
calcerr.c
|
||||
calcerr.h
|
||||
conf.h
|
||||
cscript/.all
|
||||
cscript/4dsphere
|
||||
cscript/README
|
||||
cscript/fproduct
|
||||
cscript/mersenne
|
||||
cscript/piforever
|
||||
cscript/plus
|
||||
cscript/powerterm
|
||||
cscript/simple
|
||||
cscript/square
|
||||
custom/.all
|
||||
custom/Makefile.simple
|
||||
custom/libcustcalc*
|
||||
endian
|
||||
endian_calc.h
|
||||
fposval.h
|
||||
have_const.h
|
||||
have_fpos.h
|
||||
have_fpos_pos.h
|
||||
have_getpgid.h
|
||||
have_getprid.h
|
||||
have_getsid.h
|
||||
have_gettime.h
|
||||
have_memmv.h
|
||||
have_newstr.h
|
||||
have_offscl.h
|
||||
have_posscl.h
|
||||
have_rusage.h
|
||||
have_stdlib.h
|
||||
have_stdvs
|
||||
have_strdup.h
|
||||
have_string.h
|
||||
have_times.h
|
||||
have_uid_t.h
|
||||
have_unistd.h
|
||||
have_unused.h
|
||||
have_urandom.h
|
||||
have_ustat.h
|
||||
help/.all
|
||||
help/COPYING
|
||||
help/COPYING-LGPL
|
||||
help/binding
|
||||
help/bindings
|
||||
help/bug
|
||||
help/bugs
|
||||
help/builtin
|
||||
help/change
|
||||
help/changes
|
||||
help/copy
|
||||
help/cscript
|
||||
help/custom_cal
|
||||
help/errorcode
|
||||
help/errorcodes
|
||||
help/full
|
||||
help/funclist
|
||||
help/funclist.c
|
||||
help/libcalc
|
||||
help/man
|
||||
help/new_custom
|
||||
help/resource
|
||||
help/type
|
||||
help/usage
|
||||
libcalc*
|
||||
libcustcalc*
|
||||
longbits
|
||||
longbits.h
|
||||
sample_many
|
||||
sample_rand
|
||||
terminal.h
|
||||
ver_calc
|
||||
|
||||
# other commonly excluded patterns
|
||||
#
|
||||
*~
|
||||
*.BAK
|
||||
core*
|
||||
.DS_Store
|
||||
*.dSYM/
|
||||
*.[oa]
|
||||
.*.swp
|
||||
*,v
|
181
BUGS
181
BUGS
@@ -20,26 +20,43 @@ configuration, try backing them out and see if things get better.
|
||||
|
||||
To be sure that your version of calc is up to date, check out:
|
||||
|
||||
http://reality.sgi.com/chongo/tech/comp/calc/calc-download.html
|
||||
http://www.isthe.com/chongo/tech/comp/calc/calc-download.html
|
||||
|
||||
The calc web site is located at:
|
||||
|
||||
http://reality.sgi.com/chongo/tech/comp/calc/index.html
|
||||
http://www.isthe.com/chongo/tech/comp/calc/index.html
|
||||
|
||||
=-=
|
||||
|
||||
If you have tried all of the above and things still are not right,
|
||||
then it may be time to send in a bug report. You can send bug reports to:
|
||||
then it may be time to send in a bug report. You can send bug
|
||||
and bug fixes reports to:
|
||||
|
||||
calc-bugs at postofc dot corp dot sgi dot com
|
||||
calc-bug-report at asthe dot com
|
||||
|
||||
[[ Replace 'at' with @, 'dot' is with . and remove the spaces ]]
|
||||
NOTE: Remove spaces and replace 'at' with @, 'dot' with .
|
||||
|
||||
This replaces the old calc-bugs at asthe dot com address.
|
||||
|
||||
To be sure we see your EMail reporting a calc bug, please use the
|
||||
following phase in your EMail Subject line:
|
||||
|
||||
calc bug report
|
||||
|
||||
That phrase in your subject line will help ensure your request
|
||||
will get past our anti-spam filters. You may have additional
|
||||
words in your subject line.
|
||||
|
||||
However, you may find it more helpful to simply subscribe
|
||||
to the calc-tester mailing list (see below) and then to
|
||||
send your report to that mailing list as a wider set calc
|
||||
testers may be able to help you.
|
||||
|
||||
When you send your report, please include the following information:
|
||||
|
||||
* a description of the problem
|
||||
* the version of calc you are using (if you cannot get calc
|
||||
it to run, then send us the 4 #define lines from version.c)
|
||||
to run, then send us the 4 #define lines from version.c)
|
||||
* if you modified calc from an official patch, send me the mods you made
|
||||
* the type of system you were using
|
||||
* the type of compiler you were using
|
||||
@@ -53,115 +70,97 @@ When you send your report, please include the following information:
|
||||
|
||||
Stack traces from core dumps are useful to send as well.
|
||||
|
||||
=-=
|
||||
|
||||
Send any comments, compiler warning messages, suggestions and most
|
||||
importantly, fixes (in the form of a context diff patch) to:
|
||||
|
||||
calc-tester at postofc dot corp dot sgi dot com
|
||||
|
||||
[[ Replace 'at' with @, 'dot' is with . and remove the spaces ]]
|
||||
|
||||
You should use the above calc-bugs address for bug reports, if you are
|
||||
not currently a member of the calc-tester mailing list.
|
||||
Fell free to use the above address to send in big fixes (in the form
|
||||
of a context diff patch).
|
||||
|
||||
=-=
|
||||
|
||||
Known bugs:
|
||||
|
||||
The output of the alg_config.cal resource file is bogus.
|
||||
We would welcome a replacement for this code.
|
||||
|
||||
We are sure some more bugs exist. When you find them, please let
|
||||
us know! See the above for details on how to report and were to
|
||||
EMail your bug reports and hopefully patches to fix them.
|
||||
|
||||
=-=
|
||||
|
||||
Problems with known work-a-rounds:
|
||||
mis-features in calc:
|
||||
|
||||
* 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.
|
||||
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.
|
||||
|
||||
* 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,:
|
||||
* When statement is of the form { ... }, the leading { MUST BE ON
|
||||
THE SAME LINE as the if, for, while or do keyword.
|
||||
|
||||
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}
|
||||
This works as expected:
|
||||
|
||||
* There is a bug in some versions of the Dec/Compaq cc for the Alpha
|
||||
where the following:
|
||||
if (expr) {
|
||||
...
|
||||
}
|
||||
|
||||
#include <stdio.h>
|
||||
#define SVAL(a,b) (unsigned long)(0x ## a ## b ## ULL)
|
||||
main(){SVAL(b8a8aeb0,8168eadc);}
|
||||
However this WILL NOT WORK AS EXPECTED:
|
||||
|
||||
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.
|
||||
if (expr)
|
||||
{
|
||||
...
|
||||
}
|
||||
|
||||
* 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:
|
||||
This needs to be changed. See also "help statement", "help unexpected",
|
||||
and "help todo".
|
||||
|
||||
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
|
||||
...
|
||||
* The chi.cal resource file does not work well with odd degrees
|
||||
of freedom. Can someone improve this algorithm?
|
||||
|
||||
it finally hangs at test 2000.
|
||||
* The intfile.cal resource file reads and writes big or little Endian
|
||||
integers to/from files the hard way. It does NOT use blkcpy. The
|
||||
following code:
|
||||
|
||||
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:
|
||||
i = (ord("\n") << 16) | (ord("i") << 8) | ord("H")
|
||||
b = blk()
|
||||
copy(i, b)
|
||||
fd = fopen("file", "w")
|
||||
copy(b, fd);
|
||||
fclose(fd)
|
||||
|
||||
DEBUG= -g
|
||||
will write an extra NUL octet to the file. Where as:
|
||||
|
||||
* 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.
|
||||
read intfile
|
||||
i = (ord("\n") << 16) | (ord("i") << 8) | ord("H")
|
||||
be2file(i, "file2")
|
||||
|
||||
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:
|
||||
will not.
|
||||
|
||||
LCC="cc -xarch=v9"
|
||||
CCWARN="-DFORCE_STDC -w"
|
||||
DEBUG="-fast -xarch=v9"
|
||||
=-=
|
||||
|
||||
* Under BSDI v4, the warnings of the form:
|
||||
To subscribe to the calc-tester mailing list, visit the following URL:
|
||||
|
||||
/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
|
||||
http://www.isthe.com/chongo/tech/comp/calc/calc-tester.html
|
||||
|
||||
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.
|
||||
This is a low volume moderated mailing list.
|
||||
|
||||
## Copyright (C) 1999 Landon Curt Noll
|
||||
This mailing list replaces calc-tester at asthe dot com list.
|
||||
|
||||
If you need a human to help you with your mailing list subscription,
|
||||
please send EMail to our special:
|
||||
|
||||
calc-tester-maillist-help at asthe dot com
|
||||
|
||||
NOTE: Remove spaces and replace 'at' with @, 'dot' with .
|
||||
|
||||
address. To be sure we see your EMail asking for help with your
|
||||
mailing list subscription, please use the following phase in your
|
||||
EMail Subject line:
|
||||
|
||||
calc tester mailing list help
|
||||
|
||||
That phrase in your subject line will help ensure your
|
||||
request will get past our anti-spam filters. You may have
|
||||
additional words in your subject line.
|
||||
|
||||
## Copyright (C) 1999-2014 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
|
||||
@@ -175,14 +174,10 @@ Problems with 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.
|
||||
##
|
||||
## @(#) $Revision: 29.1 $
|
||||
## @(#) $Id: BUGS,v 29.1 1999/12/14 09:15:29 chongo Exp $
|
||||
## @(#) $Source: /usr/local/src/cmd/calc/RCS/BUGS,v $
|
||||
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
##
|
||||
## Under source code control: 1994/03/18 14:06:13
|
||||
## File existed as early as: 1994
|
||||
##
|
||||
## chongo <was here> /\oo/\ http://reality.sgi.com/chongo/
|
||||
## Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
|
103
COPYING
103
COPYING
@@ -6,17 +6,13 @@ This file is Copyrighted
|
||||
|
||||
This file is covered under the following Copyright:
|
||||
|
||||
Copyright (C) 1999 Landon Curt Noll
|
||||
Copyright (C) 1999-2014 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.1 $
|
||||
# @(#) $Id: COPYING,v 29.1 1999/12/14 09:15:29 chongo Exp $
|
||||
# @(#) $Source: /usr/local/src/cmd/calc/RCS/COPYING,v $
|
||||
|
||||
=-=
|
||||
-=-
|
||||
|
||||
Calc is covered by the GNU Lesser General Public License
|
||||
--------------------------------------------------------
|
||||
@@ -45,28 +41,72 @@ 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:
|
||||
To subscribe to the calc-tester mailing list, visit the following URL:
|
||||
|
||||
Web: http://reality.sgi.com/chongo/tech/comp/calc/index.html
|
||||
http://www.isthe.com/chongo/tech/comp/calc/index.html
|
||||
http://www.isthe.com/chongo/tech/comp/calc/calc-tester.html
|
||||
|
||||
EMail: calc-tester at postofc dot corp dot sgi dot com
|
||||
calc-tester at isthe dot com
|
||||
This is a low volume moderated mailing list.
|
||||
|
||||
[[ Replace 'at' with @, 'dot' is with . and remove spaces ]]
|
||||
This mailing list replaces calc-tester at asthe dot com list.
|
||||
|
||||
The 2nd address set is provided in case the 1st address set no
|
||||
longer functions.
|
||||
If you need a human to help you with your mailing list subscription,
|
||||
please send EMail to our special:
|
||||
|
||||
=-=
|
||||
calc-tester-maillist-help at asthe dot com
|
||||
|
||||
NOTE: Remove spaces and replace 'at' with @, 'dot' with .
|
||||
|
||||
address. To be sure we see your EMail asking for help with your
|
||||
mailing list subscription, please use the following phase in your
|
||||
EMail Subject line:
|
||||
|
||||
calc tester mailing list help
|
||||
|
||||
That phrase in your subject line will help ensure your
|
||||
request will get past our anti-spam filters. You may have
|
||||
additional words in your subject line.
|
||||
|
||||
-=-
|
||||
|
||||
Calc bug reports and calc bug fixes should be sent to:
|
||||
|
||||
calc-bug-report at asthe dot com
|
||||
|
||||
NOTE: Remove spaces and replace 'at' with @, 'dot' with .
|
||||
|
||||
This replaces the old calc-bugs at asthe dot com address.
|
||||
|
||||
To be sure we see your EMail reporting a calc bug, please use the
|
||||
following phase in your EMail Subject line:
|
||||
|
||||
calc bug report
|
||||
|
||||
That phrase in your subject line will help ensure your
|
||||
request will get past our anti-spam filters. You may have
|
||||
additional words in your subject line.
|
||||
|
||||
However, you may find it more helpful to simply subscribe
|
||||
to the calc-tester mailing list (see above) and then to
|
||||
send your report to that mailing list as a wider set calc
|
||||
testers may be able to help you.
|
||||
|
||||
-=-
|
||||
|
||||
The calc web site is located at:
|
||||
|
||||
http://www.isthe.com/chongo/tech/comp/calc/
|
||||
|
||||
NOTE: The EMail address uses 'asthe', while the web site uses 'isthe'.
|
||||
|
||||
-=-
|
||||
|
||||
Calc's relationship to the GNU Lesser General Public License
|
||||
------------------------------------------------------------
|
||||
@@ -122,13 +162,13 @@ 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
|
||||
-----------------------------------
|
||||
|
||||
With the exception of the files listed below, Calc is covered under
|
||||
the following Copyrights:
|
||||
the following GNU Lesser General Public License Copyrights:
|
||||
|
||||
Copyright (C) year David I. Bell
|
||||
Copyright (C) year David I. Bell and Landon Curt Noll
|
||||
@@ -137,13 +177,13 @@ Calc copyrights and exception files
|
||||
Copyright (C) year Landon Curt Noll
|
||||
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
|
||||
|
||||
A few files are not covered under the GNU Lesser General Public
|
||||
License. The source files not covered are:
|
||||
These files are not covered under one of the Copyrights listed above:
|
||||
|
||||
shs1.c shs1.h shs.c shs.h
|
||||
md5.c md5.h lib/qtime.cal COPYING
|
||||
COPYING-LGPL
|
||||
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
|
||||
@@ -155,7 +195,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 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
|
||||
---------------------------------
|
||||
@@ -169,7 +216,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
|
||||
---------------------------------------------------
|
||||
|
23
COPYING-LGPL
23
COPYING-LGPL
@@ -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!
|
||||
|
||||
|
||||
|
213
HOWTO.INSTALL
213
HOWTO.INSTALL
@@ -1,34 +1,168 @@
|
||||
Installing calc in 4 easy steps:
|
||||
Installing calc from the bzip2-ed tarball in 4 easy steps:
|
||||
|
||||
1) Look at the makefile, and adjust it to suit your needs.
|
||||
0) If your platform supports i686 RPMs, you may want to go to:
|
||||
|
||||
Here are some Makefile hints:
|
||||
http://www.isthe.com/chongo/src/calc/
|
||||
|
||||
Select a compiler set by commenting in the appropriate set
|
||||
of cc options. As shipped the Makefile assumes a gcc-like
|
||||
environment such as Linux. If a more appropriate cc set if
|
||||
found below, comment out the Linux set and comment in that
|
||||
set or edit the gcc set or the common cc set as needed.
|
||||
and use these RPMs:
|
||||
|
||||
You may or may not need RANLIB when building libraries.
|
||||
As shipped the Makefile assumes RANLIB is needed.
|
||||
Comment the in/out the RANLIB value if ranlib does
|
||||
not work or does not exist.
|
||||
* calc*.i686.rpm
|
||||
- all that is needed if you just want to use calc
|
||||
|
||||
You may want to change the default pager used by calc.
|
||||
As shipped the Makefile assumes 'more'. On your system
|
||||
you may find 'less' to be a better pager.
|
||||
* calc-devel-*.i686.rpm
|
||||
- calc *.h header and *.a lib files for use in other programs
|
||||
|
||||
Set TOPDIR to be the place under which help files, calc,
|
||||
include files and calc libs are to be installed. As shipped
|
||||
the Makefile assumes a TOPDIR of /usr/local/lib.
|
||||
* calc.*.src.rpm
|
||||
- calc source in RPM package form
|
||||
|
||||
Set BINDIR to the place where calc is installed. As shipped
|
||||
the Makefile assumes a BINDIR /usr/local/bin.
|
||||
The following 4 steps apply to calc source tree that comes from either:
|
||||
|
||||
bunzip2 -c calc-*.tar.bz2 | tar -xvf -
|
||||
|
||||
or from:
|
||||
|
||||
rpm -ivh calc-*.src.rpm
|
||||
cd /var/tmp
|
||||
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.
|
||||
|
||||
Some report that under macOS, one has to declare the target
|
||||
to be darwin. So for macOS, one might have to do:
|
||||
|
||||
# for macOS users only, force the target to be darwin
|
||||
#
|
||||
make target=Darwin clobber
|
||||
make target=Darwin all
|
||||
make target=Darwin chk
|
||||
make target=Darwin install
|
||||
|
||||
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'
|
||||
suggestion.
|
||||
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! If you are building under Windoz or a Windoz-like environment !
|
||||
! (such as Cygwin or DJGPP), read the README.WINDOWS file. !
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
You should determine if these Makefile variables are reasonable:
|
||||
|
||||
INCDIR Where the system include (.h) files are kept.
|
||||
BINDIR Where to install calc binary files.
|
||||
LIBDIR Where to install calc link library (*.a) files.
|
||||
CALC_SHAREDIR Where to install calc help, .cal, startup, and
|
||||
config files.
|
||||
|
||||
You may want to change the default installation locations for
|
||||
these values, which are based on the 4 values listed above:
|
||||
|
||||
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
|
||||
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
|
||||
to install calc somewhere other than into the system area.
|
||||
|
||||
For example, if:
|
||||
|
||||
BINDIR= /usr/bin
|
||||
LIBDIR= /usr/lib
|
||||
CALC_SHAREDIR= /usr/share/calc
|
||||
|
||||
and if:
|
||||
|
||||
T= /var/tmp/testing
|
||||
|
||||
Then the installation locations will be:
|
||||
|
||||
calc binary files: /var/tmp/testing/usr/bin
|
||||
calc link library: /var/tmp/testing/usr/lib
|
||||
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.
|
||||
|
||||
Look for the section that starts:
|
||||
|
||||
################
|
||||
# compiler set #
|
||||
################
|
||||
|
||||
Select a compiler set by commenting in the appropriate set
|
||||
of cc options. As shipped the Makefile assumes a gcc-like
|
||||
environment such as Linux. If a more appropriate cc set if
|
||||
found below, comment out the Linux set and comment in that
|
||||
set or edit the gcc set or the common cc set as needed.
|
||||
|
||||
You may want to change these Makrfile variables from their defaults:
|
||||
|
||||
RANLIB
|
||||
|
||||
You may or may not need RANLIB when building libraries.
|
||||
As shipped the Makefile assumes RANLIB is needed.
|
||||
Comment the in/out the RANLIB value if ranlib does
|
||||
not work or does not exist.
|
||||
|
||||
CALCPAGER
|
||||
|
||||
You may want to change the default pager used by calc.
|
||||
As shipped the Makefile assumes 'more'. On your system
|
||||
you may find 'less' to be a better pager.
|
||||
|
||||
DEBUG
|
||||
|
||||
Some compilers (to put it mildly) have bugs. Sometimes the
|
||||
DEBUG Makefile variable causes the compiler / optimizer to
|
||||
produce bad code. Other compilers do just fine.
|
||||
|
||||
If possible try to use DEBUG=-O3 -g3 (maximum optimization
|
||||
and debug symbols). If the calc test fails (see step 3),
|
||||
try lowering either the -O value and/or the -g3. Also try
|
||||
using -Osomething without -g.
|
||||
|
||||
Adjust other Makefile variables as needed.
|
||||
|
||||
2) build calc:
|
||||
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
|
||||
|
||||
@@ -36,20 +170,35 @@ Installing calc in 4 easy steps:
|
||||
you may find. See the BUGS file if you find any compiler
|
||||
warning or errors.
|
||||
|
||||
3) test calc:
|
||||
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
|
||||
|
||||
==> If you run into problems, follow the BUGS file instructions.
|
||||
==> If you run into problems, read the BUGS file and follow
|
||||
the instructions found in there.
|
||||
|
||||
4) install calc:
|
||||
NOTE: For a quiet check which only prints if something goes wrong:
|
||||
|
||||
make chk
|
||||
|
||||
4) install calc:
|
||||
|
||||
make install
|
||||
|
||||
We suggest that you might want to read the README file and look at
|
||||
the calc help subsystem. See the README file for details.
|
||||
We suggest that you might want to read the README.FIRST file and look at
|
||||
the calc help subsystem. See also the README.md file.
|
||||
|
||||
## 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
|
||||
@@ -63,14 +212,10 @@ 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.
|
||||
##
|
||||
## @(#) $Revision: 29.1 $
|
||||
## @(#) $Id: HOWTO.INSTALL,v 29.1 1999/12/14 09:15:29 chongo Exp $
|
||||
## @(#) $Source: /usr/local/src/cmd/calc/RCS/HOWTO.INSTALL,v $
|
||||
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
##
|
||||
## Under source code control: 1999/09/27 20:48:44
|
||||
## File existed as early as: 1999
|
||||
##
|
||||
## chongo <was here> /\oo/\ http://reality.sgi.com/chongo/
|
||||
## Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
|
275
LIBRARY
275
LIBRARY
@@ -48,78 +48,245 @@ convenient for outside use. So you should read the source for a routine
|
||||
to see if it really does what you think it does. I won't guarantee that
|
||||
obscure internal routines won't change or disappear in future releases!
|
||||
|
||||
When calc is installed, all of the include files needed to build
|
||||
libcalc.a along with the link library itself are installed into ${LIBDIR}.
|
||||
When calc is installed, all of libraries are installed into ${LIBDIR}.
|
||||
All of the calc header files are installed under ${INCDIRCALC}.
|
||||
|
||||
If CALC_SRC is defined, then the calc header files will assume that
|
||||
they are in or under the current directory. However, most external
|
||||
programs most likely will not be located under calc'c source tree.
|
||||
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:
|
||||
|
||||
-I${LIBDIR} -L${LIBDIR} -lcalc
|
||||
-I${INCDIR} -L${LIBDIR} -lcalc
|
||||
|
||||
--------------
|
||||
ERROR HANDLING
|
||||
--------------
|
||||
If custom functions are also used, they may want to compile with:
|
||||
|
||||
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:
|
||||
-I${INCDIR} -L${LIBDIR} -lcalc -lcustcalc
|
||||
|
||||
math_error("Division by zero");
|
||||
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:
|
||||
|
||||
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.
|
||||
-UCALC_SRC
|
||||
|
||||
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.
|
||||
as well.
|
||||
|
||||
External programs that wish to use this math_error may want to compile with:
|
||||
-------------------
|
||||
MATH ERROR HANDLING
|
||||
-------------------
|
||||
|
||||
-I${LIBDIR} -L${LIBDIR} -lcalc
|
||||
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:
|
||||
|
||||
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.
|
||||
void math_error(char *fmt, ...);
|
||||
|
||||
For example:
|
||||
Your program must handle math errors in one of three ways:
|
||||
|
||||
#include <setjmp.h>
|
||||
1) Print the error message and then exit
|
||||
|
||||
extern jmp_buf calc_jmp_buf;
|
||||
extern int calc_jmp;
|
||||
extern char *calc_error;
|
||||
int error;
|
||||
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.
|
||||
|
||||
...
|
||||
2) Use setjmp and longjmp in your program
|
||||
|
||||
if ((error = setjmp(calc_jmp_buf)) != 0) {
|
||||
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.
|
||||
|
||||
/* reinitialize calc after a longjmp */
|
||||
reinitialize();
|
||||
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.
|
||||
|
||||
For example:
|
||||
|
||||
#include <setjmp.h>
|
||||
#include "lib_calc.h"
|
||||
|
||||
int error;
|
||||
|
||||
...
|
||||
|
||||
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.
|
||||
@@ -469,14 +636,10 @@ 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.
|
||||
##
|
||||
## @(#) $Revision: 29.1 $
|
||||
## @(#) $Id: LIBRARY,v 29.1 1999/12/14 09:15:29 chongo Exp $
|
||||
## @(#) $Source: /usr/local/src/cmd/calc/RCS/LIBRARY,v $
|
||||
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
##
|
||||
## Under source code control: 1993/07/30 19:44:49
|
||||
## File existed as early as: 1993
|
||||
##
|
||||
## chongo <was here> /\oo/\ http://reality.sgi.com/chongo/
|
||||
## Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
|
6259
Makefile.ship
Normal file
6259
Makefile.ship
Normal file
File diff suppressed because it is too large
Load Diff
@@ -4,7 +4,7 @@ See the HOWTO.INSTALL file for information on how to build and install calc.
|
||||
|
||||
To be sure that your version of calc is up to date, check out:
|
||||
|
||||
http://reality.sgi.com/chongo/tech/comp/calc/calc-download.html
|
||||
http://www.isthe.com/chongo/tech/comp/calc/calc-download.html
|
||||
|
||||
We are interested in any/all feedback on recent versions of calc.
|
||||
In particular we would like to hear about:
|
||||
@@ -73,34 +73,64 @@ for a wish/todo list. Code contributions are welcome.
|
||||
|
||||
=-=
|
||||
|
||||
To join the calc-tester mailing list. Send a request to:
|
||||
To subscribe to the calc-tester mailing list, visit the following URL:
|
||||
|
||||
calc-tester-request at postofc dot corp dot sgi dot com
|
||||
http://www.isthe.com/chongo/tech/comp/calc/calc-tester.html
|
||||
|
||||
[[ Replace 'at' with @, 'dot' is with . and remove the spaces ]]
|
||||
This is a low volume moderated mailing list.
|
||||
|
||||
Your message body (not the subject) should consist of:
|
||||
This mailing list replaces calc-tester at asthe dot com list.
|
||||
|
||||
subscribe calc-tester address
|
||||
end
|
||||
name your_full_name
|
||||
If you need a human to help you with your mailing list subscription,
|
||||
please send EMail to our special:
|
||||
|
||||
where ``address'' is your EMail address and ``your_full_name'' is
|
||||
your full name.
|
||||
calc-tester-maillist-help at asthe dot com
|
||||
|
||||
Calc bug reports, however should be sent to:
|
||||
NOTE: Remove spaces and replace 'at' with @, 'dot' with .
|
||||
|
||||
calc-bugs at postofc dot corp dot sgi dot com
|
||||
address. To be sure we see your EMail asking for help with your
|
||||
mailing list subscription, please use the following phase in your
|
||||
EMail Subject line:
|
||||
|
||||
[[ Replace 'at' with @, 'dot' is with . and remove the spaces ]]
|
||||
calc tester mailing list help
|
||||
|
||||
but see the BUGS file first.
|
||||
That phrase in your subject line will help ensure your
|
||||
request will get past our anti-spam filters. You may have
|
||||
additional words in your subject line.
|
||||
|
||||
-=-
|
||||
|
||||
Calc bug reports and calc bug fixes should be sent to:
|
||||
|
||||
calc-bug-report at asthe dot com
|
||||
|
||||
NOTE: Remove spaces and replace 'at' with @, 'dot' with .
|
||||
|
||||
This replaces the old calc-bugs at asthe dot com address.
|
||||
|
||||
To be sure we see your EMail reporting a calc bug, please use the
|
||||
following phase in your EMail Subject line:
|
||||
|
||||
calc bug report
|
||||
|
||||
That phrase in your subject line will help ensure your
|
||||
request will get past our anti-spam filters. You may have
|
||||
additional words in your subject line.
|
||||
|
||||
However, you may find it more helpful to simply subscribe
|
||||
to the calc-tester mailing list (see above) and then to
|
||||
send your report to that mailing list as a wider set calc
|
||||
testers may be able to help you.
|
||||
|
||||
-=-
|
||||
|
||||
The calc web site is located at:
|
||||
|
||||
http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
http://www.isthe.com/chongo/tech/comp/calc/
|
||||
|
||||
## Copyright (C) 1999 Landon Curt Noll
|
||||
NOTE: The EMail address uses 'asthe', while the web site uses 'isthe'.
|
||||
|
||||
## Copyright (C) 1999,2014,2017 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
|
||||
@@ -114,14 +144,10 @@ 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.
|
||||
##
|
||||
## @(#) $Revision: 29.1 $
|
||||
## @(#) $Id: README,v 29.1 1999/12/14 09:15:29 chongo Exp $
|
||||
## @(#) $Source: /usr/local/src/cmd/calc/RCS/README,v $
|
||||
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
##
|
||||
## Under source code control: 1995/10/25 05:27:59
|
||||
## File existed as early as: 1995
|
||||
##
|
||||
## chongo <was here> /\oo/\ http://reality.sgi.com/chongo/
|
||||
## Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
164
README.WINDOWS
Normal file
164
README.WINDOWS
Normal file
@@ -0,0 +1,164 @@
|
||||
Dear calc user on a Windoz based system,
|
||||
|
||||
See the HOWTO.INSTALL file for information on how to build and install calc.
|
||||
See also the README file.
|
||||
|
||||
NOTE: The main developers do not have access to a Windoz based platform.
|
||||
While we will make an effort to not break calc Windoz based system,
|
||||
our lack of a Windoz test environment will mean we will make mistakes
|
||||
from time to time. Hopefully Windowz users can overcome these mistakes.
|
||||
Of course you are welcome to send us any patches that fix your
|
||||
Windoz build environment.
|
||||
|
||||
|
||||
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
|
||||
=-= compiling with Windows Subsystem for Linux (WSL) =-Cygwin =-=
|
||||
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
|
||||
|
||||
It has been reported that calc version 2.12.6.4 has been successfully
|
||||
compiled, installed and running on Windows 10 on 2018 Jan 21.
|
||||
|
||||
We were told:
|
||||
|
||||
"The Windows Subsystem for Linux (WSL) is a new Windows 10 feature that
|
||||
enables you to run native Linux command-line tools directly on Windows"
|
||||
|
||||
https://docs.microsoft.com/cs-cz/windows/wsl/about
|
||||
|
||||
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
|
||||
=-= 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 =-=
|
||||
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
|
||||
|
||||
You might want to try using the DJGPP system to compile calc. See:
|
||||
|
||||
http://www.delorie.com/djgpp/
|
||||
|
||||
for DJGPP details and availability.
|
||||
|
||||
To compile with DJGPP, one needs to select a number of Makefile
|
||||
variable changes. Eli Zaretskii <eliz at is dot elta dot co dot il>
|
||||
recommends the following settings:
|
||||
|
||||
TERMCONTROL= -DUSE_TERMIOS
|
||||
BYTE_ORDER= -DLITTLE_ENDIAN
|
||||
LONG_BITS= 32
|
||||
HAVE_FPOS_POS= -DHAVE_NO_FPOS_POS
|
||||
FPOS_BITS= 32
|
||||
OFF_T_BITS= 32
|
||||
DEV_BITS= 32
|
||||
INODE_BITS= 32
|
||||
HAVE_USTAT= -DHAVE_NO_USTAT
|
||||
HAVE_GETSID= -DHAVE_NO_GETSID
|
||||
HAVE_GETPGID= -DHAVE_NO_GETPGID
|
||||
HAVE_GETTIME= -DHAVE_NO_GETTIME
|
||||
HAVE_GETPRID= -DHAVE_NO_GETPRID
|
||||
HAVE_URANDOM_H= NO
|
||||
ALIGN32= -UMUST_ALIGN32
|
||||
HAVE_MALLOC_H= YES
|
||||
HAVE_STDLIB_H= YES
|
||||
HAVE_STRING_H= YES
|
||||
HAVE_TIMES_H= NO
|
||||
HAVE_SYS_TIMES_H= YES
|
||||
HAVE_TIME_H= YES
|
||||
HAVE_SYS_TIME_H= YES
|
||||
HAVE_UNISTD_H= YES
|
||||
BINDIR= /dev/env/DJDIR/bin
|
||||
INCDIR= /dev/env/DJDIR/include
|
||||
LIBDIR= /dev/env/DJDIR/lib
|
||||
MANDIR= /dev/env/DJDIR/man/man1
|
||||
CATDIR= /dev/env/DJDIR/man/cat1
|
||||
NROFF= groff
|
||||
CALCPATH= .;./cal;~/.cal;${CALC_SHAREDIR};${CUSTOMCALDIR}
|
||||
CALCRC= ${CALC_SHAREDIR}/startup;~/.calcrc;./.calcinit
|
||||
CALCPAGER= less.exe -ci
|
||||
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.
|
||||
|
||||
Look for Makefile comments of the form:
|
||||
|
||||
# Select ...something... for DJGPP.
|
||||
|
||||
Follow those recommendations. In cases where they conflict with
|
||||
the above Makefile list, follow the recommendation in the Makefile.
|
||||
|
||||
|
||||
## 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
|
||||
## 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.
|
||||
##
|
||||
## Under source code control: 2001/02/25 14:00:05
|
||||
## File existed as early as: 2001
|
||||
##
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
260
README.md
Normal file
260
README.md
Normal file
@@ -0,0 +1,260 @@
|
||||
# What is calc?
|
||||
|
||||
Calc is an interactive calculator which provides for easy large
|
||||
Otherwise, it enters interactive mode. In this mode, it accepts
|
||||
commands one at a time, processes them, and displays the answers.
|
||||
In the simplest case, commands are simply expressions which are
|
||||
evaluated. For example, the following line can be input:
|
||||
|
||||
```sh
|
||||
3 * (4 + 1)
|
||||
```
|
||||
|
||||
and the calculator will print:
|
||||
|
||||
```sh
|
||||
15
|
||||
```
|
||||
|
||||
Calc as the usual collection of arithmetic operators +, -, /, * as
|
||||
well as ^ (exponentiation), % (modulus) and // (integer divide).
|
||||
For example:
|
||||
|
||||
```sh
|
||||
3 * 19^43 - 1
|
||||
```
|
||||
|
||||
will produce:
|
||||
|
||||
```sh
|
||||
29075426613099201338473141505176993450849249622191102976
|
||||
```
|
||||
|
||||
Notice that calc values can be very large. For example:
|
||||
|
||||
```sh
|
||||
2^23209-1
|
||||
```
|
||||
|
||||
will print:
|
||||
|
||||
```sh
|
||||
402874115778988778181873329071 ... many digits ... 3779264511
|
||||
```
|
||||
|
||||
The special '.' symbol (called dot), represents the result of the
|
||||
last command expression, if any. This is of great use when a series
|
||||
of partial results are calculated, or when the output mode is changed
|
||||
and the last result needs to be redisplayed. For example, the above
|
||||
result can be modified by typing:
|
||||
|
||||
```sh
|
||||
. % (2^127-1)
|
||||
```
|
||||
|
||||
and the calculator will print:
|
||||
|
||||
```sh
|
||||
47385033654019111249345128555354223304
|
||||
```
|
||||
|
||||
For more complex calculations, variables can be used to save the
|
||||
intermediate results. For example, the result of adding 7 to the
|
||||
previous result can be saved by typing:
|
||||
|
||||
```sh
|
||||
curds = 15
|
||||
whey = 7 + 2*curds
|
||||
```
|
||||
|
||||
Functions can be used in expressions. There are a great number of
|
||||
pre-defined functions. For example, the following will calculate
|
||||
the factorial of the value of 'whey':
|
||||
|
||||
```sh
|
||||
fact(whey)
|
||||
```
|
||||
|
||||
and the calculator prints:
|
||||
|
||||
```sh
|
||||
13763753091226345046315979581580902400000000
|
||||
```
|
||||
|
||||
The calculator also knows about complex numbers, so that typing:
|
||||
|
||||
```sh
|
||||
(2+3i) * (4-3i)
|
||||
cos(.)
|
||||
```
|
||||
|
||||
will print:
|
||||
|
||||
```sh
|
||||
17+6i
|
||||
-55.50474777265624667147+193.9265235748927986537i
|
||||
```
|
||||
|
||||
The calculator can calculate transcendental functions, and accept and
|
||||
display numbers in real or exponential format. For example, typing:
|
||||
|
||||
```sh
|
||||
config("display", 70),
|
||||
epsilon(1e-70),
|
||||
sin(1)
|
||||
```
|
||||
|
||||
prints:
|
||||
|
||||
```sh
|
||||
0.8414709848078965066525023216302989996225630607983710656727517099919104
|
||||
```
|
||||
|
||||
Calc can output values in terms of fractions, octal or hexadecimal.
|
||||
For example:
|
||||
|
||||
```sh
|
||||
config("mode", "fraction"),
|
||||
(17/19)^23
|
||||
print
|
||||
base(16),
|
||||
(19/17)^29
|
||||
print
|
||||
log(79.3i)
|
||||
```
|
||||
|
||||
will print:
|
||||
|
||||
```sh
|
||||
19967568900859523802559065713/257829627945307727248226067259
|
||||
|
||||
0x9201e65bdbb801eaf403f657efcf863/0x5cd2e2a01291ffd73bee6aa7dcf7d1
|
||||
|
||||
0x17b5164ac24ee836bf/0xc7b7a8e3ef5fcf752+0x883eaf5adadd26be3/0xc7b7a8e3ef5fcf752i
|
||||
```
|
||||
|
||||
All numbers are represented as fractions with arbitrarily large
|
||||
numerators and denominators which are always reduced to lowest terms.
|
||||
Real or exponential format numbers can be input and are converted
|
||||
to the equivalent fraction. Hex, binary, or octal numbers can be
|
||||
input by using numbers with leading '0x', '0b' or '0' characters.
|
||||
Complex numbers can be input using a trailing 'i', as in '2+3i'.
|
||||
Strings and characters are input by using single or double quotes.
|
||||
|
||||
Commands are statements in a C-like language, where each input
|
||||
line is treated as the body of a procedure. Thus the command
|
||||
line can contain variable declarations, expressions, labels,
|
||||
conditional tests, and loops. Assignments to any variable name
|
||||
will automatically define that name as a global variable. The
|
||||
other important thing to know is that all non-assignment expressions
|
||||
which are evaluated are automatically printed. Thus, you can evaluate
|
||||
an expression's value by simply typing it in.
|
||||
|
||||
Many useful built-in mathematical functions are available. Use the:
|
||||
|
||||
```sh
|
||||
help builtin
|
||||
```
|
||||
|
||||
command to list them.
|
||||
|
||||
You can also define your own functions by using the 'define' keyword,
|
||||
followed by a function declaration very similar to C.
|
||||
|
||||
```sh
|
||||
define f2(n)
|
||||
{
|
||||
local ans;
|
||||
|
||||
ans = 1;
|
||||
while (n > 1)
|
||||
ans *= (n -= 2);
|
||||
return ans;
|
||||
}
|
||||
```
|
||||
|
||||
Thus the input:
|
||||
|
||||
```sh
|
||||
f2(79)
|
||||
```
|
||||
|
||||
will produce:
|
||||
|
||||
```sh
|
||||
1009847364737869270905302433221592504062302663202724609375
|
||||
```
|
||||
|
||||
Functions which only need to return a simple expression can be defined
|
||||
using an equals sign, as in the example:
|
||||
|
||||
```sh
|
||||
define sc(a,b) = a^3 + b^3
|
||||
```
|
||||
|
||||
Thus the input:
|
||||
|
||||
```sh
|
||||
sc(31, 61)
|
||||
```
|
||||
|
||||
will produce:
|
||||
|
||||
```sh
|
||||
256772
|
||||
```
|
||||
|
||||
Variables in functions can be defined as either 'global', 'local',
|
||||
or 'static'. Global variables are common to all functions and the
|
||||
command line, whereas local variables are unique to each function
|
||||
level, and are destroyed when the function returns. Static variables
|
||||
are scoped within single input files, or within functions, and are
|
||||
never destroyed. Variables are not typed at definition time, but
|
||||
dynamically change as they are used.
|
||||
|
||||
For more information about the calc language and features, try:
|
||||
|
||||
```sh
|
||||
help overview
|
||||
```
|
||||
|
||||
Calc has a help command that will produce information about
|
||||
every builtin function, command as well as a number of other
|
||||
aspects of calc usage. Try the command:
|
||||
|
||||
```sh
|
||||
help help
|
||||
```
|
||||
|
||||
for and overview of the help system. The command:
|
||||
|
||||
```sh
|
||||
help builtin
|
||||
```
|
||||
|
||||
provides information on built-in mathematical functions, whereas:
|
||||
|
||||
```sh
|
||||
help asinh
|
||||
```
|
||||
|
||||
will provides information a specific function. The following
|
||||
help files:
|
||||
|
||||
```sh
|
||||
help command
|
||||
help define
|
||||
help operator
|
||||
help statement
|
||||
help variable
|
||||
```
|
||||
|
||||
provide a good overview of the calc language. If you are familiar
|
||||
with C, you should also try:
|
||||
|
||||
```sh
|
||||
help unexpected
|
||||
```
|
||||
|
||||
It contains information about differences between C and calc
|
||||
that may surprize C programmers.
|
273
addop.c
273
addop.c
@@ -1,7 +1,7 @@
|
||||
/*
|
||||
* addop - add opcodes to a function being compiled
|
||||
*
|
||||
* Copyright (C) 1999 David I. Bell and Ernest Bowen
|
||||
* Copyright (C) 1999-2007 David I. Bell and Ernest Bowen
|
||||
*
|
||||
* Primary author: David I. Bell
|
||||
*
|
||||
@@ -17,23 +17,19 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: addop.c,v 29.1 1999/12/14 09:15:29 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/RCS/addop.c,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:48:10
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
#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 +40,17 @@
|
||||
#define OPCODEALLOCSIZE 100 /* reallocate size for opcodes in functions */
|
||||
|
||||
|
||||
static 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,8 +180,8 @@ void
|
||||
endfunc(void)
|
||||
{
|
||||
register FUNC *fp; /* function just finished */
|
||||
unsigned long size; /* size of just created function */
|
||||
long index;
|
||||
size_t size; /* size of just created function */
|
||||
unsigned long index;
|
||||
|
||||
if (oldop != OP_RETURN) {
|
||||
addop(OP_UNDEF);
|
||||
@@ -195,8 +191,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);
|
||||
@@ -208,10 +204,10 @@ endfunc(void)
|
||||
memcpy((char *) fp, (char *) curfunc, size);
|
||||
if (curfunc != functemplate)
|
||||
free(curfunc);
|
||||
if (conf->traceflags & TRACE_FNCODES) {
|
||||
if (newname[0] != '*' && (conf->traceflags & TRACE_FNCODES)) {
|
||||
dumpnames = TRUE;
|
||||
for (size = 0; size < fp->f_opcodecount; ) {
|
||||
printf("%ld: ", (long)size);
|
||||
printf("%ld: ", (unsigned long)size);
|
||||
size += dumpop(&fp->f_opcodes[size]);
|
||||
}
|
||||
}
|
||||
@@ -280,12 +276,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) ||
|
||||
@@ -302,7 +299,7 @@ void
|
||||
freefunc(FUNC *fp)
|
||||
{
|
||||
long index;
|
||||
long i;
|
||||
unsigned long i;
|
||||
|
||||
if (fp == NULL)
|
||||
return;
|
||||
@@ -318,7 +315,7 @@ freefunc(FUNC *fp)
|
||||
/*NOTREACHED*/
|
||||
}
|
||||
}
|
||||
if (conf->traceflags & TRACE_FNCODES) {
|
||||
if (newname[0] != '*' && (conf->traceflags & TRACE_FNCODES)) {
|
||||
printf("Freeing function \"%s\"\n",namestr(&funcnames,index));
|
||||
dumpnames = FALSE;
|
||||
for (i = 0; i < fp->f_opcodecount; ) {
|
||||
@@ -383,7 +380,7 @@ clearopt(void)
|
||||
FUNC *
|
||||
findfunc(long index)
|
||||
{
|
||||
if ((unsigned long) index >= funccount) {
|
||||
if (index >= funccount) {
|
||||
math_error("Undefined function");
|
||||
/*NOTREACHED*/
|
||||
}
|
||||
@@ -451,124 +448,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);
|
||||
|
10
align32.c
10
align32.c
@@ -15,17 +15,13 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: align32.c,v 29.1 1999/12/14 09:15:29 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/RCS/align32.c,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1995/11/23 05:18:06
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://reality.sgi.com/chongo/
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
|
80
alloc.h
80
alloc.h
@@ -1,7 +1,7 @@
|
||||
/*
|
||||
* alloc - storage allocation and storage debug macros
|
||||
*
|
||||
* Copyright (C) 1999 David I. Bell
|
||||
* Copyright (C) 1999-2007,2014 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,65 +15,56 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: alloc.h,v 29.1 1999/12/14 09:15:29 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/RCS/alloc.h,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:48:29
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
#if !defined(__ALLOC_H__)
|
||||
#define __ALLOC_H__
|
||||
#if !defined(INCLUDE_ALLOC_H)
|
||||
#define INCLUDE_ALLOC_H
|
||||
|
||||
|
||||
#include "have_malloc.h"
|
||||
#include "have_newstr.h"
|
||||
#include "have_string.h"
|
||||
#include "have_memmv.h"
|
||||
|
||||
#ifdef HAVE_MALLOC_H
|
||||
# include <malloc.h>
|
||||
#if defined(CALC_SRC) /* if we are building from the calc source tree */
|
||||
# include "have_newstr.h"
|
||||
# include "have_string.h"
|
||||
# include "have_memmv.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
|
||||
# include <calc/have_newstr.h>
|
||||
# include <calc/have_string.h>
|
||||
# include <calc/have_memmv.h>
|
||||
#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
|
||||
|
||||
@@ -87,13 +78,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__ */
|
||||
#endif /* !INCLUDE_ALLOC_H */
|
||||
|
36
assocfunc.c
36
assocfunc.c
@@ -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,16 +15,12 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: assocfunc.c,v 29.1 1999/12/14 09:15:29 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/RCS/assocfunc.c,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1993/07/20 23:04:27
|
||||
* File existed as early as: 1993
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -46,10 +42,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 +65,7 @@ associndex(ASSOC *ap, BOOL create, long dim, VALUE *indices)
|
||||
{
|
||||
ASSOCELEM **listhead;
|
||||
ASSOCELEM *ep;
|
||||
static VALUE val;
|
||||
STATIC VALUE val;
|
||||
QCKHASH hash;
|
||||
int i;
|
||||
|
||||
@@ -83,7 +79,7 @@ associndex(ASSOC *ap, BOOL create, long dim, VALUE *indices)
|
||||
* so that we can first select the correct hash chain, and
|
||||
* also so we can quickly compare each element for a match.
|
||||
*/
|
||||
hash = FNV1_32_BASIS;
|
||||
hash = QUICKHASH_BASIS;
|
||||
for (i = 0; i < dim; i++)
|
||||
hash = hashvalue(&indices[i], hash);
|
||||
|
||||
@@ -200,7 +196,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 +328,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 +337,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 +354,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 +398,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 +518,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;
|
||||
|
211
blkcpy.c
211
blkcpy.c
@@ -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,16 +17,12 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: blkcpy.c,v 29.1 1999/12/14 09:15:29 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/RCS/blkcpy.c,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1997/04/18 20:41:26
|
||||
* File existed as early as: 1997
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
@@ -36,7 +32,7 @@
|
||||
#include "value.h"
|
||||
#include "file.h"
|
||||
#include "blkcpy.h"
|
||||
#include "string.h"
|
||||
#include "str.h"
|
||||
|
||||
|
||||
/*
|
||||
@@ -73,51 +69,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,20 +276,20 @@ 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;
|
||||
|
||||
if (num < 0)
|
||||
num = smat->m_size - ssi;
|
||||
if ((USB32) ssi + num > smat->m_size)
|
||||
if (ssi + num > smat->m_size)
|
||||
return E_COPY5;
|
||||
if (num == 0)
|
||||
return 0;
|
||||
if (dsi < 0)
|
||||
dsi = 0;
|
||||
if ((USB32) dsi + num > dmat->m_size)
|
||||
if (dsi + num > dmat->m_size)
|
||||
return E_COPY7;
|
||||
vtemp = (VALUE *) malloc(num * sizeof(VALUE));
|
||||
if (vtemp == NULL) {
|
||||
@@ -311,7 +307,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,19 +325,19 @@ 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;
|
||||
if (num < 0)
|
||||
num = blk->datalen - ssi;
|
||||
if ((USB32) ssi + num > blk->datalen)
|
||||
if (ssi + num > blk->datalen)
|
||||
return E_COPY5;
|
||||
if (num == 0)
|
||||
return 0;
|
||||
if (dsi < 0)
|
||||
dsi = 0;
|
||||
if ((USB32) dsi + num > dmat->m_size)
|
||||
if (dsi + num > dmat->m_size)
|
||||
return E_COPY7;
|
||||
op = blk->data + ssi;
|
||||
vtemp = (VALUE *) malloc(num * sizeof(VALUE));
|
||||
@@ -363,7 +359,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 +370,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;
|
||||
@@ -389,7 +386,7 @@ copymat2blk(MATRIX *smat, long ssi, long num, BLOCK *dblk, long dsi, BOOL norelo
|
||||
num = smat->m_size - ssi;
|
||||
if (num == 0)
|
||||
return 0;
|
||||
if ((USB32) ssi + num > smat->m_size)
|
||||
if (ssi + num > smat->m_size)
|
||||
return E_COPY5;
|
||||
if (dsi < 0)
|
||||
dsi = dblk->datalen;
|
||||
@@ -429,6 +426,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;
|
||||
@@ -436,11 +434,11 @@ copymat2list(MATRIX *smat, long ssi, long num, LIST *lp, long dsi)
|
||||
num = smat->m_size - ssi;
|
||||
if (num == 0)
|
||||
return 0;
|
||||
if ((USB32) ssi + num > smat->m_size)
|
||||
if (ssi + num > smat->m_size)
|
||||
return E_COPY5;
|
||||
if (dsi < 0)
|
||||
dsi = 0;
|
||||
if ((USB32) dsi + num > lp->l_count)
|
||||
if (dsi + num > lp->l_count)
|
||||
return E_COPY7;
|
||||
vtemp = (VALUE *) malloc(num * sizeof(VALUE));
|
||||
if (vtemp == NULL) {
|
||||
@@ -456,8 +454,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 +476,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;
|
||||
@@ -484,11 +484,11 @@ copylist2mat(LIST *lp, long ssi, long num, MATRIX *dmat, long dsi)
|
||||
num = lp->l_count - ssi;
|
||||
if (num == 0)
|
||||
return 0;
|
||||
if ((USB32) ssi + num > lp->l_count)
|
||||
if (ssi + num > lp->l_count)
|
||||
return E_COPY5;
|
||||
if (dsi < 0)
|
||||
dsi = 0;
|
||||
if ((USB32) dsi + num > dmat->m_size)
|
||||
if (dsi + num > dmat->m_size)
|
||||
return E_COPY7;
|
||||
vtemp = (VALUE *) malloc(num * sizeof(VALUE));
|
||||
if (vtemp == NULL) {
|
||||
@@ -508,7 +508,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 +526,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;
|
||||
@@ -533,11 +534,11 @@ copylist2list(LIST *slp, long ssi, long num, LIST *dlp, long dsi)
|
||||
num = slp->l_count - ssi;
|
||||
if (num == 0)
|
||||
return 0;
|
||||
if ((USB32) ssi + num > slp->l_count)
|
||||
if (ssi + num > slp->l_count)
|
||||
return E_COPY5;
|
||||
if (dsi < 0)
|
||||
dsi = 0;
|
||||
if ((USB32) dsi + num > dlp->l_count)
|
||||
if (dsi + num > dlp->l_count)
|
||||
return E_COPY7;
|
||||
vtemp = (VALUE *) malloc(num * sizeof(VALUE));
|
||||
if (vtemp == NULL) {
|
||||
@@ -555,8 +556,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);
|
||||
@@ -572,7 +575,7 @@ copyblk2file(BLOCK *sblk, long ssi, long num, FILEID id, long dsi)
|
||||
{
|
||||
FILEIO *fiop;
|
||||
FILE *fp;
|
||||
unsigned int numw;
|
||||
long numw;
|
||||
|
||||
if (ssi > sblk->datalen)
|
||||
return E_COPY2;
|
||||
@@ -581,7 +584,7 @@ copyblk2file(BLOCK *sblk, long ssi, long num, FILEID id, long dsi)
|
||||
if (num == 0)
|
||||
return 0;
|
||||
|
||||
fiop = findid(id, 'w');
|
||||
fiop = findid(id, TRUE);
|
||||
if (fiop == NULL)
|
||||
return E_COPYF1;
|
||||
fp = fiop->fp;
|
||||
@@ -609,7 +612,7 @@ copyfile2blk(FILEID id, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc)
|
||||
{
|
||||
FILEIO *fiop;
|
||||
FILE *fp;
|
||||
unsigned int numw;
|
||||
long numw;
|
||||
ZVALUE fsize;
|
||||
long filelen;
|
||||
long newlen;
|
||||
@@ -618,7 +621,7 @@ copyfile2blk(FILEID id, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc)
|
||||
|
||||
if (id < 3) /* excludes copying from stdin */
|
||||
return E_COPYF1;
|
||||
fiop = findid(id, 'r');
|
||||
fiop = findid(id, FALSE);
|
||||
if (fiop == NULL)
|
||||
return E_COPYF1;
|
||||
|
||||
@@ -639,7 +642,7 @@ copyfile2blk(FILEID id, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc)
|
||||
num = filelen - ssi;
|
||||
if (num == 0)
|
||||
return 0;
|
||||
if ((USB32) ssi + num > filelen)
|
||||
if (ssi + num > filelen)
|
||||
return E_COPY5;
|
||||
if (fseek(fp, ssi, 0)) /* using system fseek XXX */
|
||||
return E_COPYF2;
|
||||
@@ -677,7 +680,7 @@ copystr2file(STRING *str, long ssi, long num, FILEID id, long dsi)
|
||||
{
|
||||
long len;
|
||||
FILEIO *fiop;
|
||||
unsigned int numw;
|
||||
long numw;
|
||||
FILE *fp;
|
||||
|
||||
len = str->s_len;
|
||||
@@ -688,9 +691,9 @@ copystr2file(STRING *str, long ssi, long num, FILEID id, long dsi)
|
||||
num = len - ssi;
|
||||
if (num <= 0) /* Nothing to be copied */
|
||||
return 0;
|
||||
if ((USB32) ssi + num > len)
|
||||
if (ssi + num > len)
|
||||
return E_COPY5; /* Insufficient memory in str */
|
||||
fiop = findid(id, 'w');
|
||||
fiop = findid(id, TRUE);
|
||||
if (fiop == NULL)
|
||||
return E_COPYF1;
|
||||
fp = fiop->fp;
|
||||
@@ -714,7 +717,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;
|
||||
@@ -726,7 +730,7 @@ copyblk2blk(BLOCK *sblk, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc
|
||||
num = sblk->datalen - ssi;
|
||||
if (num == 0) /* Nothing to be copied */
|
||||
return 0;
|
||||
if ((unsigned int) ssi + num > sblk->datalen)
|
||||
if (ssi + num > sblk->datalen)
|
||||
return E_COPY5;
|
||||
if (dsi < 0)
|
||||
dsi = dblk->datalen;
|
||||
@@ -756,7 +760,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 +811,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 +843,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 +857,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 +884,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 || (unsigned long) 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 +902,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 +915,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 +934,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 +981,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 */
|
||||
@@ -991,14 +997,14 @@ copynum2blk(NUMBER *snum, long ssi, long num, BLOCK *dblk, long dsi, BOOL norelo
|
||||
num = snum->num.len - ssi;
|
||||
if (num == 0) /* Nothing to be copied */
|
||||
return 0;
|
||||
if ((unsigned long) ssi + num > snum->num.len)
|
||||
if (ssi + num > snum->num.len)
|
||||
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 +1023,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 +1033,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 */
|
||||
@@ -1044,11 +1051,11 @@ copyblk2num(BLOCK *sblk, long ssi, long num, NUMBER *dnum, long dsi, NUMBER **re
|
||||
num = sblk->datalen - ssi;
|
||||
if (num == 0) /* Nothing to be copied */
|
||||
return 0;
|
||||
if ((unsigned long) ssi + num > sblk->datalen)
|
||||
if (ssi + num > sblk->datalen)
|
||||
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;
|
||||
|
||||
|
52
blkcpy.h
52
blkcpy.h
@@ -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,2014 Landon Curt Noll and Ernest Bowen
|
||||
*
|
||||
* Primary author: Landon Curt Noll
|
||||
*
|
||||
@@ -17,46 +17,42 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: blkcpy.h,v 29.1 1999/12/14 09:15:29 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/RCS/blkcpy.h,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1997/04/18 20:41:25
|
||||
* File existed as early as: 1997
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
#if !defined(__BLKCPY_H__)
|
||||
#define __BLKCPY_H__
|
||||
#if !defined(INCLUDE_BLKCPY_H)
|
||||
#define INCLUDE_BLKCPY_H
|
||||
|
||||
/*
|
||||
* 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__ */
|
||||
#endif /* !INCLUDE_BLKCPY_H */
|
||||
|
28
block.c
28
block.c
@@ -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,17 +17,13 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: block.c,v 29.1 1999/12/14 09:15:29 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/RCS/block.c,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1997/02/27 00:29:40
|
||||
* File existed as early as: 1997
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://reality.sgi.com/chongo/
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
@@ -37,19 +33,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 +53,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 +150,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)
|
||||
{
|
||||
|
||||
|
52
block.h
52
block.h
@@ -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,2014 Landon Curt Noll and Ernest Bowen
|
||||
*
|
||||
* Primary author: Landon Curt Noll
|
||||
*
|
||||
@@ -17,22 +17,18 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: block.h,v 29.1 1999/12/14 09:15:30 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/RCS/block.h,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1997/02/21 05:03:39
|
||||
* File existed as early as: 1997
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://reality.sgi.com/chongo/
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
#if !defined(__BLOCK_H__)
|
||||
#define __BLOCK_H__
|
||||
#if !defined(INCLUDE_BLOCK_H)
|
||||
#define INCLUDE_BLOCK_H
|
||||
|
||||
|
||||
/*
|
||||
@@ -160,7 +156,7 @@ typedef struct nblock NBLOCK;
|
||||
/*
|
||||
* block debug
|
||||
*/
|
||||
extern int blk_debug; /* 0 => debug off */
|
||||
EXTERN int blk_debug; /* 0 => debug off */
|
||||
|
||||
|
||||
/*
|
||||
@@ -204,22 +200,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__ */
|
||||
#endif /* !INCLUDE_BLOCK_H */
|
||||
|
13
byteswap.c
13
byteswap.c
@@ -15,17 +15,13 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: byteswap.c,v 29.1 1999/12/14 09:15:30 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/RCS/byteswap.c,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1995/10/11 04:44:01
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://reality.sgi.com/chongo/
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
@@ -102,7 +98,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*/
|
||||
}
|
||||
|
||||
|
24
byteswap.h
24
byteswap.h
@@ -1,7 +1,7 @@
|
||||
/*
|
||||
* byteswap - byte swapping macros
|
||||
*
|
||||
* Copyright (C) 1999 Landon Curt Noll
|
||||
* Copyright (C) 1999,2014 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
|
||||
@@ -15,25 +15,25 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: byteswap.h,v 29.1 1999/12/14 09:15:30 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/RCS/byteswap.h,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1995/10/11 04:44:01
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://reality.sgi.com/chongo/
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
#if !defined(__BYTESWAP_H__)
|
||||
#define __BYTESWAP_H__
|
||||
#if !defined(INCLUDE_BYTESWAP_H)
|
||||
#define INCLUDE_BYTESWAP_H
|
||||
|
||||
|
||||
#include "longbits.h"
|
||||
#if defined(CALC_SRC) /* if we are building from the calc source tree */
|
||||
# include "longbits.h"
|
||||
#else
|
||||
# include <calc/longbits.h>
|
||||
#endif
|
||||
|
||||
|
||||
/*
|
||||
@@ -174,4 +174,4 @@
|
||||
#endif /* LONG_BITS == 64 */
|
||||
|
||||
|
||||
#endif /* !__BYTESWAP_H__ */
|
||||
#endif /* !INCLUDE_BYTESWAP_H */
|
||||
|
384
cal/Makefile
384
cal/Makefile
@@ -2,7 +2,7 @@
|
||||
#
|
||||
# cal - makefile for calc standard resource files
|
||||
#
|
||||
# Copyright (C) 1999 Landon Curt Noll
|
||||
# Copyright (C) 1999-2006,2017 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,35 +16,144 @@
|
||||
# A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
# distributed with calc under the filename COPYING-LGPL. You should have
|
||||
# received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
# 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# @(#) $Revision: 29.1 $
|
||||
# @(#) $Id: Makefile,v 29.1 1999/12/14 09:15:30 chongo Exp $
|
||||
# @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/Makefile,v $
|
||||
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
#
|
||||
# Under source code control: 1991/07/21 05:00:54
|
||||
# File existed as early as: 1991
|
||||
#
|
||||
# chongo <was here> /\oo/\ http://reality.sgi.com/chongo/
|
||||
# Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
# chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
# Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
#
|
||||
# calculator by David I. Bell with help/mods from others
|
||||
# Makefile by Landon Curt Noll
|
||||
|
||||
# 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.
|
||||
#
|
||||
# where to install things
|
||||
TOPDIR= /usr/local/lib
|
||||
#TOPDIR= /usr/lib
|
||||
#TOPDIR= /usr/libdata
|
||||
####
|
||||
|
||||
LIBDIR= ${TOPDIR}/calc
|
||||
# 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:
|
||||
#
|
||||
# INCDIR= /dev/env/DJDIR/include
|
||||
#
|
||||
# If in doubt, set:
|
||||
#
|
||||
# INCDIR= /usr/include
|
||||
#
|
||||
|
||||
#INCDIR= /usr/local/include
|
||||
#INCDIR= /dev/env/DJDIR/include
|
||||
INCDIR= /usr/include
|
||||
|
||||
# where to install calc realted things
|
||||
#
|
||||
# ${BINDIR} where to install calc binary files
|
||||
# ${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.
|
||||
#
|
||||
# For DJGPP, select:
|
||||
#
|
||||
# BINDIR= /dev/env/DJDIR/bin
|
||||
# LIBDIR= /dev/env/DJDIR/lib
|
||||
# CALC_SHAREDIR= /dev/env/DJDIR/share/calc
|
||||
#
|
||||
# If in doubt, set:
|
||||
#
|
||||
# BINDIR= /usr/bin
|
||||
# LIBDIR= /usr/lib
|
||||
# CALC_SHAREDIR= /usr/share/calc
|
||||
#
|
||||
#BINDIR= /usr/local/bin
|
||||
#BINDIR= /dev/env/DJDIR/bin
|
||||
BINDIR= /usr/bin
|
||||
|
||||
#LIBDIR= /usr/local/lib
|
||||
#LIBDIR= /dev/env/DJDIR/lib
|
||||
LIBDIR= /usr/lib
|
||||
|
||||
#CALC_SHAREDIR= /usr/local/lib/calc
|
||||
#CALC_SHAREDIR= /dev/env/DJDIR/share/calc
|
||||
CALC_SHAREDIR= /usr/share/calc
|
||||
|
||||
# By default, these values are based CALC_SHAREDIR, INCDIR, BINDIR
|
||||
# ---------------------------------------------------------------
|
||||
# ${HELPDIR} where the help directory is installed
|
||||
# ${CALC_INCDIR} where the calc include 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.
|
||||
#
|
||||
# If in doubt, set:
|
||||
#
|
||||
# HELPDIR= ${CALC_SHAREDIR}/help
|
||||
# CALC_INCDIR= ${INCDIR}/calc
|
||||
# SCRIPTDIR= ${BINDIR}/cscript
|
||||
#
|
||||
HELPDIR= ${CALC_SHAREDIR}/help
|
||||
CALC_INCDIR= ${INCDIR}/calc
|
||||
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
|
||||
# to install calc somewhere other than into the system area.
|
||||
#
|
||||
# For example, if:
|
||||
#
|
||||
# BINDIR= /usr/bin
|
||||
# LIBDIR= /usr/lib
|
||||
# CALC_SHAREDIR= /usr/share/calc
|
||||
#
|
||||
# and if:
|
||||
#
|
||||
# T= /var/tmp/testing
|
||||
#
|
||||
# Then the installation locations will be:
|
||||
#
|
||||
# calc binary files: /var/tmp/testing/usr/bin
|
||||
# calc link library: /var/tmp/testing/usr/lib
|
||||
# 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 in doubt, use T=
|
||||
#
|
||||
T=
|
||||
|
||||
# Makefile debug
|
||||
#
|
||||
@@ -57,20 +166,50 @@ Q=@
|
||||
# standard tools
|
||||
#
|
||||
CHMOD= chmod
|
||||
CMP= cmp
|
||||
RM= rm
|
||||
MKDIR= mkdir
|
||||
RMDIR= rmdir
|
||||
CP= cp
|
||||
MV= mv
|
||||
CO= co
|
||||
TRUE= true
|
||||
TOUCH= touch
|
||||
SED= sed
|
||||
SORT= sort
|
||||
FMT= fmt
|
||||
|
||||
# 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 \
|
||||
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 xx_print.cal natnumset.cal qtime.cal test8400.cal \
|
||||
test8500.cal
|
||||
# This list is prodiced by the detaillist rule when no WARNINGS are detected.
|
||||
#
|
||||
# Please use:
|
||||
#
|
||||
# make calc_files_list
|
||||
#
|
||||
# to keep this list in nice sorted order and to check that these
|
||||
# deailed help files are under RCS control.
|
||||
#
|
||||
CALC_FILES= README 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 factorial.cal \
|
||||
factorial2.cal gvec.cal hello.cal hms.cal infinities.cal \
|
||||
intfile.cal intnum.cal lambertw.cal linear.cal lnseries.cal \
|
||||
lucas.cal lucas_chk.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 regress.cal repeat.cal \
|
||||
screen.cal seedrandom.cal set8700.cal set8700.line smallfactors.cal \
|
||||
solve.cal specialfunctions.cal statistics.cal strings.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 calc files are now obsolete and are removed by the install rule.
|
||||
#
|
||||
DEAD_CALC_FILES= lucas_tbl.cal
|
||||
|
||||
# These files are found (but not built) in the distribution
|
||||
#
|
||||
@@ -85,8 +224,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
|
||||
|
||||
##
|
||||
#
|
||||
@@ -102,48 +241,163 @@ all: ${CALC_FILES} ${MAKE_FILE} .all
|
||||
##
|
||||
|
||||
distlist: ${DISTLIST}
|
||||
${Q}for i in ${DISTLIST}; do \
|
||||
echo cal/$$i; \
|
||||
done
|
||||
|
||||
distdir:
|
||||
${Q}echo cal
|
||||
|
||||
calcliblist:
|
||||
${Q}for i in ${CALCLIBLIST} /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
|
||||
|
||||
calcliblist:
|
||||
${Q} for i in ${CALCLIBLIST} /dev/null; do \
|
||||
if [ X"$$i" != X"/dev/null" ]; then \
|
||||
echo cal/$$i; \
|
||||
fi; \
|
||||
done
|
||||
|
||||
# These next rule help form the ${CALC_FILES} makefile variables above.
|
||||
#
|
||||
calc_files_list:
|
||||
${Q} -(find . -mindepth 1 -maxdepth 1 -type f -name '*.cal' -print | \
|
||||
while read i; do \
|
||||
if [ X"$$i" != X"/dev/null" ]; then \
|
||||
if [ ! -f RCS/$$i,v ]; then \
|
||||
echo "WARNING: $$i not under RCS control" 1>&2; \
|
||||
else \
|
||||
echo $$i; \
|
||||
fi; \
|
||||
fi; \
|
||||
done; \
|
||||
echo '--first_line--'; \
|
||||
echo README; \
|
||||
echo set8700.line; \
|
||||
echo bindings) | \
|
||||
${SED} -e 's:^\./::' | LANG=C ${SORT} | ${FMT} -70 | \
|
||||
${SED} -e '1s/--first_line--/CALC_FILES=/' -e '2,$$s/^/ /' \
|
||||
-e 's/$$/ \\/' -e '$$s/ \\$$//'
|
||||
|
||||
##
|
||||
#
|
||||
# rpm rules
|
||||
#
|
||||
##
|
||||
|
||||
echo_inst_files:
|
||||
${Q} for i in ${CALC_FILES} /dev/null; do \
|
||||
if [ X"$$i" != X"/dev/null" ]; then \
|
||||
echo __file__ ${CALC_SHAREDIR}/$$i; \
|
||||
fi; \
|
||||
done
|
||||
|
||||
##
|
||||
#
|
||||
# Utility rules
|
||||
#
|
||||
##
|
||||
|
||||
clean:
|
||||
|
||||
clobber:
|
||||
rm -f .all
|
||||
|
||||
install: all
|
||||
-${Q}if [ ! -d ${TOPDIR} ]; then \
|
||||
echo mkdir ${TOPDIR}; \
|
||||
mkdir ${TOPDIR}; \
|
||||
else \
|
||||
true; \
|
||||
clobber: clean
|
||||
${RM} -f .all
|
||||
-${Q} if [ -e .DS_Store ]; then \
|
||||
echo ${RM} -rf .DS_Store; \
|
||||
${RM} -rf .DS_Store; \
|
||||
fi
|
||||
-${Q}if [ ! -d ${LIBDIR} ]; then \
|
||||
echo mkdir ${LIBDIR}; \
|
||||
mkdir ${LIBDIR}; \
|
||||
else \
|
||||
true; \
|
||||
fi
|
||||
${Q}for i in ${CALC_FILES}; do \
|
||||
echo rm -f ${LIBDIR}/$$i; \
|
||||
rm -f ${LIBDIR}/$$i; \
|
||||
echo cp $$i ${LIBDIR}; \
|
||||
cp $$i ${LIBDIR}; \
|
||||
echo ${CHMOD} 0444 ${LIBDIR}/$$i; \
|
||||
${CHMOD} 0444 ${LIBDIR}/$$i; \
|
||||
-${Q} for i in ${DEAD_CALC_FILES} /dev/null; do \
|
||||
if [ "$$i" = "/dev/null" ]; then \
|
||||
continue; \
|
||||
fi; \
|
||||
if [ -e "${T}${CALC_SHAREDIR}/$$i" ]; then \
|
||||
echo "${RM} -f ${T}${CALC_SHAREDIR}/$$i"; \
|
||||
${RM} -f ${T}${CALC_SHAREDIR}/$$i; \
|
||||
fi; \
|
||||
if [ -e "./$$i" ]; then \
|
||||
echo "${RM} -f ./$$i"; \
|
||||
${RM} -f ./$$i; \
|
||||
fi; \
|
||||
done
|
||||
|
||||
# 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} -p ${T}${CALC_SHAREDIR}; \
|
||||
${MKDIR} -p ${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}; \
|
||||
else \
|
||||
${TRUE}; \
|
||||
fi
|
||||
${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}; \
|
||||
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"; \
|
||||
fi; \
|
||||
done
|
||||
${Q} for i in ${DEAD_CALC_FILES} /dev/null; do \
|
||||
if [ "$$i" = "/dev/null" ]; then \
|
||||
continue; \
|
||||
fi; \
|
||||
if [ -e "${T}${CALC_SHAREDIR}/$$i" ]; then \
|
||||
echo "${RM} -f ${T}${CALC_SHAREDIR}/$$i"; \
|
||||
${RM} -f ${T}${CALC_SHAREDIR}/$$i; \
|
||||
fi; \
|
||||
if [ -e "./$$i" ]; then \
|
||||
echo "${RM} -f ./$$i"; \
|
||||
${RM} -f ./$$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 ${DEAD_CALC_FILES} /dev/null; do \
|
||||
if [ "$$i" = "/dev/null" ]; then \
|
||||
continue; \
|
||||
fi; \
|
||||
if [ -e "${T}${CALC_SHAREDIR}/$$i" ]; then \
|
||||
echo "${RM} -f ${T}${CALC_SHAREDIR}/$$i"; \
|
||||
${RM} -f ${T}${CALC_SHAREDIR}/$$i; \
|
||||
fi; \
|
||||
if [ -e "./$$i" ]; then \
|
||||
echo "${RM} -f ./$$i"; \
|
||||
${RM} -f ./$$i; \
|
||||
fi; \
|
||||
done
|
||||
-${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
|
||||
${Q}echo remove files that are obsolete
|
||||
-rm -f nextprime.cal nextprim.cal
|
||||
-rm -f test1000.cal test2000.cal ${LIBDIR}/test2000.cal
|
||||
-rm -f ${LIBDIR}/nextprime.cal ${LIBDIR}/nextprim.cal
|
||||
-rm -f ${LIBDIR}/test1000.cal ${LIBDIR}/cryrand.cal
|
||||
|
1198
cal/README
1198
cal/README
File diff suppressed because it is too large
Load Diff
1522
cal/alg_config.cal
Normal file
1522
cal/alg_config.cal
Normal file
File diff suppressed because it is too large
Load Diff
10
cal/beer.cal
10
cal/beer.cal
@@ -15,17 +15,13 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: beer.cal,v 29.1 1999/12/14 09:15:30 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/beer.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1996/11/13 13:21:05
|
||||
* File existed as early as: 1996
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://reality.sgi.com/chongo/
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
|
@@ -1,7 +1,7 @@
|
||||
/*
|
||||
* bernoulli - clculate the Nth Bernoulli number B(n)
|
||||
*
|
||||
* Copyright (C) 1999 David I. Bell
|
||||
* Copyright (C) 2000 David I. Bell and Landon Curt Noll
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
@@ -15,26 +15,26 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: bernoulli.cal,v 29.1 1999/12/14 09:15:30 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/bernoulli.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1991/09/30 11:18:41
|
||||
* File existed as early as: 1991
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* Calculate the Nth Bernoulli number B(n).
|
||||
* This uses the following symbolic formula to calculate B(n):
|
||||
*
|
||||
* NOTE: This is now a bulitin function.
|
||||
*
|
||||
* The non-buildin code used the following symbolic formula to calculate B(n):
|
||||
*
|
||||
* (b+1)^(n+1) - b^(n+1) = 0
|
||||
*
|
||||
* where b is a dummy value, and each power b^i gets replaced by B(i).
|
||||
* For example, for n = 3:
|
||||
*
|
||||
* (b+1)^4 - b^4 = 0
|
||||
* b^4 + 4*b^3 + 6*b^2 + 4*b + 1 - b^4 = 0
|
||||
* 4*b^3 + 6*b^2 + 4*b + 1 = 0
|
||||
@@ -48,11 +48,14 @@
|
||||
*/
|
||||
|
||||
|
||||
/*
|
||||
static Bnmax;
|
||||
static mat Bn[1001];
|
||||
*/
|
||||
|
||||
define B(n)
|
||||
{
|
||||
/*
|
||||
local nn, np1, i, sum, mulval, divval, combval;
|
||||
|
||||
if (!isint(n) || (n < 0))
|
||||
@@ -85,4 +88,6 @@ define B(n)
|
||||
}
|
||||
Bnmax = n;
|
||||
return Bn[n];
|
||||
*/
|
||||
return bernoulli(n);
|
||||
}
|
||||
|
55
cal/bernpoly.cal
Normal file
55
cal/bernpoly.cal
Normal file
@@ -0,0 +1,55 @@
|
||||
/*
|
||||
* 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.
|
||||
*
|
||||
* 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)";
|
||||
}
|
@@ -15,16 +15,12 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: bigprime.cal,v 29.1 1999/12/14 09:15:30 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/bigprime.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1991/05/22 21:56:32
|
||||
* File existed as early as: 1991
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
|
@@ -14,16 +14,12 @@
|
||||
# A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
# distributed with calc under the filename COPYING-LGPL. You should have
|
||||
# received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
# 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# @(#) $Revision: 29.1 $
|
||||
# @(#) $Id: bindings,v 29.1 1999/12/14 09:15:30 chongo Exp $
|
||||
# @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/bindings,v $
|
||||
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
#
|
||||
# Under source code control: 1993/05/02 20:09:19
|
||||
# File existed as early as: 1993
|
||||
#
|
||||
# Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
# Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
|
||||
# NOTE: This facility is ignored if calc was compiled with GNU-readline.
|
||||
# In that case, the standard readline mechanisms (see readline(3))
|
||||
|
254
cal/brentsolve.cal
Normal file
254
cal/brentsolve.cal
Normal file
@@ -0,0 +1,254 @@
|
||||
/*
|
||||
* 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.
|
||||
*
|
||||
* 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)";
|
||||
}
|
247
cal/chi.cal
Normal file
247
cal/chi.cal
Normal file
@@ -0,0 +1,247 @@
|
||||
/*
|
||||
* chi - chi^2 probabilities with degrees of freedom for null hypothesis
|
||||
*
|
||||
* Copyright (C) 2001 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.
|
||||
*
|
||||
* Under source code control: 2001/03/27 14:10:11
|
||||
* File existed as early as: 2001
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
/*
|
||||
* Z(x)
|
||||
*
|
||||
* From Handbook of Mathematical Functions
|
||||
* 10th printing, Dec 1972 with corrections
|
||||
* National Bureau of Standards
|
||||
*
|
||||
* Section 26.2.1, p931.
|
||||
*/
|
||||
define Z(x, eps_term)
|
||||
{
|
||||
local eps; /* error term */
|
||||
|
||||
/* obtain the error term */
|
||||
if (isnull(eps_term)) {
|
||||
eps = epsilon();
|
||||
} else {
|
||||
eps = eps_term;
|
||||
}
|
||||
|
||||
/* compute Z(x) value */
|
||||
return exp(-x*x/2, eps) / sqrt(2*pi(eps), eps);
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* P(x[, eps]) asymtotic P(x) expansion for x>0 to an given epsilon error term
|
||||
*
|
||||
* NOTE: If eps is omitted, the stored epsilon value is used.
|
||||
*
|
||||
* From Handbook of Mathematical Functions
|
||||
* 10th printing, Dec 1972 with corrections
|
||||
* National Bureau of Standards
|
||||
*
|
||||
* 26.2.11, p932:
|
||||
*
|
||||
* P(x) = 1/2 + Z(x) * sum(n=0; n < infinity){x^(2*n+1)/(1*3*5*...(2*n+1)};
|
||||
*
|
||||
* We continue the fraction until it is less than epsilon error term.
|
||||
*
|
||||
* Also note 26.2.5:
|
||||
*
|
||||
* P(x) + Q(x) = 1
|
||||
*/
|
||||
define P(x, eps_term)
|
||||
{
|
||||
local eps; /* error term */
|
||||
local s; /* sum */
|
||||
local x2; /* x^2 */
|
||||
local x_term; /* x^(2*r+1) */
|
||||
local odd_prod; /* 1*3*5* ... */
|
||||
local odd_term; /* next odd value to multiply into odd_prod */
|
||||
local term; /* the recent term added to the sum */
|
||||
|
||||
/* obtain the error term */
|
||||
if (isnull(eps_term)) {
|
||||
eps = epsilon();
|
||||
} else {
|
||||
eps = eps_term;
|
||||
}
|
||||
|
||||
/* firewall */
|
||||
if (x <= 0) {
|
||||
if (x == 0) {
|
||||
return 0; /* hack */
|
||||
} else {
|
||||
quit "Q(x[,eps]) 1st argument must be >= 0";
|
||||
}
|
||||
}
|
||||
if (eps <= 0) {
|
||||
quit "Q(x[,eps]) 2nd argument must be > 0";
|
||||
}
|
||||
|
||||
/*
|
||||
* aproximate sum(n=0; n < infinity){x^(2*n+1)/(1*3*5*...(2*n+1)}
|
||||
*/
|
||||
x2 = x*x;
|
||||
x_term = x;
|
||||
s = x_term; /* 1st term */
|
||||
odd_term = 1;
|
||||
odd_prod = 1;
|
||||
do {
|
||||
|
||||
/* compute the term */
|
||||
odd_term += 2;
|
||||
odd_prod *= odd_term;
|
||||
x_term *= x2;
|
||||
term = x_term / odd_prod;
|
||||
s += term;
|
||||
|
||||
} while (term >= eps);
|
||||
|
||||
/* apply term and factor */
|
||||
return 0.5 + Z(x,eps)*s;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* chi_prob(chi_sq, v[, eps]) - Prob of >= chi^2 with v degrees of freedom
|
||||
*
|
||||
* Computes the Probability, given the Null Hypothesis, that a given
|
||||
* Chi squared values >= chi_sq with v degrees of freedom.
|
||||
*
|
||||
* The chi_prob() function does not work well with odd degrees of freedom.
|
||||
* It is reasonable with even degrees of freedom, although one must give
|
||||
* a sifficently small error term as the degress gets large (>100).
|
||||
*
|
||||
* NOTE: This function does not work well with odd degrees of freedom.
|
||||
* Can somebody help / find a bug / provide a better method of
|
||||
* this odd degrees of freedom case?
|
||||
*
|
||||
* NOTE: This function works well with even degrees of freedom. However
|
||||
* when the even degrees gets large (say, as you approach 100), you
|
||||
* need to increase your error term.
|
||||
*
|
||||
* From Handbook of Mathematical Functions
|
||||
* 10th printing, Dec 1972 with corrections
|
||||
* National Bureau of Standards
|
||||
*
|
||||
* Section 26.4.4, p941:
|
||||
*
|
||||
* For odd v:
|
||||
*
|
||||
* Q(chi_sq, v) = 2*Q(chi) + 2*Z(chi) * (
|
||||
* sum(r=1, r<=(r-1)/2) {(chi_sq^r/chi) / (1*3*5*...(2*r-1)});
|
||||
*
|
||||
* chi = sqrt(chi_sq)
|
||||
*
|
||||
* NOTE: Q(x) = 1-P(x)
|
||||
*
|
||||
* Section 26.4.5, p941.
|
||||
*
|
||||
* For even v:
|
||||
*
|
||||
* Q(chi_sq, v) = sqrt(2*pi()) * Z(chi) * ( 1 +
|
||||
* sum(r=1, r=((v-2)/2)) { chi_sq^r / (2*4*...*(2r)) } );
|
||||
*
|
||||
* chi = sqrt(chi_sq)
|
||||
*
|
||||
* Observe that:
|
||||
*
|
||||
* Z(x) = exp(-x*x/2) / sqrt(2*pi()); (Section 26.2.1, p931)
|
||||
*
|
||||
* and thus:
|
||||
*
|
||||
* sqrt(2*pi()) * Z(chi) =
|
||||
* sqrt(2*pi()) * Z(sqrt(chi_sq)) =
|
||||
* sqrt(2*pi()) * exp(-sqrt(chi_sq)*sqrt(chi_sq)/2) / sqrt(2*pi()) =
|
||||
* exp(-sqrt(chi_sq)*sqrt(chi_sq)/2) =
|
||||
* exp(-sqrt(-chi_sq/2)
|
||||
*
|
||||
* So:
|
||||
*
|
||||
* Q(chi_sq, v) = exp(-sqrt(-chi_sq/2) * ( 1 + sum(....){...} );
|
||||
*/
|
||||
define chi_prob(chi_sq, v, eps_term)
|
||||
{
|
||||
local eps; /* error term */
|
||||
local r; /* index in finite sum */
|
||||
local r_lim; /* limit value for r */
|
||||
local s; /* sum */
|
||||
local d; /* demoninator (2*4*6*... or 1*3*5...) */
|
||||
local chi_term; /* chi_sq^r */
|
||||
local ret; /* return value */
|
||||
|
||||
/* obtain the error term */
|
||||
if (isnull(eps_term)) {
|
||||
eps = epsilon();
|
||||
} else {
|
||||
eps = eps_term;
|
||||
}
|
||||
|
||||
/*
|
||||
* odd degrees of freedom
|
||||
*/
|
||||
if (isodd(v)) {
|
||||
|
||||
local chi; /* sqrt(chi_sq) */
|
||||
|
||||
/* setup for sum */
|
||||
s = 1;
|
||||
d = 1;
|
||||
chi = sqrt(abs(chi_sq), eps);
|
||||
chi_term = chi;
|
||||
r_lim = (v-1)/2;
|
||||
|
||||
/* compute sum(r=1, r=((v-1)/2)) {(chi_sq^r/chi) / (1*3*5...*(2r-1))} */
|
||||
for (r=2; r <= r_lim; ++r) {
|
||||
chi_term *= chi_sq;
|
||||
d *= (2*r)-1;
|
||||
s += chi_term/d;
|
||||
}
|
||||
|
||||
/* apply term and factor, Q(x) = 1-P(x) */
|
||||
ret = 2*(1-P(chi)) + 2*Z(chi)*s;
|
||||
|
||||
/*
|
||||
* even degrees of freedom
|
||||
*/
|
||||
} else {
|
||||
|
||||
/* setup for sum */
|
||||
s =1;
|
||||
d = 1;
|
||||
chi_term = 1;
|
||||
r_lim = (v-2)/2;
|
||||
|
||||
/* compute sum(r=1, r=((v-2)/2)) { chi_sq^r / (2*4*...*(2r)) } */
|
||||
for (r=1; r <= r_lim; ++r) {
|
||||
chi_term *= chi_sq;
|
||||
d *= r*2;
|
||||
s += chi_term/d;
|
||||
}
|
||||
|
||||
/* apply factor - see observation in the main comment above */
|
||||
ret = exp(-chi_sq/2, eps) * s;
|
||||
}
|
||||
|
||||
return ret;
|
||||
}
|
@@ -17,16 +17,12 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: chrem.cal,v 29.1 1999/12/14 09:15:31 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/chrem.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1992/09/26 01:00:47
|
||||
* File existed as early as: 1992
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
|
100
cal/constants.cal
Normal file
100
cal/constants.cal
Normal file
@@ -0,0 +1,100 @@
|
||||
/*
|
||||
* 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.
|
||||
*
|
||||
* 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()";
|
||||
}
|
48
cal/deg.cal
48
cal/deg.cal
@@ -15,22 +15,18 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: deg.cal,v 29.1 1999/12/14 09:15:31 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/deg.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:33
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
obj dms {deg, min, sec};
|
||||
obj deg {deg, min, sec};
|
||||
|
||||
define dms(deg, min, sec)
|
||||
define deg(deg, min, sec)
|
||||
{
|
||||
local ans;
|
||||
|
||||
@@ -38,18 +34,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,31 +62,31 @@ 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 = -ans.deg;
|
||||
ans.min = -ans.min;
|
||||
ans.sec = -ans.sec;
|
||||
ans.deg = -a.deg;
|
||||
ans.min = -a.min;
|
||||
ans.sec = -a.sec;
|
||||
return ans;
|
||||
}
|
||||
|
||||
|
||||
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 +99,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 +130,5 @@ define fixdms(a)
|
||||
}
|
||||
|
||||
if (config("resource_debug") & 3) {
|
||||
print "obj dms {deg, min, sec} defined";
|
||||
print "obj deg {deg, min, sec} defined";
|
||||
}
|
||||
|
380
cal/dms.cal
Normal file
380
cal/dms.cal
Normal file
@@ -0,0 +1,380 @@
|
||||
/*
|
||||
* 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.
|
||||
*
|
||||
* 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";
|
||||
}
|
189
cal/dotest.cal
Normal file
189
cal/dotest.cal
Normal file
@@ -0,0 +1,189 @@
|
||||
/*
|
||||
* 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.
|
||||
*
|
||||
* 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;
|
||||
}
|
@@ -15,29 +15,26 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: ellip.cal,v 29.1 1999/12/14 09:15:31 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/ellip.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:33
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* 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 +42,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 +78,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 +100,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 +138,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 +159,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 +181,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;
|
||||
}
|
||||
|
200
cal/factorial.cal
Normal file
200
cal/factorial.cal
Normal file
@@ -0,0 +1,200 @@
|
||||
/*
|
||||
* 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.
|
||||
*
|
||||
* 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)";
|
||||
}
|
719
cal/factorial2.cal
Normal file
719
cal/factorial2.cal
Normal file
@@ -0,0 +1,719 @@
|
||||
/*
|
||||
* 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.
|
||||
*
|
||||
* 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)";
|
||||
}
|
103
cal/gvec.cal
Normal file
103
cal/gvec.cal
Normal file
@@ -0,0 +1,103 @@
|
||||
/*
|
||||
* 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.
|
||||
*
|
||||
* 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;
|
||||
}
|
@@ -15,17 +15,13 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: hello.cal,v 29.1 1999/12/14 09:15:31 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/hello.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1996/11/13 13:25:43
|
||||
* File existed as early as: 1996
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://reality.sgi.com/chongo/
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
|
380
cal/hms.cal
Normal file
380
cal/hms.cal
Normal file
@@ -0,0 +1,380 @@
|
||||
/*
|
||||
* 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.
|
||||
*
|
||||
* 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";
|
||||
}
|
88
cal/infinities.cal
Normal file
88
cal/infinities.cal
Normal file
@@ -0,0 +1,88 @@
|
||||
/*
|
||||
* infinities - handle infinities symbolically, a little helper file
|
||||
*
|
||||
* 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.
|
||||
*/
|
||||
|
||||
|
||||
static resource_debug_level;
|
||||
resource_debug_level = config("resource_debug", 0);
|
||||
|
||||
|
||||
define isinfinite(x)
|
||||
{
|
||||
if (isstr(x)) {
|
||||
if (strncmp(x, "cinf", 4) == 0
|
||||
|| strncmp(x, "pinf", 4) == 0 || strncmp(x, "ninf", 4) == 0)
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
define iscinf(x)
|
||||
{
|
||||
if (isstr(x)) {
|
||||
if (strncmp(x, "cinf", 4) == 0)
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
define ispinf(x)
|
||||
{
|
||||
if (isstr(x)) {
|
||||
if (strncmp(x, "pinf", 4) == 0)
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
define isninf(x)
|
||||
{
|
||||
if (isstr(x)) {
|
||||
if (strncmp(x, "ninf", 4) == 0)
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
define cinf()
|
||||
{
|
||||
return "cinf";
|
||||
}
|
||||
|
||||
define ninf()
|
||||
{
|
||||
return "ninf";
|
||||
}
|
||||
|
||||
define pinf()
|
||||
{
|
||||
return "pinf";
|
||||
}
|
||||
|
||||
|
||||
config("resource_debug", resource_debug_level),;
|
||||
if (config("resource_debug") & 3) {
|
||||
print "isinfinite(x)";
|
||||
print "iscinf(x)";
|
||||
print "ispinf(x)";
|
||||
print "isninf(x)";
|
||||
print "cinf()";
|
||||
print "ninf()";
|
||||
print "pinf()";
|
||||
}
|
218
cal/intfile.cal
Normal file
218
cal/intfile.cal
Normal file
@@ -0,0 +1,218 @@
|
||||
/*
|
||||
* intfile - integer to file and file to integer conversion
|
||||
*
|
||||
* Copyright (C) 2001 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.
|
||||
*
|
||||
* Under source code control: 2001/03/31 08:13:11
|
||||
* File existed as early as: 2001
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
/*
|
||||
* NOTE: Because leading HALF values are trimmed from integer, a file
|
||||
* that begins with lots of 0 bits (in the case of big endian)
|
||||
* or that ends with lots of 0 bits (in the case of little endian)
|
||||
* will be changed when the subsequent integer is written back.
|
||||
*/
|
||||
|
||||
|
||||
/*
|
||||
* file2be - convert a file into an big endian integer
|
||||
*
|
||||
* given:
|
||||
* filename filename to read
|
||||
*
|
||||
* returns:
|
||||
* integer read from its contents on big endian order
|
||||
*/
|
||||
define file2be(filename)
|
||||
{
|
||||
local fd; /* open file */
|
||||
local ret; /* integer to return */
|
||||
local c; /* character read from the file */
|
||||
local i;
|
||||
|
||||
/*
|
||||
* open the file for reading
|
||||
*/
|
||||
fd = fopen(filename, "rb");
|
||||
if (!isfile(fd)) quit "file2be: cannot open file for reading";
|
||||
|
||||
/*
|
||||
* read the contents of the file
|
||||
*
|
||||
* The first octets become the most significant bits of the integer.
|
||||
*/
|
||||
ret = 0;
|
||||
while (! isnull(c = fgetc(fd))) {
|
||||
ret <<= 8;
|
||||
ret += ord(c);
|
||||
}
|
||||
|
||||
/*
|
||||
* cleanup and return the integer
|
||||
*/
|
||||
fclose(fd);
|
||||
return ret;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* file2le - convert a file into an little endian integer
|
||||
*
|
||||
* given:
|
||||
* filename filename to read
|
||||
*
|
||||
* returns:
|
||||
* integer read from its contents on little endian order
|
||||
*/
|
||||
define file2le(filename)
|
||||
{
|
||||
local fd; /* open file */
|
||||
local ret; /* integer to return */
|
||||
local c; /* character read from the file */
|
||||
local shft; /* bit shift for the c value */
|
||||
local i;
|
||||
|
||||
/*
|
||||
* open the file for reading
|
||||
*/
|
||||
fd = fopen(filename, "rb");
|
||||
if (!isfile(fd)) quit "file2le: cannot open file for reading";
|
||||
|
||||
/*
|
||||
* read the contents of the file into a string
|
||||
*
|
||||
* The first octets become are the least significant bits of the integer.
|
||||
*/
|
||||
ret = 0;
|
||||
shft = 0;
|
||||
while (! isnull(c = fgetc(fd))) {
|
||||
ret |= (ord(c) << shft);
|
||||
shft += 8;
|
||||
}
|
||||
|
||||
/*
|
||||
* cleanup and return the integer
|
||||
*/
|
||||
fclose(fd);
|
||||
return ret;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* be2file - convert a big endian integer into a file
|
||||
*
|
||||
* given:
|
||||
* v integer to write to the file
|
||||
* filename filename to write
|
||||
*
|
||||
* returns:
|
||||
* The number of octets written to the file.
|
||||
*
|
||||
* NOTE: The absolute value of the integer is written to the file.
|
||||
*/
|
||||
define be2file(v, filename)
|
||||
{
|
||||
local fd; /* open file */
|
||||
local octlen; /* length of v in octets */
|
||||
local i;
|
||||
|
||||
/*
|
||||
* firewall
|
||||
*/
|
||||
if (!isint(v)) {
|
||||
quit "be2file: 1st arg not an integer";
|
||||
}
|
||||
v = abs(v);
|
||||
|
||||
/*
|
||||
* open the file for writing
|
||||
*/
|
||||
fd = fopen(filename, "wb");
|
||||
if (!isfile(fd)) quit "be2file: cannot open file for writing";
|
||||
|
||||
/*
|
||||
* write the octets to the file
|
||||
*
|
||||
* The most significant bits of the integer become the first file octets.
|
||||
*/
|
||||
octlen = int((highbit(v)+8) / 8);
|
||||
for (i=octlen-1; i >= 0; --i) {
|
||||
fputc(fd, char(v >> (i*8)));
|
||||
}
|
||||
|
||||
/*
|
||||
* cleanup
|
||||
*/
|
||||
fclose(fd);
|
||||
return octlen;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* le2file - convert a little endian integer into a file
|
||||
*
|
||||
* given:
|
||||
* v integer to write to the file
|
||||
* filename filename to write
|
||||
*
|
||||
* returns:
|
||||
* The number of octets written to the file.
|
||||
*
|
||||
* NOTE: The absolute value of the integer is written to the file.
|
||||
*/
|
||||
define le2file(v, filename)
|
||||
{
|
||||
local fd; /* open file */
|
||||
local cnt; /* octets written */
|
||||
|
||||
/*
|
||||
* firewall
|
||||
*/
|
||||
if (!isint(v)) {
|
||||
quit "be2file: 1st arg not an integer";
|
||||
}
|
||||
v = abs(v);
|
||||
|
||||
/*
|
||||
* open the file for writing
|
||||
*/
|
||||
fd = fopen(filename, "wb");
|
||||
if (!isfile(fd)) quit "le2file: cannot open file for writing";
|
||||
|
||||
/*
|
||||
* Write the octets to the file.
|
||||
*
|
||||
* The least significant bits of the integer become the first file octets.
|
||||
*/
|
||||
cnt = 0;
|
||||
while (v > 0) {
|
||||
fputc(fd, char(v));
|
||||
v >>= 8;
|
||||
++cnt;
|
||||
}
|
||||
|
||||
/*
|
||||
* cleanup
|
||||
*/
|
||||
fclose(fd);
|
||||
return cnt;
|
||||
}
|
728
cal/intnum.cal
Normal file
728
cal/intnum.cal
Normal file
@@ -0,0 +1,728 @@
|
||||
/*
|
||||
* intnum - implementation of tanhsinh- and Gauss-Legendre quadrature
|
||||
*
|
||||
* 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.
|
||||
*/
|
||||
|
||||
|
||||
static resource_debug_level;
|
||||
resource_debug_level = config("resource_debug", 0);
|
||||
|
||||
|
||||
read -once infinities;
|
||||
|
||||
static __CZ__tanhsinh_x;
|
||||
static __CZ__tanhsinh_w;
|
||||
static __CZ__tanhsinh_order;
|
||||
static __CZ__tanhsinh_prec;
|
||||
|
||||
define quadtsdeletenodes()
|
||||
{
|
||||
free(__CZ__tanhsinh_x);
|
||||
free(__CZ__tanhsinh_w);
|
||||
free(__CZ__tanhsinh_order);
|
||||
free(__CZ__tanhsinh_prec);
|
||||
}
|
||||
|
||||
define quadtscomputenodes(order, expo, eps)
|
||||
{
|
||||
local t cht sht chp sum k PI places;
|
||||
local h t0 x w;
|
||||
if (__CZ__tanhsinh_order == order && __CZ__tanhsinh_prec == eps)
|
||||
return 1;
|
||||
__CZ__tanhsinh_order = order;
|
||||
__CZ__tanhsinh_prec = eps;
|
||||
__CZ__tanhsinh_x = list();
|
||||
__CZ__tanhsinh_w = list();
|
||||
/* The tanhsinh algorithm needs a slightly higher precision than G-L */
|
||||
eps = epsilon(eps * 1e-2);
|
||||
places = highbit(1 + int (1 / epsilon())) +1;
|
||||
PI = pi();
|
||||
sum = 0;
|
||||
t0 = 2 ^ (-expo);
|
||||
h = 2 * t0;
|
||||
/*
|
||||
* The author wanted to use the mpmath trick here which was
|
||||
* advertised---and reasonably so!---to be faster. Didn't work out
|
||||
* so well with calc.
|
||||
* PI4 = PI/4;
|
||||
* expt0 = bround(exp(t0),places);
|
||||
* a = bround( PI4 * expt0,places);
|
||||
* b = bround(PI4 / expt0,places);
|
||||
* udelta = bround(exp(h),places);
|
||||
* urdelta = bround(1/udelta,places);
|
||||
*/
|
||||
/* make use of x(-t) = -x(t), w(-t) = w(t) */
|
||||
for (k = 0; k < 20 * order + 1; k++) {
|
||||
/*
|
||||
* x = tanh(pi/2 * sinh(t))
|
||||
* w = pi/2 * cosh(t) / cosh(pi/2 * sinh(t))^2
|
||||
*/
|
||||
t = bround(t0 + k * h, places);
|
||||
|
||||
cht = bround(cosh(t), places);
|
||||
sht = bround(sinh(t), places);
|
||||
chp = bround(cosh(0.5 * PI * sht), places);
|
||||
x = bround(tanh(0.5 * PI * sht), places);
|
||||
w = bround((PI * h * cht) / (2 * chp ^ 2), places);
|
||||
/*
|
||||
* c = bround(exp(a-b),places);
|
||||
* d = bround(1/c,places);
|
||||
* co =bround( (c+d)/2,places);
|
||||
* si =bround( (c-d)/2,places);
|
||||
* x = bround(si / co,places);
|
||||
* w = bround((a+b) / co^2,places);
|
||||
*/
|
||||
if (abs(x - 1) <= eps)
|
||||
break;
|
||||
|
||||
append(__CZ__tanhsinh_x, x);
|
||||
append(__CZ__tanhsinh_w, w);
|
||||
/*
|
||||
* a *= udelta;
|
||||
* b *= urdelta;
|
||||
*/
|
||||
}
|
||||
|
||||
/* Normalize the weights to make them add up to 2 (two) */
|
||||
/*
|
||||
* for(k=0;k < size(__CZ__tanhsinh_w);k++)
|
||||
* sum = bround(sum + __CZ__tanhsinh_w[k],places);
|
||||
* sum *= 2;
|
||||
* for(k=0;k < size(__CZ__tanhsinh_w);k++)
|
||||
* __CZ__tanhsinh_w[k] = bround(2.0 * __CZ__tanhsinh_w[k] / sum,places);
|
||||
*/
|
||||
|
||||
epsilon(eps);
|
||||
return 1;
|
||||
}
|
||||
|
||||
define quadtscore(a, b, n)
|
||||
{
|
||||
local k c d order eps places sum ret x x1 x2 xm w w1 w2 m sizel;
|
||||
|
||||
eps = epsilon(epsilon() * 1e-2);
|
||||
places = highbit(1 + int (1 / epsilon())) +1;
|
||||
m = int (4 + max(0, ln(places / 30.0) / ln(2))) + 2;
|
||||
if (!isnull(n)) {
|
||||
order = n;
|
||||
m = ilog(order / 3, 2) + 1;
|
||||
} else
|
||||
order = 3 * 2 ^ (m - 1);
|
||||
|
||||
quadtscomputenodes(order, m, epsilon());
|
||||
sizel = size(__CZ__tanhsinh_w);
|
||||
|
||||
if (isinfinite(a) || isinfinite(b)) {
|
||||
/*
|
||||
* x
|
||||
* t = ------------
|
||||
* 2
|
||||
* sqrt(1 - y )
|
||||
*/
|
||||
if (isninf(a) && ispinf(b)) {
|
||||
for (k = 0; k < sizel; k++) {
|
||||
x1 = __CZ__tanhsinh_x[k];
|
||||
x2 = -__CZ__tanhsinh_x[k];
|
||||
w1 = __CZ__tanhsinh_w[k];
|
||||
|
||||
x = bround(x1 * (1 - x1 ^ 2) ^ (-1 / 2), places);
|
||||
xm = bround(x2 * (1 - x2 ^ 2) ^ (-1 / 2), places);
|
||||
w = bround(w1 * (((1 - x1 ^ 2) ^ (-1 / 2)) / (1 - x1 ^ 2)),
|
||||
places);
|
||||
w2 = bround(w1 * (((1 - x2 ^ 2) ^ (-1 / 2)) / (1 - x2 ^ 2)),
|
||||
places);
|
||||
sum += bround(w * f(x), places);
|
||||
sum += bround(w2 * f(xm), places);
|
||||
}
|
||||
}
|
||||
/*
|
||||
* 1
|
||||
* t = - - + b + 1
|
||||
* x
|
||||
*/
|
||||
else if (isninf(a) && !iscinf(b)) {
|
||||
for (k = 0; k < sizel; k++) {
|
||||
x1 = __CZ__tanhsinh_x[k];
|
||||
x2 = -__CZ__tanhsinh_x[k];
|
||||
w1 = __CZ__tanhsinh_w[k];
|
||||
|
||||
x = bround((b + 1) - (2 / (x1 + 1)), places);
|
||||
xm = bround((b + 1) - (2 / (x2 + 1)), places);
|
||||
w = bround(w1 * (1 / 2 * (2 / (x1 + 1)) ^ 2), places);
|
||||
w2 = bround(w1 * (1 / 2 * (2 / (x2 + 1)) ^ 2), places);
|
||||
sum += bround(w * f(x), places);
|
||||
sum += bround(w2 * f(xm), places);
|
||||
}
|
||||
}
|
||||
/*
|
||||
* 1
|
||||
* t = - + a - 1
|
||||
* x
|
||||
*/
|
||||
else if (!iscinf(a) && ispinf(b)) {
|
||||
for (k = 0; k < sizel; k++) {
|
||||
x1 = __CZ__tanhsinh_x[k];
|
||||
x2 = -__CZ__tanhsinh_x[k];
|
||||
w1 = __CZ__tanhsinh_w[k];
|
||||
x = bround((a - 1) + (2 / (x1 + 1)), places);
|
||||
xm = bround((a - 1) + (2 / (x2 + 1)), places);
|
||||
w = bround(w1 * (((1 / 2) * (2 / (x1 + 1)) ^ 2)), places);
|
||||
w2 = bround(w1 * (((1 / 2) * (2 / (x2 + 1)) ^ 2)), places);
|
||||
sum += bround(w * f(x), places);
|
||||
sum += bround(w2 * f(xm), places);
|
||||
}
|
||||
} else if (isninf(a) || isninf(b)) {
|
||||
/*TODO: swap(a,b) and negate(w)? Lookup! */
|
||||
return newerror("quadtscore: reverse limits?");
|
||||
} else {
|
||||
return
|
||||
newerror("quadtscore: complex infinity not yet implemented");
|
||||
}
|
||||
ret = sum;
|
||||
} else {
|
||||
/* Avoid rounding errors */
|
||||
if (a == -1 && b == 1) {
|
||||
c = 1;
|
||||
d = 0;
|
||||
} else {
|
||||
c = (b - a) / 2;
|
||||
d = (b + a) / 2;
|
||||
}
|
||||
sum = 0;
|
||||
for (k = 0; k < sizel; k++) {
|
||||
sum +=
|
||||
bround(__CZ__tanhsinh_w[k] * f(c * __CZ__tanhsinh_x[k] + d),
|
||||
places);
|
||||
sum +=
|
||||
bround(__CZ__tanhsinh_w[k] * f(c * -__CZ__tanhsinh_x[k] + d),
|
||||
places);
|
||||
}
|
||||
ret = c * sum;
|
||||
}
|
||||
epsilon(eps);
|
||||
return ret;
|
||||
}
|
||||
|
||||
static __CZ__quadts_error;
|
||||
|
||||
define quadts(a, b, points)
|
||||
{
|
||||
local k sp results epsbits nsect interval length segment slope C ;
|
||||
local x1 x2 y1 y2 sum D1 D2 D3 D4;
|
||||
if (param(0) < 2)
|
||||
return newerror("quadts: not enough arguments");
|
||||
epsbits = highbit(1 + int (1 / epsilon())) +1;
|
||||
if (param(0) < 3 || isnull(points)) {
|
||||
/* return as given */
|
||||
return quadtscore(a, b);
|
||||
} else {
|
||||
if ((isinfinite(a) || isinfinite(b))
|
||||
&& (!ismat(points) && !islist(points)))
|
||||
return
|
||||
newerror(strcat
|
||||
("quadts: segments of infinite length ",
|
||||
"are not yet supported"));
|
||||
if (ismat(points) || islist(points)) {
|
||||
sp = size(points);
|
||||
if (sp == 0)
|
||||
return
|
||||
newerror(strcat
|
||||
("quadts: variable 'points` must be a list or ",
|
||||
"1d-matrix of a length > 0"));
|
||||
/* check if all points are numbers */
|
||||
for (k = 0; k < sp; k++) {
|
||||
if (!isnum(points[k]))
|
||||
return
|
||||
newerror(strcat
|
||||
("quadts: elements of 'points` must be",
|
||||
" numbers only"));
|
||||
}
|
||||
/* We have n-1 intervals and a and b, hence n-1 + 2 results */
|
||||
results = mat[sp + 1];
|
||||
if (a != points[0]) {
|
||||
results[0] = quadtscore(a, points[0]);
|
||||
} else {
|
||||
results[0] = 0;
|
||||
}
|
||||
if (sp == 1) {
|
||||
if (b != points[0]) {
|
||||
results[1] = quadtscore(points[0], b);
|
||||
} else {
|
||||
results[1] = 0;
|
||||
}
|
||||
} else {
|
||||
for (k = 1; k < sp; k++) {
|
||||
results[k] = quadtscore(points[k - 1], points[k]);
|
||||
}
|
||||
if (b != points[k - 1]) {
|
||||
results[k] = quadtscore(points[k - 1], b);
|
||||
} else {
|
||||
results[k] = 0;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
if (!isint(points) || points <= 0)
|
||||
return newerror(strcat("quadts: variable 'points` must be a ",
|
||||
"list or a positive integer"));
|
||||
/* Taking "points" as the number of equally spaced intervals */
|
||||
results = mat[points + 1];
|
||||
/* It is easy if a,b lie on the real line */
|
||||
if (isreal(a) && isreal(b)) {
|
||||
length = abs(a - b);
|
||||
segment = length / points;
|
||||
|
||||
for (k = 1; k <= points; k++) {
|
||||
results[k - 1] =
|
||||
quadtscore(a + (k - 1) * segment, a + k * segment);
|
||||
}
|
||||
} else {
|
||||
/* We have at least one complex limit but treat "points" still
|
||||
* as the number of equally spaced intervals on a straight line
|
||||
* connecting a and b. Computing the segments here is a bit
|
||||
* more complicated but not much, it should have been taught in
|
||||
* highschool.
|
||||
* Other contours by way of a list of points */
|
||||
slope = (im(b) - im(a)) / (re(b) - re(a));
|
||||
C = (im(a) + slope) * re(a);
|
||||
length = abs(re(a) - re(b));
|
||||
segment = length / points;
|
||||
|
||||
/* y = mx+C where m is the slope, x is the real part and y the
|
||||
* imaginary part */
|
||||
if(re(a)>re(b))swap(a,b);
|
||||
for (k = re(a); k <= (re(b)); k+=segment) {
|
||||
x1 = slope*(k) + C;
|
||||
results[k] = quadtscore(k + x1 * 1i);
|
||||
}
|
||||
} /* else of isreal */
|
||||
} /* else of ismat|islist */
|
||||
} /* else of isnull(points) */
|
||||
/* With a bit of undeserved luck we have a result by now. */
|
||||
sp = size(results);
|
||||
for (k = 0; k < sp; k++) {
|
||||
sum += results[k];
|
||||
}
|
||||
return sum;
|
||||
}
|
||||
|
||||
static __CZ__gl_x;
|
||||
static __CZ__gl_w;
|
||||
static __CZ__gl_order;
|
||||
static __CZ__gl_prec;
|
||||
|
||||
define quadglcomputenodes(N)
|
||||
{
|
||||
local places k l x w t1 t2 t3 t4 t5 r tmp;
|
||||
|
||||
if (__CZ__gl_order == N && __CZ__gl_prec == epsilon())
|
||||
return;
|
||||
|
||||
__CZ__gl_x = mat[N];
|
||||
__CZ__gl_w = mat[N];
|
||||
__CZ__gl_order = N;
|
||||
__CZ__gl_prec = epsilon();
|
||||
|
||||
places = highbit(1 + int (1 / epsilon())) +1;
|
||||
|
||||
/*
|
||||
* Compute roots and weights (doing it inline seems to be fastest)
|
||||
* Trick shamelessly stolen from D. Bailey et .al (program "arprec")
|
||||
*/
|
||||
for (k = 1; k <= N//2; k++) {
|
||||
r = bround(cos(pi() * (k - .25) / (N + .5)), places);
|
||||
while (1) {
|
||||
t1 = 1, t2 = 0;
|
||||
for (l = 1; l <= N; l++) {
|
||||
t3 = t2;
|
||||
t2 = t1;
|
||||
t1 = bround(((2 * l - 1) * r * t2 - (l - 1) * t3) / l, places);
|
||||
}
|
||||
t4 = bround(N * (r * t1 - t2) / ((r ^ 2) - 1), places);
|
||||
t5 = r;
|
||||
tmp = t1 / t4;
|
||||
r = r - tmp;
|
||||
if (abs(tmp) <= epsilon())
|
||||
break;
|
||||
}
|
||||
x = r;
|
||||
w = bround(2 / ((1 - r ^ 2) * t4 ^ 2), places);
|
||||
|
||||
__CZ__gl_x[k - 1] = x;
|
||||
__CZ__gl_w[k - 1] = w;
|
||||
__CZ__gl_x[N - k] = -__CZ__gl_x[k - 1];
|
||||
__CZ__gl_w[N - k] = __CZ__gl_w[k - 1];
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
define quadgldeletenodes()
|
||||
{
|
||||
free(__CZ__gl_x);
|
||||
free(__CZ__gl_w);
|
||||
free(__CZ__gl_order);
|
||||
free(__CZ__gl_prec);
|
||||
}
|
||||
|
||||
define quadglcore(a, b, n)
|
||||
{
|
||||
local k c d digs order eps places sum ret err x x1 w w1 m;
|
||||
local phalf x2 px1 spx1 u b1 a1 half;
|
||||
|
||||
eps = epsilon(epsilon() * 1e-2);
|
||||
places = highbit(1 + int (1 / epsilon())) +1;
|
||||
if (!isnull(n))
|
||||
order = n;
|
||||
else {
|
||||
m = int (4 + max(0, ln(places / 30.0) / ln(2))) + 2;
|
||||
order = 3 * 2 ^ (m - 1);
|
||||
}
|
||||
|
||||
|
||||
quadglcomputenodes(order, 1);
|
||||
|
||||
if (isinfinite(a) || isinfinite(b)) {
|
||||
if (isninf(a) && ispinf(b)) {
|
||||
for (k = 0; k < order; k++) {
|
||||
x1 = __CZ__gl_x[k];
|
||||
w1 = __CZ__gl_w[k];
|
||||
|
||||
x = bround(x1 * (1 - x1 ^ 2) ^ (-1 / 2), places);
|
||||
w = bround(w1 * (((1 - x1 ^ 2) ^ (-1 / 2)) / (1 - x1 ^ 2)),
|
||||
places);
|
||||
sum += bround(w * f(x), places);
|
||||
}
|
||||
} else if (isninf(a) && !iscinf(b)) {
|
||||
for (k = 0; k < order; k++) {
|
||||
x1 = __CZ__gl_x[k];
|
||||
w1 = __CZ__gl_w[k];
|
||||
|
||||
x = bround((b + 1) - (2 / (x1 + 1)), places);
|
||||
w = bround(w1 * (1 / 2 * (2 / (x1 + 1)) ^ 2), places);
|
||||
sum += bround(w * f(x), places);
|
||||
}
|
||||
} else if (!iscinf(a) && ispinf(b)) {
|
||||
for (k = 0; k < order; k++) {
|
||||
x1 = __CZ__gl_x[k];
|
||||
w1 = __CZ__gl_w[k];
|
||||
x = bround((a - 1) + (2 / (x1 + 1)), places);
|
||||
w = bround(w1 * (((1 / 2) * (2 / (x1 + 1)) ^ 2)), places);
|
||||
sum += bround(w * f(x), places);
|
||||
}
|
||||
} else if (isninf(a) || isninf(b)) {
|
||||
/*TODO: swap(a,b) and negate(w)? Lookup! */
|
||||
return newerror("quadglcore: reverse limits?");
|
||||
} else
|
||||
return
|
||||
newerror("quadglcore: complex infinity not yet implemented");
|
||||
ret = sum;
|
||||
} else {
|
||||
/* Avoid rounding errors */
|
||||
if (a == -1 && b == 1) {
|
||||
c = 1;
|
||||
d = 0;
|
||||
} else {
|
||||
c = (b - a) / 2;
|
||||
d = (b + a) / 2;
|
||||
}
|
||||
sum = 0;
|
||||
for (k = 0; k < order; k++) {
|
||||
sum += bround(__CZ__gl_w[k] * f(c * __CZ__gl_x[k] + d), places);
|
||||
}
|
||||
ret = c * sum;
|
||||
}
|
||||
epsilon(eps);
|
||||
return ret;
|
||||
}
|
||||
|
||||
define quadgl(a, b, points)
|
||||
{
|
||||
local k sp results epsbits nsect interval length segment slope C x1 y1 x2
|
||||
y2;
|
||||
local sum D1 D2 D3 D4;
|
||||
if (param(0) < 2)
|
||||
return newerror("quadgl: not enough arguments");
|
||||
epsbits = highbit(1 + int (1 / epsilon())) +1;
|
||||
if (isnull(points)) {
|
||||
/* return as given */
|
||||
return quadglcore(a, b);
|
||||
} else {
|
||||
/* But if we could half the time needed to execute a single operation
|
||||
* we could do all of it in just twice that time. */
|
||||
if (isinfinite(a) || isinfinite(b)
|
||||
&& (!ismat(points) && !islist(points)))
|
||||
return
|
||||
newerror(strcat
|
||||
("quadgl: multiple segments of infinite length ",
|
||||
"are not yet supported"));
|
||||
if (ismat(points) || islist(points)) {
|
||||
sp = size(points);
|
||||
if (sp == 0)
|
||||
return
|
||||
newerror(strcat
|
||||
("quadgl: variable 'points` must be a list or ",
|
||||
"1d-matrix of a length > 0"));
|
||||
/* check if all points are numbers */
|
||||
for (k = 0; k < sp; k++) {
|
||||
if (!isnum(points[k]))
|
||||
return
|
||||
newerror(strcat
|
||||
("quadgl: elements of 'points` must be ",
|
||||
"numbers only"));
|
||||
}
|
||||
/* We have n-1 intervals and a and b, hence n-1 + 2 results */
|
||||
results = mat[sp + 1];
|
||||
if (a != points[0]) {
|
||||
results[0] = quadglcore(a, points[0]);
|
||||
} else {
|
||||
results[0] = 0;
|
||||
}
|
||||
if (sp == 1) {
|
||||
if (b != points[0]) {
|
||||
results[1] = quadglcore(points[0], b);
|
||||
} else {
|
||||
results[1] = 0;
|
||||
}
|
||||
} else {
|
||||
for (k = 1; k < sp; k++) {
|
||||
results[k] = quadglcore(points[k - 1], points[k]);
|
||||
}
|
||||
if (b != points[k - 1]) {
|
||||
results[k] = quadglcore(points[k - 1], b);
|
||||
} else {
|
||||
results[k] = 0;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
if (!isint(points) || points <= 0)
|
||||
return newerror(strcat("quadgl: variable 'points` must be a ",
|
||||
"list or a positive integer"));
|
||||
/* Taking "points" as the number of equally spaced intervals */
|
||||
results = mat[points + 1];
|
||||
/* It is easy if a,b lie on the real line */
|
||||
if (isreal(a) && isreal(b)) {
|
||||
length = abs(a - b);
|
||||
segment = length / points;
|
||||
|
||||
for (k = 1; k <= points; k++) {
|
||||
results[k - 1] =
|
||||
quadglcore(a + (k - 1) * segment, a + k * segment);
|
||||
}
|
||||
} else {
|
||||
/* Other contours by way of a list of points */
|
||||
slope = (im(b) - im(a)) / (re(b) - re(a));
|
||||
C = (im(a) + slope) * re(a);
|
||||
length = abs(re(a) - re(b));
|
||||
segment = length / points;
|
||||
|
||||
/* y = mx+C where m is the slope, x is the real part and y the
|
||||
* imaginary part */
|
||||
if(re(a)>re(b))swap(a,b);
|
||||
for (k = re(a); k <= (re(b)); k+=segment) {
|
||||
x1 = slope*(k) + C;
|
||||
results[k] = quadglcore(k + x1 * 1i);
|
||||
}
|
||||
} /* else of isreal */
|
||||
} /* else of ismat|islist */
|
||||
} /* else of isnull(points) */
|
||||
/* With a bit of undeserved luck we have a result by now. */
|
||||
sp = size(results);
|
||||
for (k = 0; k < sp; k++) {
|
||||
sum += results[k];
|
||||
}
|
||||
return sum;
|
||||
}
|
||||
|
||||
define quad(a, b, points = -1, method = "tanhsinh")
|
||||
{
|
||||
if (isnull(a) || isnull(b) || param(0) < 2)
|
||||
return newerror("quad: both limits must be given");
|
||||
if (isstr(a)) {
|
||||
if (strncmp(a, "cinf", 1) == 0)
|
||||
return
|
||||
newerror(strcat
|
||||
("quad: complex infinity not yet supported, use",
|
||||
" 'pinf' or 'ninf' respectively"));
|
||||
}
|
||||
if (isstr(b)) {
|
||||
if (strncmp(b, "cinf", 1) == 0)
|
||||
return
|
||||
newerror(strcat
|
||||
("quad: complex infinity not yet supported, use",
|
||||
" 'pinf' or 'ninf' respectively"));
|
||||
}
|
||||
|
||||
if (param(0) == 3) {
|
||||
if (isstr(points))
|
||||
method = points;
|
||||
}
|
||||
|
||||
if (strncmp(method, "tanhsinh", 1) == 0) {
|
||||
if (!isstr(points)) {
|
||||
if (points == -1) {
|
||||
return quadts(a, b);
|
||||
} else {
|
||||
return quadts(a, b, points);
|
||||
}
|
||||
} else {
|
||||
return quadts(a, b);
|
||||
}
|
||||
}
|
||||
|
||||
if (strncmp(method, "gausslegendre", 1) == 0) {
|
||||
if (!isstr(points)) {
|
||||
if (points == -1) {
|
||||
return quadgl(a, b);
|
||||
} else {
|
||||
return quadgl(a, b, points);
|
||||
}
|
||||
} else {
|
||||
return quadgl(a, b);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
define makerange(start, end, steps)
|
||||
{
|
||||
local ret k l step C length slope x1 x2 y1 y2;
|
||||
local segment;
|
||||
steps = int (steps);
|
||||
if (steps < 1) {
|
||||
return newerror("makerange: number of steps must be > 0");
|
||||
}
|
||||
if (!isnum(start) || !isnum(end)) {
|
||||
return newerror("makerange: only numbers are supported yet");
|
||||
}
|
||||
if (isreal(start) && isreal(end)) {
|
||||
step = (end - start) / (steps);
|
||||
print step;
|
||||
ret = mat[steps + 1];
|
||||
for (k = 0; k <= steps; k++) {
|
||||
ret[k] = k * step + start;
|
||||
}
|
||||
} else {
|
||||
ret = mat[steps + 1];
|
||||
if (re(start) > re(end)) {
|
||||
swap(start, end);
|
||||
}
|
||||
|
||||
slope = (im(end) - im(start)) / (re(end) - re(start));
|
||||
C = im(start) - slope * re(start);
|
||||
length = abs(re(start) - re(end));
|
||||
segment = length / (steps);
|
||||
|
||||
for (k = re(start), l = 0; k <= (re(end)); k += segment, l++) {
|
||||
x1 = slope * (k) + C;
|
||||
ret[l] = k + x1 * 1i;
|
||||
}
|
||||
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
define makecircle(radius, center, points)
|
||||
{
|
||||
local ret k a b twopi centerx centery;
|
||||
if (!isint(points) || points < 2) {
|
||||
return
|
||||
newerror("makecircle: number of points is not a positive integer");
|
||||
}
|
||||
if (!isnum(center)) {
|
||||
return newerror("makecircle: center does not lie on the complex plane");
|
||||
}
|
||||
if (!isreal(radius) || radius <= 0) {
|
||||
return newerror("makecircle: radius is not a real > 0");
|
||||
}
|
||||
ret = mat[points];
|
||||
twopi = 2 * pi();
|
||||
centerx = re(center);
|
||||
centery = im(center);
|
||||
for (k = 0; k < points; k++) {
|
||||
a = centerx + radius * cos(twopi * k / points);
|
||||
b = centery + radius * sin(twopi * k / points);
|
||||
ret[k] = a + b * 1i;
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
define makeellipse(angle, a, b, center, points)
|
||||
{
|
||||
local ret k x y twopi centerx centery;
|
||||
if (!isint(points) || points < 2) {
|
||||
return
|
||||
newerror("makeellipse: number of points is not a positive integer");
|
||||
}
|
||||
if (!isnum(center)) {
|
||||
return
|
||||
newerror("makeellipse: center does not lie on the complex plane");
|
||||
}
|
||||
if (!isreal(a) || a <= 0) {
|
||||
return newerror("makecircle: a is not a real > 0");
|
||||
}
|
||||
if (!isreal(b) || b <= 0) {
|
||||
return newerror("makecircle: b is not a real > 0");
|
||||
}
|
||||
if (!isreal(angle)) {
|
||||
return newerror("makecircle: angle is not a real");
|
||||
}
|
||||
ret = mat[points];
|
||||
twopi = 2 * pi();
|
||||
centerx = re(center);
|
||||
centery = im(center);
|
||||
for (k = 0; k < points; k++) {
|
||||
x = centerx + a * cos(twopi * k / points) * cos(angle)
|
||||
- b * sin(twopi * k / points) * sin(angle);
|
||||
y = centerx + a * cos(twopi * k / points) * sin(angle)
|
||||
+ b * sin(twopi * k / points) * cos(angle);
|
||||
ret[k] = x + y * 1i;
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
define makepoints()
|
||||
{
|
||||
local ret k;
|
||||
ret = mat[param(0)];
|
||||
for (k = 0; k < param(0); k++) {
|
||||
if (!isnum(param(k + 1))) {
|
||||
return
|
||||
newerror(strcat
|
||||
("makepoints: parameter number \"", str(k + 1),
|
||||
"\" is not a number"));
|
||||
}
|
||||
ret[k] = param(k + 1);
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
|
||||
config("resource_debug", resource_debug_level),;
|
||||
if (config("resource_debug") & 3) {
|
||||
print "quadtsdeletenodes()";
|
||||
print "quadtscomputenodes(order, expo, eps)";
|
||||
print "quadtscore(a,b,n)";
|
||||
print "quadts(a,b,points)";
|
||||
print "quadglcomputenodes(N)";
|
||||
print "quadgldeletenodes()";
|
||||
print "quadglcore(a,b,n)";
|
||||
print "quadgl(a,b,points)";
|
||||
print "quad(a,b,points=-1,method=\"tanhsinh\")";
|
||||
print "makerange(start, end, steps)";
|
||||
print "makecircle(radius, center, points)";
|
||||
print "makeellipse(angle, a, b, center, points)";
|
||||
print "makepoints(a1,[...])";
|
||||
}
|
284
cal/lambertw.cal
Normal file
284
cal/lambertw.cal
Normal file
@@ -0,0 +1,284 @@
|
||||
/*
|
||||
* 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.
|
||||
*
|
||||
* 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()";
|
||||
}
|
52
cal/linear.cal
Normal file
52
cal/linear.cal
Normal file
@@ -0,0 +1,52 @@
|
||||
/*
|
||||
* 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.
|
||||
*
|
||||
* 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
|
||||
*
|
||||
* given:
|
||||
* x0, y0 first known point on the line
|
||||
* x1, y1 second knonw point on the line
|
||||
* x a given point to interpolate on
|
||||
*
|
||||
* returns:
|
||||
* y such that (x,y) is on the line defined by (x0,y0) and (x1,y1)
|
||||
*
|
||||
* NOTE: The line cannot be vertical. So x0 != y0.
|
||||
*/
|
||||
define linear(x0, y0, x1, y1, x)
|
||||
{
|
||||
/* firewall */
|
||||
if (!isnum(x0) || ! isnum(y0) || !isnum(x1) || ! isnum(y1) || !isnum(x)) {
|
||||
quit "non-numeric argument passed to linear";
|
||||
}
|
||||
if (x0 == x1) {
|
||||
quit "linear given a line with an infinite slope";
|
||||
}
|
||||
|
||||
/* return y = y0 + (delta_Y/delta_X) * (x - x0) */
|
||||
return y0 + (((y1-y0)/(x1-x0)) * (x - x0));
|
||||
}
|
108
cal/lnseries.cal
Normal file
108
cal/lnseries.cal
Normal file
@@ -0,0 +1,108 @@
|
||||
/*
|
||||
* 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.
|
||||
*
|
||||
* 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()";
|
||||
}
|
1041
cal/lucas.cal
1041
cal/lucas.cal
File diff suppressed because it is too large
Load Diff
@@ -15,17 +15,13 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: lucas_chk.cal,v 29.1 1999/12/14 09:15:31 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/lucas_chk.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1991/01/11 05:41:43
|
||||
* File existed as early as: 1991
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://reality.sgi.com/chongo/
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -336,7 +332,7 @@ lucas_chk(high_n, quiet)
|
||||
|
||||
/* skip primes where h>=2^n */
|
||||
if (highbit(h_p[i]) >= n_p[i]) {
|
||||
if (config("resource_debug") & 3) {
|
||||
if (config("resource_debug") & 8) {
|
||||
print "h>=2^n skip:", h_p[i]:"*2^":n_p[i]:"-1";
|
||||
}
|
||||
continue;
|
||||
|
@@ -1,165 +0,0 @@
|
||||
/*
|
||||
* lucas_tbl - lucasian criteria for primality tables
|
||||
*
|
||||
* Copyright (C) 1999 Landon Curt Noll
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: lucas_tbl.cal,v 29.1 1999/12/14 09:15:31 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/lucas_tbl.cal,v $
|
||||
*
|
||||
* Under source code control: 1991/01/26 02:43:43
|
||||
* File existed as early as: 1991
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://reality.sgi.com/chongo/
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* Lucasian criteria for primality
|
||||
*
|
||||
* The following table is taken from:
|
||||
*
|
||||
* "Lucasian Criteria for the Primality of N=h*2^n-1", by Hans Riesel,
|
||||
* Mathematics of Computation, Vol 23 #108, p 872.
|
||||
*
|
||||
* The index of the *_val[] arrays correspond to the v(1) values found
|
||||
* in the table. That is, for v(1) == x:
|
||||
*
|
||||
* D == d_val[x]
|
||||
* a == a_val[x]
|
||||
* b == b_val[x]
|
||||
* r == r_val[x] (r == abs(a^2 - b^2*D))
|
||||
*
|
||||
*
|
||||
* Note that when *_val[i] is not a number, the related v(1) value
|
||||
* is not found in Table 1.
|
||||
*/
|
||||
|
||||
|
||||
trymax = 100;
|
||||
mat d_val[trymax+1];
|
||||
mat a_val[trymax+1];
|
||||
mat b_val[trymax+1];
|
||||
mat r_val[trymax+1];
|
||||
/* v1= 0 INVALID */
|
||||
/* v1= 1 INVALID */
|
||||
/* v1= 2 INVALID */
|
||||
d_val[ 3]= 5; a_val[ 3]= 1; b_val[ 3]=1; r_val[ 3]=4;
|
||||
d_val[ 4]= 3; a_val[ 4]= 1; b_val[ 4]=1; r_val[ 4]=2;
|
||||
d_val[ 5]= 21; a_val[ 5]= 3; b_val[ 5]=1; r_val[ 5]=12;
|
||||
d_val[ 6]= 2; a_val[ 6]= 1; b_val[ 6]=1; r_val[ 6]=1;
|
||||
/* v1= 7 INVALID */
|
||||
d_val[ 8]= 15; a_val[ 8]= 3; b_val[ 8]=1; r_val[ 8]=6;
|
||||
d_val[ 9]= 77; a_val[ 9]= 7; b_val[ 9]=1; r_val[ 9]=28;
|
||||
d_val[10]= 6; a_val[10]= 2; b_val[10]=1; r_val[10]=2;
|
||||
d_val[11]= 13; a_val[11]= 3; b_val[11]=1; r_val[11]=4;
|
||||
d_val[12]= 35; a_val[12]= 5; b_val[12]=1; r_val[12]=10;
|
||||
d_val[13]= 165; a_val[13]=11; b_val[13]=1; r_val[13]=44;
|
||||
/* v1=14 INVALID */
|
||||
d_val[15]= 221; a_val[15]=13; b_val[15]=1; r_val[15]=52;
|
||||
d_val[16]= 7; a_val[16]= 3; b_val[16]=1; r_val[16]=2;
|
||||
d_val[17]= 285; a_val[17]=15; b_val[17]=1; r_val[17]=60;
|
||||
/* v1=18 INVALID */
|
||||
d_val[19]= 357; a_val[19]=17; b_val[19]=1; r_val[19]=68;
|
||||
d_val[20]= 11; a_val[20]= 3; b_val[20]=1; r_val[20]=2;
|
||||
d_val[21]= 437; a_val[21]=19; b_val[21]=1; r_val[21]=76;
|
||||
d_val[22]= 30; a_val[22]= 5; b_val[22]=1; r_val[22]=5;
|
||||
/* v1=23 INVALID */
|
||||
d_val[24]= 143; a_val[24]=11; b_val[24]=1; r_val[24]=22;
|
||||
d_val[25]= 69; a_val[25]= 9; b_val[25]=1; r_val[25]=12;
|
||||
d_val[26]= 42; a_val[26]= 6; b_val[26]=1; r_val[26]=6;
|
||||
d_val[27]= 29; a_val[27]= 5; b_val[27]=1; r_val[27]=4;
|
||||
d_val[28]= 195; a_val[28]=13; b_val[28]=1; r_val[28]=26;
|
||||
d_val[29]= 93; a_val[29]= 9; b_val[29]=1; r_val[29]=12;
|
||||
d_val[30]= 14; a_val[30]= 4; b_val[30]=1; r_val[30]=2;
|
||||
d_val[31]= 957; a_val[31]=29; b_val[31]=1; r_val[31]=116;
|
||||
d_val[32]= 255; a_val[32]=15; b_val[32]=1; r_val[32]=30;
|
||||
d_val[33]=1085; a_val[33]=31; b_val[33]=1; r_val[33]=124;
|
||||
/* v1=34 INVALID */
|
||||
d_val[35]=1221; a_val[35]=33; b_val[35]=1; r_val[35]=132;
|
||||
d_val[36]= 323; a_val[36]=17; b_val[36]=1; r_val[36]=34;
|
||||
d_val[37]=1365; a_val[37]=35; b_val[37]=1; r_val[37]=140;
|
||||
d_val[38]= 10; a_val[38]= 3; b_val[38]=1; r_val[38]=1;
|
||||
d_val[39]=1517; a_val[39]=37; b_val[39]=1; r_val[39]=148;
|
||||
d_val[40]= 399; a_val[40]=19; b_val[40]=1; r_val[40]=38;
|
||||
d_val[41]=1677; a_val[41]=39; b_val[41]=1; r_val[41]=156;
|
||||
d_val[42]= 110; a_val[42]=10; b_val[42]=1; r_val[42]=10;
|
||||
d_val[43]= 205; a_val[43]=15; b_val[43]=1; r_val[43]=20;
|
||||
d_val[44]= 483; a_val[44]=21; b_val[44]=1; r_val[44]=42;
|
||||
d_val[45]=2021; a_val[45]=43; b_val[45]=1; r_val[45]=172;
|
||||
d_val[46]= 33; a_val[46]= 6; b_val[46]=1; r_val[46]=3;
|
||||
/* v1=47 INVALID */
|
||||
d_val[48]= 23; a_val[48]= 5; b_val[48]=1; r_val[48]=2;
|
||||
d_val[49]=2397; a_val[49]=47; b_val[49]=1; r_val[49]=188;
|
||||
d_val[50]= 39; a_val[50]= 6; b_val[50]=1; r_val[50]=3;
|
||||
d_val[51]= 53; a_val[51]= 7; b_val[51]=1; r_val[51]=4;
|
||||
/* v1=52 INVALID */
|
||||
d_val[53]=2805; a_val[53]=51; b_val[53]=1; r_val[53]=204;
|
||||
d_val[54]= 182; a_val[54]=13; b_val[54]=1; r_val[54]=13;
|
||||
d_val[55]=3021; a_val[55]=53; b_val[55]=1; r_val[55]=212;
|
||||
d_val[56]= 87; a_val[56]= 9; b_val[56]=1; r_val[56]=6;
|
||||
d_val[57]=3245; a_val[57]=55; b_val[57]=1; r_val[57]=220;
|
||||
d_val[58]= 210; a_val[58]=14; b_val[58]=1; r_val[58]=14;
|
||||
d_val[59]=3477; a_val[59]=57; b_val[59]=1; r_val[59]=228;
|
||||
d_val[60]= 899; a_val[60]=29; b_val[60]=1; r_val[60]=58;
|
||||
d_val[61]= 413; a_val[61]=21; b_val[61]=1; r_val[61]=28;
|
||||
/* v1=62 INVALID */
|
||||
d_val[63]=3965; a_val[63]=61; b_val[63]=1; r_val[63]=244;
|
||||
d_val[64]=1023; a_val[64]=31; b_val[64]=1; r_val[64]=62;
|
||||
d_val[65]= 469; a_val[65]=21; b_val[65]=1; r_val[65]=28;
|
||||
d_val[66]= 17; a_val[66]= 4; b_val[66]=1; r_val[66]=1;
|
||||
d_val[67]=4485; a_val[67]=65; b_val[67]=1; r_val[67]=260;
|
||||
d_val[68]=1155; a_val[68]=33; b_val[68]=1; r_val[68]=66;
|
||||
d_val[69]=4757; a_val[69]=67; b_val[69]=1; r_val[69]=268;
|
||||
d_val[70]= 34; a_val[70]= 6; b_val[70]=1; r_val[70]=2;
|
||||
d_val[71]=5037; a_val[71]=69; b_val[71]=1; r_val[71]=276;
|
||||
d_val[72]=1295; a_val[72]=35; b_val[72]=1; r_val[72]=70;
|
||||
d_val[73]= 213; a_val[73]=15; b_val[73]=1; r_val[73]=12;
|
||||
d_val[74]= 38; a_val[74]= 6; b_val[74]=1; r_val[74]=2;
|
||||
d_val[75]=5621; a_val[75]=73; b_val[75]=1; r_val[75]=292;
|
||||
d_val[76]=1443; a_val[76]=37; b_val[76]=1; r_val[76]=74;
|
||||
d_val[77]= 237; a_val[77]=15; b_val[77]=1; r_val[77]=12;
|
||||
d_val[78]= 95; a_val[78]=10; b_val[78]=1; r_val[78]=5;
|
||||
/* v1=79 INVALID */
|
||||
d_val[80]=1599; a_val[80]=39; b_val[80]=1; r_val[80]=78;
|
||||
d_val[81]=6557; a_val[81]=79; b_val[81]=1; r_val[81]=316;
|
||||
d_val[82]= 105; a_val[82]=10; b_val[82]=1; r_val[82]=5;
|
||||
d_val[83]= 85; a_val[83]= 9; b_val[83]=1; r_val[83]=4;
|
||||
d_val[84]=1763; a_val[84]=41; b_val[84]=1; r_val[84]=82;
|
||||
d_val[85]=7221; a_val[85]=83; b_val[85]=1; r_val[85]=332;
|
||||
d_val[86]= 462; a_val[86]=21; b_val[86]=1; r_val[86]=21;
|
||||
d_val[87]=7565; a_val[87]=85; b_val[87]=1; r_val[87]=340;
|
||||
d_val[88]= 215; a_val[88]=15; b_val[88]=1; r_val[88]=10;
|
||||
d_val[89]=7917; a_val[89]=87; b_val[89]=1; r_val[89]=348;
|
||||
d_val[90]= 506; a_val[90]=22; b_val[90]=1; r_val[90]=22;
|
||||
d_val[91]=8277; a_val[91]=89; b_val[91]=1; r_val[91]=356;
|
||||
d_val[92]= 235; a_val[92]=15; b_val[92]=1; r_val[92]=10;
|
||||
d_val[93]=8645; a_val[93]=91; b_val[93]=1; r_val[93]=364;
|
||||
d_val[94]= 138; a_val[94]=12; b_val[94]=1; r_val[94]=6;
|
||||
d_val[95]=9021; a_val[95]=93; b_val[95]=1; r_val[95]=372;
|
||||
d_val[96]= 47; a_val[96]= 7; b_val[96]=1; r_val[96]=2;
|
||||
d_val[97]=1045; a_val[97]=33; b_val[97]=1; r_val[97]=44;
|
||||
/* v1=98 INVALID */
|
||||
d_val[99]=9797; a_val[99]=97; b_val[99]=1; r_val[99]=388;
|
||||
d_val[100]= 51; a_val[100]= 7; b_val[100]=1; r_val[100]=2;
|
||||
|
||||
if (config("resource_debug") & 3) {
|
||||
print "d_val[100] defined";
|
||||
print "a_val[100] defined";
|
||||
print "b_val[100] defined";
|
||||
print "r_val[100] defined";
|
||||
}
|
@@ -17,16 +17,12 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: mersenne.cal,v 29.1 1999/12/14 09:15:31 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/mersenne.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1991/05/22 21:56:36
|
||||
* File existed as early as: 1991
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
|
@@ -15,17 +15,13 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: mfactor.cal,v 29.1 1999/12/14 09:15:31 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/mfactor.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1996/07/06 06:09:40
|
||||
* File existed as early as: 1996
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://reality.sgi.com/chongo/
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -261,7 +257,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 +270,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;
|
||||
}
|
||||
|
@@ -15,16 +15,12 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: mod.cal,v 29.1 1999/12/14 09:15:31 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/mod.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:34
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
|
@@ -15,16 +15,12 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: natnumset.cal,v 29.1 1999/12/14 09:15:31 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/natnumset.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1997/09/07 23:53:51
|
||||
* File existed as early as: 1997
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -471,7 +467,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";
|
||||
|
@@ -15,16 +15,12 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: pell.cal,v 29.1 1999/12/14 09:15:31 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/pell.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:34
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
|
14
cal/pi.cal
14
cal/pi.cal
@@ -1,7 +1,7 @@
|
||||
/*
|
||||
* pi - various routines to calculate pi
|
||||
*
|
||||
* Copyright (C) 1999 David I. Bell
|
||||
* Copyright (C) 1999-2004 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,16 +15,12 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: pi.cal,v 29.1 1999/12/14 09:15:31 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/pi.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1991/05/22 21:56:37
|
||||
* File existed as early as: 1991
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -61,7 +57,7 @@ define qpi(epsilon)
|
||||
yn = sqrt2 - 1;
|
||||
an = 6 - 4 * sqrt2;
|
||||
tn = 2;
|
||||
for (count = 0; count < niter; count++) {
|
||||
for (count = 0; count < niter; ++count) {
|
||||
ym = yn;
|
||||
am = an;
|
||||
tn *= 4;
|
||||
@@ -104,7 +100,7 @@ define piforever()
|
||||
* Next approximation
|
||||
*/
|
||||
p = k * k;
|
||||
q = k + k++;
|
||||
q = k + ++k;
|
||||
|
||||
a2 = a;
|
||||
b2 = b;
|
||||
|
10
cal/pix.cal
10
cal/pix.cal
@@ -15,17 +15,13 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: pix.cal,v 29.1 1999/12/14 09:15:31 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/pix.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1996/07/09 03:14:14
|
||||
* File existed as early as: 1996
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://reality.sgi.com/chongo/
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
|
@@ -15,16 +15,12 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: pollard.cal,v 29.1 1999/12/14 09:15:31 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/pollard.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1991/05/22 21:56:37
|
||||
* File existed as early as: 1991
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
|
@@ -15,16 +15,12 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: poly.cal,v 29.1 1999/12/14 09:15:31 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/poly.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:35
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
|
@@ -15,16 +15,12 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: prompt.cal,v 29.1 1999/12/14 09:15:32 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/prompt.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1995/12/18 04:43:25
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -101,7 +97,7 @@ define adder() {
|
||||
}
|
||||
}
|
||||
|
||||
global x;
|
||||
global prompt_x;
|
||||
|
||||
define showvalues(str) {
|
||||
local s;
|
||||
@@ -109,8 +105,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;
|
||||
}
|
||||
|
@@ -15,16 +15,12 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: psqrt.cal,v 29.1 1999/12/14 09:15:32 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/psqrt.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:35
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
|
@@ -1,24 +1,42 @@
|
||||
/*
|
||||
* qtime - Display time as English sentence
|
||||
*
|
||||
* Copyright (C) 1999 Klaus Alexander Seistrup and Landon Curt Noll
|
||||
*
|
||||
* Written by: Klaus Alexander Seistrup <kseis@magnetic-ink.dk>
|
||||
* With mods by: Landon Curt Noll <http://www.isthe.com/chongo/>
|
||||
*
|
||||
* 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.
|
||||
*
|
||||
* Under source code control: 1999/10/13 04:10:33
|
||||
* File existed as early as: 1999
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* usage:
|
||||
* qtime(utc_hr_offset)
|
||||
*
|
||||
* utc_hr_offset Offset from UTC in hours.
|
||||
*
|
||||
* Written by: Klaus Alexander Seistrup <kseis@magnetic-ink.dk>
|
||||
* With minor mods by: Landon Curt Noll <http://reality.sgi.com/chongo/>
|
||||
*
|
||||
* See:
|
||||
* http://www.magnetic-ink.dk/download/qtime.html
|
||||
*
|
||||
* for examples of qtime() written on other languages.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: qtime.cal,v 29.1 1999/12/14 09:15:32 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/qtime.cal,v $
|
||||
*
|
||||
* This file is not covered under version 2.1 of the GNU LGPL.
|
||||
*/
|
||||
|
||||
|
||||
|
11
cal/quat.cal
11
cal/quat.cal
@@ -15,16 +15,12 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: quat.cal,v 29.1 1999/12/14 09:15:32 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/quat.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:35
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -55,7 +51,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] : ")" :;
|
||||
}
|
||||
|
||||
|
||||
|
@@ -15,17 +15,13 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: randbitrun.cal,v 29.1 1999/12/14 09:15:32 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/randbitrun.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1995/02/13 03:43:11
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://reality.sgi.com/chongo/
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
|
@@ -15,17 +15,13 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: randmprime.cal,v 29.1 1999/12/14 09:15:32 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/randmprime.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1994/03/14 23:11:21
|
||||
* File existed as early as: 1994
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://reality.sgi.com/chongo/
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
@@ -88,8 +84,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 +93,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 +112,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";
|
||||
}
|
||||
|
@@ -15,17 +15,13 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: randombitrun.cal,v 29.1 1999/12/14 09:15:32 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/randombitrun.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1995/02/13 03:43:11
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://reality.sgi.com/chongo/
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
|
@@ -15,17 +15,13 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: randomrun.cal,v 29.1 1999/12/14 09:15:32 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/randomrun.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1997/02/19 03:35:59
|
||||
* File existed as early as: 1997
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://reality.sgi.com/chongo/
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
|
@@ -15,16 +15,12 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: randrun.cal,v 29.1 1999/12/14 09:15:32 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/randrun.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1995/02/12 20:00:06
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
|
1345
cal/regress.cal
1345
cal/regress.cal
File diff suppressed because it is too large
Load Diff
49
cal/repeat.cal
Normal file
49
cal/repeat.cal
Normal file
@@ -0,0 +1,49 @@
|
||||
/*
|
||||
* repeat - return the value of a repeated set of digits
|
||||
*
|
||||
* Copyright (C) 2003 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.
|
||||
*
|
||||
* Under source code control: 2003/01/05 00:00:01
|
||||
* File existed as early as: 2003
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
/*
|
||||
* repeat - return the value of a repeated set of digits
|
||||
*
|
||||
* usage:
|
||||
* repeat(digit_set, repeat_count)
|
||||
*/
|
||||
define repeat(digit_set, repeat_count)
|
||||
{
|
||||
local digit_count; /* digits in the digit_set */
|
||||
|
||||
/* firewall */
|
||||
if (!isint(digit_set) || digit_set <= 0) {
|
||||
quit "digit set must be an integer > 0";
|
||||
}
|
||||
if (!isint(repeat_count) || repeat_count <= 0) {
|
||||
quit "repeat count must be an integer > 0";
|
||||
}
|
||||
|
||||
/* return repeated set of digits */
|
||||
digit_count = digits(digit_set);
|
||||
return digit_set * (10^(digit_count*repeat_count)-1) / (10^digit_count-1);
|
||||
}
|
57
cal/screen.cal
Normal file
57
cal/screen.cal
Normal file
@@ -0,0 +1,57 @@
|
||||
/*
|
||||
* 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.
|
||||
*
|
||||
* 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";
|
@@ -15,17 +15,13 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: seedrandom.cal,v 29.1 1999/12/14 09:15:33 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/seedrandom.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1996/01/01 08:21:00
|
||||
* File existed as early as: 1996
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://reality.sgi.com/chongo/
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -115,7 +111,7 @@ define seedrandom(seed1, seed2, size, trials)
|
||||
p = 2*fp+1;
|
||||
} while (ptest(p,1,0) == 0);
|
||||
} while(ptest(p, trials) == 0 || ptest(fp, trials) == 0);
|
||||
if (config("resource_debug") & 3) {
|
||||
if (config("resource_debug") & 8) {
|
||||
print "/* 1st Blum prime */ p=", p;
|
||||
}
|
||||
|
||||
@@ -129,7 +125,7 @@ define seedrandom(seed1, seed2, size, trials)
|
||||
q = 2*fq+1;
|
||||
} while (ptest(q,1,0) == 0);
|
||||
} while(ptest(q, trials) == 0 || ptest(fq, trials) == 0);
|
||||
if (config("resource_debug") & 3) {
|
||||
if (config("resource_debug") & 8) {
|
||||
print "/* 2nd Blum prime */ q=", q;
|
||||
}
|
||||
|
||||
@@ -139,7 +135,7 @@ define seedrandom(seed1, seed2, size, trials)
|
||||
n = p*q; /* the Blum modulus */
|
||||
binsize = highbit(n)+1; /* smallest power of 2 > p*q */
|
||||
r = pmod(rand(1<<ceil(binsize*4/5), 1<<(binsize-2)), 2, n);
|
||||
if (config("resource_debug") & 3) {
|
||||
if (config("resource_debug") & 8) {
|
||||
print "/* seed quadratic residue */ r=", r;
|
||||
print "/* newn", binsize, "bit quadratic residue*/ newn=", n;
|
||||
}
|
||||
|
73
cal/set8700.cal
Normal file
73
cal/set8700.cal
Normal file
@@ -0,0 +1,73 @@
|
||||
/*
|
||||
* 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.
|
||||
*
|
||||
* 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 };
|
425
cal/set8700.line
Normal file
425
cal/set8700.line
Normal file
@@ -0,0 +1,425 @@
|
||||
##
|
||||
## 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.
|
||||
##
|
||||
## 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
|
71
cal/smallfactors.cal
Normal file
71
cal/smallfactors.cal
Normal file
@@ -0,0 +1,71 @@
|
||||
/*
|
||||
* smallfactors - find the factors of a number < 2^32
|
||||
*
|
||||
* 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.
|
||||
*/
|
||||
|
||||
|
||||
static resource_debug_level;
|
||||
resource_debug_level = config("resource_debug", 0);
|
||||
|
||||
|
||||
define smallfactors(x0)
|
||||
{
|
||||
local d q x flist tuple w;
|
||||
|
||||
if (x >= (2 ^ 32) - 1)
|
||||
return newerror("smallfactors: number must be < 2^32 -1");
|
||||
|
||||
tuple = mat[2];
|
||||
flist = list();
|
||||
x = x0;
|
||||
d = 2;
|
||||
q = 0;
|
||||
tuple[0] = d;
|
||||
if (x < 2)
|
||||
return 0;
|
||||
do {
|
||||
q = x // d;
|
||||
while (x == (q * d)) {
|
||||
tuple[0] = d;
|
||||
tuple[1]++;
|
||||
x = floor(q);
|
||||
q = x // d;
|
||||
}
|
||||
d = nextprime(d);
|
||||
if (tuple[1] > 0)
|
||||
append(flist, tuple);
|
||||
tuple = mat[2];
|
||||
} while (d <= x);
|
||||
return flist;
|
||||
}
|
||||
|
||||
define printsmallfactors(flist)
|
||||
{
|
||||
local k;
|
||||
for (k = 0; k < size(flist); k++) {
|
||||
print flist[k][0]:"^":flist[k][1];
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
config("resource_debug", resource_debug_level),;
|
||||
if (config("resource_debug") & 3) {
|
||||
print "smallfactors(x0)";
|
||||
print "printsmallfactors(flist)";
|
||||
|
||||
}
|
@@ -15,16 +15,12 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: solve.cal,v 29.1 1999/12/14 09:15:33 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/solve.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:37
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -47,12 +43,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);
|
||||
|
1465
cal/specialfunctions.cal
Normal file
1465
cal/specialfunctions.cal
Normal file
File diff suppressed because it is too large
Load Diff
498
cal/statistics.cal
Normal file
498
cal/statistics.cal
Normal file
@@ -0,0 +1,498 @@
|
||||
/*
|
||||
* 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.
|
||||
*
|
||||
* 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)";
|
||||
}
|
||||
|
41
cal/strings.cal
Normal file
41
cal/strings.cal
Normal file
@@ -0,0 +1,41 @@
|
||||
/*
|
||||
* strings - implementation of some of the macros in ctype.h
|
||||
*
|
||||
* 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.
|
||||
*/
|
||||
|
||||
|
||||
static resource_debug_level;
|
||||
resource_debug_level = config("resource_debug", 0);
|
||||
|
||||
define isascii(c){
|
||||
c = ord(c);
|
||||
return (c >= 0 && c< 128);
|
||||
}
|
||||
|
||||
define isblank(c){
|
||||
c = ord(c);
|
||||
return ( c == 32 || c == 9 );
|
||||
}
|
||||
|
||||
|
||||
config("resource_debug", resource_debug_level),;
|
||||
if (config("resource_debug") & 3) {
|
||||
print "isascii(c)";
|
||||
print "isblank(c)";
|
||||
}
|
||||
|
@@ -15,16 +15,12 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: sumsq.cal,v 29.1 1999/12/14 09:15:33 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/sumsq.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:37
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
|
182
cal/sumtimes.cal
Normal file
182
cal/sumtimes.cal
Normal file
@@ -0,0 +1,182 @@
|
||||
/*
|
||||
* 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.
|
||||
*
|
||||
* 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;
|
||||
}
|
@@ -15,16 +15,12 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: surd.cal,v 29.1 1999/12/14 09:15:33 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/surd.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:38
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
|
@@ -15,17 +15,13 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: test1700.cal,v 29.1 1999/12/14 09:15:33 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test1700.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1994/03/14 23:12:51
|
||||
* File existed as early as: 1994
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://reality.sgi.com/chongo/
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
|
@@ -15,17 +15,13 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: test2300.cal,v 29.1 1999/12/14 09:15:33 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test2300.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1995/07/09 06:12:13
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://reality.sgi.com/chongo/
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
|
117
cal/test2600.cal
117
cal/test2600.cal
@@ -17,16 +17,12 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: test2600.cal,v 29.1 1999/12/14 09:15:33 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test2600.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1995/10/13 00:13:14
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -91,7 +87,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 +130,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 +176,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 +234,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 +313,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 +600,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";
|
||||
|
@@ -17,16 +17,12 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: test2700.cal,v 29.1 1999/12/14 09:15:33 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test2700.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1995/11/01 22:52:25
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -41,8 +37,7 @@
|
||||
*/
|
||||
|
||||
|
||||
global defaultverbose = 1;
|
||||
global err;
|
||||
defaultverbose = 1;
|
||||
|
||||
define mknonnegreal() {
|
||||
switch(rand(8)) {
|
||||
@@ -89,11 +84,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 +123,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++;
|
||||
}
|
||||
|
@@ -17,16 +17,12 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: test3100.cal,v 29.1 1999/12/14 09:15:33 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test3100.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1995/11/28 11:56:57
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
|
@@ -17,21 +17,16 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: test3300.cal,v 29.1 1999/12/14 09:15:33 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test3300.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1995/12/02 04:27:41
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
global defaultverbose = 1; /* default verbose value */
|
||||
global err;
|
||||
defaultverbose = 1; /* default verbose value */
|
||||
|
||||
define testi(str, n, N, verbose)
|
||||
{
|
||||
@@ -82,9 +77,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) {
|
||||
|
@@ -17,16 +17,12 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: test3400.cal,v 29.1 1999/12/14 09:15:34 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test3400.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1995/12/02 05:20:11
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -54,8 +50,7 @@
|
||||
*/
|
||||
|
||||
|
||||
global defaultverbose = 1; /* default verbose value */
|
||||
global err;
|
||||
defaultverbose = 1; /* default verbose value */
|
||||
|
||||
global pi1k = pi(1e-1000);
|
||||
|
||||
|
@@ -17,16 +17,12 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: test3500.cal,v 29.1 1999/12/14 09:15:34 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test3500.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1995/12/18 22:50:46
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -53,8 +49,7 @@
|
||||
*/
|
||||
|
||||
|
||||
global defaultverbose = 1; /* default verbose value */
|
||||
global err;
|
||||
defaultverbose = 1; /* default verbose value */
|
||||
|
||||
define testfrem(x,y,verbose)
|
||||
{
|
||||
|
@@ -17,16 +17,12 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: test4000.cal,v 29.1 1999/12/14 09:15:34 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test4000.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1996/03/13 02:38:45
|
||||
* File existed as early as: 1996
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -75,8 +71,7 @@
|
||||
*/
|
||||
|
||||
|
||||
global defaultverbose = 1; /* default verbose value */
|
||||
global err;
|
||||
defaultverbose = 1; /* default verbose value */
|
||||
|
||||
/*
|
||||
* test defaults
|
||||
@@ -146,7 +141,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 +155,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 +190,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 +205,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 +239,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 +254,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 +292,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);
|
||||
}
|
||||
}
|
||||
|
||||
|
@@ -17,16 +17,12 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: test4100.cal,v 29.1 1999/12/14 09:15:34 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test4100.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1996/03/13 03:53:22
|
||||
* File existed as early as: 1996
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -70,18 +66,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 +228,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 +241,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 +302,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 +310,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 +322,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 +402,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 +415,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;
|
||||
|
@@ -17,21 +17,16 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: test4600.cal,v 29.1 1999/12/14 09:15:34 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test4600.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1996/07/02 20:04:40
|
||||
* File existed as early as: 1996
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
global defaultverbose = 1 /* default verbose value */
|
||||
global err;
|
||||
defaultverbose = 1; /* default verbose value */
|
||||
|
||||
/*
|
||||
* test globals
|
||||
@@ -53,10 +48,10 @@ define stest(str, verbose)
|
||||
/*
|
||||
* do file operations
|
||||
*/
|
||||
f = fopen("junk4600", "w");
|
||||
f = fopen("junk4600", "wb");
|
||||
if (iserror(f)) {
|
||||
print 'failed';
|
||||
print '**** fopen("junk4600", "w") failed';
|
||||
print '**** fopen("junk4600", "wb") failed';
|
||||
return 1;
|
||||
}
|
||||
if (iserror(fputs(f,
|
||||
@@ -67,9 +62,9 @@ define stest(str, verbose)
|
||||
print '**** fputs(f, "Fourscore ... failed';
|
||||
return 1;
|
||||
}
|
||||
if (iserror(freopen(f, "r"))) {
|
||||
if (iserror(freopen(f, "rb"))) {
|
||||
print 'failed';
|
||||
print '**** iserror(freopen(f, "r")) failed';
|
||||
print '**** iserror(freopen(f, "rb")) failed';
|
||||
return 1;
|
||||
}
|
||||
if (iserror(rewind(f))) {
|
||||
@@ -173,7 +168,7 @@ define ttest(str, m, n, verbose)
|
||||
print str:":",:;
|
||||
}
|
||||
i = rm("-f", "junk4600");
|
||||
f = fopen("junk4600", "w");
|
||||
f = fopen("junk4600", "wb");
|
||||
|
||||
if (isnull(n))
|
||||
n = 4;
|
||||
@@ -198,7 +193,7 @@ define ttest(str, m, n, verbose)
|
||||
fflush(f);
|
||||
if (verbose > 1)
|
||||
printf("File has size %d\n", pos[i]);
|
||||
freopen(f, "r");
|
||||
freopen(f, "rb");
|
||||
if (size(f) != pos[i]) {
|
||||
print 'failed';
|
||||
printf("**** Failure 1 for file size\n");
|
||||
|
@@ -17,21 +17,16 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: test5100.cal,v 29.1 1999/12/14 09:15:34 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test5100.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1996/12/02 23:57:10
|
||||
* File existed as early as: 1996
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
global defaultverbose = 1; /* default verbose value */
|
||||
global err;
|
||||
defaultverbose = 1; /* default verbose value */
|
||||
|
||||
/*
|
||||
* We test the new code generator declaration scope and order.
|
||||
|
@@ -17,21 +17,16 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: test5200.cal,v 29.1 1999/12/14 09:15:34 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test5200.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1997/02/07 02:48:10
|
||||
* File existed as early as: 1997
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
global defaultverbose = 1; /* default verbose value */
|
||||
global err;
|
||||
defaultverbose = 1; /* default verbose value */
|
||||
|
||||
/*
|
||||
* test the fix of a global/static bug
|
||||
|
@@ -15,17 +15,13 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: test8400.cal,v 29.1 1999/12/14 09:15:34 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test8400.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1999/10/31 01:00:03
|
||||
* File existed as early as: 1999
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://reality.sgi.com/chongo/
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
|
@@ -17,16 +17,12 @@
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: test8500.cal,v 29.1 1999/12/14 09:15:34 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test8500.cal,v $
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1999/11/12 20:59:59
|
||||
* File existed as early as: 1999
|
||||
*
|
||||
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -134,8 +130,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)
|
||||
{
|
||||
|
1402
cal/test8600.cal
Normal file
1402
cal/test8600.cal
Normal file
File diff suppressed because it is too large
Load Diff
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user