Compare commits

..

115 Commits

Author SHA1 Message Date
Landon Curt Noll
1cdb5172d8 Fix Makefile lines that picky complains about 2018-10-19 19:41:58 -07:00
Landon Curt Noll
54a7a3f7bc Release 2.12.6.10
Added a patch to replaces the manual search for include files
    in $(INCDIR) in the have_*.h targets with compiler invocations.
    Thanks goes to Helmut Grohne <helmut at subdivi dot de> who
    implemented the patch and posted it to the Debian bug tracker
    and Martin Buck (m at rtin-buck dor de) for forwarding it to us.

    The check_include make rule was fixed to not assume /usr/include.

    The qprintnum() function now takes outdigits as a 3rd argument.
    Most of the time, this 3rd argument is just conf->outdigits.
    But when it comes to the experimental '%g', this value can
    change.  This avoids having to modify conf->outdigits.
2018-10-19 19:33:57 -07:00
Landon Curt Noll
2ea77e6151 Release 2.12.6.9
Experimental changes for macOS builds.
2018-10-15 19:37:48 -07:00
Landon Curt Noll
5cfa6199e5 Merge branch '10110111-master' 2018-09-30 16:11:23 -07:00
Landon Curt Noll
da6ccc146f Improvements to %g pull request
This code %g is preliminary.

Fixed some code style issues to match the current code style.

Added regression tests and help file updates to printf and strprintf.

Fixed use of magic number -4: using -P instead.

Noted two problem areas with XXX comments in qio.c:

    1) need a qprintfg function
    2) re-write to not modify conf->outdigits
2018-09-30 16:06:28 -07:00
Landon Curt Noll
fcfe237375 Merge branch 'master' of https://github.com/10110111/calc into 10110111-master 2018-09-30 14:22:41 -07:00
Landon Curt Noll
5fb3db4558 Fixed trigonometric and hyperbolic core dumps 2018-09-30 14:08:20 -07:00
Landon Curt Noll
c8705c1198 Release calc 2.12.6.8
The following are the changes in this release:

    For historical purposes, in lucas.cal, gen_v1(1, n) always returns 4.

    Fixed some compiler warnings, thanks to a report by Mike
    <michael dot d dot ince at gmail dot com>.

    Added work around for a gcc warning bug, thanks to a report by Mike
    <michael dot d dot ince at gmail dot com>.

    Fixed errors in various help files such as:

	mat randbit seed srandom types

    Removed the MAXSTRING symbol because it was no longer used by calc.

    Increased HIST_SIZE (depth of the history stack) from 10k to 32k.

    Increased TTYSIZE (reallocation size for terminal buffers) from 100 to 8191.

    Increased MAXDEPTH (maximum depth of input stack) from 10 to 255.

    Increased interactive input buffer size from 1024 to 256k.  This has the
    effect of increasing the maximum length of an input line from a tty.
    This helps with an interactive bug that was reported by Ruslan Kabatsayev
    (b7 dot 10110111 at gmail dot com).

    The calc man page indicates that -d also disables the printing of the
    leading tilde.

    Added information to "help command" about how to silence messages
    while reading calc resource files.

    Fixed an error message buffer overflow thanks to a report by
    Frank Peters <nlp at northernlightsphoto dot biz>.

    Replaced all use of the C funcion sprintf() with snprintf().
    Replaced all use of the C funcion vsprintf() with vsnprintf().
    Replaced all DONT_HAVE_VSPRINTF with DONT_HAVE_VSNPRINTF.
    Replaced all Makefile var ${HAVE_VSPRINTF} with ${HAVE_VSNPRINTF}.
2018-09-30 10:25:18 -07:00
Ruslan Kabatsayev
0558bafcb6 Use MODE_REAL_AUTO by default instead of MODE_REAL
This will save the user from embarrassment due to getting
~0.00000000000000000000 as the result instead of e.g. 1.23e-53.
2018-06-30 18:44:14 +03:00
Ruslan Kabatsayev
f58277f53d Implement %g format for printf 2018-06-30 18:35:35 +03:00
Landon Curt Noll
e555a718c0 Released calc 2.12.6.7 with help and input fixes
Fixed errors in various help files such as:

	mat randbit seed srandom types

    Removed the MAXSTRING symbol because it was no longer used by calc.

    Increased HIST_SIZE (depth of the history stack) from 10k to 32k.

    Increased TTYSIZE (reallocation size for terminal buffers) from 100 to 8191.

    Increased MAXDEPTH (maximum depth of input stack) from 10 to 255.

    Increased interactive input buffer size from 1024 to 256k.  This has the
    effect of increasing the maximum length of an input line from a tty.
    This helps with an interactive bug that was reported by Ruslan Kabatsayev
    (b7 dot 10110111 at gmail dot com).
k
2018-03-04 11:09:09 -08:00
Landon Curt Noll
b29fcf2dd5 Fixed errors in various help files 2018-02-27 18:21:46 -08:00
Landon Curt Noll
4f86703843 Fix long lines 2018-02-27 16:16:06 -08:00
Landon Curt Noll
07d8bf0f3e Version 2.12.6.6 2018-02-21 12:38:39 -08:00
Landon Curt Noll
b4cd692bae Fixed compiler warnings
Fixed some compiler warnings.
Added work around for a gcc warning bug.
2018-02-21 12:37:46 -08:00
Landon Curt Noll
83c898cc2b Improved how lucas.cal pre-verifies numbers 2018-02-21 12:36:21 -08:00
Landon Curt Noll
c585d7aa78 Release calc version 2.12.6.5 2018-01-28 18:26:08 -08:00
Landon Curt Noll
f42a003d04 Improve formatting of comments in cal/lucas.cal 2018-01-16 15:33:00 -08:00
Landon Curt Noll
8da0471f07 Release calc version 2.12.6.4
Fixed a man page warning about ./myfile where the leading dot
was mistook for an nroff macro.  Thanks goes to David Haller
<dnh at opensuse dot org> for providing the patch.

Improved gen_v1(h,n) in lucas.cal for cases where h is not a
multiple of 3. Optimized the search for v(1) when h is a
multiple of 3.

Fixed a Makefile problem, reported by Doug Hays <doughays6 at gmail
dot com>, where if a macOS user set BINDIR, LIBDIR, CALC_SHAREDIR
or INCDIR in the top section, their values will be overwritten by
the Darwin specific section.
2018-01-16 15:27:13 -08:00
Landon Curt Noll
1c20261b93 Fixed macro warning about ./myfile 2017-09-07 14:28:54 -07:00
Landon Curt Noll
aeb9a9d473 Prepare for calc version 2.12.6.3 2017-09-06 18:20:35 -07:00
Landon Curt Noll
66883b390d Fixed CHANGES typo 2017-09-06 18:11:35 -07:00
Landon Curt Noll
ea533659ce Release calc version 2.12.6.2 2017-09-06 17:42:41 -07:00
Landon Curt Noll
9e81971f25 Verify that h*2^n-1 is not a multiple of 3 2017-09-06 17:41:56 -07:00
Landon Curt Noll
cbbd866535 Fixed a misleading indent reported by Thomas Walter 2017-09-06 17:40:49 -07:00
Landon Curt Noll
bf23f82c29 Correct comments relating to v(1) search table 2017-06-18 08:11:43 -07:00
Landon Curt Noll
ec5c584785 Fixed typo in lucas.cal comment 2017-06-18 04:11:44 -07:00
Landon Curt Noll
6bbb8c0e42 Update v(1) stats with full 1000000 test sample 2017-06-18 03:50:28 -07:00
Landon Curt Noll
438554b0ed Make a minor speedup to gen_v1(h,n) in lucas.cal 2017-06-14 16:50:58 -07:00
Landon Curt Noll
61ba4bc5c8 Improve lucas.cal v(1) search method & remarks 2017-06-14 16:30:42 -07:00
Landon Curt Noll
0145883396 Improved lucas.cal vt tables and arg checking 2017-06-09 15:44:48 -07:00
Landon Curt Noll
f91bfaab70 Prep for calc version 2.12.6.1 2017-06-05 21:05:25 -07:00
Landon Curt Noll
36ab4fdc1b Fixed mal-formatted long lines in CHANGES 2017-06-05 20:01:49 -07:00
Landon Curt Noll
1cd89398ad Fix multiple typos in the CHANGES file 2017-06-05 19:59:07 -07:00
Landon Curt Noll
bd3a381783 Warn about early GitHub history rebuild
We part of our experimenting with GitHub, we reset the history
of this repository.

Anyone who was tracking the calc "pre-release" on GitHub prior
to version 2.12.6.0 should do a:

    git reset --hard origin/master
    git cleanup -f

Or you may just want to start over:

    rm -rf calc
    git clone https://github.com/lcn2/calc.git

Sorry about that.  The previous GitHub repository was an useful
experiment.  Based on what we learned, we decided to rebuild it.
2017-06-05 17:20:26 -07:00
Landon Curt Noll
618f42c960 Improve ptest and builtin help file content 2017-05-27 14:19:15 -07:00
Landon Curt Noll
1363b58060 Fixed reading from stdin with calc -p 2017-05-25 17:24:57 -07:00
Landon Curt Noll
2c659f40ff Clarify unexpected parsing of if statements 2017-05-24 16:25:40 -07:00
Landon Curt Noll
4c243a69fe Improve GitHub readme and fix typos 2017-05-24 16:23:02 -07:00
Landon Curt Noll
f80eee7a09 Setup for README.md and improved calc overview 2017-05-23 19:09:05 -07:00
Landon Curt Noll
a044b9325b Added comments & common excluded to .gitignore 2017-05-23 18:54:22 -07:00
Landon Curt Noll
c028ea478f Reduce max line length in lucas.cal comment 2017-05-23 18:47:23 -07:00
Landon Curt Noll
62bdba6d22 Undo always enabling clang sanitize
We are not ready, just yet, to enable:

    -fsanitize=undefined -fsanitize=address

Instead we need to test with:

    make clobber all check COMMON_ADD='-fsanitize=undefined -fsanitize=address'

Once the regression test passes, we can consider how to use COMMON_ADD
during development.
2017-05-23 02:18:51 -07:00
Landon Curt Noll
4d9511243c Prepare for version 2.12.6.0 2017-05-23 02:16:52 -07:00
Landon Curt Noll
188fd372ea Added COMMON_ADD Makefile facility
Added the makefile variable ${COMMON_ADD} that will add flags
to all compile and link commands. The ${COMMON_ADD} flags are
appended to both ${COMMON_CFLAGS} and ${COMMON_LDFLAGS}.  This
facility is available to nearly all platforms except those with
very old make comamnds that do not understand the += operator.

Example on masOS (Darwin), one may invoke clang's -fsanitize
facility by:

    make clobber all COMMON_ADD='-fsanitize=undefined -fsanitize=address'

Another example.  To force C warnings to be treated as errors:

    make COMMON_ADD='-Werror'
2017-05-23 02:08:33 -07:00
Landon Curt Noll
44ffb0eec9 Clarify some comments about Ref 1 in lucas.cal 2017-05-23 01:47:10 -07:00
Landon Curt Noll
beb13bf89f Ignore source tarball files that are built
The source tarballs that are released are built from
development trees.  A number of files are created
that are not in the development tee.  Other files development
files are replaced.

We also ignore all binary files and library files that are built.
2017-05-23 01:39:43 -07:00
Landon Curt Noll
a31078bbec Remove all RCS @(#) lines and RCS strings
Some folks might think: “you still use RCS”?!?  And we will say,
hey, at least we switched from SCCS to RCS back in … I think it was
around 1994 ... at least we are keeping up! :-) :-) :-)

Logs say that SCCS version 18 became RCS version 19 on 1994 March 18.

RCS served us well.  But now it is time to move on.   And so we are
switching to git.

Calc releases produce a lot of file changes.  In the 125 releases
of calc since 1996, when I started managing calc releases, there
have been 15473 file mods!
2017-05-23 01:33:23 -07:00
Landon Curt Noll
7ae4f4009c Convert tarball tree to development tree
calc GitHub philosophy

All of the previous commits in the master branch are the consists
of compressed source tarballs.  The 125 git tags represent calc
releases from version 2.10.2t30 (Sat Jul 06 1996 04:17:00 GMT-0700)
to version 2.12.5.6 (Sun May 21 2017 15:03:29 GMT-0700).

At this point master branch will switch from those released tarballs
to the development tree.  While we will make an effort to verify
that commits won't break calc: sometimes we will end up breaking
calc.  You should consider the top of the master branch as potentially
unstable.

When we are ready to release calc, we will tag the commit with the
calc version and submit a release on GitHub.  The GitHub release
will contain the usual RPMs, SRPMs, a release README and a released
source tarball.
2017-05-22 23:32:12 -07:00
Landon Curt Noll
40fc854006 Release calc version 2.12.5.6 2017-05-21 15:39:02 -07:00
Landon Curt Noll
8dd7a3cd2a Release calc version 2.12.5.5 2017-05-21 15:39:01 -07:00
Landon Curt Noll
2726ae9d23 Release calc version 2.12.5.4 2017-05-21 15:39:01 -07:00
Landon Curt Noll
d25186fc52 Release calc version 2.12.5.3 2017-05-21 15:39:01 -07:00
Landon Curt Noll
28d1e35362 Release calc version 2.12.5.2 2017-05-21 15:39:00 -07:00
Landon Curt Noll
1ae2f953d3 Release calc version 2.12.5.0 2017-05-21 15:39:00 -07:00
Landon Curt Noll
ed4b56d1ec Release calc version 2.12.4.14 2017-05-21 15:38:59 -07:00
Landon Curt Noll
cc2f6f7b85 Release calc version 2.12.4.13 2017-05-21 15:38:59 -07:00
Landon Curt Noll
57a22a6f39 Release calc version 2.12.4.12 2017-05-21 15:38:58 -07:00
Landon Curt Noll
85bfa30897 Release calc version 2.12.4.11 2017-05-21 15:38:58 -07:00
Landon Curt Noll
17e3535595 Release calc version 2.12.4.10 2017-05-21 15:38:58 -07:00
Landon Curt Noll
7f125396c1 Release calc version 2.12.4.9 2017-05-21 15:38:57 -07:00
Landon Curt Noll
7cf611bca8 Release calc version 2.12.4.0 2017-05-21 15:38:57 -07:00
Landon Curt Noll
c9fce6a5bb Release calc version 2.12.4.1 2017-05-21 15:38:56 -07:00
Landon Curt Noll
a1c96f95a6 Release calc version 2.12.4.8 2017-05-21 15:38:56 -07:00
Landon Curt Noll
5e6b3cbd3f Release calc version 2.12.4.7 2017-05-21 15:38:55 -07:00
Landon Curt Noll
5bada5fefd Release calc version 2.12.4.6 2017-05-21 15:38:55 -07:00
Landon Curt Noll
0c20c96a7e Release calc version 2.12.4.4 2017-05-21 15:38:54 -07:00
Landon Curt Noll
e054ea87f2 Release calc version 2.12.4.3 2017-05-21 15:38:54 -07:00
Landon Curt Noll
e229393250 Release calc version 2.12.4.2 2017-05-21 15:38:53 -07:00
Landon Curt Noll
a407c7d197 Release calc version 2.12.3.3 2017-05-21 15:38:53 -07:00
Landon Curt Noll
9ea569152a Release calc version 2.12.3.2 2017-05-21 15:38:52 -07:00
Landon Curt Noll
cbcb5801fb Release calc version 2.12.3.1 2017-05-21 15:38:52 -07:00
Landon Curt Noll
bdf495150e Release calc version 2.12.3.0 2017-05-21 15:38:52 -07:00
Landon Curt Noll
b3648f030f Release calc version 2.12.2.2 2017-05-21 15:38:51 -07:00
Landon Curt Noll
71e88bdc91 Release calc version 2.12.2.1 2017-05-21 15:38:51 -07:00
Landon Curt Noll
ca0dd4560b Release calc version 2.12.2 2017-05-21 15:38:50 -07:00
Landon Curt Noll
f62d9fa1e6 Release calc version 2.12.1.13 2017-05-21 15:38:50 -07:00
Landon Curt Noll
253b47942f Release calc version 2.12.1.12 2017-05-21 15:38:50 -07:00
Landon Curt Noll
c773ee736f Release calc version 2.12.1.11 2017-05-21 15:38:50 -07:00
Landon Curt Noll
7d0cc52afe Release calc version 2.12.1.10 2017-05-21 15:38:49 -07:00
Landon Curt Noll
2441df7fdc Release calc version 2.12.1.9 2017-05-21 15:38:49 -07:00
Landon Curt Noll
5c565a7cea Release calc version 2.12.1.7 2017-05-21 15:38:49 -07:00
Landon Curt Noll
810e541281 Release calc version 2.12.1.8 2017-05-21 15:38:49 -07:00
Landon Curt Noll
ee30d787ea Release calc version 2.12.1.6 2017-05-21 15:38:48 -07:00
Landon Curt Noll
4e92927183 Release calc version 2.12.1.5 2017-05-21 15:38:48 -07:00
Landon Curt Noll
fb4a03c1f1 Release calc version 2.12.1.4 2017-05-21 15:38:48 -07:00
Landon Curt Noll
81a523043e Release calc version 2.12.1.3 2017-05-21 15:38:48 -07:00
Landon Curt Noll
2c0d0bbc1b Release calc version 2.12.1.2 2017-05-21 15:38:48 -07:00
Landon Curt Noll
a7147039ee Release calc version 2.12.1.1 2017-05-21 15:38:47 -07:00
Landon Curt Noll
6fa83e417e Release calc version 2.12.1 2017-05-21 15:38:47 -07:00
Landon Curt Noll
c335809b5f Release calc version 2.12.0.8 2017-05-21 15:38:47 -07:00
Landon Curt Noll
ee99adf8ca Release calc version 2.12.0.6 2017-05-21 15:38:47 -07:00
Landon Curt Noll
87570b56fe Release calc version 2.12.0.5 2017-05-21 15:38:47 -07:00
Landon Curt Noll
afe37ec851 Release calc version 2.12.0.4 2017-05-21 15:38:46 -07:00
Landon Curt Noll
bd3086138b Release calc version 2.12.0.3 2017-05-21 15:38:46 -07:00
Landon Curt Noll
9d62873a02 Release calc version 2.12.0.2 2017-05-21 15:38:46 -07:00
Landon Curt Noll
23a5fc3ede Release calc version 2.12.0.1 2017-05-21 15:38:46 -07:00
Landon Curt Noll
58d94b08d8 Release calc version 2.12.0 2017-05-21 15:38:45 -07:00
Landon Curt Noll
7165fa17c7 Release calc version 2.11.11 2017-05-21 15:38:45 -07:00
Landon Curt Noll
64a732b678 Release calc version 2.11.10.1 2017-05-21 15:38:45 -07:00
Landon Curt Noll
a6a37f9cad Release calc version 2.11.10 2017-05-21 15:38:45 -07:00
Landon Curt Noll
42b089a87c Release calc version 2.11.9.3 2017-05-21 15:38:44 -07:00
Landon Curt Noll
8c5e9e62fa Release calc version 2.11.9.2 2017-05-21 15:38:44 -07:00
Landon Curt Noll
29e956819c Release calc version 2.11.9.1 2017-05-21 15:38:44 -07:00
Landon Curt Noll
66c3d26611 Release calc version 2.11.9 2017-05-21 15:38:44 -07:00
Landon Curt Noll
b4952bd44f Release calc version 2.11.8.1 2017-05-21 15:38:44 -07:00
Landon Curt Noll
0d06d90751 Release calc version 2.11.8 2017-05-21 15:38:43 -07:00
Landon Curt Noll
e1a3dfda0b Release calc version 2.11.7 2017-05-21 15:38:43 -07:00
Landon Curt Noll
8db4e7af47 Release calc version 2.11.6.3 2017-05-21 15:38:43 -07:00
Landon Curt Noll
bb5c624382 Release calc version 2.11.6.1 2017-05-21 15:38:43 -07:00
Landon Curt Noll
8aedcf801a Release calc version 2.11.6.2 2017-05-21 15:38:43 -07:00
Landon Curt Noll
b60eec99bb Release calc version 2.11.6 2017-05-21 15:38:42 -07:00
Landon Curt Noll
383290a844 Release calc version 2.11.5.8 2017-05-21 15:38:42 -07:00
Landon Curt Noll
7e40db44e3 Release calc version 2.11.5.7 2017-05-21 15:38:42 -07:00
Landon Curt Noll
a57ee19ca5 Release calc version 2.11.5.6 2017-05-21 15:38:42 -07:00
623 changed files with 49452 additions and 24917 deletions

100
.gitignore vendored Normal file
View 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

219
BUGS
View File

@@ -32,22 +32,31 @@ 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
and bug fixes reports to:
calc-bugs at asthe dot com
calc-bug-report at asthe dot com
[[ NOTE: Replace 'at' with @, 'dot' is with . and remove the spaces ]]
[[ NOTE: The EMail address uses 'asthe', the web site URL uses 'isthe' ]]
NOTE: Remove spaces and replace 'at' with @, 'dot' with .
Your subject must contain the words:
This replaces the old calc-bugs at asthe dot com address.
calc bug report
To be sure we see your EMail reporting a calc bug, please use the
following phase in your EMail Subject line:
You may have additional words in your 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
@@ -68,158 +77,39 @@ 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:
=-=
* The gcc as shipped with Redhat 7 perhaps other Linux distributions
has a bug causes calc to dump core on startup of it is
compiled BOTH optimized (-O, -O1, -O2 or -O3) as well as
with debugging (-g or -g3.
mis-features in calc:
On Redhat, the gcc -v which has this problem is:
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.
gcc version 2.96 20000731 (Red Hat Linux 7.1 2.96-85)
* When statement is of the form { ... }, the leading { MUST BE ON
THE SAME LINE as the if, for, while or do keyword.
there may be other gcc versions that also suffer this fate.
This works as expected:
The work-a-round is to change the DEBUG Makefile variable to either:
if (expr) {
...
}
compile for speed: -O3
compile to debug: -g3
However this WILL NOT WORK AS EXPECTED:
but not both.
if (expr)
{
...
}
* There is a bug in gcc-2.95 that causes calc, when compiled with -O2,
to fail the regression test. The work-a-round is to compile with -O
or to use gcc-2.96 or later.
This bug has been observed on the Sparc and the PowerPC machine.
On the PowerPC with gcc-2.95 when compiled with -O2, the following
patch seems to help:
*** zfunc.c.orig Fri Feb 23 18:18:39 2001
--- zfunc.c Fri Feb 23 18:39:33 2001
***************
*** 1481,1487 ****
{
HALF *a, *A, *b, *a0, u;
int i, j, j1, j2, k, k1, m, m0, m1, n, n0, o;
! FULL d, e, f, g, h, s, t, x, topbit;
int remsign;
BOOL up, onebit;
ZVALUE sqrt;
--- 1481,1488 ----
{
HALF *a, *A, *b, *a0, u;
int i, j, j1, j2, k, k1, m, m0, m1, n, n0, o;
! volatile FULL d;
! FULL e, f, g, h, s, t, x, topbit;
int remsign;
BOOL up, onebit;
ZVALUE sqrt;
*** zmath.c 2000/06/07 14:02:13 29.2
--- zmath.c 2001/03/13 19:47:03
***************
*** 1608,1614 ****
void
zbitvalue(long n, ZVALUE *res)
{
! ZVALUE z;
if (n < 0) n = 0;
z.sign = 0;
--- 1608,1614 ----
void
zbitvalue(long n, ZVALUE *res)
{
! volatile ZVALUE z;
if (n < 0) n = 0;
z.sign = 0;
* Solaris cc somtimes barfs while compiling zrand.c. In particular, calc
barfs on on the SVAL macro. The work-a-round is to use the Solaric cc
Makefile set sets -DFORCE_STDC. I.e,:
CCWARN=
CCOPT= ${DEBUG} ${NO_SHARED}
CCMISC= -DFORCE_STDC
#
CFLAGS= ${CCWARN} ${CCOPT} ${CCMISC}
ICFLAGS= ${CCWARN} ${CCMISC}
#
LCFLAGS=
LDFLAGS= ${NO_SHARED} ${LD_NO_SHARED}
ILDFLAGS=
#
LCC= cc
CC= ${PURIFY} ${LCC}
* There is a bug in some versions of the Dec/Compaq cc for the Alpha
where the following:
#include <stdio.h>
#define SVAL(a,b) (unsigned long)(0x ## a ## b ## ULL)
main(){SVAL(b8a8aeb0,8168eadc);}
fails because it puts a space inside the concatenated hex. Calc
has code that is affected by this bug. This bug has been reported
to Compaq and may be fixed in the future. A work-a-round is to
compile with cc -std0 or to use a later version of their compiler.
* On a Digital UNIX V4.0F (Rev. 1229) on a 500 Mhz 21264, make check
dies a horrible death starting in test 600 and 622 gives 100s of
messages for calc version 2.11.0t9.4 using the Dec's cc with -O2:
600: Beginning test_bignums
601: muldivcheck 1
**** abc != acb: 602: muldivcheck 2
**** acb != bac: 602: muldivcheck 2
...
**** t4 != a4: 622: algcheck 1
**** t5 != a5: 622: algcheck 1
**** t6 != a6: 622: algcheck 1
**** t4 != a4: 622: algcheck 1
...
it finally hangs at test 2000.
The work-a-round is to compile calc without the optimizer. If this
happens to you, try compiling without -O and without -O2. I.e., in
the Makefile, set:
DEBUG= -g
* There are problems compiling calc on the sparcv9 under 64 bit
Solaris. On that platform, gcc-2.96 is able to compile calc, but
calc dumps core very early on in startup. It is said that sparcv9
support in gcc-2.96 is very unofficial and thus there is no
work-a-round for gcc-2-96.
There is a work-a-round for this architecture us one is using the
Solaris CC on the sparcv9. It has been reported that setting the
following Makefile variables will produce a working version of
calc on the sparcv9 under 64 bit Solaris:
LCC="cc -xarch=v9"
CCWARN="-DFORCE_STDC -w"
DEBUG="-fast -xarch=v9"
* Under BSDI v4, the warnings of the form:
/usr/include/ctype.h:147: warning: `__runetype' defined but not used
/usr/include/ctype.h:161: warning: `__isctype' defined but not used
/usr/include/ctype.h:170: warning: `toupper' defined but not used
/usr/include/ctype.h:177: warning: `tolower' defined but not used
are seen. These warnings are the result of mis-features in BSDI
include files. They do not have an impact on the operation
or performance. The work-a-round is to ignore these warnings
under BSDI.
This needs to be changed. See also "help statement", "help unexpected",
and "help todo".
* The chi.cal resource file does not work well with odd degrees
of freedom. Can someone improve this algorithm?
@@ -243,7 +133,34 @@ Problems with known work-a-rounds:
will not.
## Copyright (C) 1999 Landon Curt Noll
=-=
To subscribe to the calc-tester mailing list, visit the following URL:
http://www.isthe.com/chongo/tech/comp/calc/calc-tester.html
This is a low volume moderated mailing list.
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
@@ -257,11 +174,7 @@ 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.14 $
## @(#) $Id: BUGS,v 29.14 2001/12/11 03:18:21 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

2525
CHANGES

File diff suppressed because it is too large Load Diff

97
COPYING
View File

@@ -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.6 $
# @(#) $Id: COPYING,v 29.6 2001/06/01 11:26:53 chongo Exp $
# @(#) $Source: /usr/local/src/cmd/calc/RCS/COPYING,v $
=-=
-=-
Calc is covered by the GNU Lesser General Public License
--------------------------------------------------------
@@ -45,55 +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://www.isthe.com/chongo/tech/comp/calc/email.html
http://www.isthe.com/chongo/tech/comp/calc/calc-tester.html
To join the low volume calc mailing list. Send a EMail message to:
This is a low volume moderated mailing list.
calc-tester-request at asthe dot com
This mailing list replaces calc-tester at asthe dot com list.
Your subject must contain the words:
If you need a human to help you with your mailing list subscription,
please send EMail to our special:
calc mailing list subscription
calc-tester-maillist-help at asthe dot com
You may have additional words in your subject line.
NOTE: Remove spaces and replace 'at' with @, 'dot' with .
Your message body (not the subject) should consist of:
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:
subscribe calc-tester address
end
name your_full_name
calc tester mailing list help
where ``address'' is your EMail address and ``your_full_name'' is
your full name.
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.
Feel free to follow the name line with additional EMail text as desired.
=-=
-=-
Calc bug reports and calc bug fixes should be sent to:
calc-bugs at asthe dot com
calc-bug-report at asthe dot com
[[ NOTE: Replace 'at' with @, 'dot' is with . and remove the spaces ]]
[[ NOTE: The EMail address uses 'asthe' and the web site URL uses 'isthe' ]]
NOTE: Remove spaces and replace 'at' with @, 'dot' with .
Your subject must contain the words:
This replaces the old calc-bugs at asthe dot com address.
calc bug report
To be sure we see your EMail reporting a calc bug, please use the
following phase in your EMail Subject line:
You may have additional words in your 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
------------------------------------------------------------
@@ -149,7 +162,7 @@ Calc's relationship to the GNU Lesser General Public License
except for the exception files explicitly listed in the ``Calc
copyrights and exception files'' section below.
=-=
-=-
Calc copyrights and exception files
-----------------------------------
@@ -164,12 +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
These files are not covered under one of the Copyrights listed above:
shs1.c shs1.h shs.c shs.h
md5.c md5.h COPYING COPYING-LGPL
cal/qtime.cal
sha1.c sha1.h COPYING
COPYING-LGPL cal/qtime.cal cal/screen.cal
The file COPYING-LGPL, which contains a copy of the version 2.1
GNU Lesser General Public License, is itself Copyrighted by the
@@ -181,15 +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
exception files have non-LGPL Copyrights. Other files are under a
LGPL Copyright but have different authors.
Some of these exception files are in the public domain. Other files
are under the LGPL but have different authors that those listed above.
In all cases one may use and distribute these exception files freely.
And because one may freely distribute the LGPL covered files, the
entire calc source may be freely used and distributed.
=-=
-=-
General Copyleft and License info
---------------------------------
@@ -203,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
---------------------------------------------------

View File

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

View File

@@ -1,41 +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:
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.
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
@@ -43,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
@@ -70,11 +212,7 @@ 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.3 $
## @(#) $Id: HOWTO.INSTALL,v 29.3 2001/12/11 02:51:00 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

251
LIBRARY
View File

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

5258
Makefile

File diff suppressed because it is too large Load Diff

6259
Makefile.ship Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -73,52 +73,64 @@ for a wish/todo list. Code contributions are welcome.
=-=
To join the calc-tester mailing list. Send an EMail message to:
To subscribe to the calc-tester mailing list, visit the following URL:
calc-tester-request at asthe dot com
http://www.isthe.com/chongo/tech/comp/calc/calc-tester.html
[[ NOTE: Replace 'at' with @, 'dot' is with . and remove the spaces ]]
[[ NOTE: The EMail address uses 'asthe' and the web site URL uses 'isthe' ]]
This is a low volume moderated mailing list.
Your subject must contain the words:
This mailing list replaces calc-tester at asthe dot com list.
calc mailing list subscription
If you need a human to help you with your mailing list subscription,
please send EMail to our special:
You may have additional words in your subject line.
calc-tester-maillist-help at asthe dot com
Your message body (not the subject) should consist of:
NOTE: Remove spaces and replace 'at' with @, 'dot' with .
subscribe calc-tester address
end
name your_full_name
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:
where ``address'' is your EMail address and ``your_full_name'' is
your full name.
calc tester mailing list help
Feel free to follow the name line with additional EMail text as desired.
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.
=-=
-=-
Send Calc bug and bug fixes to:
Calc bug reports and calc bug fixes should be sent to:
calc-bugs at asthe dot com
calc-bug-report at asthe dot com
[[ NOTE: Replace 'at' with @, 'dot' is with . and remove the spaces ]]
[[ NOTE: The EMail address uses 'asthe' and the web site URL uses 'isthe' ]]
NOTE: Remove spaces and replace 'at' with @, 'dot' with .
but see the BUGS file first.
This replaces the old calc-bugs at asthe dot com address.
Your subject must contain the words:
To be sure we see your EMail reporting a calc bug, please use the
following phase in your EMail Subject line:
calc bug report
calc bug report
You may have additional words in your subject line.
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/
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
@@ -132,11 +144,7 @@ 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.3 $
## @(#) $Id: README,v 29.3 2001/06/01 11:26:53 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

View File

@@ -3,15 +3,6 @@ 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 Windoz port is extremely experimental, untested and perhaps
incomplete. We are in the process of making it easier. The
following should help anyone who is trying to make a go of this
under the current code conditions.
NOTE: We are currently ONLY making an effort to support building under
Windoz using the Cygwin project (http://sources.redhat.com/cygwin/)
with the GCC compiler and Un*x tools for Windows.
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
@@ -19,77 +10,138 @@ NOTE: The main developers do not have access to a Windoz based platform.
Of course you are welcome to send us any patches that fix your
Windoz build environment.
=-=
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
=-= compiling with 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 was performed by Thomas Jones-Low
(tjoneslo at softstart dot com). He said:
The major porting work for Cygwin was performed by Thomas Jones-Low
(tjoneslo at softstart dot com).
I had previous stated to this group that I have successfully managed
to port a version of Calc to Windows, and promised some point to
post what was required, so here it is.
In March 2009, Michael Penk (mpenk at wuska dot com) reported success in
installs under Cygwin:
One obvious manner of doing this port is to get the latest version
of the Cygwin project (http://sources.redhat.com/cygwin/) with the
GCC compiler and Un*x tools for Windows and recompile.
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.
I built my working version using Calc ... I am using Visual C++
version 7.0, which is an older version of the Microsoft development
tools. The make file provided with Calc is not compatible with
NMAKE, so I used the Visual Studio tools to generate another one
(not included). Calc is built in two parts, calc.dll, which is the
library, and calcexe.exe which is the command line interface.
Using the calc Makefile, he did the following:
He recommends that you generate by hand all of the header files generated
by the make file:
make all target=Cygwin
make check
make install
align32.h args.h calcerr.h conf.h endian_calc.h
fposval.h have_const.h have_fpos.h have_fpos_pos.h have_malloc.h
have_memmv.h have_newstr.h have_offscl.h have_posscl.h
have_stdlib.h have_string.h have_times.h have_uid_t.h
have_unistd.h longbits.h longlong.h terminal.h
have_ustat.h have_getsid.h have_getpgid.h
have_gettime.h have_getprid.h have_urandom.h have_rusage.h
have_strdup.h
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. Just copy the win32/*.[ch] files up into the top level calc
source directory, edited (if needed) and build using the Cygwin GCC
compiler.
needs.
=-=
In particular:
People who maintain calc need to keep in mind the following:
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.
The following was added to opcodes.h, config.h, zmath.h and value.h:
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
=-= compiling under DJGPP =-=
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#if defined(_WIN32)
#ifdef _EXPORTING
#define DLL __declspec(dllexport)
#else
#define DLL __declspec(dllimport)
#endif
You might want to try using the DJGPP system to compile calc. See:
#else /* Windoz free systems */
http://www.delorie.com/djgpp/
#define DLL
for DJGPP details and availability.
#endif /* Windoz free systems */
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:
Then DLL was added in front of all the exported functions. For example:
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
extern int configtype(char*);
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.
was changed to:
Look for Makefile comments of the form:
DLL extern int configtype(char*);
# 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) 2001 Landon Curt Noll and Thomas Jones-Low
## Copyright (C) 2002-2009 Landon Curt Noll and Thomas Jones-Low
##
## Calc is open software; you can redistribute it and/or modify it under
## the terms of the version 2.1 of the GNU Lesser General Public License
@@ -103,11 +155,7 @@ was changed to:
## A copy of version 2.1 of the GNU Lesser General Public License is
## distributed with calc under the filename COPYING-LGPL. You should have
## received a copy with calc; if not, write to Free Software Foundation, Inc.
## 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
##
## @(#) $Revision: 29.6 $
## @(#) $Id: README.WINDOWS,v 29.6 2001/04/08 22:13:38 chongo Exp $
## @(#) $Source: /usr/local/src/cmd/calc/RCS/README.WINDOWS,v $
## 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

260
README.md Normal file
View 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.

267
addop.c
View File

@@ -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,11 +17,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.3 $
* @(#) $Id: addop.c,v 29.3 2000/07/17 15:35:49 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
@@ -33,7 +29,7 @@
#include <stdio.h>
#include "calc.h"
#include "opcodes.h"
#include "string.h"
#include "str.h"
#include "func.h"
#include "token.h"
#include "label.h"
@@ -44,17 +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);
@@ -211,7 +207,7 @@ endfunc(void)
if (newname[0] != '*' && (conf->traceflags & TRACE_FNCODES)) {
dumpnames = TRUE;
for (size = 0; size < fp->f_opcodecount; ) {
printf("%ld: ", (long)size);
printf("%ld: ", (unsigned long)size);
size += dumpop(&fp->f_opcodes[size]);
}
}
@@ -280,12 +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;
@@ -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);

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: align32.c,v 29.2 2000/06/07 14:02:13 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

71
alloc.h
View File

@@ -1,7 +1,7 @@
/*
* alloc - storage allocation and storage debug macros
*
* Copyright (C) 1999 David I. Bell
* Copyright (C) 1999-2007,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,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.4 $
* @(#) $Id: alloc.h,v 29.4 2001/06/08 21:00:58 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
@@ -28,59 +24,47 @@
*/
#if !defined(__ALLOC_H__)
#define __ALLOC_H__
#if !defined(INCLUDE_ALLOC_H)
#define INCLUDE_ALLOC_H
#if defined(CALC_SRC) /* if we are building from the calc source tree */
# include "have_malloc.h"
# include "have_newstr.h"
# include "have_string.h"
# include "have_memmv.h"
#else
# include <calc/have_malloc.h>
# include <calc/have_newstr.h>
# include <calc/have_string.h>
# include <calc/have_memmv.h>
#endif
#ifdef HAVE_MALLOC_H
# include <malloc.h>
#else
#if defined(FORCE_STDC) || (defined(__STDC__) && __STDC__ != 0) || defined(__cplusplus)
extern void *malloc();
extern void *realloc();
extern void free();
# else
extern char *malloc();
extern char *realloc();
extern void free();
# endif
#endif
#ifdef HAVE_STRING_H
# include <string.h>
#else
#if defined(_WIN32) && defined(NOTCYGWIN)
#include <stdio.h>
#endif
# if defined(HAVE_NEWSTR)
extern void *memcpy();
extern void *memset();
#if defined(FORCE_STDC) || (defined(__STDC__) && __STDC__ != 0) || defined(__cplusplus)
extern size_t strlen();
E_FUNC void *memcpy();
E_FUNC void *memset();
#if defined(FORCE_STDC) || \
(defined(__STDC__) && __STDC__ != 0) || defined(__cplusplus)
E_FUNC size_t strlen();
# else
extern long strlen();
E_FUNC long strlen();
# endif
# else /* HAVE_NEWSTR */
extern void bcopy();
extern void bfill();
extern char *index();
E_FUNC void bcopy();
E_FUNC void bfill();
E_FUNC char *index();
# endif /* HAVE_NEWSTR */
extern char *strchr();
extern char *strcpy();
extern char *strncpy();
extern char *strcat();
extern int strcmp();
E_FUNC char *strchr();
E_FUNC char *strcpy();
E_FUNC char *strncpy();
E_FUNC char *strcat();
E_FUNC int strcmp();
#endif
@@ -94,13 +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 */

View File

@@ -1,7 +1,7 @@
/*
* assocfunc - association table routines
*
* Copyright (C) 1999 David I. Bell
* Copyright (C) 1999-2007 David I. Bell
*
* Calc is open software; you can redistribute it and/or modify it under
* the terms of the version 2.1 of the GNU Lesser General Public License
@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: assocfunc.c,v 29.2 2000/06/07 14:02:13 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
@@ -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;

203
blkcpy.c
View File

@@ -1,7 +1,7 @@
/*
* blkcpy - general values and related routines used by the calculator
*
* Copyright (C) 1999 Landon Curt Noll and Ernest Bowen
* Copyright (C) 1999-2007 Landon Curt Noll and Ernest Bowen
*
* Primary author: Landon Curt Noll
*
@@ -17,11 +17,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.3 $
* @(#) $Id: blkcpy.c,v 29.3 2001/04/10 22:06:46 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
@@ -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;
@@ -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;
@@ -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,7 +691,7 @@ 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, TRUE);
if (fiop == NULL)
@@ -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;

View File

@@ -1,7 +1,7 @@
/*
* blkcpy - general values and related routines used by the calculator
*
* Copyright (C) 1999 Landon Curt Noll and Ernest Bowen
* Copyright (C) 1999-2007,2014 Landon Curt Noll and Ernest Bowen
*
* Primary author: Landon Curt Noll
*
@@ -17,11 +17,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: blkcpy.h,v 29.2 2000/06/07 14:02:13 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
@@ -30,33 +26,33 @@
*/
#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 */

24
block.c
View File

@@ -1,7 +1,7 @@
/*
* block - fixed, dynamic, fifo and circular memory blocks
*
* Copyright (C) 1999 Landon Curt Noll and Ernest Bowen
* Copyright (C) 1999-2007 Landon Curt Noll and Ernest Bowen
*
* Primary author: Landon Curt Noll
*
@@ -17,11 +17,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: block.c,v 29.2 2000/06/07 14:02:13 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
@@ -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)
{

48
block.h
View File

@@ -1,7 +1,7 @@
/*
* block - fixed, dynamic, fifo and circular memory blocks
*
* Copyright (C) 1999 Landon Curt Noll and Ernest Bowen
* Copyright (C) 1999-2007,2014 Landon Curt Noll and Ernest Bowen
*
* Primary author: Landon Curt Noll
*
@@ -17,11 +17,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: block.h,v 29.2 2000/06/07 14:02:13 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
@@ -31,8 +27,8 @@
*/
#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 */

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: byteswap.c,v 29.2 2000/06/07 14:02:13 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
@@ -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*/
}

View File

@@ -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,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.4 $
* @(#) $Id: byteswap.h,v 29.4 2001/06/08 21:00:58 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
@@ -29,8 +25,8 @@
*/
#if !defined(__BYTESWAP_H__)
#define __BYTESWAP_H__
#if !defined(INCLUDE_BYTESWAP_H)
#define INCLUDE_BYTESWAP_H
#if defined(CALC_SRC) /* if we are building from the calc source tree */
@@ -178,4 +174,4 @@
#endif /* LONG_BITS == 64 */
#endif /* !__BYTESWAP_H__ */
#endif /* !INCLUDE_BYTESWAP_H */

View File

@@ -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,11 +16,7 @@
# A copy of version 2.1 of the GNU Lesser General Public License is
# 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.12 $
# @(#) $Id: Makefile,v 29.12 2001/06/08 22:38:53 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
@@ -33,31 +29,127 @@
# 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
#SHAREDIR= /usr/local/lib
#SHAREDIR= /usr/lib
SHAREDIR= /usr/share
#SHAREDIR= /usr/libdata
####
CSHAREDIR= ${SHAREDIR}/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
# when forming the calc rpm, the Makefile is called with T=$RPM_BUILD_ROOT.
# 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.
#
# 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.
# 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=
#
@@ -75,20 +167,49 @@ Q=@
#
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 test8600.cal chi.cal intfile.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
#
@@ -103,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
##
#
@@ -120,20 +241,43 @@ 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
@@ -141,8 +285,10 @@ calcliblist:
##
echo_inst_files:
${Q}for i in ${CALC_FILES}; do \
echo __file__ ${CSHAREDIR}/$$i; \
${Q} for i in ${CALC_FILES} /dev/null; do \
if [ X"$$i" != X"/dev/null" ]; then \
echo __file__ ${CALC_SHAREDIR}/$$i; \
fi; \
done
##
@@ -153,42 +299,105 @@ echo_inst_files:
clean:
clobber:
rm -f .all
install: all
-${Q}if [ ! -d $T${SHAREDIR} ]; then \
echo mkdir $T${SHAREDIR}; \
mkdir $T${SHAREDIR}; \
if [ ! -d "$T${SHAREDIR}" ]; then \
echo mkdir -p "$T${SHAREDIR}"; \
mkdir -p "$T${SHAREDIR}"; \
fi; \
echo ${CHMOD} 0755 $T${SHAREDIR}; \
${CHMOD} 0755 $T${SHAREDIR}; \
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 $T${CSHAREDIR} ]; then \
echo mkdir $T${CSHAREDIR}; \
mkdir $T${CSHAREDIR}; \
if [ ! -d "$T${CSHAREDIR}" ]; then \
echo mkdir -p "$T${CSHAREDIR}"; \
mkdir -p "$T${CSHAREDIR}"; \
-${Q} for i in ${DEAD_CALC_FILES} /dev/null; do \
if [ "$$i" = "/dev/null" ]; then \
continue; \
fi; \
echo ${CHMOD} 0755 $T${CSHAREDIR}; \
${CHMOD} 0755 $T${CSHAREDIR}; \
else \
true; \
fi
${Q}for i in ${CALC_FILES}; do \
if ${CMP} -s $$i $T${CSHAREDIR}/$$i; then \
true; \
else \
rm -f $T${CSHAREDIR}/$$i.new; \
cp -f $$i $T${CSHAREDIR}/$$i.new; \
${CHMOD} 0444 $T${CSHAREDIR}/$$i.new; \
mv -f $T${CSHAREDIR}/$$i.new $T${CSHAREDIR}/$$i; \
echo "installed $T${CSHAREDIR}/$$i"; \
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

1095
cal/README

File diff suppressed because it is too large Load Diff

1522
cal/alg_config.cal Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: beer.cal,v 29.2 2000/06/07 14:02:25 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

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.3 $
* @(#) $Id: bernoulli.cal,v 29.3 2000/12/17 12:26:04 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

55
cal/bernpoly.cal Normal file
View 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)";
}

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: bigprime.cal,v 29.2 2000/06/07 14:02:25 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

View File

@@ -14,11 +14,7 @@
# A copy of version 2.1 of the GNU Lesser General Public License is
# distributed with calc under the filename COPYING-LGPL. You should have
# received a copy with calc; if not, write to Free Software Foundation, Inc.
# 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
#
# @(#) $Revision: 29.2 $
# @(#) $Id: bindings,v 29.2 2000/06/07 14:02:25 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

254
cal/brentsolve.cal Normal file
View 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)";
}

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: chi.cal,v 29.2 2001/04/08 10:21:23 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/chi.cal,v $
* 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

View File

@@ -17,11 +17,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: chrem.cal,v 29.2 2000/06/07 14:02:25 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

100
cal/constants.cal Normal file
View 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()";
}

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: deg.cal,v 29.2 2000/06/07 14:02:25 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
@@ -28,9 +24,9 @@
*/
obj dms {deg, min, sec};
obj deg {deg, min, sec};
define dms(deg, min, sec)
define deg(deg, min, sec)
{
local ans;
@@ -38,18 +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
View 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
View 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;
}

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: ellip.cal,v 29.2 2000/06/07 14:02:25 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
@@ -28,16 +24,17 @@
*/
/*
* Attempt to factor numbers using elliptic functions.
* y^2 = x^3 + a*x + b (mod N).
* Attempt to factor numbers using elliptic functions:
*
* Many points (x,y) (mod N) are found that solve the above equation,
* y^2 = x^3 + a*x + b (mod ellip_N).
*
* Many points (x,y) (mod ellip_N) are found that solve the above equation,
* starting from a trivial solution and 'multiplying' that point together
* to generate high powers of the point, looking for such a point whose
* order contains a common factor with N. The order of the group of points
* varies almost randomly within a certain interval for each choice of a
* and b, and thus each choice provides an independent opportunity to
* factor N. To generate a trivial solution, a is chosen and then b is
* order contains a common factor with ellip_N. The order of the group of
* points varies almost randomly within a certain interval for each choice of
* a and b, and thus each choice provides an independent opportunity to
* factor ellip_N. To generate a trivial solution, a is chosen and then b is
* selected so that (1,1) is a solution. The multiplication is done using
* the basic fact that the equation is a cubic, and so if a line hits the
* curve in two rational points, then the third intersection point must
@@ -45,9 +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
View 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
View 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
View 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;
}

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: hello.cal,v 29.2 2000/06/07 14:02:25 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

380
cal/hms.cal Normal file
View 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
View 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()";
}

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* 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.5 $
* @(#) $Id: intfile.cal,v 29.5 2001/04/10 22:09:34 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/intfile.cal,v $
* 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

728
cal/intnum.cal Normal file
View 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
View 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
View 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
View 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()";
}

File diff suppressed because it is too large Load Diff

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.3 $
* @(#) $Id: lucas_chk.cal,v 29.3 2001/03/31 13:31:34 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/lucas_chk.cal,v $
* 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

View File

@@ -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.2 $
* @(#) $Id: lucas_tbl.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/lucas_tbl.cal,v $
*
* Under source code control: 1991/01/26 02:43:43
* File existed as early as: 1991
*
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.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";
}

View File

@@ -17,11 +17,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: mersenne.cal,v 29.2 2000/06/07 14:02:25 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

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: mfactor.cal,v 29.2 2000/06/07 14:02:25 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
@@ -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;
}

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: mod.cal,v 29.2 2000/06/07 14:02:25 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

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: natnumset.cal,v 29.2 2000/06/07 14:02:25 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
@@ -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";

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: pell.cal,v 29.2 2000/06/07 14:02:25 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

View File

@@ -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,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: pi.cal,v 29.2 2000/06/07 14:02:25 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
@@ -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;

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: pix.cal,v 29.2 2000/06/07 14:02:25 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

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: pollard.cal,v 29.2 2000/06/07 14:02:25 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

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: poly.cal,v 29.2 2000/06/07 14:02:25 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

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: prompt.cal,v 29.2 2000/06/07 14:02:25 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
@@ -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;
}

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: psqrt.cal,v 29.2 2000/06/07 14:02:25 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

View File

@@ -18,11 +18,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.4 $
* @(#) $Id: qtime.cal,v 29.4 2000/12/18 10:18:40 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/qtime.cal,v $
* 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

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: quat.cal,v 29.2 2000/06/07 14:02:25 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
@@ -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] : ")" :;
}

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: randbitrun.cal,v 29.2 2000/06/07 14:02:25 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

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: randmprime.cal,v 29.2 2000/06/07 14:02:25 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
@@ -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";
}

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: randombitrun.cal,v 29.2 2000/06/07 14:02:25 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

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: randomrun.cal,v 29.2 2000/06/07 14:02:25 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

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: randrun.cal,v 29.2 2000/06/07 14:02:25 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

File diff suppressed because it is too large Load Diff

View File

@@ -1,7 +1,7 @@
/*
* math_error - a simple libcalc math error routine
* repeat - return the value of a repeated set of digits
*
* Copyright (C) 1999 Landon Curt Noll
* 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
@@ -15,35 +15,35 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* @(#) $Revision: 29.5 $
* @(#) $Id: math_error.h,v 29.5 2001/06/08 21:00:58 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/math_error.h,v $
*
* Under source code control: 1997/03/23 18:37:10
* File existed as early as: 1997
* 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/
*/
#if !defined(__MATH_ERROR_H__)
#define __MATH_ERROR_H__
#if defined(CALC_SRC) /* if we are building from the calc source tree */
# include "win32dll.h"
#else
# include <calc/win32dll.h>
#endif
/*
* Global data definitions.
* repeat - return the value of a repeated set of digits
*
* usage:
* repeat(digit_set, repeat_count)
*/
extern DLL jmp_buf jmpbuf; /* for errors */
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";
}
#endif /* !__MATH_ERROR_H__ */
/* 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
View 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";

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.3 $
* @(#) $Id: seedrandom.cal,v 29.3 2001/03/31 13:31:34 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

73
cal/set8700.cal Normal file
View 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
View 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
View 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)";
}

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: solve.cal,v 29.2 2000/06/07 14:02:25 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
@@ -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

File diff suppressed because it is too large Load Diff

498
cal/statistics.cal Normal file
View 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
View 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)";
}

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: sumsq.cal,v 29.2 2000/06/07 14:02:25 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

182
cal/sumtimes.cal Normal file
View 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;
}

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: surd.cal,v 29.2 2000/06/07 14:02:25 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

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test1700.cal,v 29.2 2000/06/07 14:02:25 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

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test2300.cal,v 29.2 2000/06/07 14:02:25 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

View File

@@ -17,11 +17,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test2600.cal,v 29.2 2000/06/07 14:02:25 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
@@ -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";

View File

@@ -17,11 +17,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test2700.cal,v 29.2 2000/06/07 14:02:25 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
@@ -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++;
}

View File

@@ -17,11 +17,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test3100.cal,v 29.2 2000/06/07 14:02:25 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

View File

@@ -17,11 +17,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test3300.cal,v 29.2 2000/06/07 14:02:25 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
@@ -30,8 +26,7 @@
*/
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) {

View File

@@ -17,11 +17,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test3400.cal,v 29.2 2000/06/07 14:02:25 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
@@ -54,8 +50,7 @@
*/
global defaultverbose = 1; /* default verbose value */
global err;
defaultverbose = 1; /* default verbose value */
global pi1k = pi(1e-1000);

View File

@@ -17,11 +17,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test3500.cal,v 29.2 2000/06/07 14:02:25 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
@@ -53,8 +49,7 @@
*/
global defaultverbose = 1; /* default verbose value */
global err;
defaultverbose = 1; /* default verbose value */
define testfrem(x,y,verbose)
{

View File

@@ -17,11 +17,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test4000.cal,v 29.2 2000/06/07 14:02:25 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
@@ -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);
}
}

View File

@@ -17,11 +17,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test4100.cal,v 29.2 2000/06/07 14:02:25 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
@@ -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;

View File

@@ -17,11 +17,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.4 $
* @(#) $Id: test4600.cal,v 29.4 2001/04/10 22:09:02 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
@@ -30,8 +26,7 @@
*/
global defaultverbose = 1 /* default verbose value */
global err;
defaultverbose = 1; /* default verbose value */
/*
* test globals

View File

@@ -17,11 +17,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test5100.cal,v 29.2 2000/06/07 14:02:25 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
@@ -30,8 +26,7 @@
*/
global defaultverbose = 1; /* default verbose value */
global err;
defaultverbose = 1; /* default verbose value */
/*
* We test the new code generator declaration scope and order.

View File

@@ -17,11 +17,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test5200.cal,v 29.2 2000/06/07 14:02:25 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
@@ -30,8 +26,7 @@
*/
global defaultverbose = 1; /* default verbose value */
global err;
defaultverbose = 1; /* default verbose value */
/*
* test the fix of a global/static bug

View File

@@ -15,11 +15,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test8400.cal,v 29.2 2000/06/07 14:02:25 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

View File

@@ -17,11 +17,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.2 $
* @(#) $Id: test8500.cal,v 29.2 2000/06/07 14:02:25 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
@@ -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)
{

View File

@@ -17,11 +17,7 @@
* A copy of version 2.1 of the GNU Lesser General Public License is
* 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: test8600.cal,v 29.1 2000/12/04 19:57:02 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test8600.cal,v $
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* Under source code control: 2000/12/04 19:57:02
* File existed as early as: 2000

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