Release calc version 2.12.4.13

BUGS

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

COPYING

@@ -6,17 +6,17 @@ This file is Copyrighted
 
     This file is covered under the following Copyright:
 
-	Copyright (C) 1999  Landon Curt Noll
+	Copyright (C) 1999-2008  Landon Curt Noll
 	All rights reserved.
 
 	Everyone is permitted to copy and distribute verbatim copies
 	of this license document, but changing it is not allowed.
 
-    # @(#) $Revision: 29.8 $
+    # @(#) $Revision: 30.4 $
-    # @(#) $Id: COPYING,v 29.8 2006/05/01 19:16:57 chongo Exp $
+    # @(#) $Id: COPYING,v 30.4 2013/09/01 20:14:30 chongo Exp $
-    # @(#) $Source: /usr/local/src/cmd/calc/RCS/COPYING,v $
+    # @(#) $Source: /usr/local/src/bin/calc/RCS/COPYING,v $
 
-=-=
+-=-
 
 Calc is covered by the GNU Lesser General Public License
 --------------------------------------------------------
@@ -45,12 +45,12 @@ Calc is covered by the GNU Lesser General Public License
     Public License by the calc command:			help copying-lgpl
 
     You should have received a copy of the version 2.1 GNU Lesser General
-    Public License with calc; if not, write to:
+    Public License with calc; if not, write to the following address:
 
 	    Free Software Foundation, Inc.
-	    59 Temple Place
+	    51 Franklin Street
-	    Suite 330
+	    Fifth Floor
-	    Boston, MA	02111-1307
+	    Boston, MA  02110-1301
 	    USA
 
     The contact addresses for calc is as follows:
@@ -78,7 +78,7 @@ Calc is covered by the GNU Lesser General Public License
 
     Feel free to follow the name line with additional EMail text as desired.
 
-=-=
+-=-
 
     Calc bug reports and calc bug fixes should be sent to:
 
@@ -93,7 +93,7 @@ Calc is covered by the GNU Lesser General Public License
 
     You may have additional words in your subject line.
 
-=-=
+-=-
 
 Calc's relationship to the GNU Lesser General Public License
 ------------------------------------------------------------
@@ -149,7 +149,7 @@ Calc's relationship to the GNU Lesser General Public License
      except for the exception files explicitly listed in the ``Calc
      copyrights and exception files'' section below.
 
-=-=
+-=-
 
 Calc copyrights and exception files
 -----------------------------------
@@ -165,12 +165,12 @@ Calc copyrights and exception files
 	Copyright (C) year  Ernest Bowen and Landon Curt Noll
 	Copyright (C) year  Ernest Bowen
 	Copyright (C) year  Petteri Kettunen and Landon Curt Noll
+	Copyright (C) year  Christoph Zurnieden
 
     These files are not covered under one of the Copyrights listed above:
 
-	    shs1.c	    shs1.h	 shs.c		shs.h
+	    sha1.c		sha1.h		COPYING
-	    md5.c	    md5.h	 COPYING	COPYING-LGPL
+	    COPYING-LGPL	cal/qtime.cal	cal/screen.cal
-	    cal/qtime.cal   cal/screen.cal
 
     The file COPYING-LGPL, which contains a copy of the version 2.1
     GNU Lesser General Public License, is itself Copyrighted by the
@@ -182,15 +182,14 @@ Calc copyrights and exception files
     top of this file.  It is important to note that you may distribute
     verbatim copies of this file but you may not modify this file.
 
-    Some of these exception files are in the public domain.  Other
+    Some of these exception files are in the public domain.  Other files
-    exception files have non-LGPL Copyrights.  Other files are under a
+    are under the LGPL but have different authors that those listed above.
-    LGPL Copyright but have different authors.
 
     In all cases one may use and distribute these exception files freely.
     And because one may freely distribute the LGPL covered files, the
     entire calc source may be freely used and distributed.
 
-=-=
+-=-
 
 General Copyleft and License info
 ---------------------------------
@@ -204,7 +203,7 @@ General Copyleft and License info
 	http://www.gnu.org/copyleft/lesser.html
 	http://www.gnu.org/copyleft/lesser.txt
 
-=-=
+-=-
 
 Why calc did not use the GNU General Public License
 ---------------------------------------------------

COPYING-LGPL

@@ -1,8 +1,8 @@
-		  GNU LESSER GENERAL PUBLIC LICENSE
+                  GNU LESSER GENERAL PUBLIC LICENSE
-		       Version 2.1, February 1999
+                       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!
-
-

HOWTO.INSTALL

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

LIBRARY

@@ -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_error() function is called by the math routines on an error
-the math routines on an error condition, such as malloc failures or a
+condition, such as malloc failures, division by zero, or some form of
-division by zero.  The routine is called in the manner of printf, with a
+an internal computation error.  The routine is called in the manner of
-format string and optional arguments.  (However, none of the low level math
+printf, with a format string and optional arguments:
-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:
 
-	math_error("Division by zero");
+	    void math_error(char *fmt, ...);
 
-Your program can handle errors in basically one of two ways.  Firstly, it
+Your program must handle math errors in one of three ways:
-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.
 
-For convenience, the link library libcalc.a contains a math_error routine.
+    1) Print the error message and then exit
-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.
 
-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
+	Use setjmp at some appropriate level in your program, and let
-this routine will longjmp back (with the value of calc_jmp) instead.
+	the longjmp in math_error() return to that level and to allow you
-In addition, the last calc error message will be found in calc_error;
+	to recover from the error.  This is what the calc program does.
-this error is not printed to stderr.  The calc error message will
-not have a trailing newline.
 
-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;
+	    #include <setjmp.h>
-    extern int calc_jmp;
+	    #include "lib_calc.h"
-    extern char *calc_error;
-    int error;
 
-    ...
+	    int error;
 
-    if ((error = setjmp(calc_jmp_buf)) != 0) {
+	    ...
 
-	    /* reinitialize calc after a longjmp */
+	    if ((error = setjmp(calc_matherr_jmpbuf)) != 0) {
-	    reinitialize();
+
+		    /* 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
+The output from the routines in the link library normally goes to stdout.
-can divert that output to either another FILE handle, or else to a string.
+You can divert that output to either another FILE handle, or else
-Read the routines in zio.c to see what is available.  Diversions can be
+to a string.  Read the routines in zio.c to see what is available.
-nested.
+Diversions can be nested.
 
 You use math_setfp to divert output to another FILE handle.  Calling
 math_setfp with stdout restores output to stdout.
@@ -487,11 +636,11 @@ need call libcalc_call_me_last() only once.
 ## A copy of version 2.1 of the GNU Lesser General Public License is
 ## distributed with calc under the filename COPYING-LGPL.  You should have
 ## received a copy with calc; if not, write to Free Software Foundation, Inc.
-## 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+## 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 ##
-## @(#) $Revision: 29.5 $
+## @(#) $Revision: 30.1 $
-## @(#) $Id: LIBRARY,v 29.5 2001/06/08 22:57:35 chongo Exp $
+## @(#) $Id: LIBRARY,v 30.1 2007/03/16 11:09:46 chongo Exp $
-## @(#) $Source: /usr/local/src/cmd/calc/RCS/LIBRARY,v $
+## @(#) $Source: /usr/local/src/bin/calc/RCS/LIBRARY,v $
 ##
 ## Under source code control:	1993/07/30 19:44:49
 ## File existed as early as:	1993

README

@@ -132,11 +132,11 @@ The calc web site is located at:
 ## A copy of version 2.1 of the GNU Lesser General Public License is
 ## distributed with calc under the filename COPYING-LGPL.  You should have
 ## received a copy with calc; if not, write to Free Software Foundation, Inc.
-## 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+## 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 ##
-## @(#) $Revision: 29.3 $
+## @(#) $Revision: 30.1 $
-## @(#) $Id: README,v 29.3 2001/06/01 11:26:53 chongo Exp $
+## @(#) $Id: README,v 30.1 2007/03/16 11:09:46 chongo Exp $
-## @(#) $Source: /usr/local/src/cmd/calc/RCS/README,v $
+## @(#) $Source: /usr/local/src/bin/calc/RCS/README,v $
 ##
 ## Under source code control:	1995/10/25 05:27:59
 ## File existed as early as:	1995

README.WINDOWS

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

addop.c

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

align32.c

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: align32.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
+ * @(#) $Id: align32.c,v 30.1 2007/03/16 11:09:46 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/RCS/align32.c,v $
+ * @(#) $Source: /usr/local/src/bin/calc/RCS/align32.c,v $
  *
  * Under source code control:	1995/11/23 05:18:06
  * File existed as early as:	1995

alloc.h

@@ -1,7 +1,7 @@
 /*
  * alloc - storage allocation and storage debug macros
  *
- * Copyright (C) 1999  David I. Bell
+ * Copyright (C) 1999-2007  David I. Bell
  *
  * Calc is open software; you can redistribute it and/or modify it under
  * the terms of the version 2.1 of the GNU Lesser General Public License
@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.4 $
+ * @(#) $Revision: 30.3 $
- * @(#) $Id: alloc.h,v 29.4 2001/06/08 21:00:58 chongo Exp $
+ * @(#) $Id: alloc.h,v 30.3 2013/08/11 08:41:38 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/RCS/alloc.h,v $
+ * @(#) $Source: /usr/local/src/bin/calc/RCS/alloc.h,v $
  *
  * Under source code control:	1990/02/15 01:48:29
  * File existed as early as:	before 1990
@@ -33,54 +33,42 @@
 
 
 #if defined(CALC_SRC)	/* if we are building from the calc source tree */
-# include "have_malloc.h"
 # include "have_newstr.h"
 # include "have_string.h"
 # include "have_memmv.h"
 #else
-# include <calc/have_malloc.h>
 # include <calc/have_newstr.h>
 # include <calc/have_string.h>
 # include <calc/have_memmv.h>
 #endif
 
-#ifdef HAVE_MALLOC_H
-# include <malloc.h>
-#else
-#if defined(FORCE_STDC) || (defined(__STDC__) && __STDC__ != 0) || defined(__cplusplus)
-   extern void *malloc();
-   extern void *realloc();
-   extern void free();
-# else
-   extern char *malloc();
-   extern char *realloc();
-   extern void free();
-# endif
-#endif
-
 #ifdef HAVE_STRING_H
 # include <string.h>
 
 #else
+#if defined(_WIN32) && defined(NOTCYGWIN)
+#include <stdio.h>
+#endif
 
 # if defined(HAVE_NEWSTR)
-extern void *memcpy();
+E_FUNC void *memcpy();
-extern void *memset();
+E_FUNC void *memset();
-#if defined(FORCE_STDC) || (defined(__STDC__) && __STDC__ != 0) || defined(__cplusplus)
+#if defined(FORCE_STDC) || \
-extern size_t strlen();
+   (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();
+E_FUNC void bcopy();
-extern void bfill();
+E_FUNC void bfill();
-extern char *index();
+E_FUNC char *index();
 # endif /* HAVE_NEWSTR */
-extern char *strchr();
+E_FUNC char *strchr();
-extern char *strcpy();
+E_FUNC char *strcpy();
-extern char *strncpy();
+E_FUNC char *strncpy();
-extern char *strcat();
+E_FUNC char *strcat();
-extern int strcmp();
+E_FUNC int strcmp();
 
 #endif
 
@@ -94,13 +82,14 @@ extern int strcmp();
 #endif /* HAVE_NEWSTR */
 
 #if !defined(HAVE_MEMMOVE)
-# undef CALC_SIZE_T
+# undef MEMMOVE_SIZE_T
-#if defined(FORCE_STDC) || (defined(__STDC__) && __STDC__ != 0) || defined(__cplusplus)
+#if defined(FORCE_STDC) || \
-#  define CALC_SIZE_T size_t
+   (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__ */

assocfunc.c

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

blkcpy.c

@@ -1,7 +1,7 @@
 /*
  * blkcpy - general values and related routines used by the calculator
  *
- * Copyright (C) 1999-2006  Landon Curt Noll and Ernest Bowen
+ * Copyright (C) 1999-2007  Landon Curt Noll and Ernest Bowen
  *
  * Primary author:  Landon Curt Noll
  *
@@ -17,11 +17,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.9 $
+ * @(#) $Revision: 30.2 $
- * @(#) $Id: blkcpy.c,v 29.9 2006/05/20 08:43:55 chongo Exp $
+ * @(#) $Id: blkcpy.c,v 30.2 2013/08/11 08:41:38 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/RCS/blkcpy.c,v $
+ * @(#) $Source: /usr/local/src/bin/calc/RCS/blkcpy.c,v $
  *
  * Under source code control:	1997/04/18 20:41:26
  * File existed as early as:	1997
@@ -36,7 +36,7 @@
 #include "value.h"
 #include "file.h"
 #include "blkcpy.h"
-#include "string.h"
+#include "str.h"
 
 
 /*
@@ -374,7 +374,8 @@ copyblk2mat(BLOCK *blk, long ssi, long num, MATRIX *dmat, long dsi)
  * copymat2blk - copy matrix to block
  */
 int
-copymat2blk(MATRIX *smat, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc)
+copymat2blk(MATRIX *smat, long ssi, long num, BLOCK *dblk, long dsi,
+	    BOOL noreloc)
 {
 	long i;
 	long newlen;
@@ -720,7 +721,8 @@ copystr2file(STRING *str, long ssi, long num, FILEID id, long dsi)
  * copyblk2blk - copy block to block
  */
 int
-copyblk2blk(BLOCK *sblk, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc)
+copyblk2blk(BLOCK *sblk, long ssi, long num, BLOCK *dblk, long dsi,
+	    BOOL noreloc)
 {
 	long	newlen;
 	long	newsize;
@@ -762,7 +764,8 @@ copyblk2blk(BLOCK *sblk, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc
  * copystr2blk - copy string to block
  */
 int
-copystr2blk(STRING *str, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc)
+copystr2blk(STRING *str, long ssi, long num, BLOCK *dblk, long dsi,
+	    BOOL noreloc)
 {
 	long	len;
 	long	newlen;
@@ -935,7 +938,7 @@ copyostr2blk(char *str,long ssi,long num,BLOCK *dblk,long dsi,BOOL noreloc)
  *	s1
  */
 void *
-memmove(void *s1, const void *s2, CALC_SIZE_T n)
+memmove(void *s1, CONST void *s2, MEMMOVE_SIZE_T n)
 {
 	/*
 	 * firewall
@@ -982,7 +985,8 @@ memmove(void *s1, const void *s2, CALC_SIZE_T n)
  * copynum2blk - copy number numerator to block
  */
 int
-copynum2blk(NUMBER *snum, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc)
+copynum2blk(NUMBER *snum, long ssi, long num, BLOCK *dblk, long dsi,
+	    BOOL noreloc)
 {
 	size_t	newlen;
 	size_t	newsize;
@@ -1033,7 +1037,8 @@ copynum2blk(NUMBER *snum, long ssi, long num, BLOCK *dblk, long dsi, BOOL norelo
  * copyblk2num - copy block to number
  */
 int
-copyblk2num(BLOCK *sblk, long ssi, long num, NUMBER *dnum, long dsi, NUMBER **res)
+copyblk2num(BLOCK *sblk, long ssi, long num, NUMBER *dnum, long dsi,
+	    NUMBER **res)
 {
 	size_t	newlen;
 	NUMBER *ret;		/* cloned and modified numerator */

blkcpy.h

@@ -1,7 +1,7 @@
 /*
  * blkcpy - general values and related routines used by the calculator
  *
- * Copyright (C) 1999  Landon Curt Noll and Ernest Bowen
+ * Copyright (C) 1999-2007  Landon Curt Noll and Ernest Bowen
  *
  * Primary author:  Landon Curt Noll
  *
@@ -17,11 +17,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: blkcpy.h,v 29.2 2000/06/07 14:02:13 chongo Exp $
+ * @(#) $Id: blkcpy.h,v 30.1 2007/03/16 11:09:46 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/RCS/blkcpy.h,v $
+ * @(#) $Source: /usr/local/src/bin/calc/RCS/blkcpy.h,v $
  *
  * Under source code control:	1997/04/18 20:41:25
  * File existed as early as:	1997
@@ -36,27 +36,27 @@
 /*
  * the main copy gateway function
  */
-extern int copystod(VALUE *, long, long, VALUE *, long);
+E_FUNC int copystod(VALUE *, long, long, VALUE *, long);
 
 /*
  * specific copy functions
  */
-extern int copyblk2blk(BLOCK *, long, long, BLOCK *, long, BOOL);
+E_FUNC int copyblk2blk(BLOCK *, long, long, BLOCK *, long, BOOL);
-extern int copyblk2file(BLOCK *, long, long, FILEID, long);
+E_FUNC int copyblk2file(BLOCK *, long, long, FILEID, long);
-extern int copyblk2mat(BLOCK *, long, long, MATRIX *, long);
+E_FUNC int copyblk2mat(BLOCK *, long, long, MATRIX *, long);
-extern int copyblk2num(BLOCK *, long, long, NUMBER *, long, NUMBER **);
+E_FUNC int copyblk2num(BLOCK *, long, long, NUMBER *, long, NUMBER **);
-extern int copyblk2str(BLOCK *, long, long, STRING *, long);
+E_FUNC int copyblk2str(BLOCK *, long, long, STRING *, long);
-extern int copyfile2blk(FILEID, long, long, BLOCK *, long, BOOL);
+E_FUNC int copyfile2blk(FILEID, long, long, BLOCK *, long, BOOL);
-extern int copylist2list(LIST *, long, long, LIST *, long);
+E_FUNC int copylist2list(LIST *, long, long, LIST *, long);
-extern int copylist2mat(LIST *, long, long, MATRIX *, long);
+E_FUNC int copylist2mat(LIST *, long, long, MATRIX *, long);
-extern int copymat2blk(MATRIX *, long, long, BLOCK *, long, BOOL);
+E_FUNC int copymat2blk(MATRIX *, long, long, BLOCK *, long, BOOL);
-extern int copymat2list(MATRIX *, long, long, LIST *, long);
+E_FUNC int copymat2list(MATRIX *, long, long, LIST *, long);
-extern int copymat2mat(MATRIX *, long, long, MATRIX *, long);
+E_FUNC int copymat2mat(MATRIX *, long, long, MATRIX *, long);
-extern int copynum2blk(NUMBER *, long, long, BLOCK *, long, BOOL);
+E_FUNC int copynum2blk(NUMBER *, long, long, BLOCK *, long, BOOL);
-extern int copyostr2blk(char *, long, long, BLOCK *, long, BOOL);
+E_FUNC int copyostr2blk(char *, long, long, BLOCK *, long, BOOL);
-extern int copyostr2str(char *, long, long, STRING *, long);
+E_FUNC int copyostr2str(char *, long, long, STRING *, long);
-extern int copystr2blk(STRING *, long, long, BLOCK *, long, BOOL);
+E_FUNC int copystr2blk(STRING *, long, long, BLOCK *, long, BOOL);
-extern int copystr2file(STRING *, long, long, FILEID, long);
+E_FUNC int copystr2file(STRING *, long, long, FILEID, long);
-extern int copystr2str(STRING *, long, long, STRING *, long);
+E_FUNC int copystr2str(STRING *, long, long, STRING *, long);
 
 #endif /* !__BLKCPY_H__ */

block.c

@@ -1,7 +1,7 @@
 /*
  * block - fixed, dynamic, fifo and circular memory blocks
  *
- * Copyright (C) 1999  Landon Curt Noll and Ernest Bowen
+ * Copyright (C) 1999-2007  Landon Curt Noll and Ernest Bowen
  *
  * Primary author:  Landon Curt Noll
  *
@@ -17,11 +17,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.3 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: block.c,v 29.3 2006/05/01 19:16:57 chongo Exp $
+ * @(#) $Id: block.c,v 30.1 2007/03/16 11:09:46 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/RCS/block.c,v $
+ * @(#) $Source: /usr/local/src/bin/calc/RCS/block.c,v $
  *
  * Under source code control:	1997/02/27 00:29:40
  * File existed as early as:	1997
@@ -37,19 +37,19 @@
 #include "config.h"
 #include "block.h"
 #include "nametype.h"
-#include "string.h"
+#include "str.h"
 #include "calcerr.h"
 
 #define NBLOCKCHUNK 16
 
-static long nblockcount = 0;
+STATIC long nblockcount = 0;
-static long maxnblockcount = 0;
+STATIC long maxnblockcount = 0;
-static STRINGHEAD nblocknames;
+STATIC STRINGHEAD nblocknames;
-static NBLOCK **nblocks;
+STATIC NBLOCK **nblocks;
 
 
 /* forward declarations */
-static void blkchk(BLOCK*);
+S_FUNC void blkchk(BLOCK*);
 
 
 /*
@@ -154,7 +154,7 @@ blk_free(BLOCK *blk)
  *	if all is ok, otherwise math_error() is called and this
  *	function does not return
  */
-static void
+S_FUNC void
 blkchk(BLOCK *blk)
 {
 

block.h

@@ -1,7 +1,7 @@
 /*
  * block - fixed, dynamic, fifo and circular memory blocks
  *
- * Copyright (C) 1999  Landon Curt Noll and Ernest Bowen
+ * Copyright (C) 1999-2007  Landon Curt Noll and Ernest Bowen
  *
  * Primary author:  Landon Curt Noll
  *
@@ -17,11 +17,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: block.h,v 29.2 2000/06/07 14:02:13 chongo Exp $
+ * @(#) $Id: block.h,v 30.1 2007/03/16 11:09:46 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/RCS/block.h,v $
+ * @(#) $Source: /usr/local/src/bin/calc/RCS/block.h,v $
  *
  * Under source code control:	1997/02/21 05:03:39
  * File existed as early as:	1997
@@ -160,7 +160,7 @@ typedef struct nblock NBLOCK;
 /*
  * block debug
  */
-extern int blk_debug;	/* 0 => debug off */
+EXTERN int blk_debug;	/* 0 => debug off */
 
 
 /*
@@ -204,22 +204,22 @@ typedef USB8 OCTET;
 /*
  * external functions
  */
-extern BLOCK *blkalloc(int, int);
+E_FUNC BLOCK *blkalloc(int, int);
-extern void blk_free(BLOCK*);
+E_FUNC void blk_free(BLOCK*);
-extern BLOCK *blkrealloc(BLOCK*, int, int);
+E_FUNC BLOCK *blkrealloc(BLOCK*, int, int);
-extern void blktrunc(BLOCK*);
+E_FUNC void blktrunc(BLOCK*);
-extern BLOCK *blk_copy(BLOCK*);
+E_FUNC BLOCK *blk_copy(BLOCK*);
-extern int blk_cmp(BLOCK*, BLOCK*);
+E_FUNC int blk_cmp(BLOCK*, BLOCK*);
-extern void blk_print(BLOCK*);
+E_FUNC void blk_print(BLOCK*);
-extern void nblock_print(NBLOCK *);
+E_FUNC void nblock_print(NBLOCK *);
-extern NBLOCK *createnblock(char *, int, int);
+E_FUNC NBLOCK *createnblock(char *, int, int);
-extern NBLOCK *reallocnblock(int, int, int);
+E_FUNC NBLOCK *reallocnblock(int, int, int);
-extern int removenblock(int);
+E_FUNC int removenblock(int);
-extern int findnblockid(char *);
+E_FUNC int findnblockid(char *);
-extern NBLOCK *findnblock(int);
+E_FUNC NBLOCK *findnblock(int);
-extern BLOCK *copyrealloc(BLOCK*, int, int);
+E_FUNC BLOCK *copyrealloc(BLOCK*, int, int);
-extern int countnblocks(void);
+E_FUNC int countnblocks(void);
-extern void shownblocks(void);
+E_FUNC void shownblocks(void);
 
 
 #endif /* !__BLOCK_H__ */

byteswap.c

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.2 $
- * @(#) $Id: byteswap.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
+ * @(#) $Id: byteswap.c,v 30.2 2013/08/11 08:41:38 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/RCS/byteswap.c,v $
+ * @(#) $Source: /usr/local/src/bin/calc/RCS/byteswap.c,v $
  *
  * Under source code control:	1995/10/11 04:44:01
  * File existed as early as:	1995
@@ -102,7 +102,8 @@ swap_b8_in_ZVALUE(ZVALUE *dest, ZVALUE *src, BOOL all)
 		 */
 		dest = malloc(sizeof(ZVALUE));
 		if (dest == NULL) {
-			math_error("swap_b8_in_ZVALUE: swap_b8_in_ZVALUE: Not enough memory");
+			math_error("swap_b8_in_ZVALUE: swap_b8_in_ZVALUE: "
+				    "Not enough memory");
 			/*NOTREACHED*/
 		}
 

byteswap.h

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.4 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: byteswap.h,v 29.4 2001/06/08 21:00:58 chongo Exp $
+ * @(#) $Id: byteswap.h,v 30.1 2007/03/16 11:09:46 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/RCS/byteswap.h,v $
+ * @(#) $Source: /usr/local/src/bin/calc/RCS/byteswap.h,v $
  *
  * Under source code control:	1995/10/11 04:44:01
  * File existed as early as:	1995

cal/Makefile

@@ -2,7 +2,7 @@
 #
 # cal - makefile for calc standard resource files
 #
-# Copyright (C) 1999  Landon Curt Noll
+# Copyright (C) 1999-2006  Landon Curt Noll
 #
 # Calc is open software; you can redistribute it and/or modify it under
 # the terms of the version 2.1 of the GNU Lesser General Public License
@@ -16,11 +16,11 @@
 # A copy of version 2.1 of the GNU Lesser General Public License is
 # distributed with calc under the filename COPYING-LGPL.  You should have
 # received a copy with calc; if not, write to Free Software Foundation, Inc.
-# 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+# 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 #
-# @(#) $Revision: 29.18 $
+# @(#) $Revision: 30.10 $
-# @(#) $Id: Makefile,v 29.18 2006/05/20 19:32:40 chongo Exp $
+# @(#) $Id: Makefile,v 30.10 2013/09/02 03:02:00 chongo Exp $
-# @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/Makefile,v $
+# @(#) $Source: /usr/local/src/bin/calc/cal/RCS/Makefile,v $
 #
 # Under source code control:	1991/07/21 05:00:54
 # File existed as early as:	1991
@@ -33,14 +33,31 @@
 
 # required vars
 #
-SHELL = /bin/sh
+SHELL= /bin/sh
-MAKE_FILE = Makefile
 
 ####
 # Normally, the upper level makefile will set these values.  We provide
 # a default here just in case you want to build from this directory.
 ####
 
+# Normally certain files depend on the Makefile.  If the Makefile is
+# changed, then certain steps should be redone.  If MAKE_FILE is
+# set to Makefile, then these files will depend on Makefile.  If
+# MAKE_FILE is empty, then they wont.
+#
+# If in doubt, set MAKE_FILE to Makefile
+#
+MAKE_FILE= Makefile
+
+# Controlling file makefile basename (without the path)
+#
+# This is the basename same of the makefile that may/does/will drive
+# this makefile.
+#
+# If in doubt, set TOP_MAKE_FILE to Makefile
+#
+TOP_MAKE_FILE= Makefile
+
 # Where the system include (.h) files are kept
 #
 # For DJGPP, select:
@@ -62,9 +79,9 @@ INCDIR= /usr/include
 # ${LIBDIR}		where calc link library (*.a) files are installed
 # ${CALC_SHAREDIR}	where to install calc help, .cal, startup, config files
 #
-# NOTE: The install rule prepends installation paths with $T, which
+# NOTE: The install rule prepends installation paths with ${T}, which
-#	by default is empty.  If $T is non-empty, then installation
+#	by default is empty.  If ${T} is non-empty, then installation
-#	locations will be relative to the $T directory.
+#	locations will be relative to the ${T} directory.
 #
 # For DJGPP, select:
 #
@@ -94,35 +111,26 @@ CALC_SHAREDIR= /usr/share/calc
 # ---------------------------------------------------------------
 # ${HELPDIR}		where the help directory is installed
 # ${CALC_INCDIR}	where the calc include files are installed
-# ${CUSTOMCALDIR}	where custom *.cal files are installed
-# ${CUSTOMHELPDIR}	where custom help files are installed
-# ${CUSTOMINCPDIR}	where custom .h files are installed
 # ${SCRIPTDIR}		where calc shell scripts are installed
 #
-# NOTE: The install rule prepends installation paths with $T, which
+# NOTE: The install rule prepends installation paths with ${T}, which
-#	by default is empty.  If $T is non-empty, then installation
+#	by default is empty.  If ${T} is non-empty, then installation
-#	locations will be relative to the $T directory.
+#	locations will be relative to the ${T} directory.
 #
 # If in doubt, set:
 #
 #	HELPDIR= ${CALC_SHAREDIR}/help
 #	CALC_INCDIR= ${INCDIR}/calc
-#	CUSTOMCALDIR= ${CALC_SHAREDIR}/custom
-#	CUSTOMHELPDIR= ${CALC_SHAREDIR}/custhelp
-#	CUSTOMINCDIR= ${CALC_INCDIR}/custom
 #	SCRIPTDIR= ${BINDIR}/cscript
 #
 HELPDIR= ${CALC_SHAREDIR}/help
 CALC_INCDIR= ${INCDIR}/calc
-CUSTOMCALDIR= ${CALC_SHAREDIR}/custom
-CUSTOMHELPDIR= ${CALC_SHAREDIR}/custhelp
-CUSTOMINCDIR= ${CALC_INCDIR}/custom
 SCRIPTDIR= ${BINDIR}/cscript
 
 # T - top level directory under which calc will be installed
 #
-# The calc install is performed under $T, the calc build is
+# The calc install is performed under ${T}, the calc build is
-# performed under /.	The purpose for $T is to allow someone
+# performed under /.	The purpose for ${T} is to allow someone
 # to install calc somewhere other than into the system area.
 #
 # For example, if:
@@ -142,10 +150,10 @@ SCRIPTDIR= ${BINDIR}/cscript
 #     calc help, .cal ...:	/var/tmp/testing/usr/share/calc
 #     ... etc ...		/var/tmp/testing/...
 #
-# If $T is empty, calc is installed under /, which is the same
+# 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
+# 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
+# calc is installed under ${T}, as if one had to chroot under
-# $T for calc to operate.
+# ${T} for calc to operate.
 #
 # If in doubt, use T=
 #
@@ -163,21 +171,45 @@ 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 \
+# This list is prodiced by the detaillist rule when no WARNINGS are detected.
-	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 \
+# Please use:
-	sumsq.cal surd.cal unitfrac.cal varargs.cal chrem.cal mfactor.cal \
+#
-	bindings randmprime.cal test1700.cal randrun.cal linear.cal \
+#	make calc_files_list
-	randbitrun.cal bernoulli.cal test2300.cal test2600.cal \
+#
-	test2700.cal test3100.cal test3300.cal test3400.cal prompt.cal \
+# to keep this list in nice sorted order and to check that these
-	test3500.cal seedrandom.cal test4000.cal test4100.cal test4600.cal \
+# deailed help files are under RCS control.
-	beer.cal hello.cal test5100.cal test5200.cal randombitrun.cal \
+#
-	randomrun.cal repeat.cal xx_print.cal natnumset.cal qtime.cal \
+CALC_FILES= README alg_config.cal beer.cal bernoulli.cal \
-	test8400.cal test8500.cal test8600.cal chi.cal intfile.cal screen.cal \
+	bernpoly.cal bigprime.cal bindings brentsolve.cal chi.cal chrem.cal \
-	dotest.cal set8700.cal set8700.line
+	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 lucas_tbl.cal mersenne.cal mfactor.cal \
+	mod.cal natnumset.cal pell.cal pi.cal pix.cal pollard.cal poly.cal \
+	prompt.cal psqrt.cal qtime.cal quat.cal randbitrun.cal randmprime.cal \
+	randombitrun.cal randomrun.cal randrun.cal 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 files are found (but not built) in the distribution
 #
@@ -192,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
+	${RM} -f .all
-	touch .all
+	${TOUCH} .all
 
 ##
 #
@@ -209,22 +241,43 @@ all: ${CALC_FILES} ${MAKE_FILE} .all
 ##
 
 distlist: ${DISTLIST}
-	${Q}for i in ${DISTLIST} /dev/null; do \
+	${Q} for i in ${DISTLIST} /dev/null; do \
 	    if [ X"$$i" != X"/dev/null" ]; then \
 		echo cal/$$i; \
 	    fi; \
 	done
 
 distdir:
-	${Q}echo cal
+	${Q} echo cal
 
 calcliblist:
-	${Q}for i in ${CALCLIBLIST} /dev/null; do \
+	${Q} for i in ${CALCLIBLIST} /dev/null; do \
 	    if [ X"$$i" != X"/dev/null" ]; then \
 		echo cal/$$i; \
 	    fi; \
 	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
@@ -232,7 +285,7 @@ calcliblist:
 ##
 
 echo_inst_files:
-	${Q}for i in ${CALC_FILES} /dev/null; do \
+	${Q} for i in ${CALC_FILES} /dev/null; do \
 	    if [ X"$$i" != X"/dev/null" ]; then \
 		echo __file__ ${CALC_SHAREDIR}/$$i; \
 	    fi; \
@@ -246,33 +299,62 @@ echo_inst_files:
 
 clean:
 
-clobber:
+clobber: clean
-	rm -f .all
+	${RM} -f .all
 
+# install everything
+#
+# NOTE: Keep the uninstall rule in reverse order to the install rule
+#
 install: all
-	-${Q}if [ ! -d $T${CALC_SHAREDIR} ]; then \
+	-${Q} if [ ! -d ${T}${CALC_SHAREDIR} ]; then \
-	    echo mkdir $T${CALC_SHAREDIR}; \
+	    echo ${MKDIR} ${T}${CALC_SHAREDIR}; \
-	    mkdir $T${CALC_SHAREDIR}; \
+	    ${MKDIR} ${T}${CALC_SHAREDIR}; \
-	    if [ ! -d "$T${CALC_SHAREDIR}" ]; then \
+	    if [ ! -d "${T}${CALC_SHAREDIR}" ]; then \
-		echo mkdir -p "$T${CALC_SHAREDIR}"; \
+		echo ${MKDIR} -p "${T}${CALC_SHAREDIR}"; \
-		mkdir -p "$T${CALC_SHAREDIR}"; \
+		${MKDIR} -p "${T}${CALC_SHAREDIR}"; \
 	    fi; \
-	    echo ${CHMOD} 0755 $T${CALC_SHAREDIR}; \
+	    echo ${CHMOD} 0755 ${T}${CALC_SHAREDIR}; \
-	    ${CHMOD} 0755 $T${CALC_SHAREDIR}; \
+	    ${CHMOD} 0755 ${T}${CALC_SHAREDIR}; \
 	else \
-	    true; \
+	    ${TRUE}; \
 	fi
-	${Q}for i in ${CALC_FILES} /dev/null; do \
+	${Q} for i in ${CALC_FILES} /dev/null; do \
 	    if [ "$$i" = "/dev/null" ]; then \
 		continue; \
 	    fi; \
-	    if ${CMP} -s $$i $T${CALC_SHAREDIR}/$$i; then \
+	    if ${CMP} -s $$i ${T}${CALC_SHAREDIR}/$$i; then \
-		true; \
+		${TRUE}; \
 	    else \
-		rm -f $T${CALC_SHAREDIR}/$$i.new; \
+		${RM} -f ${T}${CALC_SHAREDIR}/$$i.new; \
-		cp -f $$i $T${CALC_SHAREDIR}/$$i.new; \
+		${CP} -f $$i ${T}${CALC_SHAREDIR}/$$i.new; \
-		${CHMOD} 0444 $T${CALC_SHAREDIR}/$$i.new; \
+		${CHMOD} 0444 ${T}${CALC_SHAREDIR}/$$i.new; \
-		mv -f $T${CALC_SHAREDIR}/$$i.new $T${CALC_SHAREDIR}/$$i; \
+		${MV} -f ${T}${CALC_SHAREDIR}/$$i.new ${T}${CALC_SHAREDIR}/$$i;\
-		echo "installed $T${CALC_SHAREDIR}/$$i"; \
+		echo "installed ${T}${CALC_SHAREDIR}/$$i"; \
+	    fi; \
+	done
+
+# Try to remove everything that was installed
+#
+# NOTE: Keep the uninstall rule in reverse order to the install rule
+#
+uninstall:
+	-${Q} for i in ${CALC_FILES} /dev/null; do \
+	    if [ "$$i" = "/dev/null" ]; then \
+		continue; \
+	    fi; \
+	    if [ -f "${T}${CALC_SHAREDIR}/$$i" ]; then \
+	    	${RM} -f "${T}${CALC_SHAREDIR}/$$i"; \
+		if [ -f "${T}${CALC_SHAREDIR}/$$i" ]; then \
+		   echo "cannot uninstall ${T}${CALC_SHAREDIR}/$$i"; \
+		else \
+		   echo "uninstalled ${T}${CALC_SHAREDIR}/$$i"; \
+		fi; \
+	    fi; \
+	done
+	-${Q} for i in ${CALC_SHAREDIR}; do \
+	    if [ -d "${T}$$i" ]; then \
+		${RMDIR} "${T}$$i" 2>/dev/null; \
+		echo "cleaned up ${T}$$i"; \
 	    fi; \
 	done

cal/beer.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: beer.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: beer.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/beer.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/beer.cal,v $
  *
  * Under source code control:	1996/11/13 13:21:05
  * File existed as early as:	1996

cal/bernoulli.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.3 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: bernoulli.cal,v 29.3 2000/12/17 12:26:04 chongo Exp $
+ * @(#) $Id: bernoulli.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/bernoulli.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/bernoulli.cal,v $
  *
  * Under source code control:	1991/09/30 11:18:41
  * File existed as early as:	1991

cal/bernpoly.cal

@@ -0,0 +1,59 @@
+/*
+ * bernpoly - Bernoully polynomials B_n(z) for arbitrary n,z..
+ *
+ * Copyright (C) 2013 Christoph Zurnieden
+ *
+ * Calc is open software; you can redistribute it and/or modify it under
+ * the terms of the version 2.1 of the GNU Lesser General Public License
+ * as published by the Free Software Foundation.
+ *
+ * Calc is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General
+ * Public License for more details.
+ *
+ * A copy of version 2.1 of the GNU Lesser General Public License is
+ * distributed with calc under the filename COPYING-LGPL.  You should have
+ * received a copy with calc; if not, write to Free Software Foundation, Inc.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+ *
+ * @(#) $Revision: 30.4 $
+ * @(#) $Id: bernpoly.cal,v 30.4 2013/08/18 20:01:53 chongo Exp $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/bernpoly.cal,v $
+ *
+ * Under source code control:	2013/08/11 01:31:28
+ * File existed as early as:	2013
+ */
+
+
+static resource_debug_level;
+resource_debug_level = config("resource_debug", 0);
+
+
+read -once zeta2
+
+
+/* Idea by Don Zagier */
+define bernpoly(n,z){
+  local h s c k;
+  if(isint(n) && n>=0){
+    h=0;s=0;c=-1;
+    for(k=1;k<=n+1;k++){
+      c*=1-(n+2)/k;
+      s+=z^n;
+      z++;
+      h+=c*s/k;
+    }
+    return h;
+  }
+  else return -n*hurwitzzeta(1-n,z);
+}
+
+
+/*
+ * restore internal function from resource debugging
+ */
+config("resource_debug", resource_debug_level),;
+if (config("resource_debug") & 3) {
+    print "bernpoly(n,z)";
+}

cal/bigprime.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: bigprime.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: bigprime.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/bigprime.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/bigprime.cal,v $
  *
  * Under source code control:	1991/05/22 21:56:32
  * File existed as early as:	1991

cal/bindings

@@ -14,11 +14,11 @@
 # A copy of version 2.1 of the GNU Lesser General Public License is
 # distributed with calc under the filename COPYING-LGPL.  You should have
 # received a copy with calc; if not, write to Free Software Foundation, Inc.
-# 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+# 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 #
-# @(#) $Revision: 29.2 $
+# @(#) $Revision: 30.1 $
-# @(#) $Id: bindings,v 29.2 2000/06/07 14:02:25 chongo Exp $
+# @(#) $Id: bindings,v 30.1 2007/03/16 11:09:54 chongo Exp $
-# @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/bindings,v $
+# @(#) $Source: /usr/local/src/bin/calc/cal/RCS/bindings,v $
 #
 # Under source code control:	1993/05/02 20:09:19
 # File existed as early as:	1993

cal/brentsolve.cal

@@ -0,0 +1,258 @@
+/*
+ * brentsolve - Root finding with the Brent-Dekker trick
+ *
+ * Copyright (C) 2013 Christoph Zurnieden
+ *
+ * Calc is open software; you can redistribute it and/or modify it under
+ * the terms of the version 2.1 of the GNU Lesser General Public License
+ * as published by the Free Software Foundation.
+ *
+ * Calc is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General
+ * Public License for more details.
+ *
+ * A copy of version 2.1 of the GNU Lesser General Public License is
+ * distributed with calc under the filename COPYING-LGPL.  You should have
+ * received a copy with calc; if not, write to Free Software Foundation, Inc.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+ *
+ * @(#) $Revision: 30.4 $
+ * @(#) $Id: brentsolve.cal,v 30.4 2013/08/18 20:01:53 chongo Exp $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/brentsolve.cal,v $
+ *
+ * Under source code control:	2013/08/11 01:31:28
+ * File existed as early as:	2013
+ */
+
+
+static resource_debug_level;
+resource_debug_level = config("resource_debug", 0);
+
+
+/*
+  A short explanation is at http://en.wikipedia.org/wiki/Brent%27s_method
+  I tried to follow the description at wikipedia as much as possible to make
+  the slight changes I did more visible.
+  You may give http://people.sc.fsu.edu/~jburkardt/cpp_src/brent/brent.html a
+  short glimpse (Brent's originl Fortran77 versions and some translations of
+  it).
+*/
+
+static true = 1;
+static false = 0;
+define brentsolve(low, high,eps){
+  local a b c d fa fb fc fa2 fb2 fc2 s fs  tmp tmp2  mflag i places;
+  a = low;
+  b = high;
+  c = 0;
+
+  if(isnull(eps))
+    eps = epsilon(epsilon()*1e-3);
+  places = highbit(1 + int( 1/epsilon() ) ) + 1;
+
+  d = 1/eps;
+
+  fa = f(a);
+  fb = f(b);
+
+  fc = 0;
+  s = 0;
+  fs = 0;
+
+  if(fa * fb >= 0){
+    if(fa < fb){
+      epsilon(eps);
+      return a;
+    }
+    else{
+      epsilon(eps);
+      return b;
+    }
+  }
+
+  if(abs(fa) < abs(fb)){
+    tmp = a; a = b; b = tmp;
+    tmp = fa; fa = fb; fb = tmp;
+  }
+
+  c = a;
+  fc = fa;
+  mflag = 1;
+  i = 0;
+
+  while(!(fb==0) && (abs(a-b) > eps)){
+    if((fa != fc) && (fb != fc)){
+      /* Inverse quadratic interpolation*/
+      fc2 = fc^2;
+      fa2 = fa^2;
+      s = bround(((fb^2*((fc*a)-(c*fa)))+(fb*((c*fa2)-(fc2*a)))+(b*((fc2*fa)
+                    -(fc*fa2))))/((fc - fb)*(fa - fb)*(fc - fa)),places++);
+    }
+    else{
+      /* Secant Rule*/
+      s =bround( b - fb * (b - a) / (fb - fa),places++);
+    }
+    tmp2 = (3 * a + b) / 4;
+    if( (!( ((s > tmp2) && (s < b))||((s < tmp2) && (s > b))))
+        || (mflag && (abs(s - b) >= (abs(b - c) / 2)))
+        || (!mflag && (abs(s - b) >= (abs(c - d) / 2)))) {
+      s = (a + b) / 2;
+      mflag = true;
+    }
+    else{
+      if( (mflag && (abs(b - c) < eps))
+          || (!mflag && (abs(c - d) < eps))) {
+        s = (a + b) / 2;
+        mflag = true;
+      }
+      else
+        mflag = false;
+    }
+    fs = f(s);
+    c = b;
+    fc = fb;
+    if (fa * fs < 0){
+      b = s;
+      fb = fs;
+    }
+    else {
+      a = s;
+      fa = fs;
+    }
+
+    if (abs(fa) < abs(fb)){
+      tmp = a; a = b; b = tmp;
+      tmp = fa; fa = fb; fb = tmp;
+    }
+    i++;
+    if (i > 1000){
+      epsilon(eps);
+      return newerror("brentsolve: does not converge");
+    }
+  }
+  epsilon(eps);
+  return b;
+}
+
+/*
+  A variation of the solver to accept functions named differently from "f". The
+  code should explain it.
+*/
+define brentsolve2(low, high,which,eps){
+  local a b c d fa fb fc fa2 fb2 fc2 s fs  tmp tmp2  mflag i places;
+  a = low;
+  b = high;
+  c = 0;
+
+  switch(param(0)){
+    case 0:
+    case 1: return newerror("brentsolve2: not enough argments");
+    case 2: eps = epsilon(epsilon()*1e-2);
+            which = 0;break;
+    case 3: eps = epsilon(epsilon()*1e-2);break;
+    default: break;
+  };
+  places = highbit(1 + int(1/epsilon())) + 1;
+
+  d = 1/eps;
+
+  switch(which){
+    case 1:  fa = __CZ__invbeta(a);
+             fb = __CZ__invbeta(b); break;
+    case 2:  fa = __CZ__invincgamma(a);
+             fb = __CZ__invincgamma(b); break;
+
+    default: fa = f(a);fb = f(b);   break;
+  };
+
+  fc = 0;
+  s = 0;
+  fs = 0;
+
+  if(fa * fb >= 0){
+    if(fa < fb)
+      return a;
+    else
+      return b;
+  }
+
+  if(abs(fa) < abs(fb)){
+    tmp = a; a = b; b = tmp;
+    tmp = fa; fa = fb; fb = tmp;
+  }
+
+  c = a;
+  fc = fa;
+  mflag = 1;
+  i = 0;
+
+  while(!(fb==0) && (abs(a-b) > eps)){
+
+    if((fa != fc) && (fb != fc)){
+      /* Inverse quadratic interpolation*/
+      fc2 = fc^2;
+      fa2 = fa^2;
+      s = bround(((fb^2*((fc*a)-(c*fa)))+(fb*((c*fa2)-(fc2*a)))+(b*((fc2*fa)
+                    -(fc*fa2))))/((fc - fb)*(fa - fb)*(fc - fa)),places);
+      places++;
+    }
+    else{
+      /* Secant Rule*/
+      s =bround( b - fb * (b - a) / (fb - fa),places);
+      places++;
+    }
+    tmp2 = (3 * a + b) / 4;
+    if( (!( ((s > tmp2) && (s < b))||((s < tmp2) && (s > b))))
+        || (mflag && (abs(s - b) >= (abs(b - c) / 2)))
+        || (!mflag && (abs(s - b) >= (abs(c - d) / 2)))) {
+      s = (a + b) / 2;
+      mflag = true;
+    }
+    else{
+      if( (mflag && (abs(b - c) < eps))
+          || (!mflag && (abs(c - d) < eps))) {
+        s = (a + b) / 2;
+        mflag = true;
+      }
+      else
+        mflag = false;
+    }
+    switch(which){
+      case 1:  fs = __CZ__invbeta(s); break;
+      case 2:  fs = __CZ__invincgamma(s); break;
+
+      default: fs = f(s);             break;
+    };
+    c = b;
+    fc = fb;
+    if (fa * fs < 0){
+      b = s;
+      fb = fs;
+    }
+    else {
+      a = s;
+      fa = fs;
+    }
+
+    if (abs(fa) < abs(fb)){
+      tmp = a; a = b; b = tmp;
+      tmp = fa; fa = fb; fb = tmp;
+    }
+    i++;
+    if (i > 1000){
+      return newerror("brentsolve2: does not converge");
+    }
+  }
+  return b;
+}
+
+
+/*
+ * restore internal function from resource debugging
+ */
+config("resource_debug", resource_debug_level),;
+if (config("resource_debug") & 3) {
+    print "brentsolve(low, high,eps)";
+    print "brentsolve2(low, high,which,eps)";
+}

cal/chi.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: chi.cal,v 29.2 2001/04/08 10:21:23 chongo Exp $
+ * @(#) $Id: chi.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/chi.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/chi.cal,v $
  *
  * Under source code control:	2001/03/27 14:10:11
  * File existed as early as:	2001

cal/chrem.cal

@@ -17,11 +17,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: chrem.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: chrem.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/chrem.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/chrem.cal,v $
  *
  * Under source code control:	1992/09/26 01:00:47
  * File existed as early as:	1992

cal/constants.cal

@@ -0,0 +1,104 @@
+/*
+ * constants - implementation of different constants to arbitrary precision
+ *
+ * Copyright (C) 2013 Christoph Zurnieden
+ *
+ * Calc is open software; you can redistribute it and/or modify it under
+ * the terms of the version 2.1 of the GNU Lesser General Public License
+ * as published by the Free Software Foundation.
+ *
+ * Calc is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General
+ * Public License for more details.
+ *
+ * A copy of version 2.1 of the GNU Lesser General Public License is
+ * distributed with calc under the filename COPYING-LGPL.  You should have
+ * received a copy with calc; if not, write to Free Software Foundation, Inc.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+ *
+ * @(#) $Revision: 30.4 $
+ * @(#) $Id: constants.cal,v 30.4 2013/08/18 20:01:53 chongo Exp $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/constants.cal,v $
+ *
+ * Under source code control:	2013/08/11 01:31:28
+ * File existed as early as:	2013
+ */
+
+
+static resource_debug_level;
+resource_debug_level = config("resource_debug", 0);
+
+
+static __CZ__euler_mascheroni = 0;
+static __CZ__euler_mascheroni_prec = 0;
+
+
+define e(){
+  local k temp1 temp2 ret eps factor upperlimit prec;
+
+  prec = digits(1/epsilon());
+  if(__CZ__euler_mascheroni != 0 &&  __CZ__euler_mascheroni_prec >= prec)
+    return __CZ__euler_mascheroni;
+  if(prec<=20) return 2.718281828459045235360287471;
+  if(prec<=1800){
+    __CZ__euler_mascheroni = exp(1);
+    __CZ__euler_mascheroni_prec = prec;
+  }
+
+  eps=epsilon(1e-20);
+  factor = 1;
+  k = 0;
+  upperlimit = prec * ln(10);
+  while(k<upperlimit){
+    k += ln(factor);
+    factor++;
+  }
+  epsilon(eps);
+  temp1 = 0;
+  ret   = 1;
+  for(k=3;k<=factor;k++){
+    temp2 = temp1;
+    temp1 = ret;
+    ret =  (k-1) *(temp1 + temp2);
+  }
+
+  ret = inverse( ret * inverse(factorial(factor) ) ) ;
+  __CZ__euler_mascheroni = ret;
+  __CZ__euler_mascheroni_prec = prec;
+  return ret;
+}
+
+
+/* Lupas' series */
+static __CZ__catalan = 0;
+static __CZ__catalan_prec = 0;
+define G(){
+  local eps a s t n;
+  eps = epsilon(epsilon()*1e-10);
+  if(__CZ__catalan != 0 &&  __CZ__catalan >= log(1/eps))
+    return __CZ__catalan;
+  a = 1;
+  s = 0;
+  t = 1;
+  n = 1;
+  while(abs(t)> eps){
+    a *= 32 * n^3 * (2*n-1);
+    a /=((3-16*n+16*n^2)^2);
+    t = a * (-1)^(n-1) * (40*n^2-24*n+3) / (n^3 * (2*n-1));
+    s += t;
+    n += 1;
+  }
+  s = s/64;
+  __CZ__catalan = s;
+  __CZ__catalan_prec = log(1/eps);
+  epsilon(eps);
+  return s;
+}
+
+
+config("resource_debug", resource_debug_level),;
+if (config("resource_debug") & 3) {
+    print "e()";
+    print "G()";
+}

cal/deg.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.4 $
+ * @(#) $Revision: 30.2 $
- * @(#) $Id: deg.cal,v 29.4 2003/01/26 19:32:41 chongo Exp $
+ * @(#) $Id: deg.cal,v 30.2 2010/09/02 06:01:14 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/deg.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/deg.cal,v $
  *
  * Under source code control:	1990/02/15 01:50:33
  * File existed as early as:	before 1990
@@ -28,9 +28,9 @@
  */
 
 
-obj dms {deg, min, sec};
+obj deg {deg, min, sec};
 
-define dms(deg, min, sec)
+define deg(deg, min, sec)
 {
 	local ans;
 
@@ -38,18 +38,18 @@ define dms(deg, min, sec)
 		sec = 0;
 	if (isnull(min))
 		min = 0;
-	obj dms ans;
+	obj deg ans;
 	ans.deg = deg;
 	ans.min = min;
 	ans.sec = sec;
-	fixdms(ans);
+	fixdeg(ans);
 	return ans;
 }
 
 
-define dms_add(a, b)
+define deg_add(a, b)
 {
-	local obj dms	ans;
+	local obj deg	ans;
 
 	ans.deg = 0;
 	ans.min = 0;
@@ -66,14 +66,14 @@ define dms_add(a, b)
 		ans.sec += b.sec;
 	} else
 		ans.deg += b;
-	fixdms(ans);
+	fixdeg(ans);
 	return ans;
 }
 
 
-define dms_neg(a)
+define deg_neg(a)
 {
-	local obj dms	ans;
+	local obj deg	ans;
 
 	ans.deg = -a.deg;
 	ans.min = -a.min;
@@ -82,15 +82,15 @@ define dms_neg(a)
 }
 
 
-define dms_sub(a, b)
+define deg_sub(a, b)
 {
 	return a - b;
 }
 
 
-define dms_mul(a, b)
+define deg_mul(a, b)
 {
-	local obj dms	ans;
+	local obj deg	ans;
 
 	if (istype(a, ans) && istype(b, ans))
 		quit "Cannot multiply degrees together";
@@ -103,24 +103,24 @@ define dms_mul(a, b)
 		ans.min = b.min * a;
 		ans.sec = b.sec * a;
 	}
-	fixdms(ans);
+	fixdeg(ans);
 	return ans;
 }
 
 
-define dms_print(a)
+define deg_print(a)
 {
 	print a.deg : 'd' : a.min : 'm' : a.sec : 's' :;
 }
 
 
-define dms_abs(a)
+define deg_abs(a)
 {
 	return a.deg + a.min / 60 + a.sec / 3600;
 }
 
 
-define fixdms(a)
+define fixdeg(a)
 {
 	a.min += frac(a.deg) * 60;
 	a.deg = int(a.deg);
@@ -134,5 +134,5 @@ define fixdms(a)
 }
 
 if (config("resource_debug") & 3) {
-    print "obj dms {deg, min, sec} defined";
+    print "obj deg {deg, min, sec} defined";
 }

cal/dms.cal

@@ -0,0 +1,384 @@
+/*
+ * dms - calculate in degrees, minutes, and seconds (based on deg)
+ *
+ * Copyright (C) 1999,2010  David I. Bell and Landon Curt Noll
+ *
+ * Calc is open software; you can redistribute it and/or modify it under
+ * the terms of the version 2.1 of the GNU Lesser General Public License
+ * as published by the Free Software Foundation.
+ *
+ * Calc is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.	 See the GNU Lesser General
+ * Public License for more details.
+ *
+ * A copy of version 2.1 of the GNU Lesser General Public License is
+ * distributed with calc under the filename COPYING-LGPL.  You should have
+ * received a copy with calc; if not, write to Free Software Foundation, Inc.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+ *
+ * @(#) $Revision: 30.2 $
+ * @(#) $Id: dms.cal,v 30.2 2010/09/02 06:14:16 chongo Exp $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/dms.cal,v $
+ *
+ * Under source code control:	1990/02/15 01:50:33
+ * File existed as early as:	before 1990
+ *
+ * Share and enjoy!  :-)	http://www.isthe.com/chongo/tech/comp/calc/
+ */
+
+
+obj dms {deg, min, sec};
+
+define dms(deg, min, sec)
+{
+    local obj dms ans;		/* return value */
+
+    /* default missing args to 0 */
+    if (isnull(sec)) {
+	sec = 0;
+    }
+    if (isnull(min)) {
+	min = 0;
+    }
+
+    /* load object */
+    ans.deg = deg;
+    ans.min = min;
+    ans.sec = sec;
+
+    /* return properly formed object */
+    ans = fixdms(ans);
+    return ans;
+}
+
+
+define dms_add(a, b)
+{
+    local obj dms ans;		/* return value */
+
+    /* initalize value to 1st arg */
+    if (istype(a, ans)) {
+	/* 1st arg is dms object, load it */
+	ans.deg = a.deg;
+	ans.min = a.min;
+	ans.sec = a.sec;
+    } else {
+	/* 1st arg is not dms, assume scalar degrees */
+	ans.deg = a;
+	ans.min = 0;
+	ans.sec = 0;
+    }
+
+    /* add value of 2nd arg */
+    if (istype(b, ans)) {
+	/* 2nd arg is dms object, add it */
+	ans.deg += b.deg;
+	ans.min += b.min;
+	ans.sec += b.sec;
+    } else {
+	/* 2nd arg is not dms, add scalar degrees */
+	ans.deg += b;
+    }
+
+    /* return normalized result */
+    ans = fixdms(ans);
+    return ans;
+}
+
+
+define dms_neg(a)
+{
+    local obj dms ans;		/* return value */
+
+    /* negate argument */
+    if (istype(a, ans)) {
+	/* 1st arg is dms object, load it */
+	ans.deg = -a.deg;
+	ans.min = -a.min;
+	ans.sec = -a.sec;
+    } else {
+	/* 2nd arg is not dms, negate scalar degrees */
+	ans.deg = -a;
+	ans.min = 0;
+	ans.sec = 0;
+    }
+
+    /* return normalized result */
+    ans = fixdms(ans);
+    return ans;
+}
+
+
+define dms_sub(a, b)
+{
+    local obj dms ans;		/* return value */
+
+    /* initalize value to 1st arg */
+    if (istype(a, ans)) {
+	/* 1st arg is dms object, load it */
+	ans.deg = a.deg;
+	ans.min = a.min;
+	ans.sec = a.sec;
+    } else {
+	/* 1st arg is not dms, assume scalar degrees */
+	ans.deg = a;
+	ans.min = 0;
+	ans.sec = 0;
+    }
+
+    /* subtract value of 2nd arg */
+    if (istype(b, ans)) {
+	/* 2nd arg is dms object, subtract it */
+	ans.deg -= b.deg;
+	ans.min -= b.min;
+	ans.sec -= b.sec;
+    } else {
+	/* 2nd arg is not dms, subtract scalar degrees */
+	ans.deg -= b;
+    }
+
+    /* return normalized result */
+    ans = fixdms(ans);
+    return ans;
+}
+
+
+define dms_mul(a, b)
+{
+    local obj dms ans;		/* return value */
+
+    /* dms object multiplication */
+    if (istype(a, ans) && istype(b, ans)) {
+	ans.deg = dms_abs(a) * dms_abs(b);
+	ans.min = 0;
+	ans.sec = 0;
+
+    /* scalar multiplication */
+    } else if (istype(a, ans)) {
+	ans.deg = a.deg * b;
+	ans.min = a.min * b;
+	ans.sec = a.sec * b;
+    } else {
+	ans.deg = b.deg * a;
+	ans.min = b.min * a;
+	ans.sec = b.sec * a;
+    }
+
+    /* return normalized result */
+    ans = fixdms(ans);
+    return ans;
+}
+
+
+define dms_print(a)
+{
+    local obj dms ans;		/* temp object for dms type testing */
+
+    /* firewall - arg must be a dms object */
+    if (! istype(a, ans)) {
+	quit "dms_print called with non dms object";
+    }
+
+    /* print in dms form */
+    print a.deg : 'd' : a.min : 'm' : a.sec : 's' :;
+}
+
+
+define dms_abs(a)
+{
+    local obj dms ans;		/* temp object for dms type testing */
+    local deg;			/* return scalar value */
+
+    /* firewall - just absolute value non dms objects */
+    if (! istype(a, ans)) {
+    	return abs(a);
+    }
+
+    /* compute degrees */
+    deg = a.deg + a.min / 60 + a.sec / 3600;
+
+    /* return degrees */
+    return deg;
+}
+
+
+define dms_norm(a)
+{
+    local obj dms ans;		/* temp object for dms type testing */
+    local deg;			/* degrees */
+
+    /* firewall - arg must be a dms object */
+    if (! istype(a, ans)) {
+	quit "dms_norm called with non dms object";
+    }
+
+    /* square degrees (norm is the square of absolute value */
+    deg = dms_abs(a);
+
+    /* return degrees */
+    return deg*deg;
+}
+
+
+define dms_test(a)
+{
+    local obj dms ans;		/* temp value */
+
+    /* firewall - arg must be a dms object */
+    if (! istype(a, ans)) {
+	quit "dms_test called with non dms object";
+    }
+
+    /* return false of non-zero */
+    ans = fixdms(a);
+    if (ans.deg == 0 && ans.min == 0 && ans.sec == 0) {
+	/* false */
+	return 0;
+    }
+    /* true */
+    return 1;
+}
+
+
+define dms_int(a)
+{
+    local obj dms ans;		/* return value */
+
+    /* firewall - arg must be a dms object */
+    if (! istype(a, ans)) {
+	quit "dms_int called with non dms object";
+    }
+
+    /* normalize the argument */
+    ans = fixdms(a);
+
+    /* truncate to the nearest second */
+    ans.sec = int(ans.sec);
+
+    /* return value to the nearest second */
+    return ans;
+}
+
+
+define dms_frac(a)
+{
+    local obj dms ans;		/* return value */
+
+    /* firewall - arg must be a dms object */
+    if (! istype(a, ans)) {
+	quit "dms_frac called with non dms object";
+    }
+
+    /* normalize the argument */
+    ans = fixdms(a);
+
+    /* remove all but fractional seconds */
+    ans.deg = 0;
+    ans.min = 0;
+    ans.sec = frac(ans.sec);
+
+    /* return value to the second fraction */
+    return ans;
+}
+
+
+define dms_rel(a,b)
+{
+    local abs_a, abs_b;		/* scalars of the arguments */
+
+    /* compute scalars of the arguments */
+    abs_a = dms_abs(a);
+    abs_b = dms_abs(b);
+
+    /* return the comparison */
+    return cmp(abs_a, abs_b);
+}
+
+
+define dms_cmp(a,b)
+{
+    local abs_a, abs_b;		/* scalars of the arguments */
+
+    /* compute scalars of the arguments */
+    abs_a = dms_abs(a);
+    abs_b = dms_abs(b);
+
+    /* return the equality comparison */
+    return (abs_a == abs_b);
+}
+
+
+define dms_inc(a)
+{
+    local obj dms ans;		/* return value */
+
+    /* increment a dms object */
+    if (istype(a, ans)) {
+	ans = a;
+	++ans.sec;
+
+	/* return normalized result */
+	ans = fixdms(ans);
+	return ans;
+    }
+
+    /* increment a scalar */
+    return a+1;
+}
+
+
+define dms_dec(a)
+{
+    local obj dms ans;		/* return value */
+
+    /* decrement a dms object */
+    if (istype(a, ans)) {
+	ans = a;
+	--ans.sec;
+
+	/* return normalized result */
+	ans = fixdms(ans);
+	return ans;
+    }
+
+    /* decrement a scalar */
+    return a-1;
+}
+
+
+define fixdms(a)
+{
+    local obj dms ans;		/* temp value */
+
+    /* firewall */
+    if (! istype(a, ans)) {
+	quit "attempt to fix a non dms object";
+    }
+
+    /* force minutes to be intergral */
+    a.min += frac(a.deg) * 60;
+    a.deg = int(a.deg);
+
+    /* force degrees to be intergral */
+    a.sec += frac(a.min) * 60;
+    a.min = int(a.min);
+
+    /* carry excess seconds into minutes */
+    a.min += a.sec // 60;
+    a.sec %= 60;
+
+    /* carry excess minutes into degrees */
+    a.deg += a.min // 60;
+    a.min %= 60;
+
+    /* round degrees :-) */
+    a.deg %= 360;
+
+    /* return normalized result */
+    return a;
+}
+
+if (config("resource_debug") & 3) {
+    print "obj dms {deg, min, sec} defined";
+}

cal/dotest.cal

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

cal/ellip.cal

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

cal/factorial.cal

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

cal/factorial2.cal

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

cal/gvec.cal

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

cal/hello.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: hello.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: hello.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/hello.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/hello.cal,v $
  *
  * Under source code control:	1996/11/13 13:25:43
  * File existed as early as:	1996

cal/hms.cal

@@ -0,0 +1,384 @@
+/*
+ * hms - calculate in hours, minutes, and seconds
+ *
+ * Copyright (C) 2010  Landon Curt Noll
+ *
+ * Calc is open software; you can redistribute it and/or modify it under
+ * the terms of the version 2.1 of the GNU Lesser General Public License
+ * as published by the Free Software Foundation.
+ *
+ * Calc is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.	 See the GNU Lesser General
+ * Public License for more details.
+ *
+ * A copy of version 2.1 of the GNU Lesser General Public License is
+ * distributed with calc under the filename COPYING-LGPL.  You should have
+ * received a copy with calc; if not, write to Free Software Foundation, Inc.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+ *
+ * @(#) $Revision: 30.2 $
+ * @(#) $Id: hms.cal,v 30.2 2010/09/02 06:14:16 chongo Exp $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/hms.cal,v $
+ *
+ * Under source code control:	2010/09/01 17:14:55
+ * File existed as early as:	2010
+ *
+ * Share and enjoy!  :-)	http://www.isthe.com/chongo/tech/comp/calc/
+ */
+
+
+obj hms {hour, min, sec};
+
+define hms(hour, min, sec)
+{
+    local obj hms ans;		/* return value */
+
+    /* default missing args to 0 */
+    if (isnull(sec)) {
+	sec = 0;
+    }
+    if (isnull(min)) {
+	min = 0;
+    }
+
+    /* load object */
+    ans.hour = hour;
+    ans.min = min;
+    ans.sec = sec;
+
+    /* return properly formed object */
+    ans = fixhms(ans);
+    return ans;
+}
+
+
+define hms_add(a, b)
+{
+    local obj hms ans;		/* return value */
+
+    /* initalize value to 1st arg */
+    if (istype(a, ans)) {
+	/* 1st arg is hms object, load it */
+	ans.hour = a.hour;
+	ans.min = a.min;
+	ans.sec = a.sec;
+    } else {
+	/* 1st arg is not hms, assume scalar hours */
+	ans.hour = a;
+	ans.min = 0;
+	ans.sec = 0;
+    }
+
+    /* add value of 2nd arg */
+    if (istype(b, ans)) {
+	/* 2nd arg is hms object, add it */
+	ans.hour += b.hour;
+	ans.min += b.min;
+	ans.sec += b.sec;
+    } else {
+	/* 2nd arg is not hms, add scalar hours */
+	ans.hour += b;
+    }
+
+    /* return normalized result */
+    ans = fixhms(ans);
+    return ans;
+}
+
+
+define hms_neg(a)
+{
+    local obj hms ans;		/* return value */
+
+    /* negate argument */
+    if (istype(a, ans)) {
+	/* 1st arg is hms object, load it */
+	ans.hour = -a.hour;
+	ans.min = -a.min;
+	ans.sec = -a.sec;
+    } else {
+	/* 2nd arg is not hms, negate scalar hours */
+	ans.hour = -a;
+	ans.min = 0;
+	ans.sec = 0;
+    }
+
+    /* return normalized result */
+    ans = fixhms(ans);
+    return ans;
+}
+
+
+define hms_sub(a, b)
+{
+    local obj hms ans;		/* return value */
+
+    /* initalize value to 1st arg */
+    if (istype(a, ans)) {
+	/* 1st arg is hms object, load it */
+	ans.hour = a.hour;
+	ans.min = a.min;
+	ans.sec = a.sec;
+    } else {
+	/* 1st arg is not hms, assume scalar hours */
+	ans.hour = a;
+	ans.min = 0;
+	ans.sec = 0;
+    }
+
+    /* subtract value of 2nd arg */
+    if (istype(b, ans)) {
+	/* 2nd arg is hms object, subtract it */
+	ans.hour -= b.hour;
+	ans.min -= b.min;
+	ans.sec -= b.sec;
+    } else {
+	/* 2nd arg is not hms, subtract scalar hours */
+	ans.hour -= b;
+    }
+
+    /* return normalized result */
+    ans = fixhms(ans);
+    return ans;
+}
+
+
+define hms_mul(a, b)
+{
+    local obj hms ans;		/* return value */
+
+    /* hms object multiplication */
+    if (istype(a, ans) && istype(b, ans)) {
+	ans.hour = hms_abs(a) * hms_abs(b);
+	ans.min = 0;
+	ans.sec = 0;
+
+    /* scalar multiplication */
+    } else if (istype(a, ans)) {
+	ans.hour = a.hour * b;
+	ans.min = a.min * b;
+	ans.sec = a.sec * b;
+    } else {
+	ans.hour = b.hour * a;
+	ans.min = b.min * a;
+	ans.sec = b.sec * a;
+    }
+
+    /* return normalized result */
+    ans = fixhms(ans);
+    return ans;
+}
+
+
+define hms_print(a)
+{
+    local obj hms ans;		/* temp object for hms type testing */
+
+    /* firewall - arg must be a hms object */
+    if (! istype(a, ans)) {
+	quit "hms_print called with non hms object";
+    }
+
+    /* print in hms form */
+    print a.hour : ':' : a.min : ':' : a.sec :;
+}
+
+
+define hms_abs(a)
+{
+    local obj hms ans;		/* temp object for hms type testing */
+    local hour;			/* return scalar value */
+
+    /* firewall - just absolute value non hms objects */
+    if (! istype(a, ans)) {
+    	return abs(a);
+    }
+
+    /* compute hours */
+    hour = a.hour + a.min / 60 + a.sec / 3600;
+
+    /* return hours */
+    return hour;
+}
+
+
+define hms_norm(a)
+{
+    local obj hms ans;		/* temp object for hms type testing */
+    local hour;			/* hours */
+
+    /* firewall - arg must be a hms object */
+    if (! istype(a, ans)) {
+	quit "hms_norm called with non hms object";
+    }
+
+    /* square hours (norm is the square of absolute value */
+    hour = hms_abs(a);
+
+    /* return hours */
+    return hour*hour;
+}
+
+
+define hms_test(a)
+{
+    local obj hms ans;		/* temp value */
+
+    /* firewall - arg must be a hms object */
+    if (! istype(a, ans)) {
+	quit "hms_test called with non hms object";
+    }
+
+    /* return false of non-zero */
+    ans = fixhms(a);
+    if (ans.hour == 0 && ans.min == 0 && ans.sec == 0) {
+	/* false */
+	return 0;
+    }
+    /* true */
+    return 1;
+}
+
+
+define hms_int(a)
+{
+    local obj hms ans;		/* return value */
+
+    /* firewall - arg must be a hms object */
+    if (! istype(a, ans)) {
+	quit "hms_int called with non hms object";
+    }
+
+    /* normalize the argument */
+    ans = fixhms(a);
+
+    /* truncate to the nearest second */
+    ans.sec = int(ans.sec);
+
+    /* return value to the nearest second */
+    return ans;
+}
+
+
+define hms_frac(a)
+{
+    local obj hms ans;		/* return value */
+
+    /* firewall - arg must be a hms object */
+    if (! istype(a, ans)) {
+	quit "hms_frac called with non hms object";
+    }
+
+    /* normalize the argument */
+    ans = fixhms(a);
+
+    /* remove all but fractional seconds */
+    ans.hour = 0;
+    ans.min = 0;
+    ans.sec = frac(ans.sec);
+
+    /* return value to the second fraction */
+    return ans;
+}
+
+
+define hms_rel(a,b)
+{
+    local abs_a, abs_b;		/* scalars of the arguments */
+
+    /* compute scalars of the arguments */
+    abs_a = hms_abs(a);
+    abs_b = hms_abs(b);
+
+    /* return the comparison */
+    return cmp(abs_a, abs_b);
+}
+
+
+define hms_cmp(a,b)
+{
+    local abs_a, abs_b;		/* scalars of the arguments */
+
+    /* compute scalars of the arguments */
+    abs_a = hms_abs(a);
+    abs_b = hms_abs(b);
+
+    /* return the equality comparison */
+    return (abs_a == abs_b);
+}
+
+
+define hms_inc(a)
+{
+    local obj hms ans;		/* return value */
+
+    /* increment a hms object */
+    if (istype(a, ans)) {
+	ans = a;
+	++ans.sec;
+
+	/* return normalized result */
+	ans = fixhms(ans);
+	return ans;
+    }
+
+    /* increment a scalar */
+    return a+1;
+}
+
+
+define hms_dec(a)
+{
+    local obj hms ans;		/* return value */
+
+    /* decrement a hms object */
+    if (istype(a, ans)) {
+	ans = a;
+	--ans.sec;
+
+	/* return normalized result */
+	ans = fixhms(ans);
+	return ans;
+    }
+
+    /* decrement a scalar */
+    return a-1;
+}
+
+
+define fixhms(a)
+{
+    local obj hms ans;		/* temp value */
+
+    /* firewall */
+    if (! istype(a, ans)) {
+	quit "attempt to fix a non hms object";
+    }
+
+    /* force minutes to be intergral */
+    a.min += frac(a.hour) * 60;
+    a.hour = int(a.hour);
+
+    /* force hours to be intergral */
+    a.sec += frac(a.min) * 60;
+    a.min = int(a.min);
+
+    /* carry excess seconds into minutes */
+    a.min += a.sec // 60;
+    a.sec %= 60;
+
+    /* carry excess minutes into hours */
+    a.hour += a.min // 60;
+    a.min %= 60;
+
+    /* round hours by day */
+    a.hour %= 24;
+
+    /* return normalized result */
+    return a;
+}
+
+if (config("resource_debug") & 3) {
+    print "obj hms {hour, min, sec} defined";
+}

cal/infinities.cal

@@ -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()";
+}

cal/intfile.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.5 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: intfile.cal,v 29.5 2001/04/10 22:09:34 chongo Exp $
+ * @(#) $Id: intfile.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/intfile.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/intfile.cal,v $
  *
  * Under source code control:   2001/03/31 08:13:11
  * File existed as early as:    2001

cal/intnum.cal

@@ -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,[...])";
+}

cal/lambertw.cal

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

cal/linear.cal

@@ -1,3 +1,33 @@
+/*
+ * linear - perform a simple two point 2D linear interpolation
+ *
+ * Copyright (C) 2005-2007  Landon Curt Noll
+ *
+ * Calc is open software; you can redistribute it and/or modify it under
+ * the terms of the version 2.1 of the GNU Lesser General Public License
+ * as published by the Free Software Foundation.
+ *
+ * Calc is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.	 See the GNU Lesser General
+ * Public License for more details.
+ *
+ * A copy of version 2.1 of the GNU Lesser General Public License is
+ * distributed with calc under the filename COPYING-LGPL.  You should have
+ * received a copy with calc; if not, write to Free Software Foundation, Inc.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+ *
+ * @(#) $Revision: 30.2 $
+ * @(#) $Id: linear.cal,v 30.2 2007/03/17 05:57:42 chongo Exp $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/linear.cal,v $
+ *
+ * Under source code control:	2005/12/12 06:41:50
+ * File existed as early as:	2005
+ *
+ * chongo <was here> /\oo/\	http://www.isthe.com/chongo/
+ * Share and enjoy!  :-)	http://www.isthe.com/chongo/tech/comp/calc/
+ */
+
 /*
  * linear - perform a simple two point 2D linear interpolation
  *

cal/lnseries.cal

@@ -0,0 +1,112 @@
+/*
+ * lnseries - special functions (e.g.: gamma, zeta, psi)
+ *
+ * Copyright (C) 2013 Christoph Zurnieden
+ *
+ * Calc is open software; you can redistribute it and/or modify it under
+ * the terms of the version 2.1 of the GNU Lesser General Public License
+ * as published by the Free Software Foundation.
+ *
+ * Calc is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General
+ * Public License for more details.
+ *
+ * A copy of version 2.1 of the GNU Lesser General Public License is
+ * distributed with calc under the filename COPYING-LGPL.  You should have
+ * received a copy with calc; if not, write to Free Software Foundation, Inc.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+ *
+ * @(#) $Revision: 30.4 $
+ * @(#) $Id: lnseries.cal,v 30.4 2013/08/18 20:01:53 chongo Exp $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/lnseries.cal,v $
+ *
+ * Under source code control:	2013/08/11 01:31:28
+ * File existed as early as:	2013
+ */
+
+
+/*
+ * hide internal function from resource debugging
+ */
+static resource_debug_level;
+resource_debug_level = config("resource_debug", 0);
+
+
+static __CZ__int_logs;
+static __CZ__int_logs_limit;
+static __CZ__int_logs_prec;
+
+
+define deletelnseries(){
+  free(__CZ__int_logs,__CZ__int_logs_limit,__CZ__int_logs_prec);
+}
+
+define lnfromseries(n){
+  if(    isnull(__CZ__int_logs)
+      || __CZ__int_logs_limit < n
+      || __CZ__int_logs_prec < log(1/epsilon())){
+
+    lnseries(n+1);
+  }
+  return __CZ__int_logs[n,0];
+}
+
+define lnseries(limit){
+  local k j eps ;
+  if(    isnull(__CZ__int_logs)
+      || __CZ__int_logs_limit < limit
+      || __CZ__int_logs_prec < log(1/epsilon())){
+    __CZ__int_logs = mat[limit+1,2];
+    __CZ__int_logs_limit = limit;
+    __CZ__int_logs_prec = log(1/epsilon());
+
+    /* probably still too much */
+    eps = epsilon(epsilon()*10^(-(5+log(limit))));
+    k =2;
+    while(1){
+      /* the prime itself, compute logarithm */
+      __CZ__int_logs[k,0] = ln(k);
+      __CZ__int_logs[k,1] = k;
+
+      for(j = 2*k;j<=limit;j+=k){
+       /* multiples of prime k, add logarithm of k computed earlier */
+       __CZ__int_logs[j,0] += __CZ__int_logs[k,0];
+       /* First hit, set counter to number */
+       if(__CZ__int_logs[j,1] ==0)
+         __CZ__int_logs[j,1]=j;
+       /* reduce counter by prime added */
+       __CZ__int_logs[j,1] //= __CZ__int_logs[k,1];
+      }
+
+      k++;
+      if(k>=limit) break;
+      /* Erastothenes-sieve: look for next prime. */
+      while(__CZ__int_logs[k,0]!=0){
+        k++;
+        if(k>=limit) break;
+      }
+    }
+    /* Second run to include the last factor */
+    for(k=1;k<=limit;k++){
+      if(__CZ__int_logs[k,1] != k){
+        __CZ__int_logs[k,0] +=__CZ__int_logs[ __CZ__int_logs[k,1],0];
+        __CZ__int_logs[k,1] = 0;
+      }
+    }
+
+    epsilon(eps);
+  }
+  return 1;
+}
+
+
+/*
+ * restore internal function from resource debugging
+ */
+config("resource_debug", resource_debug_level),;
+if (config("resource_debug") & 3) {
+    print "lnseries(limit)";
+    print "lnfromseries(n)";
+    print "deletelnseries()";
+}

cal/lucas.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.6 $
+ * @(#) $Revision: 30.2 $
- * @(#) $Id: lucas.cal,v 29.6 2002/07/10 09:43:46 chongo Exp $
+ * @(#) $Id: lucas.cal,v 30.2 2013/09/27 08:58:46 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/lucas.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/lucas.cal,v $
  *
  * Under source code control:	1990/05/03 16:49:51
  * File existed as early as:	1990
@@ -442,7 +442,7 @@ lucas(h, n)
  * See the function gen_v1() for details on the value of v(1).
  *
  * input:
- *	h	- h as in h*2^n-1	(h mod 2 != 0)
+ *	h	- h as in h*2^n-1
  *	n	- n as in h*2^n-1
  *	v1	- gen_v1(h,n)		(see function below)
  *
@@ -475,13 +475,6 @@ gen_u0(h, n, v1)
 		quit "bogus arg: v1 is <= 0";
 	}
 
-	/*
-	 * enforce the h mod rules
-	 */
-	if (h%2 == 0) {
-		quit "h must not be even";
-	}
-
 	/*
 	 * enforce the h > 0 and n >= 2 rules
 	 */

cal/lucas_chk.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.3 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: lucas_chk.cal,v 29.3 2001/03/31 13:31:34 chongo Exp $
+ * @(#) $Id: lucas_chk.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/lucas_chk.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/lucas_chk.cal,v $
  *
  * Under source code control:	1991/01/11 05:41:43
  * File existed as early as:	1991

cal/lucas_tbl.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: lucas_tbl.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: lucas_tbl.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/lucas_tbl.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/lucas_tbl.cal,v $
  *
  * Under source code control:	1991/01/26 02:43:43
  * File existed as early as:	1991

cal/mersenne.cal

@@ -17,11 +17,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: mersenne.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: mersenne.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/mersenne.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/mersenne.cal,v $
  *
  * Under source code control:	1991/05/22 21:56:36
  * File existed as early as:	1991

cal/mfactor.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: mfactor.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: mfactor.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/mfactor.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/mfactor.cal,v $
  *
  * Under source code control:	1996/07/06 06:09:40
  * File existed as early as:	1996
@@ -261,7 +261,7 @@ define mfactor(n, start_k, rept_loop, p_elim)
 	} else {
 		/* report this loop */
 		printf("at 2*%d*%d+1, cpu: %f\n",
-			(q-1)/(2*n), n, runtime());
+			(q-1)/(2*n), n, usertime());
 		fflush(files(1));
 		loop = 0;
 	}
@@ -274,7 +274,7 @@ define mfactor(n, start_k, rept_loop, p_elim)
 		if (rept_loop <= ++loop) {
 			/* report this loop */
 			printf("at 2*%d*%d+1, cpu: %f\n",
-				(q-1)/(2*n), n, runtime());
+				(q-1)/(2*n), n, usertime());
 			fflush(files(1));
 			loop = 0;
 		}

cal/mod.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: mod.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: mod.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/mod.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/mod.cal,v $
  *
  * Under source code control:	1990/02/15 01:50:34
  * File existed as early as:	before 1990

cal/natnumset.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.3 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: natnumset.cal,v 29.3 2006/05/01 19:19:46 chongo Exp $
+ * @(#) $Id: natnumset.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/natnumset.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/natnumset.cal,v $
  *
  * Under source code control:	1997/09/07 23:53:51
  * File existed as early as:	1997

cal/pell.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: pell.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: pell.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/pell.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/pell.cal,v $
  *
  * Under source code control:	1990/02/15 01:50:34
  * File existed as early as:	before 1990

cal/pi.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.5 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: pi.cal,v 29.5 2004/02/23 14:04:01 chongo Exp $
+ * @(#) $Id: pi.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/pi.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/pi.cal,v $
  *
  * Under source code control:	1991/05/22 21:56:37
  * File existed as early as:	1991

cal/pix.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: pix.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: pix.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/pix.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/pix.cal,v $
  *
  * Under source code control:	1996/07/09 03:14:14
  * File existed as early as:	1996

cal/pollard.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: pollard.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: pollard.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/pollard.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/pollard.cal,v $
  *
  * Under source code control:	1991/05/22 21:56:37
  * File existed as early as:	1991

cal/poly.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: poly.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: poly.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/poly.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/poly.cal,v $
  *
  * Under source code control:	1990/02/15 01:50:35
  * File existed as early as:	before 1990

cal/prompt.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: prompt.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: prompt.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/prompt.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/prompt.cal,v $
  *
  * Under source code control:	1995/12/18 04:43:25
  * File existed as early as:	1995
@@ -101,7 +101,7 @@ define adder() {
 	}
 }
 
-global x;
+global prompt_x;
 
 define showvalues(str) {
 	local s;
@@ -109,8 +109,8 @@ define showvalues(str) {
 		s = prompt("? ");
 		if (s == "end")
 			break;
-		x = eval(s);
+		prompt_x = eval(s);
-		if (!isnum(x)) {
+		if (!isnum(prompt_x)) {
 			print "Please enter a number";
 			continue;
 		}

cal/psqrt.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: psqrt.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: psqrt.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/psqrt.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/psqrt.cal,v $
  *
  * Under source code control:	1990/02/15 01:50:35
  * File existed as early as:	before 1990

cal/qtime.cal

@@ -18,11 +18,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.4 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: qtime.cal,v 29.4 2000/12/18 10:18:40 chongo Exp $
+ * @(#) $Id: qtime.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/qtime.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/qtime.cal,v $
  *
  * Under source code control:	1999/10/13 04:10:33
  * File existed as early as:	1999

cal/quat.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.2 $
- * @(#) $Id: quat.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: quat.cal,v 30.2 2013/08/11 08:41:38 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/quat.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/quat.cal,v $
  *
  * Under source code control:	1990/02/15 01:50:35
  * File existed as early as:	before 1990
@@ -55,7 +55,8 @@ define quat(a,b,c,d)
 
 define quat_print(a)
 {
-	print "quat(" : a.s : ", " : a.v[0] : ", " : a.v[1] : ", " : a.v[2] : ")" :;
+	print "quat(" : a.s : ", " : a.v[0] : ", " :
+	      a.v[1] : ", " : a.v[2] : ")" :;
 }
 
 

cal/randbitrun.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: randbitrun.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: randbitrun.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/randbitrun.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/randbitrun.cal,v $
  *
  * Under source code control:	1995/02/13 03:43:11
  * File existed as early as:	1995

cal/randmprime.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: randmprime.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: randmprime.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/randmprime.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/randmprime.cal,v $
  *
  * Under source code control:	1994/03/14 23:11:21
  * File existed as early as:	1994
@@ -88,8 +88,8 @@ randmprime(bits, seed, dbg)
      * loop until we find a prime
      */
     if (dbg >= 1) {
-	start = runtime();
+	start = usertime();
-	init = runtime();
+	init = usertime();
 	plush = 0;
 	print "DEBUG1: testing (h+" : plush : ")*2^" : n : "-1";
     }
@@ -97,7 +97,7 @@ randmprime(bits, seed, dbg)
 
 	/* bump h, and n if needed */
 	if (dbg >= 2) {
-	    stop = runtime();
+	    stop = usertime();
 	    print "DEBUG2: last test:", stop-start, "	total time:", stop-init;
 	}
 	if (dbg >= 1) {
@@ -116,7 +116,7 @@ randmprime(bits, seed, dbg)
 
     /* found a prime */
     if (dbg >= 2) {
-	stop = runtime();
+	stop = usertime();
 	print "DEBUG2: last test:", stop-start, "   total time:", stop-init;
 	print "DEBUG3: " : h : "*2^" : n : "-1 is prime";
     }

cal/randombitrun.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: randombitrun.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: randombitrun.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/randombitrun.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/randombitrun.cal,v $
  *
  * Under source code control:	1995/02/13 03:43:11
  * File existed as early as:	1995

cal/randomrun.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: randomrun.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: randomrun.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/randomrun.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/randomrun.cal,v $
  *
  * Under source code control:	1997/02/19 03:35:59
  * File existed as early as:	1997

cal/randrun.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: randrun.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: randrun.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/randrun.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/randrun.cal,v $
  *
  * Under source code control:	1995/02/12 20:00:06
  * File existed as early as:	1995

cal/repeat.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.4 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: repeat.cal,v 29.4 2003/01/26 19:42:03 chongo Exp $
+ * @(#) $Id: repeat.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/repeat.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/repeat.cal,v $
  *
  * Under source code control:	2003/01/05 00:00:01
  * File existed as early as:	2003

cal/screen.cal

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

cal/seedrandom.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.3 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: seedrandom.cal,v 29.3 2001/03/31 13:31:34 chongo Exp $
+ * @(#) $Id: seedrandom.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/seedrandom.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/seedrandom.cal,v $
  *
  * Under source code control:	1996/01/01 08:21:00
  * File existed as early as:	1996

cal/set8700.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.1 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: set8700.cal,v 29.1 2006/05/20 19:35:33 chongo Exp $
+ * @(#) $Id: set8700.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/set8700.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/set8700.cal,v $
  *
  * Under source code control:	2006/05/20 14:10:11
  * File existed as early as:	2006
@@ -70,3 +70,8 @@ define set8700_g(set8700_x)
 obj set8700_point {
 	set8700_x, set8700_y, set8700_z
 }
+
+global mat set8700_c[] = { 1, 2+3i, -5+4i, 5i+6, -7i };
+
+global mat set8700_e[] = { 0, 1, 0, 0, 2, -3/2, 2, -1/2,
+			   -3, 0.5, -1.0, 0.5, 1.0, 0.0, 0.0, 0.0 };

cal/set8700.line

@@ -15,11 +15,11 @@
 ## A copy of version 2.1 of the GNU Lesser General Public License is
 ## distributed with calc under the filename COPYING-LGPL.  You should have
 ## received a copy with calc; if not, write to Free Software Foundation, Inc.
-## 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+## 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 ##
-## @(#) $Revision: 29.1 $
+## @(#) $Revision: 30.1 $
-## @(#) $Id: set8700.line,v 29.1 2006/05/20 19:35:33 chongo Exp $
+## @(#) $Id: set8700.line,v 30.1 2007/03/16 11:09:54 chongo Exp $
-## @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/set8700.line,v $
+## @(#) $Source: /usr/local/src/bin/calc/cal/RCS/set8700.line,v $
 ##
 ## Under source code control:	2006/05/20 14:10:11
 ## File existed as early as:	2006
@@ -143,7 +143,7 @@ a #= 4, a == 1
 
 ## Binary # operator not defined for strings
 
-global set8700_A; protect(set8700_A) == 0
+protect(set8700_A) == 0
 ## Testing with one lvalue
 isnull(protect(set8700_A,65))
 protect(set8700_A) == 65
@@ -302,7 +302,7 @@ protect(set8700_B,0), set8700_B = set8700_getA1(), protect(set8700_B) == 1024
 protect(set8700_B,0), set8700_B = set8700_getA2(), protect(set8700_B) == 1024
 set8700_B = set8700_getvar(), protect(set8700_B) == 1024 + 256
 
-global set8700_x, set8700_y; set8700_x = 7,  protect(set8700_x) == 0
+set8700_x = 7,  protect(set8700_x) == 0
 protect(7,2) == error(10234)
 protect(set8700_x,2.5) == error(10235)
 protect(set8700_x,"abc") == error(10235)
@@ -322,7 +322,6 @@ set8700_x++ == error(10385)
 set8700_x == 7
 set8700_x-- == error(10388)
 
-global set8700_A, set8700_B; 1
 protect(set8700_A,0), protect(set8700_A,16), 1
 set8700_A = "abcdef", protect(set8700_A) == 16		## No copy to set8700_A
 protect(set8700_B,0), set8700_B = "xyz", protect(set8700_B) == 0
@@ -403,3 +402,28 @@ set8700_P == (obj set8700_point = {1,2,3})
 set8700_L = list(mat[1] = {set8700_P}), protect(set8700_L[0][0]) == 16
 set8700_L = {{{4,5,6}}}, set8700_L[0][0] == set8700_P
 protect(set8700_L,0,2), set8700_L = {{{4,5,6}}}, set8700_L[0][0] == (obj set8700_point = {4,5,6})
+
+## Testing quomod
+quomod(14,5,3,4) == error(10374)
+global set8700_a,set8700_b; quomod("abc", 4, set8700_a, set8700_b) == error(10375)
+quomod(14,5,set8700_a,set8700_b,0) == 1 && set8700_a == 2 && set8700_b == 4
+quomod(14,5,set8700_a,set8700_b,1) == 1 && set8700_a == 3 && set8700_b == -1
+quomod("abc",2,set8700_a,set8700_b) == error(10375)
+set8700_a = "abc"; quomod(14,5,set8700_a,set8700_b) == error(10375)
+set8700_a = null(); quomod(14,5,set8700_a,set8700_b,24) == 1; set8700_a == 3 && set8700_b == -1
+quomod(14,5,set8700_a,set8700_a) == error(10374)
+quomod(14,5,set8700_a,set8700_b,-1) == error(10375)
+protect(set8700_a,1); quomod(17,2,set8700_a,set8700_b) == error(10376)
+protect(set8700_a,0); quomod(17,2,set8700_a,set8700_b); set8700_a == 8 && set8700_b == 1
+set8700_p = &set8700_a, set8700_q = &set8700_b; quomod(14,5,*set8700_p,*set8700_q); *set8700_p == 2 && *set8700_q == 4
+
+## Testing estr
+base(1/3) == 10
+strcmp(estr(null()), "\"\"") == 0
+strcmp(estr(bernoulli(48)), "-5609403368997817686249127547/46410") == 0
+strcmp(estr(sin(3i)), "1001787492740990189897i/100000000000000000000") == 0
+base(10) == 1/3
+strcmp(estr("fizzbin"), "\"fizzbin\"") == 0
+strcmp(estr(set8700_c), "mat[5]={1,2+3i,-5+4i,6+5i,-7i}") == 0
+strcmp(estr(set8700_e), "mat[16]={0,1,0,0,2,-3/2,2,-1/2,-3,1/2,-1,1/2,1,0,0,0}") == 0
+strcmp(estr(list(2,3,5)), "list(2,3,5)") == 0

cal/smallfactors.cal

@@ -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)";
+
+}

cal/solve.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.3 $
- * @(#) $Id: solve.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: solve.cal,v 30.3 2013/08/11 08:41:38 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/solve.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/solve.cal,v $
  *
  * Under source code control:	1990/02/15 01:50:37
  * File existed as early as:	before 1990
@@ -47,12 +47,13 @@ define solve(low, high, epsilon)
 	if (abs(flow) < epsilon)
 		return low;
 	fhigh = f(high);
-	if (abs(flow) < epsilon)
+	if (abs(fhigh) < epsilon)
 		return high;
 	if (sgn(flow) == sgn(fhigh))
 		quit "Non-opposite signs";
 	while (1) {
-		mid = bround(high - fhigh * (high - low) / (fhigh - flow), places);
+		mid = bround(high - fhigh * (high - low) / (fhigh - flow),
+			     places);
 		if ((mid == low) || (mid == high))
 			places++;
 		fmid = f(mid);

cal/statistics.cal

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

cal/strings.cal

@@ -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)";
+}
+

cal/sumsq.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: sumsq.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: sumsq.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/sumsq.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/sumsq.cal,v $
  *
  * Under source code control:	1990/02/15 01:50:37
  * File existed as early as:	before 1990

cal/sumtimes.cal

@@ -0,0 +1,186 @@
+/*
+ * sumtimes - runtimes evaluating sums & squares of large lists and mats
+ *
+ * Copyright (C) 2006  Ernest Bowen
+ *
+ * Calc is open software; you can redistribute it and/or modify it under
+ * the terms of the version 2.1 of the GNU Lesser General Public License
+ * as published by the Free Software Foundation.
+ *
+ * Calc is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.	 See the GNU Lesser General
+ * Public License for more details.
+ *
+ * A copy of version 2.1 of the GNU Lesser General Public License is
+ * distributed with calc under the filename COPYING-LGPL.  You should have
+ * received a copy with calc; if not, write to Free Software Foundation, Inc.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+ *
+ * @(#) $Revision: 30.1 $
+ * @(#) $Id: sumtimes.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/sumtimes.cal,v $
+ *
+ * Under source code control:	2006/06/22 17:29
+ * File existed as early as:	2006
+ *
+ * Share and enjoy!  :-)	http://www.isthe.com/chongo/tech/comp/calc/
+ */
+
+
+global sumtimes_t0, sumtimes_t1, sumtimes_t2, sumtimes_t3;
+global sumtimes_A, sumtimes_B;
+config("tilde", 0),;
+
+define timematsum(N) {
+    local n, s, p, ptop;
+
+    sumtimes_A = mat[N];
+
+    for (n = 0; n < N; n++) sumtimes_A[n] = rand(N);
+
+    ptop = &sumtimes_A[n-1];
+    sumtimes_t0 = usertime();
+    for (s = n = 0; n < N; n++) s += sumtimes_A[n];
+    sumtimes_t1 = usertime();
+    for (s = 0, p = &sumtimes_A[0]; p <= ptop; p++) s += *p;
+    sumtimes_t2 = usertime();
+    s = matsum(sumtimes_A);
+    sumtimes_t3 = usertime();
+
+    print "Matrix sum runtimes";
+    printf('\tStandard "for" loop:\t\t%.4f\n', sumtimes_t1 - sumtimes_t0);
+    printf('\t"For" loop using pointers:\t\t%.4f\n', sumtimes_t2 - sumtimes_t1);
+    printf('\tUsing builtin "matsum":\t\t%.4f\n', sumtimes_t3 - sumtimes_t2);
+}
+
+define timelistsum(N) {
+    local n, s;
+
+    sumtimes_A = makelist(N);
+    for (n = 0; n < N; n++) sumtimes_A[n] = rand(N);
+
+    sumtimes_t0 = usertime();
+    for (s = n = 0; n < N; n++) s += sumtimes_A[n];
+    sumtimes_t1 = usertime();
+    s = sum(sumtimes_A);
+    sumtimes_t2 = usertime();
+    print "List sum runtimes";
+    printf('\tStandard "for" loop:\t\t%.4f\n', sumtimes_t1 - sumtimes_t0);
+    printf('\tUsing builtin "sum":\t\t%.4f\n', sumtimes_t2 - sumtimes_t1);
+}
+
+
+define timematsort(N) {
+    local n;
+
+    sumtimes_A = mat[N];
+    for (n = 0; n < N; n++) sumtimes_A[n] = rand(N);
+    sumtimes_t0 = usertime();
+    sort(sumtimes_A);
+    sumtimes_t1 = usertime();
+    printf('\tMatrix sort runtime:\t\t%.4f\n', sumtimes_t1 - sumtimes_t0);
+}
+
+
+define timelistsort(N) {
+    local n;
+
+    sumtimes_A = makelist(N);
+    for (n = 0; n < N; n++) sumtimes_A[n] = rand(N);
+    sumtimes_t0 = usertime();
+    sort(sumtimes_A);
+    sumtimes_t1 = usertime();
+    printf('\tList sort runtime:\t\t%.4f\n', sumtimes_t1 - sumtimes_t0);
+}
+
+define timematreverse(N) {
+    local n;
+
+    sumtimes_A = mat[N];
+    for (n = 0; n < N; n++) sumtimes_A[n] = rand(N);
+    sumtimes_t0 = usertime();
+    reverse(sumtimes_A);
+    sumtimes_t1 = usertime();
+    printf('\tMatrix reverse runtime        %.4f\n', sumtimes_t1 - sumtimes_t0);
+}
+
+define timelistreverse(N) {
+    local n;
+
+    sumtimes_A = makelist(N);
+    for (n = 0; n < N; n++) sumtimes_A[n] = rand(N);
+    sumtimes_t0 = usertime();
+    reverse(sumtimes_A);
+    sumtimes_t1 = usertime();
+    printf('\tList reverse runtime:\t\t%.4f\n', sumtimes_t1 - sumtimes_t0);
+}
+
+define timematssq(N) {
+    local n, s, p, ptop;
+
+    sumtimes_A = mat[N];
+
+    for (n = 0; n < N; n++) sumtimes_A[n] = rand(N);
+
+    ptop = &sumtimes_A[n-1];
+    sumtimes_t0 = usertime();
+    for (s = n = 0; n < N; n++) s += sumtimes_A[n]^2;
+    sumtimes_t1 = usertime();
+    for (s = 0, p = &sumtimes_A[0]; p <= ptop; p++) s += (*p)^2;
+    sumtimes_t2 = usertime();
+
+    print "Matrix sum of squares runtimes";
+    printf('\tStandard "for" loop:\t\t%.4f\n', sumtimes_t1 - sumtimes_t0);
+    printf('\t"For" loop using pointers:\t\t%.4f\n', sumtimes_t2 - sumtimes_t1);
+}
+
+define timelistssq(N) {
+    local n, s;
+
+    sumtimes_A = makelist(N);
+    for (n = 0; n < N; n++) sumtimes_A[n] = rand(N);
+
+    sumtimes_t0 = usertime();
+    for (s = n = 0; n < N; n++) s += sumtimes_A[n]^2;
+    sumtimes_t1 = usertime();
+    s = ssq(sumtimes_A);
+    sumtimes_t2 = usertime();
+    print "List sum of squares runtimes";
+    printf('\tStandard "for" loop:\t\t%.4f\n', sumtimes_t1 - sumtimes_t0);
+    printf('\tUsing builtin "ssq":\t\t%.4f\n', sumtimes_t2 - sumtimes_t1);
+}
+
+define timehmean(N, M = 10) {
+    local n, s, v1, v2;
+
+    sumtimes_A = makelist(N);
+    for (n = 0; n < N; n++) sumtimes_A[n] = rand(1, M);
+
+    sumtimes_t0 = usertime();
+    for (s = n = 0; n < N; n++) s += 1/sumtimes_A[n];
+    v1 = N/s;
+    sumtimes_t1 = usertime();
+    v2 = hmean(sumtimes_A);
+    sumtimes_t2 = usertime();
+    print v1, v2;
+    print "List harmonic meanruntimes";
+    printf('\tStandard "for" loop:\t\t%.4f\n', sumtimes_t1 - sumtimes_t0);
+    printf('\tUsing builtin "hmean":\t\t%.4f\n', sumtimes_t2 - sumtimes_t1);
+}
+
+define doalltimes(N) {
+    timematsum(N);
+    print;
+    timelistsum(N);
+    print;
+    timematssq(N);
+    print;
+    timelistssq(N);
+    print;
+    timematsort(N);
+    timelistsort(N);
+    timematreverse(N);
+    timelistreverse(N);
+    print;
+}

cal/surd.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: surd.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: surd.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/surd.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/surd.cal,v $
  *
  * Under source code control:	1990/02/15 01:50:38
  * File existed as early as:	before 1990

cal/test1700.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: test1700.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: test1700.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test1700.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test1700.cal,v $
  *
  * Under source code control:	1994/03/14 23:12:51
  * File existed as early as:	1994

cal/test2300.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: test2300.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: test2300.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test2300.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test2300.cal,v $
  *
  * Under source code control:	1995/07/09 06:12:13
  * File existed as early as:	1995

cal/test2600.cal

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

cal/test2700.cal

@@ -17,11 +17,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.2 $
- * @(#) $Id: test2700.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: test2700.cal,v 30.2 2013/08/11 08:41:38 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test2700.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test2700.cal,v $
  *
  * Under source code control:	1995/11/01 22:52:25
  * File existed as early as:	1995
@@ -41,8 +41,7 @@
  */
 
 
-global defaultverbose = 1;
+defaultverbose = 1;
-global err;
 
 define mknonnegreal() {
 	switch(rand(8)) {
@@ -89,11 +88,11 @@ define mkfrac() = rand(2) ? mkposfrac() : -mkposfrac();
 define mksquarereal() = mknonnegreal()^2;
 
 /*
- * XXX - Should be able to do better than the following.  For nonsquare
+ * We might be able to do better than the following.  For nonsquare
- * positive integer less than 1e6, could use
+ * positive integer less than 1e6, could use:
  *		 x = rand(1, 1000);
  *		 return rand(x^2 + 1, (x + 1)^2);
- * Maybe could do
+ * Maybe could do:
  *		do
  *			x = mkreal_2700();
  *		while
@@ -128,7 +127,8 @@ define testcsqrt(str, n, verbose)
 			if (p) {
 			if (verbose > 0)
 				printf(
-				 "*** Type %d failure for x = %r, y = %r, z = %d\n",
+				 "*** Type %d failure for x = %r, "
+				 "y = %r, z = %d\n",
 				    p, x, y, z);
 				m++;
 			}

cal/test3100.cal

@@ -17,11 +17,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: test3100.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: test3100.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test3100.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test3100.cal,v $
  *
  * Under source code control:	1995/11/28 11:56:57
  * File existed as early as:	1995

cal/test3300.cal

@@ -17,11 +17,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: test3300.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: test3300.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test3300.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test3300.cal,v $
  *
  * Under source code control:	1995/12/02 04:27:41
  * File existed as early as:	1995
@@ -30,8 +30,7 @@
  */
 
 
-global defaultverbose = 1;	/* default verbose value */
+defaultverbose = 1;	/* default verbose value */
-global err;
 
 define testi(str, n, N, verbose)
 {
@@ -82,9 +81,9 @@ define testr(str, n, N, verbose)
 	for (i = 0; i < n; i++)
 		for (j = 0; j < n; j++)
 			A[i,j] = rand(-(N^2), N^2)/rand(1, N);
-	t = runtime();
+	t = usertime();
 	d1 = det(A);
-	t = runtime() - t;
+	t = usertime() - t;
 	d2 = det(A^2);
 	if (d2 != d1^2) {
 		if (verbose > 0) {

cal/test3400.cal

@@ -17,11 +17,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: test3400.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: test3400.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test3400.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test3400.cal,v $
  *
  * Under source code control:	1995/12/02 05:20:11
  * File existed as early as:	1995
@@ -54,8 +54,7 @@
  */
 
 
-global defaultverbose = 1;	/* default verbose value */
+defaultverbose = 1;	/* default verbose value */
-global err;
 
 global pi1k = pi(1e-1000);
 

cal/test3500.cal

@@ -17,11 +17,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: test3500.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: test3500.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test3500.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test3500.cal,v $
  *
  * Under source code control:	1995/12/18 22:50:46
  * File existed as early as:	1995
@@ -53,8 +53,7 @@
  */
 
 
-global defaultverbose = 1;	/* default verbose value */
+defaultverbose = 1;	/* default verbose value */
-global err;
 
 define testfrem(x,y,verbose)
 {

cal/test4000.cal

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

cal/test4100.cal

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

cal/test4600.cal

@@ -17,11 +17,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.4 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: test4600.cal,v 29.4 2001/04/10 22:09:02 chongo Exp $
+ * @(#) $Id: test4600.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test4600.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test4600.cal,v $
  *
  * Under source code control:	1996/07/02 20:04:40
  * File existed as early as:	1996
@@ -30,8 +30,7 @@
  */
 
 
-global defaultverbose = 1		/* default verbose value */
+defaultverbose = 1;	/* default verbose value */
-global err;
 
 /*
  * test globals

cal/test5100.cal

@@ -17,11 +17,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: test5100.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: test5100.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test5100.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test5100.cal,v $
  *
  * Under source code control:	1996/12/02 23:57:10
  * File existed as early as:	1996
@@ -30,8 +30,7 @@
  */
 
 
-global defaultverbose = 1;	/* default verbose value */
+defaultverbose = 1;	/* default verbose value */
-global err;
 
 /*
  * We test the new code generator declaration scope and order.

cal/test5200.cal

@@ -17,11 +17,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: test5200.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: test5200.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test5200.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test5200.cal,v $
  *
  * Under source code control:	1997/02/07 02:48:10
  * File existed as early as:	1997
@@ -30,8 +30,7 @@
  */
 
 
-global defaultverbose = 1;	/* default verbose value */
+defaultverbose = 1;	/* default verbose value */
-global err;
 
 /*
  * test the fix of a global/static bug

cal/test8400.cal

@@ -15,11 +15,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: test8400.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: test8400.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test8400.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test8400.cal,v $
  *
  * Under source code control:	1999/10/31 01:00:03
  * File existed as early as:	1999

cal/test8500.cal

@@ -17,11 +17,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.2 $
+ * @(#) $Revision: 30.2 $
- * @(#) $Id: test8500.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
+ * @(#) $Id: test8500.cal,v 30.2 2013/08/11 08:41:38 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test8500.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test8500.cal,v $
  *
  * Under source code control:	1999/11/12 20:59:59
  * File existed as early as:	1999
@@ -134,8 +134,8 @@ define onetest_8500(a,b,rnd) {
  * The rounding parameter is randomly chosen.
  *
  * After a run of divmod_8500 the a, b, rnd values which gave failure are
- * stored in the list L_8500.  L_8500[0], L_8500[1], L_8500[2] are a, b, rnd for the first
+ * stored in the list L_8500.  L_8500[0], L_8500[1], L_8500[2] are a, b,
- * test, etc.
+ * rnd for the first* test, etc.
  */
 define divmod_8500(N = 10, M1 = 2^128, M2 = 2^64, testnum = 0)
 {

cal/test8600.cal

@@ -17,11 +17,11 @@
  * A copy of version 2.1 of the GNU Lesser General Public License is
  * distributed with calc under the filename COPYING-LGPL.  You should have
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 29.1 $
+ * @(#) $Revision: 30.1 $
- * @(#) $Id: test8600.cal,v 29.1 2000/12/04 19:57:02 chongo Exp $
+ * @(#) $Id: test8600.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test8600.cal,v $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test8600.cal,v $
  *
  * Under source code control:	2000/12/04 19:57:02
  * File existed as early as:	2000

cal/toomcook.cal

@@ -0,0 +1,362 @@
+/*
+ * toomcook - implementation of Toom-Cook(3,4) multiplication algorithm
+ *
+ * Copyright (C) 2013 Christoph Zurnieden
+ *
+ * Calc is open software; you can redistribute it and/or modify it under
+ * the terms of the version 2.1 of the GNU Lesser General Public License
+ * as published by the Free Software Foundation.
+ *
+ * Calc is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General
+ * Public License for more details.
+ *
+ * A copy of version 2.1 of the GNU Lesser General Public License is
+ * distributed with calc under the filename COPYING-LGPL.  You should have
+ * received a copy with calc; if not, write to Free Software Foundation, Inc.
+ * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+ *
+ * @(#) $Revision: 30.4 $
+ * @(#) $Id: toomcook.cal,v 30.4 2013/08/18 20:01:53 chongo Exp $
+ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/toomcook.cal,v $
+ *
+ * Under source code control:	2013/08/11 01:31:28
+ * File existed as early as:	2013
+ */
+
+/*
+ * hide internal function from resource debugging
+ */
+static resource_debug_level;
+resource_debug_level = config("resource_debug", 0);
+
+
+/* */
+define toomcook3(a,b){
+  local alen blen  a0 a1 a2  b0 b1 b2 m ret sign mask;
+  local S0 S1 S2 S3 S4 T1 T2;
+
+  if(!isint(a) || !isint(b))
+      return newerror("toomcook3(a,b): a and/or b is not an integer");
+
+  alen = digits(a,2);
+  blen = digits(b,2);
+
+  sign = sgn(a) * sgn(b);
+  /* sgn(x) returns 0 if x = 0 */
+  if(sign == 0) return 0;
+
+  m = min(alen,blen)//3;
+  mask = ~-(1<<m);
+
+  /*
+    Cut-off at about 4,000 dec. digits
+    TODO: check
+  */
+  if(isdefined("test8900")){
+    if(m < 20) return a*b;
+  }
+  else{
+    if(m < 4096 ) return a*b;
+  }
+  a = abs(a);
+  b = abs(b);
+
+  a0 = a & mask;
+  a1 = (a>>m) & mask;
+  a2 = (a>>(2*m));
+
+  b0 =  b         & mask;
+  b1 = (b>>m)     & mask;
+  b2 = (b>>(2*m));
+
+  /*
+    Zimmermann
+  */
+
+  S0 = toomcook3(a0 , b0);
+  S1 = toomcook3((a2+a1+a0) , (b2+b1+b0));
+  S2 = toomcook3(((a2<<2)+(a1<<1)+a0) , ((b2<<2)+(b1<<1)+b0));
+  S3 = toomcook3((a2-a1+a0) , (b2-b1+b0));
+  S4 = toomcook3(a2,b2);
+  T1 = (S3<<1) + S2;
+  T1 /= 3;
+  T1 += S0;
+  T1 >>= 1;
+  T1 -= S4<<1;
+  T2 = (S1 + S3)>>1;
+  S1 -= T1;
+  S2 = T2 - S0 - S4;
+  S3 = T1 - T2;
+
+  ret =  (S4<<(4*m)) + (S3<<(3*m)) + (S2<<(2*m)) + (S1<<(1*m)) + S0;
+
+
+  ret = sign *ret;
+
+  return ret;
+}
+
+define toomcook3square(a){
+  local alen  a0 a1 a2  m tmp tmp2 ret sign S0 S1 S2 S3 S4 T1 mask;
+
+  if(!isint(a))return newerror("toomcook3square(a): a is not integer");
+
+  alen = digits(a,2);
+
+  sign = sgn(a) * sgn(a);
+  if(sign == 0) return 0;
+
+  m = alen//3;
+  mask = ~-(1<<m);
+  /*
+    Cut-off at about 5,000 dec. digits
+    TODO: check
+  */
+
+  if(isdefined("test8900")){
+    if(m < 20) return a^2;
+  }
+  else{
+    if(m < 5000 ) return a^2;
+  }
+
+  a = abs(a);
+
+  a0 = a & mask;
+  a1 = (a>>m) & mask;
+  a2 = (a>>(2*m));
+
+  /*
+   Bodrato/Zanoni
+   */
+  S0 = toomcook3square(a0);
+  S1 = toomcook3square(a2+a1+a0);
+  S2 = toomcook3square(a2-a1+a0);
+  S3 = toomcook3(a1<<1,a2);
+  S4 = toomcook3square(a2);
+
+  T1 = (S1 + S2)>>1;
+  S1 = S1 - T1 - S3;
+  S2 = T1 - S4 -S0;
+
+
+  S1 = S1<<(1*m);
+  S2 = S2<<(2*m);
+  S3 = S3<<(3*m);
+  S4 = S4<<(4*m);
+
+  ret = S0 + S1 + S2 + S3 + S4;
+  ret = sign *ret;
+
+  return ret;
+}
+
+define toomcook4(a,b)
+{
+
+  local  a0 a1 a2 a3 b0 b1 b2 b3 b4 ret tmp tmp2 tmp3 sign;
+  local  m alen blen mask;
+  local w1, w2, w3, w4, w5, w6, w7;
+
+  if(!isint(a) || !isint(b))
+    return newerror("toomcook4(a,b): a and/or b is not integer");
+
+  alen = digits(a,2);
+  blen = digits(b,2);
+
+  sign = sgn(a) * sgn(b);
+
+  if(sign == 0) return 0;
+
+  m = min(alen//4,blen//4);
+  mask = ~-(1<<m);
+
+  if(isdefined("test8900")){
+    if(m < 100) return toomcook3(a,b);
+  }
+  else{
+    if(m < 256*3072) return toomcook3(a,b);
+  }
+
+  a = abs(a);
+  b = abs(b);
+
+
+  a0 = a & mask;
+  a1 = (a>>m) & mask;
+  a2 = (a>>(2*m)) & mask;
+  a3 = (a>>(3*m));
+
+  b0 =  b         & mask;
+  b1 = (b>>m)     & mask;
+  b2 = (b>>(2*m)) & mask;
+  b3 = (b>>(3*m));
+
+  /*
+    Bodrato / Zanoni
+  */
+
+  w3 = a3 + (a1 + (a2 + a0));
+  w7 = b3 + (b1 + (b2 + b0));
+
+  w4 = -a3 + (-a1 + (a2 + a0));
+  w5 = -b3 + (-b1 + (b2 + b0));
+
+  w3 = toomcook4(w3, w7);
+  w4 = toomcook4(w4, w5);
+
+  w5 = a3 + ((a1<<2) + ((a2<<1) + (a0<<3)));
+  w2 = b3 + ((b1<<2) + ((b2<<1) + (b0<<3)));
+
+  w6 = -a3 + (-(a1<<2) + ((a2<<1) + (a0<<3)));
+  w7 = -b3 + (-(b1<<2) + ((b2<<1) + (b0<<3)));
+
+  w5 = toomcook4(w5, w2);
+  w6 = toomcook4(w6, w7);
+
+
+  w2 = (a3<<3) + ((a1<<1) + ((a2<<2) + a0));
+  w7 = (b3<<3) + ((b1<<1) + ((b2<<2) + b0));
+
+
+  w2 = toomcook4(w2, w7);
+
+  w1 = toomcook4(a3, b3);
+  w7 = toomcook4(a0, b0);
+
+  w2 = w2 + w5;
+  w6 = w5 - w6;
+  w4 = w3 - w4;
+  w5 = w5 - w1;
+  w5 -= w7 << 6;
+  w4 = w4>>1;
+  w3 = w3 - w4;
+  w5 = w5<<1;
+  w5 = w5 - w6;
+  w2 -= w3 * 65;
+  w3 = w3 - w7;
+  w3 = w3 - w1;
+  w2 += w3 * 45;
+  w5 -= w3<<3;
+  w5 = w5//24;
+  w6 =  w6 - w2;
+  w2 -= w4<<4;
+  w2 = w2//18;
+  w3 = w3 - w5;
+  w4 = w4 - w2;
+  w6 += w2 * 30;
+  w6 = w6//60;
+  w2 = w2 - w6;
+
+
+  ret = w7 + (w6<<m) + (w5<<(2*m)) + (w4<<(3*m))+ (w3<<(4*m))+
+        (w2<<(5*m))+ (w1<<(6*m));
+
+  ret = sign *ret;
+
+  return ret;
+}
+
+define toomcook4square(a){
+  local  a0 a1 a2 a3 ret S0 S1 S2 S3 S4 S5 S6 S7 tmp tmp2 tmp3;
+  local  sign m alen mask;
+  local T0 T1 T2 T3 T4 T5 T6 T7 T8;
+
+  if(!isint(a) )return newerror("toomcook3square(a): a is not integer");
+
+  alen = digits(a,2);
+
+  sign = sgn(a) * sgn(a);
+  /* sgn(x) returns 0 if x = 0 */
+  if(sign == 0) return 0;
+
+  m = (alen)//4;
+  mask = ~-( 1 << m );
+
+  /*
+    cut-off at about 2 mio. dec. digits
+    TODO: check!
+  */
+
+  if(isdefined("test8900")){
+    if(m < 100) return toomcook3square(a);
+  }
+  else{
+    if(m < 512*3072) return toomcook3square(a);
+  }
+
+  a = abs(a);
+
+  a0 = a          & mask;
+  a1 = (a>>m)     & mask;
+  a2 = (a>>(2*m)) & mask;
+  a3 = (a>>(3*m)) ;
+
+  /*
+    Bodrato / Zanoni
+  */
+
+  S1 = toomcook4square(a0);
+  S2 = toomcook4(a0<<1,a1);
+  S3 = toomcook4((a0 + a1 - a2 - a3 ) , (a0 - a1 - a2 + a3 ));
+  S4 = toomcook4square(a0 + a1 + a2 + a3 );
+  S5 = toomcook4( (a0 - a2 )<<1 , (a1 - a3 ));
+  S6 = toomcook4(a3<<1 , a2);
+  S7 = toomcook4square(a3);
+
+  T1 = S3 + S4;
+  T2 = (T1 + S5 )>>1;
+  T3 = S2 + S6;
+  T4 = T2 - T3;
+  T5 = T3 - S5;
+  T6 = T4 - S3;
+  T7 = T4 - S1;
+  T8 = T6 - S7;
+
+  ret =   (S7<<(6*m)) + (S6<<(5*m)) + (T7<<(4*m))
+        + (T5<<(3*m)) + (T8<<(2*m)) + (S2<<(1*m))  + S1;
+
+  ret = sign *ret;
+
+  return ret;
+}
+
+/*
+  TODO: Implement the asymmetric variations
+*/
+
+/*
+  produce_long_random_number(n) returns large pseudorandom numbers. Really large
+  numbers, e.g.:
+      produce_long_random_number(16)
+  is ca 4,128,561 bits (ca 1,242,821 dec. digits) large. Exact length is not
+  predeterminable because of the chaotic output of the function random().
+*/
+define __CZ__produce_long_random_number(n)
+{
+  local ret k;
+  ret = 1;
+  if(!isint(n) || n<1)
+    return newerror("__CZ__produce_long_random_number(n): "
+    		    "n is not an integer >=1");
+  for(k=0;k<n;k++){
+    ret += random();
+    ret  = toomcook4square(ret);
+  }
+  return ret;
+}
+
+
+/*
+ * restore internal function from resource debugging
+ * report important interface functions
+ */
+config("resource_debug", resource_debug_level),;
+if (config("resource_debug") & 3) {
+    print "toomcook3(a,b)";
+    print "toomcook3square(a)";
+    print "toomcook4(a,b)";
+    print "toomcook4square(a)";
+}