Fix long lines in lib_calc.c

Fixed a segfault when getpwuid() returned NULL during initialization.
Thanks goes to baratharon GitHub user for reporting this issue.

.gitignore

@@ -0,0 +1,100 @@
+# files and directories created during the building of calc and other Makefile actions
+#
+# NOTE: While many of these might be part of a released calc tarball, they are
+#	not consider development source.  Some other file(s) and/or programs
+#	generate these files.
+#
+.dynamic
+.hsrc
+Makefile.simple
+NOTES
+align32.h
+args.h
+cal/.all
+calc
+calc.1
+calc.usage
+calcerr.c
+calcerr.h
+conf.h
+cscript/.all
+cscript/4dsphere
+cscript/README
+cscript/fproduct
+cscript/mersenne
+cscript/piforever
+cscript/plus
+cscript/powerterm
+cscript/simple
+cscript/square
+custom/.all
+custom/Makefile.simple
+custom/libcustcalc*
+endian
+endian_calc.h
+fposval.h
+have_const.h
+have_fpos.h
+have_fpos_pos.h
+have_getpgid.h
+have_getprid.h
+have_getsid.h
+have_gettime.h
+have_memmv.h
+have_newstr.h
+have_offscl.h
+have_posscl.h
+have_rusage.h
+have_stdlib.h
+have_stdvs
+have_strdup.h
+have_string.h
+have_times.h
+have_uid_t.h
+have_unistd.h
+have_unused.h
+have_urandom.h
+have_ustat.h
+help/.all
+help/COPYING
+help/COPYING-LGPL
+help/binding
+help/bindings
+help/bug
+help/bugs
+help/builtin
+help/change
+help/changes
+help/copy
+help/cscript
+help/custom_cal
+help/errorcode
+help/errorcodes
+help/full
+help/funclist
+help/funclist.c
+help/libcalc
+help/man
+help/new_custom
+help/resource
+help/type
+help/usage
+libcalc*
+libcustcalc*
+longbits
+longbits.h
+sample_many
+sample_rand
+terminal.h
+ver_calc
+
+# other commonly excluded patterns
+#
+*~
+*.BAK
+core*
+.DS_Store
+*.dSYM/
+*.[oa]
+.*.swp
+*,v

BUGS

@@ -32,16 +32,25 @@ If you have tried all of the above and things still are not right,
 then it may be time to send in a bug report.  You can send bug
 and bug fixes reports to:
 
-    calc-bugs at asthe dot com
+	calc-bug-report at asthe dot com
 
-    [[ NOTE: Replace 'at' with @, 'dot' is with . and remove the spaces ]]
-    [[ NOTE: The EMail address uses 'asthe', the web site URL uses 'isthe' ]]
+	NOTE: Remove spaces and replace 'at' with @, 'dot' with .
 
-Your subject must contain the words:
+    This replaces the old calc-bugs at asthe dot com address.
 
-       calc bug report
+    To be sure we see your EMail reporting a calc bug, please use the
+    following phase in your EMail Subject line:
 
-You may have additional words in your subject line.
+	calc bug report
+
+    That phrase in your subject line will help ensure your request
+    will get past our anti-spam filters.  You may have additional
+    words in your subject line.
+
+    However, you may find it more helpful to simply subscribe
+    to the calc-tester mailing list (see below) and then to
+    send your report to that mailing list as a wider set calc
+    testers may be able to help you.
 
 When you send your report, please include the following information:
 
@@ -68,23 +77,18 @@ of a context diff patch).
 
 Known bugs:
 
+    The output of the alg_config.cal resource file is bogus.
+    We would welcome a replacement for this code.
+
     We are sure some more bugs exist.  When you find them, please let
     us know!  See the above for details on how to report and were to
     EMail your bug reports and hopefully patches to fix them.
 
 =-=
 
-Problems 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.
 
@@ -129,7 +133,34 @@ mis-features in calc:
 
       will not.
 
-## Copyright (C) 1999-2007  Landon Curt Noll
+=-=
+
+To subscribe to the calc-tester mailing list, visit the following URL:
+
+	http://www.isthe.com/chongo/tech/comp/calc/calc-tester.html
+
+    This is a low volume moderated mailing list.
+
+    This mailing list replaces calc-tester at asthe dot com list.
+
+    If you need a human to help you with your mailing list subscription,
+    please send EMail to our special:
+
+	calc-tester-maillist-help at asthe dot com
+
+	NOTE: Remove spaces and replace 'at' with @, 'dot' with .
+
+    address.  To be sure we see your EMail asking for help with your
+    mailing list subscription, please use the following phase in your
+    EMail Subject line:
+
+	calc tester mailing list help
+
+    That phrase in your subject line will help ensure your
+    request will get past our anti-spam filters.  You may have
+    additional words in your subject line.
+
+## Copyright (C) 1999-2014  Landon Curt Noll
 ##
 ## Calc is open software; you can redistribute it and/or modify it under
 ## the terms of the version 2.1 of the GNU Lesser General Public License
@@ -145,10 +176,6 @@ mis-features in calc:
 ## 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: BUGS,v 30.1 2007/03/16 11:09:46 chongo Exp $
-## @(#) $Source: /usr/local/src/cmd/calc/RCS/BUGS,v $
-##
 ## Under source code control:	1994/03/18 14:06:13
 ## File existed as early as:	1994
 ##

COPYING

@@ -6,17 +6,13 @@ This file is Copyrighted
 
     This file is covered under the following Copyright:
 
-	Copyright (C) 1999  Landon Curt Noll
+	Copyright (C) 1999-2014  Landon Curt Noll
 	All rights reserved.
 
 	Everyone is permitted to copy and distribute verbatim copies
 	of this license document, but changing it is not allowed.
 
-    # @(#) $Revision: 30.1 $
-    # @(#) $Id: COPYING,v 30.1 2007/03/16 11:09:46 chongo Exp $
-    # @(#) $Source: /usr/local/src/cmd/calc/RCS/COPYING,v $
-
-=-=
+-=-
 
 Calc is covered by the GNU Lesser General Public License
 --------------------------------------------------------
@@ -53,47 +49,64 @@ Calc is covered by the GNU Lesser General Public License
 	    Boston, MA  02110-1301
 	    USA
 
-    The contact addresses for calc is as follows:
+    To subscribe to the calc-tester mailing list, visit the following URL:
 
-	Web:	http://www.isthe.com/chongo/tech/comp/calc/email.html
+	    http://www.isthe.com/chongo/tech/comp/calc/calc-tester.html
 
-    To join the low volume calc mailing list.  Send a EMail message to:
+	This is a low volume moderated mailing list.
 
-	calc-tester-request at asthe dot com
+	This mailing list replaces calc-tester at asthe dot com list.
 
-    Your subject must contain the words:
+	If you need a human to help you with your mailing list subscription,
+	please send EMail to our special:
 
-	calc mailing list subscription
+	    calc-tester-maillist-help at asthe dot com
 
-    You may have additional words in your subject line.
+	    NOTE: Remove spaces and replace 'at' with @, 'dot' with .
 
-    Your message body (not the subject) should consist of:
+	address.  To be sure we see your EMail asking for help with your
+	mailing list subscription, please use the following phase in your
+	EMail Subject line:
 
-	 subscribe calc-tester address
-	 end
-	 name your_full_name
+	    calc tester mailing list help
 
-    where ``address'' is your EMail address and ``your_full_name'' is
-    your full name.
+	That phrase in your subject line will help ensure your
+	request will get past our anti-spam filters.  You may have
+	additional words in your subject line.
 
-    Feel free to follow the name line with additional EMail text as desired.
-
-=-=
+-=-
 
     Calc bug reports and calc bug fixes should be sent to:
 
-	calc-bugs at asthe dot com
+	    calc-bug-report at asthe dot com
 
-    [[ NOTE: Replace 'at' with @, 'dot' is with . and remove the spaces ]]
-    [[ NOTE: The EMail address uses 'asthe' and the web site URL uses 'isthe' ]]
+	    NOTE: Remove spaces and replace 'at' with @, 'dot' with .
 
-    Your subject must contain the words:
+	This replaces the old calc-bugs at asthe dot com address.
 
-	   calc bug report
+	To be sure we see your EMail reporting a calc bug, please use the
+	following phase in your EMail Subject line:
 
-    You may have additional words in your subject line.
+	    calc bug report
 
-=-=
+	That phrase in your subject line will help ensure your
+	request will get past our anti-spam filters.  You may have
+	additional words in your subject line.
+
+	However, you may find it more helpful to simply subscribe
+	to the calc-tester mailing list (see above) and then to
+	send your report to that mailing list as a wider set calc
+	testers may be able to help you.
+
+-=-
+
+    The calc web site is located at:
+
+	http://www.isthe.com/chongo/tech/comp/calc/
+
+    NOTE: The EMail address uses 'asthe', while the web site uses 'isthe'.
+
+-=-
 
 Calc's relationship to the GNU Lesser General Public License
 ------------------------------------------------------------
@@ -149,7 +162,7 @@ Calc's relationship to the GNU Lesser General Public License
      except for the exception files explicitly listed in the ``Calc
      copyrights and exception files'' section below.
 
-=-=
+-=-
 
 Calc copyrights and exception files
 -----------------------------------
@@ -165,12 +178,12 @@ Calc copyrights and exception files
 	Copyright (C) year  Ernest Bowen and Landon Curt Noll
 	Copyright (C) year  Ernest Bowen
 	Copyright (C) year  Petteri Kettunen and Landon Curt Noll
+	Copyright (C) year  Christoph Zurnieden
 
     These files are not covered under one of the Copyrights listed above:
 
-	    shs1.c	    shs1.h	 shs.c		shs.h
-	    md5.c	    md5.h	 COPYING	COPYING-LGPL
-	    cal/qtime.cal   cal/screen.cal
+	    sha1.c		sha1.h		COPYING
+	    COPYING-LGPL	cal/qtime.cal	cal/screen.cal
 
     The file COPYING-LGPL, which contains a copy of the version 2.1
     GNU Lesser General Public License, is itself Copyrighted by the
@@ -182,17 +195,14 @@ Calc copyrights and exception files
     top of this file.  It is important to note that you may distribute
     verbatim copies of this file but you may not modify this file.
 
-    Some of these exception files are in the public domain.  The md5.c
-    and md5.h files were "derived from the RSA Data Security, Inc. MD5
-    Message-Digest Algorithm" and are under a copyright that allows these
-    two files to be freely used and distributed.  Other files are under
-    the LGPL but have different authors that those listed above.
+    Some of these exception files are in the public domain.  Other files
+    are under the LGPL but have different authors that those listed above.
 
     In all cases one may use and distribute these exception files freely.
     And because one may freely distribute the LGPL covered files, the
     entire calc source may be freely used and distributed.
 
-=-=
+-=-
 
 General Copyleft and License info
 ---------------------------------
@@ -206,7 +216,7 @@ General Copyleft and License info
 	http://www.gnu.org/copyleft/lesser.html
 	http://www.gnu.org/copyleft/lesser.txt
 
-=-=
+-=-
 
 Why calc did not use the GNU General Public License
 ---------------------------------------------------

COPYING-LGPL

@@ -1,8 +1,8 @@
-		  GNU LESSER GENERAL PUBLIC LICENSE
-		       Version 2.1, February 1999
+                  GNU LESSER GENERAL PUBLIC LICENSE
+                       Version 2.1, February 1999
 
  Copyright (C) 1991, 1999 Free Software Foundation, Inc.
-     51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, 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
 
@@ -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., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, 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

@@ -32,6 +32,16 @@ Installing calc from the bzip2-ed tarball in 4 easy steps:
 	targets, the default make is sufficent.  On FreeBSD for example,
 	one must use gmake instead of make.
 
+	Some report that under macOS, one has to declare the target
+	to be darwin.  So for macOS, one might have to do:
+
+	    # for macOS users only, force the target to be darwin
+	    #
+	    make target=Darwin clobber
+	    make target=Darwin all
+	    make target=Darwin chk
+	    make target=Darwin install
+
 	If your target system does not have GNU Make (or equivalent), then
 	you should try using the Makefile.simple and custom/Makefile.simple
 	files:
@@ -185,8 +195,8 @@ Installing calc from the bzip2-ed tarball in 4 easy steps:
 
 	make install
 
-We suggest that you might want to read the README file and look at
-the calc help subsystem.  See the README file for details.
+We suggest that you might want to read the README.FIRST file and look at
+the calc help subsystem.  See also the README.md file.
 
 ## Copyright (C) 1999-2007  Landon Curt Noll
 ##
@@ -204,10 +214,6 @@ the calc help subsystem.  See the README file for details.
 ## 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.6 $
-## @(#) $Id: HOWTO.INSTALL,v 30.6 2007/10/16 12:22:22 chongo Exp $
-## @(#) $Source: /usr/local/src/cmd/calc/RCS/HOWTO.INSTALL,v $
-##
 ## Under source code control:	1999/09/27 20:48:44
 ## File existed as early as:	1999
 ##

LIBRARY

@@ -638,10 +638,6 @@ need call libcalc_call_me_last() only once.
 ## 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: LIBRARY,v 30.1 2007/03/16 11:09:46 chongo Exp $
-## @(#) $Source: /usr/local/src/cmd/calc/RCS/LIBRARY,v $
-##
 ## Under source code control:	1993/07/30 19:44:49
 ## File existed as early as:	1993
 ##

README.FIRST

@@ -73,52 +73,64 @@ for a wish/todo list.  Code contributions are welcome.
 
 =-=
 
-To join the calc-tester mailing list.  Send an EMail message to:
+To subscribe to the calc-tester mailing list, visit the following URL:
 
-    calc-tester-request at asthe dot com
+	http://www.isthe.com/chongo/tech/comp/calc/calc-tester.html
 
-    [[ NOTE: Replace 'at' with @, 'dot' is with . and remove the spaces ]]
-    [[ NOTE: The EMail address uses 'asthe' and the web site URL uses 'isthe' ]]
+    This is a low volume moderated mailing list.
 
-Your subject must contain the words:
+    This mailing list replaces calc-tester at asthe dot com list.
 
-    calc mailing list subscription
+    If you need a human to help you with your mailing list subscription,
+    please send EMail to our special:
 
-You may have additional words in your subject line.
+	calc-tester-maillist-help at asthe dot com
 
-Your message body (not the subject) should consist of:
+	NOTE: Remove spaces and replace 'at' with @, 'dot' with .
 
-     subscribe calc-tester address
-     end
-     name your_full_name
+    address.  To be sure we see your EMail asking for help with your
+    mailing list subscription, please use the following phase in your
+    EMail Subject line:
 
-where ``address'' is your EMail address and ``your_full_name'' is
-your full name.
+	calc tester mailing list help
 
-Feel free to follow the name line with additional EMail text as desired.
+    That phrase in your subject line will help ensure your
+    request will get past our anti-spam filters.  You may have
+    additional words in your subject line.
 
-=-=
+-=-
 
-Send Calc bug and bug fixes to:
+Calc bug reports and calc bug fixes should be sent to:
 
-    calc-bugs at asthe dot com
+	calc-bug-report at asthe dot com
 
-    [[ NOTE: Replace 'at' with @, 'dot' is with . and remove the spaces ]]
-    [[ NOTE: The EMail address uses 'asthe' and the web site URL uses 'isthe' ]]
+	NOTE: Remove spaces and replace 'at' with @, 'dot' with .
 
-but see the BUGS file first.
+    This replaces the old calc-bugs at asthe dot com address.
 
-Your subject must contain the words:
+    To be sure we see your EMail reporting a calc bug, please use the
+    following phase in your EMail Subject line:
 
-       calc bug report
+	calc bug report
 
-You may have additional words in your subject line.
+    That phrase in your subject line will help ensure your
+    request will get past our anti-spam filters.  You may have
+    additional words in your subject line.
+
+    However, you may find it more helpful to simply subscribe
+    to the calc-tester mailing list (see above) and then to
+    send your report to that mailing list as a wider set calc
+    testers may be able to help you.
+
+-=-
 
 The calc web site is located at:
 
-	http://www.isthe.com/chongo/tech/comp/calc/
+    http://www.isthe.com/chongo/tech/comp/calc/
 
-## Copyright (C) 1999  Landon Curt Noll
+NOTE: The EMail address uses 'asthe', while the web site uses 'isthe'.
+
+## Copyright (C) 1999,2014,2017  Landon Curt Noll
 ##
 ## Calc is open software; you can redistribute it and/or modify it under
 ## the terms of the version 2.1 of the GNU Lesser General Public License
@@ -134,10 +146,6 @@ The calc web site is located at:
 ## 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: README,v 30.1 2007/03/16 11:09:46 chongo Exp $
-## @(#) $Source: /usr/local/src/cmd/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,78 @@ NOTE: The main developers do not have access to a Windoz based platform.
       Of course you are welcome to send us any patches that fix your
       Windoz build environment.
 
+
+=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
+=-= compiling with Windows Subsystem for Linux (WSL) =-Cygwin =-=
+=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
+
+It has been reported that calc version 2.12.6.4 has been successfully
+compiled, installed and running on Windows 10 on 2018 Jan 21.
+
+We were told:
+
+  "The Windows Subsystem for Linux (WSL) is a new Windows 10 feature that
+   enables you to run native Linux command-line tools directly on Windows"
+
+   https://docs.microsoft.com/cs-cz/windows/wsl/about
+
+=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
+=-= compiling with Cygwin =-=
+=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
+
+An effort is being made to allow windows users to compile calc using the
+Cygwin project (http://sources.redhat.com/cygwin/) with the GCC compiler
+and Un*x tools for Windows.
+
+The major porting work 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 =-=
 =-=-=-=-=-=-=-=-=-=-=-=-=-=-=
@@ -68,52 +140,8 @@ Look for Makefile comments of the form:
 Follow those recommendations.  In cases where they conflict with
 the above Makefile list, follow the recommendation in the Makefile.
 
-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
-=-= compiling with Cygwin =-=
-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
 
-An effort is being made to allow windows users to compile calc using the
-Cygwin project (http://sources.redhat.com/cygwin/) with the GCC compiler
-and Un*x tools for Windows.
-
-The major porting work was performed by Thomas Jones-Low
-(tjoneslo at softstart dot com).  He said:
-
-    I had previous stated to this group that I have successfully managed
-    to port a version of Calc to Windows, and promised some point to
-    post what was required, so here it is.
-
-    One obvious manner of doing this port is to get the latest version
-    of the Cygwin project (http://sources.redhat.com/cygwin/) with the
-    GCC compiler and Un*x tools for Windows and recompile.
-
-    I built my working version using Calc ... I am using Visual C++
-    version 7.0, which is an older version of the Microsoft development
-    tools. The make file provided with Calc is not compatible with
-    NMAKE, so I used the Visual Studio tools to generate another one
-    (not included). Calc is built in two parts, calc.dll, which is the
-    library, and calc.exe which is the command line interface.
-
-He recommended that you generate by hand all of the header files that
-by the Makefile.  This has been done for you via the makefile rule:
-
-	make win32_hsrc
-
-which uses the Makefile variables in win32.mkdef to form these header
-files under win32 directory.
-
-You will find generated versions of these files located in the win32
-sub-directory.  These files may be appropriate for your Cygwin building
-needs.
-
-In particular:
-
-	Just copy the win32/*.[ch] files up into the top level calc
-	source directory, edit them (if needed) and build using the
-	Cygwin GCC compiler and Cygwin build environment.
-
-
-## Copyright (C) 2002-2007  Landon Curt Noll and Thomas Jones-Low
+## Copyright (C) 2002-2009  Landon Curt Noll and Thomas Jones-Low
 ##
 ## Calc is open software; you can redistribute it and/or modify it under
 ## the terms of the version 2.1 of the GNU Lesser General Public License
@@ -129,10 +157,6 @@ In particular:
 ## 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: README.WINDOWS,v 30.1 2007/03/16 11:09:46 chongo Exp $
-## @(#) $Source: /usr/local/src/cmd/calc/RCS/README.WINDOWS,v $
-##
 ## Under source code control:	2001/02/25 14:00:05
 ## File existed as early as:	2001
 ##

README.md

@@ -0,0 +1,260 @@
+# What is calc?
+
+Calc is an interactive calculator which provides for easy large
+Otherwise, it enters interactive mode.  In this mode, it accepts
+commands one at a time, processes them, and displays the answers.
+In the simplest case, commands are simply expressions which are
+evaluated.  For example, the following line can be input:
+
+```sh
+3 * (4 + 1)
+```
+
+and the calculator will print:
+
+```sh
+15
+```
+
+Calc as the usual collection of arithmetic operators +, -, /, * as
+well as ^ (exponentiation), % (modulus) and // (integer divide).
+For example:
+
+```sh
+3 * 19^43 - 1
+```
+
+will produce:
+
+```sh
+29075426613099201338473141505176993450849249622191102976
+```
+
+Notice that calc values can be very large.  For example:
+
+```sh
+2^23209-1
+```
+
+will print:
+
+```sh
+402874115778988778181873329071 ... many digits ... 3779264511
+```
+
+The special '.' symbol (called dot), represents the result of the
+last command expression, if any.  This is of great use when a series
+of partial results are calculated, or when the output mode is changed
+and the last result needs to be redisplayed.  For example, the above
+result can be modified by typing:
+
+```sh
+. % (2^127-1)
+```
+
+and the calculator will print:
+
+```sh
+47385033654019111249345128555354223304
+```
+
+For more complex calculations, variables can be used to save the
+intermediate results.  For example, the result of adding 7 to the
+previous result can be saved by typing:
+
+```sh
+curds = 15
+whey = 7 + 2*curds
+```
+
+Functions can be used in expressions.  There are a great number of
+pre-defined functions.  For example, the following will calculate
+the factorial of the value of 'whey':
+
+```sh
+fact(whey)
+```
+
+and the calculator prints:
+
+```sh
+13763753091226345046315979581580902400000000
+```
+
+The calculator also knows about complex numbers, so that typing:
+
+```sh
+(2+3i) * (4-3i)
+cos(.)
+```
+
+will print:
+
+```sh
+17+6i
+-55.50474777265624667147+193.9265235748927986537i
+```
+
+The calculator can calculate transcendental functions, and accept and
+display numbers in real or exponential format. For example, typing:
+
+```sh
+config("display", 70),
+epsilon(1e-70),
+sin(1)
+```
+
+prints:
+
+```sh
+0.8414709848078965066525023216302989996225630607983710656727517099919104
+```
+
+Calc can output values in terms of fractions, octal or hexadecimal.
+For example:
+
+```sh
+config("mode", "fraction"),
+(17/19)^23
+print
+base(16),
+(19/17)^29
+print
+log(79.3i)
+```
+
+ will print:
+
+```sh
+19967568900859523802559065713/257829627945307727248226067259
+
+0x9201e65bdbb801eaf403f657efcf863/0x5cd2e2a01291ffd73bee6aa7dcf7d1
+
+0x17b5164ac24ee836bf/0xc7b7a8e3ef5fcf752+0x883eaf5adadd26be3/0xc7b7a8e3ef5fcf752i
+```
+
+All numbers are represented as fractions with arbitrarily large
+numerators and denominators which are always reduced to lowest terms.
+Real or exponential format numbers can be input and are converted
+to the equivalent fraction.  Hex, binary, or octal numbers can be
+input by using numbers with leading '0x', '0b' or '0' characters.
+Complex numbers can be input using a trailing 'i', as in '2+3i'.
+Strings and characters are input by using single or double quotes.
+
+Commands are statements in a C-like language, where each input
+line is treated as the body of a procedure.  Thus the command
+line can contain variable declarations, expressions, labels,
+conditional tests, and loops.  Assignments to any variable name
+will automatically define that name as a global variable.  The
+other important thing to know is that all non-assignment expressions
+which are evaluated are automatically printed.  Thus, you can evaluate
+an expression's value by simply typing it in.
+
+Many useful built-in mathematical functions are available.  Use the:
+
+```sh
+help builtin
+```
+
+command to list them.
+
+You can also define your own functions by using the 'define' keyword,
+followed by a function declaration very similar to C.
+
+```sh
+define f2(n)
+{
+	local ans;
+
+	ans = 1;
+	while (n > 1)
+		ans *= (n -= 2);
+	return ans;
+}
+```
+
+Thus the input:
+
+```sh
+f2(79)
+```
+
+will produce:
+
+```sh
+1009847364737869270905302433221592504062302663202724609375
+```
+
+Functions which only need to return a simple expression can be defined
+using an equals sign, as in the example:
+
+```sh
+define sc(a,b) = a^3 + b^3
+```
+
+Thus the input:
+
+```sh
+sc(31, 61)
+```
+
+will produce:
+
+```sh
+256772
+```
+
+Variables in functions can be defined as either 'global', 'local',
+or 'static'.  Global variables are common to all functions and the
+command line, whereas local variables are unique to each function
+level, and are destroyed when the function returns.  Static variables
+are scoped within single input files, or within functions, and are
+never destroyed.  Variables are not typed at definition time, but
+dynamically change as they are used.
+
+For more information about the calc language and features, try:
+
+```sh
+help overview
+```
+
+Calc has a help command that will produce information about
+every builtin function, command as well as a number of other
+aspects of calc usage.  Try the command:
+
+```sh
+help help
+```
+
+for and overview of the help system.  The command:
+
+```sh
+help builtin
+```
+
+provides information on built-in mathematical functions, whereas:
+
+```sh
+help asinh
+```
+
+will provides information a specific function.  The following
+help files:
+
+```sh
+help command
+help define
+help operator
+help statement
+help variable
+```
+
+provide a good overview of the calc language.  If you are familiar
+with C, you should also try:
+
+```sh
+help unexpected
+```
+
+It contains information about differences between C and calc
+that may surprize C programmers.

addop.c

@@ -19,10 +19,6 @@
  * 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: addop.c,v 30.1 2007/03/16 11:09:46 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/RCS/addop.c,v $
- *
  * Under source code control:	1990/02/15 01:48:10
  * File existed as early as:	before 1990
  *

align32.c

@@ -17,10 +17,6 @@
  * 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: align32.c,v 30.1 2007/03/16 11:09:46 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/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-2007  David I. Bell
+ * Copyright (C) 1999-2007,2014  David I. Bell
  *
  * Calc is open software; you can redistribute it and/or modify it under
  * the terms of the version 2.1 of the GNU Lesser General Public License
@@ -17,10 +17,6 @@
  * 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: alloc.h,v 30.2 2008/04/15 21:17:57 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/RCS/alloc.h,v $
- *
  * Under source code control:	1990/02/15 01:48:29
  * File existed as early as:	before 1990
  *
@@ -28,8 +24,8 @@
  */
 
 
-#if !defined(__ALLOC_H__)
-#define __ALLOC_H__
+#if !defined(INCLUDE_ALLOC_H)
+#define INCLUDE_ALLOC_H
 
 
 #if defined(CALC_SRC)	/* if we are building from the calc source tree */
@@ -53,7 +49,8 @@
 # if defined(HAVE_NEWSTR)
 E_FUNC void *memcpy();
 E_FUNC void *memset();
-#if defined(FORCE_STDC) || (defined(__STDC__) && __STDC__ != 0) || defined(__cplusplus)
+#if defined(FORCE_STDC) || \
+   (defined(__STDC__) && __STDC__ != 0) || defined(__cplusplus)
 E_FUNC size_t strlen();
 #  else
 E_FUNC long strlen();
@@ -82,7 +79,8 @@ E_FUNC int strcmp();
 
 #if !defined(HAVE_MEMMOVE)
 # undef MEMMOVE_SIZE_T
-#if defined(FORCE_STDC) || (defined(__STDC__) && __STDC__ != 0) || defined(__cplusplus)
+#if defined(FORCE_STDC) || \
+   (defined(__STDC__) && __STDC__ != 0) || defined(__cplusplus)
 #  define MEMMOVE_SIZE_T size_t
 # else
 #  define MEMMOVE_SIZE_T long
@@ -90,4 +88,4 @@ E_FUNC int strcmp();
 E_FUNC void *memmove(void *s1, CONST void *s2, MEMMOVE_SIZE_T n);
 #endif
 
-#endif /* !__ALLOC_H__ */
+#endif /* !INCLUDE_ALLOC_H */

assocfunc.c

@@ -17,10 +17,6 @@
  * 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: assocfunc.c,v 30.1 2007/03/16 11:09:46 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/RCS/assocfunc.c,v $
- *
  * Under source code control:	1993/07/20 23:04:27
  * File existed as early as:	1993
  *
@@ -83,7 +79,7 @@ associndex(ASSOC *ap, BOOL create, long dim, VALUE *indices)
 	 * so that we can first select the correct hash chain, and
 	 * also so we can quickly compare each element for a match.
 	 */
-	hash = FNV1_32_BASIS;
+	hash = QUICKHASH_BASIS;
 	for (i = 0; i < dim; i++)
 		hash = hashvalue(&indices[i], hash);
 
@@ -332,7 +328,8 @@ assoccopy(ASSOC *oldap)
 			oldep = oldep->e_next) {
 			ep = (ASSOCELEM *) malloc(ELEMSIZE(oldep->e_dim));
 			if (ep == NULL) {
-				math_error("Cannot allocate association element");
+				math_error("Cannot allocate "
+					   "association element");
 				/*NOTREACHED*/
 			}
 			ep->e_dim = oldep->e_dim;
@@ -340,7 +337,8 @@ assoccopy(ASSOC *oldap)
 			ep->e_value.v_type = V_NULL;
 			ep->e_value.v_subtype = V_NOSUBTYPE;
 			for (i = 0; i < ep->e_dim; i++)
-				copyvalue(&oldep->e_indices[i], &ep->e_indices[i]);
+				copyvalue(&oldep->e_indices[i],
+					  &ep->e_indices[i]);
 			copyvalue(&oldep->e_value, &ep->e_value);
 			listhead = &ap->a_table[ep->e_hash % ap->a_size];
 			ep->e_next = *listhead;

blkcpy.c

@@ -19,10 +19,6 @@
  * 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: blkcpy.c,v 30.1 2007/03/16 11:09:46 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/RCS/blkcpy.c,v $
- *
  * Under source code control:	1997/04/18 20:41:26
  * File existed as early as:	1997
  *
@@ -374,7 +370,8 @@ copyblk2mat(BLOCK *blk, long ssi, long num, MATRIX *dmat, long dsi)
  * copymat2blk - copy matrix to block
  */
 int
-copymat2blk(MATRIX *smat, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc)
+copymat2blk(MATRIX *smat, long ssi, long num, BLOCK *dblk, long dsi,
+	    BOOL noreloc)
 {
 	long i;
 	long newlen;
@@ -720,7 +717,8 @@ copystr2file(STRING *str, long ssi, long num, FILEID id, long dsi)
  * copyblk2blk - copy block to block
  */
 int
-copyblk2blk(BLOCK *sblk, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc)
+copyblk2blk(BLOCK *sblk, long ssi, long num, BLOCK *dblk, long dsi,
+	    BOOL noreloc)
 {
 	long	newlen;
 	long	newsize;
@@ -762,7 +760,8 @@ copyblk2blk(BLOCK *sblk, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc
  * copystr2blk - copy string to block
  */
 int
-copystr2blk(STRING *str, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc)
+copystr2blk(STRING *str, long ssi, long num, BLOCK *dblk, long dsi,
+	    BOOL noreloc)
 {
 	long	len;
 	long	newlen;
@@ -982,7 +981,8 @@ memmove(void *s1, CONST void *s2, MEMMOVE_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 +1033,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-2007  Landon Curt Noll and Ernest Bowen
+ * Copyright (C) 1999-2007,2014  Landon Curt Noll and Ernest Bowen
  *
  * Primary author:  Landon Curt Noll
  *
@@ -19,10 +19,6 @@
  * 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: blkcpy.h,v 30.1 2007/03/16 11:09:46 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/RCS/blkcpy.h,v $
- *
  * Under source code control:	1997/04/18 20:41:25
  * File existed as early as:	1997
  *
@@ -30,8 +26,8 @@
  */
 
 
-#if !defined(__BLKCPY_H__)
-#define __BLKCPY_H__
+#if !defined(INCLUDE_BLKCPY_H)
+#define INCLUDE_BLKCPY_H
 
 /*
  * the main copy gateway function
@@ -59,4 +55,4 @@ E_FUNC int copystr2blk(STRING *, long, long, BLOCK *, long, BOOL);
 E_FUNC int copystr2file(STRING *, long, long, FILEID, long);
 E_FUNC int copystr2str(STRING *, long, long, STRING *, long);
 
-#endif /* !__BLKCPY_H__ */
+#endif /* !INCLUDE_BLKCPY_H */

block.c

@@ -19,10 +19,6 @@
  * 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: block.c,v 30.1 2007/03/16 11:09:46 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/RCS/block.c,v $
- *
  * Under source code control:	1997/02/27 00:29:40
  * File existed as early as:	1997
  *

block.h

@@ -1,7 +1,7 @@
 /*
  * block - fixed, dynamic, fifo and circular memory blocks
  *
- * Copyright (C) 1999-2007  Landon Curt Noll and Ernest Bowen
+ * Copyright (C) 1999-2007,2014  Landon Curt Noll and Ernest Bowen
  *
  * Primary author:  Landon Curt Noll
  *
@@ -19,10 +19,6 @@
  * 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: block.h,v 30.1 2007/03/16 11:09:46 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/RCS/block.h,v $
- *
  * Under source code control:	1997/02/21 05:03:39
  * File existed as early as:	1997
  *
@@ -31,8 +27,8 @@
  */
 
 
-#if !defined(__BLOCK_H__)
-#define __BLOCK_H__
+#if !defined(INCLUDE_BLOCK_H)
+#define INCLUDE_BLOCK_H
 
 
 /*
@@ -222,4 +218,4 @@ E_FUNC int countnblocks(void);
 E_FUNC void shownblocks(void);
 
 
-#endif /* !__BLOCK_H__ */
+#endif /* !INCLUDE_BLOCK_H */

byteswap.c

@@ -17,10 +17,6 @@
  * 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: byteswap.c,v 30.1 2007/03/16 11:09:46 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/RCS/byteswap.c,v $
- *
  * Under source code control:	1995/10/11 04:44:01
  * File existed as early as:	1995
  *
@@ -102,7 +98,8 @@ swap_b8_in_ZVALUE(ZVALUE *dest, ZVALUE *src, BOOL all)
 		 */
 		dest = malloc(sizeof(ZVALUE));
 		if (dest == NULL) {
-			math_error("swap_b8_in_ZVALUE: swap_b8_in_ZVALUE: Not enough memory");
+			math_error("swap_b8_in_ZVALUE: swap_b8_in_ZVALUE: "
+				    "Not enough memory");
 			/*NOTREACHED*/
 		}
 

byteswap.h

@@ -1,7 +1,7 @@
 /*
  * byteswap - byte swapping macros
  *
- * Copyright (C) 1999  Landon Curt Noll
+ * Copyright (C) 1999,2014  Landon Curt Noll
  *
  * Calc is open software; you can redistribute it and/or modify it under
  * the terms of the version 2.1 of the GNU Lesser General Public License
@@ -17,10 +17,6 @@
  * 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: byteswap.h,v 30.1 2007/03/16 11:09:46 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/RCS/byteswap.h,v $
- *
  * Under source code control:	1995/10/11 04:44:01
  * File existed as early as:	1995
  *
@@ -29,8 +25,8 @@
  */
 
 
-#if !defined(__BYTESWAP_H__)
-#define __BYTESWAP_H__
+#if !defined(INCLUDE_BYTESWAP_H)
+#define INCLUDE_BYTESWAP_H
 
 
 #if defined(CALC_SRC)	/* if we are building from the calc source tree */
@@ -178,4 +174,4 @@
 #endif /* LONG_BITS == 64 */
 
 
-#endif /* !__BYTESWAP_H__ */
+#endif /* !INCLUDE_BYTESWAP_H */

cal/Makefile

@@ -2,7 +2,7 @@
 #
 # cal - makefile for calc standard resource files
 #
-# Copyright (C) 1999-2006  Landon Curt Noll
+# Copyright (C) 1999-2006,2017  Landon Curt Noll
 #
 # Calc is open software; you can redistribute it and/or modify it under
 # the terms of the version 2.1 of the GNU Lesser General Public License
@@ -18,10 +18,6 @@
 # received a copy with calc; if not, write to Free Software Foundation, Inc.
 # 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 #
-# @(#) $Revision: 30.3 $
-# @(#) $Id: Makefile,v 30.3 2007/09/21 01:27:27 chongo Exp $
-# @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/Makefile,v $
-#
 # Under source code control:	1991/07/21 05:00:54
 # File existed as early as:	1991
 #
@@ -179,21 +175,41 @@ MV= mv
 CO= co
 TRUE= true
 TOUCH= touch
+SED= sed
+SORT= sort
+FMT= fmt
 
 # The calc files to install
 #
-CALC_FILES= README bigprime.cal deg.cal ellip.cal lucas.cal lucas_chk.cal \
-	lucas_tbl.cal mersenne.cal mod.cal pell.cal pi.cal pix.cal \
-	pollard.cal poly.cal psqrt.cal quat.cal regress.cal solve.cal \
-	sumsq.cal surd.cal unitfrac.cal varargs.cal chrem.cal mfactor.cal \
-	bindings randmprime.cal test1700.cal randrun.cal linear.cal \
-	randbitrun.cal bernoulli.cal test2300.cal test2600.cal \
-	test2700.cal test3100.cal test3300.cal test3400.cal prompt.cal \
-	test3500.cal seedrandom.cal test4000.cal test4100.cal test4600.cal \
-	beer.cal hello.cal test5100.cal test5200.cal randombitrun.cal \
-	randomrun.cal repeat.cal xx_print.cal natnumset.cal qtime.cal \
-	test8400.cal test8500.cal test8600.cal chi.cal intfile.cal screen.cal \
-	dotest.cal set8700.cal set8700.line alg_config.cal sumtimes.cal
+# This list is prodiced by the detaillist rule when no WARNINGS are detected.
+#
+# Please use:
+#
+#	make calc_files_list
+#
+# to keep this list in nice sorted order and to check that these
+# deailed help files are under RCS control.
+#
+CALC_FILES= README alg_config.cal beer.cal bernoulli.cal \
+	bernpoly.cal bigprime.cal bindings brentsolve.cal chi.cal chrem.cal \
+	constants.cal deg.cal dms.cal dotest.cal ellip.cal factorial.cal \
+	factorial2.cal gvec.cal hello.cal hms.cal infinities.cal \
+	intfile.cal intnum.cal lambertw.cal linear.cal lnseries.cal \
+	lucas.cal lucas_chk.cal mersenne.cal mfactor.cal \
+	mod.cal natnumset.cal pell.cal pi.cal pix.cal pollard.cal poly.cal \
+	prompt.cal psqrt.cal qtime.cal quat.cal randbitrun.cal randmprime.cal \
+	randombitrun.cal randomrun.cal randrun.cal regress.cal repeat.cal \
+	screen.cal seedrandom.cal set8700.cal set8700.line smallfactors.cal \
+	solve.cal specialfunctions.cal statistics.cal strings.cal sumsq.cal \
+	sumtimes.cal surd.cal test1700.cal test2300.cal test2600.cal \
+	test2700.cal test3100.cal test3300.cal test3400.cal test3500.cal \
+	test4000.cal test4100.cal test4600.cal test5100.cal test5200.cal \
+	test8400.cal test8500.cal test8600.cal test8900.cal toomcook.cal \
+	unitfrac.cal varargs.cal xx_print.cal zeta2.cal
+
+# These calc files are now obsolete and are removed by the install rule.
+#
+DEAD_CALC_FILES= lucas_tbl.cal
 
 # These files are found (but not built) in the distribution
 #
@@ -241,6 +257,27 @@ calcliblist:
 	    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
@@ -264,6 +301,23 @@ clean:
 
 clobber: clean
 	${RM} -f .all
+	-${Q} if [ -e .DS_Store ]; then \
+	    echo ${RM} -rf .DS_Store; \
+	    ${RM} -rf .DS_Store; \
+	fi
+	-${Q} for i in ${DEAD_CALC_FILES} /dev/null; do \
+	    if [ "$$i" = "/dev/null" ]; then \
+		continue; \
+	    fi; \
+	    if [ -e "${T}${CALC_SHAREDIR}/$$i" ]; then \
+		echo "${RM} -f ${T}${CALC_SHAREDIR}/$$i"; \
+		${RM} -f ${T}${CALC_SHAREDIR}/$$i; \
+	    fi; \
+	    if [ -e "./$$i" ]; then \
+		echo "${RM} -f ./$$i"; \
+		${RM} -f ./$$i; \
+	    fi; \
+	done
 
 # install everything
 #
@@ -271,8 +325,8 @@ clobber: clean
 #
 install: all
 	-${Q} if [ ! -d ${T}${CALC_SHAREDIR} ]; then \
-	    echo ${MKDIR} ${T}${CALC_SHAREDIR}; \
-	    ${MKDIR} ${T}${CALC_SHAREDIR}; \
+	    echo ${MKDIR} -p ${T}${CALC_SHAREDIR}; \
+	    ${MKDIR} -p ${T}${CALC_SHAREDIR}; \
 	    if [ ! -d "${T}${CALC_SHAREDIR}" ]; then \
 		echo ${MKDIR} -p "${T}${CALC_SHAREDIR}"; \
 		${MKDIR} -p "${T}${CALC_SHAREDIR}"; \
@@ -292,16 +346,42 @@ install: all
 		${RM} -f ${T}${CALC_SHAREDIR}/$$i.new; \
 		${CP} -f $$i ${T}${CALC_SHAREDIR}/$$i.new; \
 		${CHMOD} 0444 ${T}${CALC_SHAREDIR}/$$i.new; \
-		${MV} -f ${T}${CALC_SHAREDIR}/$$i.new ${T}${CALC_SHAREDIR}/$$i; \
+		${MV} -f ${T}${CALC_SHAREDIR}/$$i.new ${T}${CALC_SHAREDIR}/$$i;\
 		echo "installed ${T}${CALC_SHAREDIR}/$$i"; \
 	    fi; \
 	done
+	${Q} for i in ${DEAD_CALC_FILES} /dev/null; do \
+	    if [ "$$i" = "/dev/null" ]; then \
+		continue; \
+	    fi; \
+	    if [ -e "${T}${CALC_SHAREDIR}/$$i" ]; then \
+		echo "${RM} -f ${T}${CALC_SHAREDIR}/$$i"; \
+		${RM} -f ${T}${CALC_SHAREDIR}/$$i; \
+	    fi; \
+	    if [ -e "./$$i" ]; then \
+		echo "${RM} -f ./$$i"; \
+		${RM} -f ./$$i; \
+	    fi; \
+	done
 
 # Try to remove everything that was installed
 #
 # NOTE: Keep the uninstall rule in reverse order to the install rule
 #
 uninstall:
+	- ${Q} for i in ${DEAD_CALC_FILES} /dev/null; do \
+	    if [ "$$i" = "/dev/null" ]; then \
+		continue; \
+	    fi; \
+	    if [ -e "${T}${CALC_SHAREDIR}/$$i" ]; then \
+		echo "${RM} -f ${T}${CALC_SHAREDIR}/$$i"; \
+		${RM} -f ${T}${CALC_SHAREDIR}/$$i; \
+	    fi; \
+	    if [ -e "./$$i" ]; then \
+		echo "${RM} -f ./$$i"; \
+		${RM} -f ./$$i; \
+	    fi; \
+	done
 	-${Q} for i in ${CALC_FILES} /dev/null; do \
 	    if [ "$$i" = "/dev/null" ]; then \
 		continue; \

cal/alg_config.cal

@@ -1,7 +1,7 @@
 /*
  * alg_config - help determine optimal values for algorithm levels
  *
- * Copyright (C) 2006  Landon Curt Noll
+ * Copyright (C) 2006,2014  Landon Curt Noll
  *
  * Calc is open software; you can redistribute it and/or modify it under
  * the terms of the version 2.1 of the GNU Lesser General Public License
@@ -17,10 +17,6 @@
  * 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: alg_config.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/alg_config.cal,v $
- *
  * Under source code control:	2006/06/07 14:10:11
  * File existed as early as:	2006
  *
@@ -28,8 +24,37 @@
  * Share and enjoy!  :-)	http://www.isthe.com/chongo/tech/comp/calc/
  */
 
+static test_time;	/* try for this many seconds in loop test */
 
-global test_time;	/* try for this many seconds in loop test */
+
+/*
+ * close_to_one - set to 1 if the ratio is close enough to 1
+ *
+ * given:
+ *	ratio	the ratio of time between two algorithms
+ *
+ * retuns:
+ *	1	When ratio is near 1.0
+ *	0	otherwise
+ *
+ * We consider the range [0.995, 1.005] to be close enough to 1 to be call unity
+ * because of the precision of the CPU timing.
+ */
+define close_to_one(ratio)
+{
+    /* firewall */
+    if (!isreal(ratio)) {
+	quit "close: 1st arg: must be a real number";
+    }
+
+    /* check if the ratio is far from unity */
+    if ((ratio < 0.995) || (ratio > 1.005)) {
+	return 0;
+    }
+
+    /* we are close to unity */
+    return 1;
+}
 
 
 /*
@@ -80,7 +105,8 @@ define mul_loop(repeat, x)
     len = sizeof((*x)[0]) / baseb_bytes;
     for (i=1; i < 4; ++i) {
 	if ((sizeof((*x)[i]) / baseb_bytes) != len) {
-	    quit "mul_loop: 2nd arg matrix elements are not of equal BASEB-bit word length";
+	    quit "mul_loop: 2nd arg matrix elements are not of "
+	         "equal BASEB-bit word length";
 	}
     }
 
@@ -142,7 +168,7 @@ define mul_loop(repeat, x)
  *	len	length in BASEB-bit words to multiply
  *
  * return:
- *	ratio of (1st / 2nd) algorithm rate
+ *	ratio of (1st / 2nd) algorithm rate.
  *
  * When want to determine a rate to a precision of 1 part in 1000.
  * Most systems today return CPU time to at least 10 msec precision.
@@ -165,6 +191,7 @@ define mul_ratio(len)
     local tover;		/* est of time for loop overhead */
     local alg1_rate;		/* loop rate of 1st algorithm */
     local alg2_rate;		/* loop rate of 2nd algorithm */
+    local ret;			/* return ratio, or 1.0 */
     local i;
 
     /*
@@ -217,12 +244,12 @@ define mul_ratio(len)
      * determine the 1st algorithm rate
      */
     loops = max(1, ceil(loops * test_time / tlen));
-    if (loops < 8) {
+    if (loops < 16) {
 	if (config("user_debug") > 1) {
-	    printf("    we must expand loop test time to more than %d secs\n",
-		ceil(test_time * (8 / loops)));
+	    printf("    we must expand alg1 loop test time to about %d secs\n",
+		ceil(test_time * (16 / loops)));
 	}
-	loops = 8;
+	loops = 16;
     }
     if (config("user_debug") > 3) {
 	printf("\t    will try alg1 %d loops\n", loops);
@@ -263,12 +290,12 @@ define mul_ratio(len)
      * determine the 2nd algorithm rate
      */
     loops = max(1, ceil(loops * test_time / tlen));
-    if (loops < 8) {
+    if (loops < 16) {
 	if (config("user_debug") > 1) {
-	    printf("    we must expand loop test time to more than %d secs\n",
-		ceil(test_time * (8 / loops)));
+	    printf("    we must expand alg2 loop test time to about %d secs\n",
+		ceil(test_time * (16 / loops)));
 	}
-	loops = 8;
+	loops = 16;
     }
     tlen = mul_loop(loops, &x);
     if (config("user_debug") > 3) {
@@ -297,7 +324,12 @@ define mul_ratio(len)
     /*
      * return alg1 / alg2 rate ratio
      */
-    return (alg1_rate / alg2_rate);
+    ret = alg1_rate / alg2_rate;
+    if (config("user_debug") > 2) {
+	printf("\tprecise ratio is: %.f mul_ratio will return: %.3f\n",
+		alg1_rate / alg2_rate, ret);
+    }
+    return ret;
 }
 
 
@@ -319,30 +351,40 @@ define best_mul2()
 {
     local ratio;	/* previously calculated alg1/alg2 ratio */
     local low;		/* low loop value tested */
-    local high;		/* low loop value tested */
+    local high;		/* high loop value tested */
+    local mid;		/* between low and high */
+    local best_val;	/* value found with ratio closest to unity */
+    local best_ratio;	/* cloest ratio found to unity */
     local expand;	/* how fast to expand the length */
 
     /*
      * setup
      */
-    test_time = 15.0;
-    if (config("user_debug") > 0) {
-	printf("will start with loop test time of %d secs\n", test_time);
+    printf("WARNING: This tool may not be computing the correct best value\n");
+    test_time = 5.0;
+    printf("The best_mul2() function will take a LONG time to run!\n");
+    printf("It is important that best_mul2() run on an othwewise idle host!\n");
+    if (config("user_debug") <= 0) {
+	printf("To monitor progress, set user_debug to 2: "
+	       "config(\"user_debug\", 2)\n");
     }
+    printf("Starting with loop test time of %d secs\n", test_time);
 
     /*
      * firewall - must have a >1 ratio for the initial length
      */
-    high = 16;
+    high = 8;
+    best_val = high;
     if (config("user_debug") > 0) {
 	printf("testing multiply alg1/alg2 ratio for len = %d\n", high);
     }
     ratio = mul_ratio(high);
+    best_ratio = ratio;
     if (config("user_debug") > 1) {
-	printf("    multiply alg1/alg2 ratio = %.3f\n", ratio);
+	printf("    multiply alg1/alg2 ratio = %.6f\n", ratio);
     }
-    if (ratio <= 1.0) {
-	quit "best_mul2: tests imply config(\"mul2\") should be < 4";
+    if (ratio < 1.0) {
+	quit "best_mul2: tests imply mul2 should be < 16, which seems bogus";
     }
 
     /*
@@ -355,7 +397,7 @@ define best_mul2()
 	 * We will multiplicatively expand our test level until
 	 * the ratio drops below 1.0.
 	 */
-	expand = ((ratio >= 3.5) ? 16 : 2^round(ratio));
+	expand = 2;
 	low = high;
 	high *= expand;
 	if (config("user_debug") > 1) {
@@ -367,19 +409,63 @@ define best_mul2()
 	 * determine the alg1/alg2 test ratio for this new length
 	 */
 	if (high >= 2^31) {
-	    quit "best_mul2: tests imply config(\"mul2\") should be >= 2^31";
+	    quit "best_mul2: test implies mul2 >= 2^31, which seems bogus";
 	}
 	if (config("user_debug") > 0) {
 	    printf("testing multiply alg1/alg2 ratio for len = %d\n", high);
 	}
 	ratio = mul_ratio(high);
-	if (config("user_debug") > 1) {
-	    printf("    multiply alg1/alg2 ratio = %.3f\n", ratio);
+	if (abs(ratio - 1.0) < abs(best_ratio - 1.0)) {
+	    best_val = high;
+	    best_ratio = ratio;
+	    if (config("user_debug") > 1) {
+		printf("    len %d has a new cloest ratio to unity: %.6f\n",
+		       best_val, best_ratio);
+	    }
 	}
-    } while (ratio >= 1.0);
+	if (config("user_debug") > 1) {
+	    printf("    multiply alg1/alg2 ratio = %.6f\n", ratio);
+	}
+    } while (ratio > 1.0);
+
+    /*
+     * If we previously expanded more than by a factor of 2, then
+     * we may have jumped over the crossover point.  So now
+     * drop down powers of two until the ratio is again >= 1.0
+     */
+    if (expand > 2) {
+	do {
+
+	    /*
+	     * contract by 2
+	     */
+	    high /= 2;
+	    low = high / 2;
+	    if (config("user_debug") > 0) {
+		printf("retesting multiply alg1/alg2 ratio for len = %d\n",
+		       high);
+	    }
+	    ratio = mul_ratio(high);
+	    if (abs(ratio - 1.0) < abs(best_ratio - 1.0)) {
+		best_val = high;
+		best_ratio = ratio;
+		if (config("user_debug") > 1) {
+		    printf("    len %d has a new cloest ratio to unity: %.6f\n",
+			   best_val, best_ratio);
+		}
+	    }
+	    if (config("user_debug") > 1) {
+		printf("    multiply alg1/alg2 ratio = %.6f\n", ratio);
+	    }
+
+	} while (ratio <= 1.0);
+
+	/* now that the ratio flipped again, use the previous range */
+	low = high;
+	high = high * 2;
+    }
     if (config("user_debug") > 0) {
-	printf("alg1/alg2 ratio now < 1.0, starting binary search between %d and %d\n",
-	    low, high);
+	printf("Starting binary search between %d and %d\n", low, high);
     }
 
     /*
@@ -388,30 +474,54 @@ define best_mul2()
     while (low+1 < high) {
 
     	/* try the mid-point */
+	mid = int((low+high)/2);
 	if (config("user_debug") > 0) {
-	    printf("testing multiply alg1/alg2 ratio for len = %d\n",
-	    	int((low+high)/2));
+	    printf("testing multiply alg1/alg2 ratio for len = %d\n", mid);
+	}
+	ratio = mul_ratio(mid);
+	if (abs(ratio - 1.0) < abs(best_ratio - 1.0)) {
+	    best_val = mid;
+	    best_ratio = ratio;
+	    if (config("user_debug") > 1) {
+		printf("    len %d has a new cloest ratio to unity: %.6f\n",
+		       best_val, best_ratio);
+	    }
 	}
-	ratio = mul_ratio(int((low+high)/2));
 	if (config("user_debug") > 1) {
-	    printf("    multiply alg1/alg2 ratio = %.3f\n", ratio);
+	    printf("    len %d multiply alg1/alg2 ratio = %.6f\n", mid, ratio);
+	}
+
+	/* stop search if near unity */
+	if (close_to_one(ratio)) {
+	    low = mid;
+	    high = mid;
+	    if (config("user_debug") > 0) {
+	    	printf("\twe are close enough to unity ratio at: %d\n", mid);
+	    }
+	    break;
 	}
 
 	/* bump lower range up if we went over */
-	if (ratio >= 1.0) {
+	if (ratio > 1.0) {
 	    if (config("user_debug") > 2) {
 	    	printf("\tmove low from %d up to %d\n",
-		    low, int((low+high)/2));
+		    low, mid);
 	    }
-	    low = int((low+high)/2);
+	    low = mid;
 
 	/* drop higher range down if we went under */
 	} else {
 	    if (config("user_debug") > 2) {
 	    	printf("\tmove high from %d down to %d\n",
-		     high, int((low+high)/2));
+		     high, mid);
 	    }
-	    high = int((low+high)/2);
+	    high = mid;
+	}
+
+	/* report on test loop progress */
+	if (config("user_debug") > 1) {
+	    printf("\tsetting low: %d high: %d diff: %d\n",
+	    	   low, high, high-low);
 	}
     }
 
@@ -419,10 +529,15 @@ define best_mul2()
      * return on the suggested config("mul2") value
      */
     if (config("user_debug") > 0) {
-	printf("best value of config(\"mul2\") is %d\n",
-	    (ratio >= 1.0) ? high : low);
+	printf("Best value for multiply is near %d\n", best_val);
+	printf("Best multiply alg1/alg2 ratio is: %.6f\n", best_ratio);
+	printf("We suggest placing this line in your .calcrc:\n");
+	printf("config(\"mul2\", %d),;\n", best_val);
+	printf("WARNING: It is believed that the output "
+	       "of this resource file is bogus!\n");
+	printf("WARNING: You may NOT wish to follow the above suggeston.\n");
     }
-    return ((ratio >= 1.0) ? high : low);
+    return mid;
 }
 
 
@@ -472,7 +587,8 @@ define sq_loop(repeat, x)
     len = sizeof((*x)[0]) / baseb_bytes;
     for (i=1; i < 4; ++i) {
 	if ((sizeof((*x)[i]) / baseb_bytes) != len) {
-	    quit "sq_loop: 2nd arg matrix elements are not of equal BASEB-bit word length";
+	    quit "sq_loop: 2nd arg matrix elements are not of equal "
+	         "BASEB-bit word length";
 	}
     }
 
@@ -559,6 +675,7 @@ define sq_ratio(len)
     local tover;		/* est of time for loop overhead */
     local alg1_rate;		/* loop rate of 1st algorithm */
     local alg2_rate;		/* loop rate of 2nd algorithm */
+    local ret;			/* return ratio, or 1.0 */
     local i;
 
     /*
@@ -611,12 +728,12 @@ define sq_ratio(len)
      * determine the 1st algorithm rate
      */
     loops = max(1, ceil(loops * test_time / tlen));
-    if (loops < 8) {
+    if (loops < 16) {
 	if (config("user_debug") > 1) {
-	    printf("    we must expand loop test time to more than %d secs\n",
-		ceil(test_time * (8 / loops)));
+	    printf("    we must expand alg1 loop test time to about %d secs\n",
+		ceil(test_time * (16 / loops)));
 	}
-	loops = 8;
+	loops = 16;
     }
     tlen = sq_loop(loops, &x);
     if (config("user_debug") > 3) {
@@ -654,12 +771,12 @@ define sq_ratio(len)
      * determine the 2nd algorithm rate
      */
     loops = max(1, ceil(loops * test_time / tlen));
-    if (loops < 8) {
+    if (loops < 16) {
 	if (config("user_debug") > 1) {
-	    printf("    we must expand loop test time to more than %d secs\n",
-		ceil(test_time * (8 / loops)));
+	    printf("    we must expand alg2 loop test time to about %d secs\n",
+		ceil(test_time * (16 / loops)));
 	}
-	loops = 8;
+	loops = 16;
     }
     tlen = sq_loop(loops, &x);
     if (config("user_debug") > 3) {
@@ -688,7 +805,12 @@ define sq_ratio(len)
     /*
      * return alg1 / alg2 rate ratio
      */
-    return (alg1_rate / alg2_rate);
+    ret = alg1_rate / alg2_rate;
+    if (config("user_debug") > 2) {
+	printf("\tprecise ratio is: %.f sq_ratio will return: %.3f\n",
+		alg1_rate / alg2_rate, ret);
+    }
+    return ret;
 }
 
 
@@ -710,30 +832,40 @@ define best_sq2()
 {
     local ratio;	/* previously calculated alg1/alg2 ratio */
     local low;		/* low loop value tested */
-    local high;		/* low loop value tested */
+    local high;		/* high loop value tested */
+    local mid;		/* between low and high */
+    local best_val;	/* value found with ratio closest to unity */
+    local best_ratio;	/* cloest ratio found to unity */
     local expand;	/* how fast to expand the length */
 
     /*
      * setup
      */
-    test_time = 15.0;
-    if (config("user_debug") > 0) {
-	printf("will start with loop test time of %d secs\n", test_time);
+    printf("WARNING: This tool may not be computing the correct best value\n");
+    test_time = 5.0;
+    printf("The best_sq2() function will take a LONG time to run!\n");
+    printf("It is important that best_sq2() run on an othwewise idle host!\n");
+    if (config("user_debug") <= 0) {
+	printf("To monitor progress, set user_debug to 2: "
+	       "config(\"user_debug\", 2)\n");
     }
+    printf("Starting with loop test time of %d secs\n", test_time);
 
     /*
      * firewall - must have a >1 ratio for the initial length
      */
-    high = 16;
+    high = 8;
+    best_val = high;
     if (config("user_debug") > 0) {
 	printf("testing square alg1/alg2 ratio for len = %d\n", high);
     }
     ratio = sq_ratio(high);
+    best_ratio = ratio;
     if (config("user_debug") > 1) {
 	printf("    square alg1/alg2 ratio = %.3f\n", ratio);
     }
-    if (ratio <= 1.0) {
-	quit "best_sq2: tests imply config(\"sq2\") should be < 4";
+    if (ratio < 1.0) {
+	quit "best_sq2: test implies sq2 < 16, which seems bogus";
     }
 
     /*
@@ -746,31 +878,75 @@ define best_sq2()
 	 * We will multiplicatively expand our test level until
 	 * the ratio drops below 1.0.
 	 */
-	expand = ((ratio >= 3.5) ? 16 : 2^round(ratio));
+	expand = 2;
 	low = high;
 	high *= expand;
 	if (config("user_debug") > 1) {
 	    printf("    expand the next test range by a factor of %d\n",
-	           expand);
+	    	   expand);
 	}
 
 	/*
 	 * determine the alg1/alg2 test ratio for this new length
 	 */
 	if (high >= 2^31) {
-	    quit "best_sq2: tests imply config(\"sq2\") should be >= 2^31";
+	    quit "best_sq2: tests imply sq2 >= 2^31, which seems bogus";
 	}
 	if (config("user_debug") > 0) {
 	    printf("testing square alg1/alg2 ratio for len = %d\n", high);
 	}
 	ratio = sq_ratio(high);
+	if (abs(ratio - 1.0) < abs(best_ratio - 1.0)) {
+	    best_val = high;
+	    best_ratio = ratio;
+	    if (config("user_debug") > 1) {
+		printf("    len %d has a new cloest ratio to unity: %.6f\n",
+		       best_val, best_ratio);
+	    }
+	}
 	if (config("user_debug") > 1) {
 	    printf("    square alg1/alg2 ratio = %.3f\n", ratio);
 	}
-    } while (ratio >= 1.0);
+    } while (ratio > 1.0);
+
+    /*
+     * If we previously expanded more than by a factor of 2, then
+     * we may have jumped over the crossover point.  So now
+     * drop down powers of two until the ratio is again >= 1.0
+     */
+    if (expand > 2) {
+	do {
+
+	    /*
+	     * contract by 2
+	     */
+	    high /= 2;
+	    low = high / 2;
+	    if (config("user_debug") > 0) {
+		printf("retesting multiply alg1/alg2 ratio for len = %d\n",
+		       high);
+	    }
+	    ratio = mul_ratio(high);
+	    if (abs(ratio - 1.0) < abs(best_ratio - 1.0)) {
+		best_val = high;
+		best_ratio = ratio;
+		if (config("user_debug") > 1) {
+		    printf("    len %d has a new cloest ratio to unity: %.6f\n",
+			   best_val, best_ratio);
+		}
+	    }
+	    if (config("user_debug") > 1) {
+		printf("    multiply alg1/alg2 ratio = %.6f\n", ratio);
+	    }
+
+	} while (ratio <= 1.0);
+
+	/* now that the ratio flipped again, use the previous range */
+	low = high;
+	high = high * 2;
+    }
     if (config("user_debug") > 0) {
-	printf("alg1/alg2 ratio now < 1.0, starting binary search between %d and %d\n",
-	    low, high);
+	printf("Starting binary search between %d and %d\n", low, high);
     }
 
     /*
@@ -779,41 +955,71 @@ define best_sq2()
     while (low+1 < high) {
 
     	/* try the mid-point */
+	mid = int((low+high)/2);
 	if (config("user_debug") > 0) {
-	    printf("testing square alg1/alg2 ratio for len = %d\n",
-	    	int((low+high)/2));
+	    printf("testing square alg1/alg2 ratio for len = %d\n", mid);
+	}
+	ratio = sq_ratio(mid);
+	if (abs(ratio - 1.0) < abs(best_ratio - 1.0)) {
+	    best_val = mid;
+	    best_ratio = ratio;
+	    if (config("user_debug") > 1) {
+		printf("    len %d has a new cloest ratio to unity: %.6f\n",
+		       best_val, best_ratio);
+	    }
 	}
-	ratio = sq_ratio(int((low+high)/2));
 	if (config("user_debug") > 1) {
-	    printf("    square alg1/alg2 ratio = %.3f\n", ratio);
+	    printf("    len %d square alg1/alg2 ratio = %.6f\n", mid, ratio);
+	}
+
+	/* stop search if near unity */
+	if (close_to_one(ratio)) {
+	    low = mid;
+	    high = mid;
+	    if (config("user_debug") > 0) {
+	    	printf("\twe are close enough to unity ratio at: %d\n", mid);
+	    }
+	    break;
 	}
 
 	/* bump lower range up if we went over */
-	if (ratio >= 1.0) {
+	if (ratio > 1.0) {
 	    if (config("user_debug") > 2) {
 	    	printf("\tmove low from %d up to %d\n",
-		    low, int((low+high)/2));
+		    low, mid);
 	    }
-	    low = int((low+high)/2);
+	    low = mid;
 
 	/* drop higher range down if we went under */
 	} else {
 	    if (config("user_debug") > 2) {
 	    	printf("\tmove high from %d down to %d\n",
-		     high, int((low+high)/2));
+		     high, mid);
 	    }
-	    high = int((low+high)/2);
+	    high = mid;
+	}
+
+	/* report on test loop progress */
+	if (config("user_debug") > 1) {
+	    printf("\tsetting low: %d high: %d diff: %d\n",
+	    	   low, high, high-low);
 	}
     }
 
     /*
      * return on the suggested config("sq2") value
      */
+    mid = int((low+high)/2);
     if (config("user_debug") > 0) {
-	printf("best value of config(\"sq2\") is %d\n",
-	    (ratio >= 1.0) ? high : low);
+	printf("Best value for square is near %d\n", best_val);
+	printf("Best square alg1/alg2 ratio is: %.6f\n", best_ratio);
+	printf("We suggest placing this line in your .calcrc:\n");
+	printf("config(\"sq2\", %d),;\n", best_val);
+	printf("WARNING: It is believed that the output "
+	       "of this resource file is bogus!\n");
+	printf("WARNING: You may NOT wish to follow the above suggeston.\n");
     }
-    return ((ratio >= 1.0) ? high : low);
+    return mid;
 }
 
 
@@ -866,7 +1072,8 @@ define pow_loop(repeat, x, ex)
     len = sizeof((*x)[0]) / baseb_bytes;
     for (i=1; i < 4; ++i) {
 	if ((sizeof((*x)[i]) / baseb_bytes) != len) {
-	    quit "pow_loop: 2nd arg matrix elements are not of equal BASEB-bit word length";
+	    quit "pow_loop: 2nd arg matrix elements are not of "
+	         "equal BASEB-bit word length";
 	}
     }
     if (!isint(ex) || ex < 3) {
@@ -963,6 +1170,7 @@ define pow_ratio(len)
     local alg1_rate;		/* loop rate of 1st algorithm */
     local alg2_rate;		/* loop rate of 2nd algorithm */
     local ex;			/* exponent to use in pow_loop() */
+    local ret;			/* return ratio, or 1.0 */
     local i;
 
     /*
@@ -985,7 +1193,7 @@ define pow_ratio(len)
     /*
      * setup
      */
-    ex = 5;
+    ex = 7;
 
     /*
      * initialize x, the values we will pmod
@@ -1021,12 +1229,12 @@ define pow_ratio(len)
      * determine the 1st algorithm rate
      */
     loops = max(1, ceil(loops * test_time / tlen));
-    if (loops < 8) {
+    if (loops < 16) {
 	if (config("user_debug") > 1) {
-	    printf("    we must expand loop test time to more than %d secs\n",
-		ceil(test_time * (8 / loops)));
+	    printf("    we must expand alg1 loop test time to about %d secs\n",
+		ceil(test_time * (16 / loops)));
 	}
-	loops = 8;
+	loops = 16;
     }
     tlen = pow_loop(loops, &x, ex);
     if (config("user_debug") > 3) {
@@ -1065,12 +1273,12 @@ define pow_ratio(len)
      * determine the 2nd algorithm rate
      */
     loops = max(1, ceil(loops * test_time / tlen));
-    if (loops < 8) {
+    if (loops < 16) {
 	if (config("user_debug") > 1) {
-	    printf("    we must expand loop test time to more than %d secs\n",
-		ceil(test_time * (8 / loops)));
+	    printf("    we must expand alg2 loop test time to about %d secs\n",
+		ceil(test_time * (16 / loops)));
 	}
-	loops = 8;
+	loops = 16;
     }
     tlen = pow_loop(loops, &x, ex);
     if (config("user_debug") > 3) {
@@ -1099,7 +1307,12 @@ define pow_ratio(len)
     /*
      * return alg1 / alg2 rate ratio
      */
-    return (alg1_rate / alg2_rate);
+    ret = alg1_rate / alg2_rate;
+    if (config("user_debug") > 2) {
+	printf("\tprecise ratio is: %.f pow_ratio will return: %.3f\n",
+		alg1_rate / alg2_rate, ret);
+    }
+    return ret;
 }
 
 
@@ -1121,17 +1334,25 @@ define best_pow2()
 {
     local ratio;	/* previously calculated alg1/alg2 ratio */
     local low;		/* low loop value tested */
-    local high;		/* low loop value tested */
+    local high;		/* high loop value tested */
+    local mid;		/* between low and high */
+    local best_val;	/* value found with ratio closest to unity */
+    local best_ratio;	/* cloest ratio found to unity */
     local expand;	/* how fast to expand the length */
     local looped;	/* 1 ==> we have expanded lengths before */
 
     /*
      * setup
      */
-    test_time = 15.0;
-    if (config("user_debug") > 0) {
-	printf("will start with loop test time of %d secs\n", test_time);
+    printf("WARNING: This tool may not be computing the correct best value\n");
+    test_time = 60.0;
+    printf("The best_pow2() function will take a LONG time to run!\n");
+    printf("It is important that best_pow2() run on an othwewise idle host!\n");
+    if (config("user_debug") <= 0) {
+	printf("To monitor progress, set user_debug to 2: "
+	       "config(\"user_debug\", 2)\n");
     }
+    printf("Starting with loop test time of %d secs\n", test_time);
 
     /*
      * firewall - must have a >1.02 ratio for the initial length
@@ -1142,16 +1363,27 @@ define best_pow2()
      */
     low = 4;
     high = 4;
+    best_val = high;
+    best_ratio = 1e10;	/* not a real value */
     do {
 	high *= 4;
 	if (config("user_debug") > 0) {
 	    printf("testing pmod alg1/alg2 ratio for len = %d\n", high);
 	}
 	ratio = pow_ratio(high);
+	if (abs(ratio - 1.0) < abs(best_ratio - 1.0)) {
+	    best_val = high;
+	    best_ratio = ratio;
+	    if (config("user_debug") > 1) {
+		printf("    len %d has a new cloest ratio to unity: %.6f\n",
+		       best_val, best_ratio);
+	    }
+	}
 	if (config("user_debug") > 1) {
 	    printf("    pmod alg1/alg2 ratio = %.3f\n", ratio);
 	    if (ratio > 1.0 && ratio <= 1.02) {
-	    printf("    while alg1 is slightly better than alg2, it is not clearly better\n");
+	    printf("    while alg1 is slightly better than alg2, "
+	    	   "it is not clearly better\n");
 	    }
 	}
     } while (ratio <= 1.02);
@@ -1193,20 +1425,27 @@ define best_pow2()
 	 * determine the alg1/alg2 test ratio for this new length
 	 */
 	if (high >= 2^31) {
-	    quit "best_pow2: tests imply config(\"pow2\") should be >= 2^31";
+	    quit "best_pow2: test implies pow2 >= 2^31, which seems bogus";
 	}
 	if (config("user_debug") > 0) {
 	    printf("testing pmod alg1/alg2 ratio for len = %d\n", high);
 	}
 	ratio = pow_ratio(high);
+	if (abs(ratio - 1.0) < abs(best_ratio - 1.0)) {
+	    best_val = high;
+	    best_ratio = ratio;
+	    if (config("user_debug") > 1) {
+		printf("    len %d has a new cloest ratio to unity: %.6f\n",
+		       best_val, best_ratio);
+	    }
+	}
 	if (config("user_debug") > 1) {
-	    printf("    pmod alg1/alg2 ratio = %.3f\n", ratio);
+	    printf("    pmod alg1/alg2 ratio = %.6f\n", ratio);
 	}
 	looped = 1;
-    } while (ratio >= 1.0);
+    } while (ratio > 1.0);
     if (config("user_debug") > 0) {
-	printf("alg1/alg2 ratio now < 1.0, starting binary search between %d and %d\n",
-	    low, high);
+	printf("Starting binary search between %d and %d\n", low, high);
     }
 
     /*
@@ -1215,39 +1454,69 @@ define best_pow2()
     while (low+1 < high) {
 
     	/* try the mid-point */
+	mid = int((low+high)/2);
 	if (config("user_debug") > 0) {
-	    printf("testing pmod alg1/alg2 ratio for len = %d\n",
-	    	int((low+high)/2));
+	    printf("testing pow2 alg1/alg2 ratio for len = %d\n", mid);
+	}
+	ratio = pow_ratio(mid);
+	if (abs(ratio - 1.0) < abs(best_ratio - 1.0)) {
+	    best_val = mid;
+	    best_ratio = ratio;
+	    if (config("user_debug") > 1) {
+		printf("    len %d has a new cloest ratio to unity: %.6f\n",
+		       best_val, best_ratio);
+	    }
 	}
-	ratio = pow_ratio(int((low+high)/2));
 	if (config("user_debug") > 1) {
-	    printf("    pmod alg1/alg2 ratio = %.3f\n", ratio);
+	    printf("    len %d pmod alg1/alg2 ratio = %.6f\n", mid, ratio);
+	}
+
+	/* stop search if near unity */
+	if (close_to_one(ratio)) {
+	    low = mid;
+	    high = mid;
+	    if (config("user_debug") > 0) {
+	    	printf("\twe are close enough to unity ratio at: %d\n", mid);
+	    }
+	    break;
 	}
 
 	/* bump lower range up if we went over */
-	if (ratio >= 1.0) {
+	if (ratio > 1.0) {
 	    if (config("user_debug") > 2) {
 	    	printf("\tmove low from %d up to %d\n",
-		    low, int((low+high)/2));
+		    low, mid);
 	    }
-	    low = int((low+high)/2);
+	    low = mid;
 
 	/* drop higher range down if we went under */
 	} else {
 	    if (config("user_debug") > 2) {
 	    	printf("\tmove high from %d down to %d\n",
-		     high, int((low+high)/2));
+		     high, mid);
 	    }
-	    high = int((low+high)/2);
+	    high = mid;
+	}
+
+	/* report on test loop progress */
+	if (config("user_debug") > 1) {
+	    printf("\tsetting low: %d high: %d diff: %d\n",
+	    	   low, high, high-low);
 	}
     }
 
     /*
      * return on the suggested config("pow2") value
      */
+    mid = int((low+high)/2);
     if (config("user_debug") > 0) {
-	printf("best value of config(\"pow2\") is %d\n",
-	    (ratio >= 1.0) ? high : low);
+	printf("Best value for pmod is near %d\n", best_val);
+	printf("Best pmod alg1/alg2 ratio is: %.6f\n", best_ratio);
+	printf("We suggest placing this line in your .calcrc:\n");
+	printf("config(\"pow2\", %d),;\n", best_val);
+	printf("WARNING: It is believed that the output "
+	       "of this resource file is bogus!\n");
+	printf("WARNING: You may NOT wish to follow the above suggeston.\n");
     }
-    return ((ratio >= 1.0) ? high : low);
+    return mid;
 }

cal/beer.cal

@@ -17,10 +17,6 @@
  * 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: beer.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/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

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

cal/bigprime.cal

@@ -17,10 +17,6 @@
  * 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: bigprime.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/bigprime.cal,v $
- *
  * Under source code control:	1991/05/22 21:56:32
  * File existed as early as:	1991
  *

cal/bindings

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

cal/chi.cal

@@ -17,10 +17,6 @@
  * 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: chi.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/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

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

cal/deg.cal

@@ -17,10 +17,6 @@
  * 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: deg.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/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 +24,9 @@
  */
 
 
-obj dms {deg, min, sec};
+obj deg {deg, min, sec};
 
-define dms(deg, min, sec)
+define deg(deg, min, sec)
 {
 	local ans;
 
@@ -38,18 +34,18 @@ define dms(deg, min, sec)
 		sec = 0;
 	if (isnull(min))
 		min = 0;
-	obj dms ans;
+	obj deg ans;
 	ans.deg = deg;
 	ans.min = min;
 	ans.sec = sec;
-	fixdms(ans);
+	fixdeg(ans);
 	return ans;
 }
 
 
-define dms_add(a, b)
+define deg_add(a, b)
 {
-	local obj dms	ans;
+	local obj deg	ans;
 
 	ans.deg = 0;
 	ans.min = 0;
@@ -66,14 +62,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 +78,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 +99,24 @@ define dms_mul(a, b)
 		ans.min = b.min * a;
 		ans.sec = b.sec * a;
 	}
-	fixdms(ans);
+	fixdeg(ans);
 	return ans;
 }
 
 
-define dms_print(a)
+define deg_print(a)
 {
 	print a.deg : 'd' : a.min : 'm' : a.sec : 's' :;
 }
 
 
-define dms_abs(a)
+define deg_abs(a)
 {
 	return a.deg + a.min / 60 + a.sec / 3600;
 }
 
 
-define fixdms(a)
+define fixdeg(a)
 {
 	a.min += frac(a.deg) * 60;
 	a.deg = int(a.deg);
@@ -134,5 +130,5 @@ define fixdms(a)
 }
 
 if (config("resource_debug") & 3) {
-    print "obj dms {deg, min, sec} defined";
+    print "obj deg {deg, min, sec} defined";
 }

cal/dms.cal

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

cal/dotest.cal

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

cal/ellip.cal

@@ -17,10 +17,6 @@
  * 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: ellip.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/ellip.cal,v $
- *
  * Under source code control:	1990/02/15 01:50:33
  * File existed as early as:	before 1990
  *

cal/factorial.cal

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

cal/factorial2.cal

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

cal/gvec.cal

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

cal/hello.cal

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

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

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

cal/linear.cal

@@ -17,10 +17,6 @@
  * 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/cmd/calc/cal/RCS/linear.cal,v $
- *
  * Under source code control:	2005/12/12 06:41:50
  * File existed as early as:	2005
  *

cal/lnseries.cal

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

cal/lucas_chk.cal

@@ -17,10 +17,6 @@
  * 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: 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 $
- *
  * Under source code control:	1991/01/11 05:41:43
  * File existed as early as:	1991
  *

cal/lucas_tbl.cal

@@ -1,165 +0,0 @@
-/*
- * lucas_tbl - lucasian criteria for primality tables
- *
- * Copyright (C) 1999  Landon Curt Noll
- *
- * Calc is open software; you can redistribute it and/or modify it under
- * the terms of the version 2.1 of the GNU Lesser General Public License
- * as published by the Free Software Foundation.
- *
- * Calc is distributed in the hope that it will be useful, but WITHOUT
- * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
- * or FITNESS FOR A PARTICULAR PURPOSE.	 See the GNU Lesser General
- * Public License for more details.
- *
- * A copy of version 2.1 of the GNU Lesser General Public License is
- * distributed with calc under the filename COPYING-LGPL.  You should have
- * received a copy with calc; if not, write to Free Software Foundation, Inc.
- * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
- *
- * @(#) $Revision: 30.1 $
- * @(#) $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 $
- *
- * Under source code control:	1991/01/26 02:43:43
- * File existed as early as:	1991
- *
- * chongo <was here> /\oo/\	http://www.isthe.com/chongo/
- * Share and enjoy!  :-)	http://www.isthe.com/chongo/tech/comp/calc/
- */
-
-/*
- * Lucasian criteria for primality
- *
- * The following table is taken from:
- *
- *	"Lucasian Criteria for the Primality of N=h*2^n-1", by Hans Riesel,
- *	Mathematics of Computation, Vol 23 #108, p 872.
- *
- * The index of the *_val[] arrays correspond to the v(1) values found
- * in the table.  That is, for v(1) == x:
- *
- *	D == d_val[x]
- *	a == a_val[x]
- *	b == b_val[x]
- *	r == r_val[x]		(r == abs(a^2 - b^2*D))
- *
- *
- * Note that when *_val[i] is not a number, the related v(1) value
- * is not found in Table 1.
- */
-
-
-trymax = 100;
-mat d_val[trymax+1];
-mat a_val[trymax+1];
-mat b_val[trymax+1];
-mat r_val[trymax+1];
-/* v1= 0	    INVALID */
-/* v1= 1	    INVALID */
-/* v1= 2	    INVALID */
-d_val[ 3]=   5;	 a_val[ 3]= 1;	b_val[ 3]=1;  r_val[ 3]=4;
-d_val[ 4]=   3;	 a_val[ 4]= 1;	b_val[ 4]=1;  r_val[ 4]=2;
-d_val[ 5]=  21;	 a_val[ 5]= 3;	b_val[ 5]=1;  r_val[ 5]=12;
-d_val[ 6]=   2;	 a_val[ 6]= 1;	b_val[ 6]=1;  r_val[ 6]=1;
-/* v1= 7	    INVALID */
-d_val[ 8]=  15;	 a_val[ 8]= 3;	b_val[ 8]=1;  r_val[ 8]=6;
-d_val[ 9]=  77;	 a_val[ 9]= 7;	b_val[ 9]=1;  r_val[ 9]=28;
-d_val[10]=   6;	 a_val[10]= 2;	b_val[10]=1;  r_val[10]=2;
-d_val[11]=  13;	 a_val[11]= 3;	b_val[11]=1;  r_val[11]=4;
-d_val[12]=  35;	 a_val[12]= 5;	b_val[12]=1;  r_val[12]=10;
-d_val[13]= 165;	 a_val[13]=11;	b_val[13]=1;  r_val[13]=44;
-/* v1=14	    INVALID */
-d_val[15]= 221;	 a_val[15]=13;	b_val[15]=1;  r_val[15]=52;
-d_val[16]=   7;	 a_val[16]= 3;	b_val[16]=1;  r_val[16]=2;
-d_val[17]= 285;	 a_val[17]=15;	b_val[17]=1;  r_val[17]=60;
-/* v1=18	    INVALID */
-d_val[19]= 357;	 a_val[19]=17;	b_val[19]=1;  r_val[19]=68;
-d_val[20]=  11;	 a_val[20]= 3;	b_val[20]=1;  r_val[20]=2;
-d_val[21]= 437;	 a_val[21]=19;	b_val[21]=1;  r_val[21]=76;
-d_val[22]=  30;	 a_val[22]= 5;	b_val[22]=1;  r_val[22]=5;
-/* v1=23	    INVALID */
-d_val[24]= 143;	 a_val[24]=11;	b_val[24]=1;  r_val[24]=22;
-d_val[25]=  69;	 a_val[25]= 9;	b_val[25]=1;  r_val[25]=12;
-d_val[26]=  42;	 a_val[26]= 6;	b_val[26]=1;  r_val[26]=6;
-d_val[27]=  29;	 a_val[27]= 5;	b_val[27]=1;  r_val[27]=4;
-d_val[28]= 195;	 a_val[28]=13;	b_val[28]=1;  r_val[28]=26;
-d_val[29]=  93;	 a_val[29]= 9;	b_val[29]=1;  r_val[29]=12;
-d_val[30]=  14;	 a_val[30]= 4;	b_val[30]=1;  r_val[30]=2;
-d_val[31]= 957;	 a_val[31]=29;	b_val[31]=1;  r_val[31]=116;
-d_val[32]= 255;	 a_val[32]=15;	b_val[32]=1;  r_val[32]=30;
-d_val[33]=1085;	 a_val[33]=31;	b_val[33]=1;  r_val[33]=124;
-/* v1=34	    INVALID */
-d_val[35]=1221;	 a_val[35]=33;	b_val[35]=1;  r_val[35]=132;
-d_val[36]= 323;	 a_val[36]=17;	b_val[36]=1;  r_val[36]=34;
-d_val[37]=1365;	 a_val[37]=35;	b_val[37]=1;  r_val[37]=140;
-d_val[38]=  10;	 a_val[38]= 3;	b_val[38]=1;  r_val[38]=1;
-d_val[39]=1517;	 a_val[39]=37;	b_val[39]=1;  r_val[39]=148;
-d_val[40]= 399;	 a_val[40]=19;	b_val[40]=1;  r_val[40]=38;
-d_val[41]=1677;	 a_val[41]=39;	b_val[41]=1;  r_val[41]=156;
-d_val[42]= 110;	 a_val[42]=10;	b_val[42]=1;  r_val[42]=10;
-d_val[43]= 205;	 a_val[43]=15;	b_val[43]=1;  r_val[43]=20;
-d_val[44]= 483;	 a_val[44]=21;	b_val[44]=1;  r_val[44]=42;
-d_val[45]=2021;	 a_val[45]=43;	b_val[45]=1;  r_val[45]=172;
-d_val[46]=  33;	 a_val[46]= 6;	b_val[46]=1;  r_val[46]=3;
-/* v1=47	    INVALID */
-d_val[48]=  23;	 a_val[48]= 5;	b_val[48]=1;  r_val[48]=2;
-d_val[49]=2397;	 a_val[49]=47;	b_val[49]=1;  r_val[49]=188;
-d_val[50]=  39;	 a_val[50]= 6;	b_val[50]=1;  r_val[50]=3;
-d_val[51]=  53;	 a_val[51]= 7;	b_val[51]=1;  r_val[51]=4;
-/* v1=52	    INVALID */
-d_val[53]=2805;	 a_val[53]=51;	b_val[53]=1;  r_val[53]=204;
-d_val[54]= 182;	 a_val[54]=13;	b_val[54]=1;  r_val[54]=13;
-d_val[55]=3021;	 a_val[55]=53;	b_val[55]=1;  r_val[55]=212;
-d_val[56]=  87;	 a_val[56]= 9;	b_val[56]=1;  r_val[56]=6;
-d_val[57]=3245;	 a_val[57]=55;	b_val[57]=1;  r_val[57]=220;
-d_val[58]= 210;	 a_val[58]=14;	b_val[58]=1;  r_val[58]=14;
-d_val[59]=3477;	 a_val[59]=57;	b_val[59]=1;  r_val[59]=228;
-d_val[60]= 899;	 a_val[60]=29;	b_val[60]=1;  r_val[60]=58;
-d_val[61]= 413;	 a_val[61]=21;	b_val[61]=1;  r_val[61]=28;
-/* v1=62	    INVALID */
-d_val[63]=3965;	 a_val[63]=61;	b_val[63]=1;  r_val[63]=244;
-d_val[64]=1023;	 a_val[64]=31;	b_val[64]=1;  r_val[64]=62;
-d_val[65]= 469;	 a_val[65]=21;	b_val[65]=1;  r_val[65]=28;
-d_val[66]=  17;	 a_val[66]= 4;	b_val[66]=1;  r_val[66]=1;
-d_val[67]=4485;	 a_val[67]=65;	b_val[67]=1;  r_val[67]=260;
-d_val[68]=1155;	 a_val[68]=33;	b_val[68]=1;  r_val[68]=66;
-d_val[69]=4757;	 a_val[69]=67;	b_val[69]=1;  r_val[69]=268;
-d_val[70]=  34;	 a_val[70]= 6;	b_val[70]=1;  r_val[70]=2;
-d_val[71]=5037;	 a_val[71]=69;	b_val[71]=1;  r_val[71]=276;
-d_val[72]=1295;	 a_val[72]=35;	b_val[72]=1;  r_val[72]=70;
-d_val[73]= 213;	 a_val[73]=15;	b_val[73]=1;  r_val[73]=12;
-d_val[74]=  38;	 a_val[74]= 6;	b_val[74]=1;  r_val[74]=2;
-d_val[75]=5621;	 a_val[75]=73;	b_val[75]=1;  r_val[75]=292;
-d_val[76]=1443;	 a_val[76]=37;	b_val[76]=1;  r_val[76]=74;
-d_val[77]= 237;	 a_val[77]=15;	b_val[77]=1;  r_val[77]=12;
-d_val[78]=  95;	 a_val[78]=10;	b_val[78]=1;  r_val[78]=5;
-/* v1=79	    INVALID */
-d_val[80]=1599;	 a_val[80]=39;	b_val[80]=1;  r_val[80]=78;
-d_val[81]=6557;	 a_val[81]=79;	b_val[81]=1;  r_val[81]=316;
-d_val[82]= 105;	 a_val[82]=10;	b_val[82]=1;  r_val[82]=5;
-d_val[83]=  85;	 a_val[83]= 9;	b_val[83]=1;  r_val[83]=4;
-d_val[84]=1763;	 a_val[84]=41;	b_val[84]=1;  r_val[84]=82;
-d_val[85]=7221;	 a_val[85]=83;	b_val[85]=1;  r_val[85]=332;
-d_val[86]= 462;	 a_val[86]=21;	b_val[86]=1;  r_val[86]=21;
-d_val[87]=7565;	 a_val[87]=85;	b_val[87]=1;  r_val[87]=340;
-d_val[88]= 215;	 a_val[88]=15;	b_val[88]=1;  r_val[88]=10;
-d_val[89]=7917;	 a_val[89]=87;	b_val[89]=1;  r_val[89]=348;
-d_val[90]= 506;	 a_val[90]=22;	b_val[90]=1;  r_val[90]=22;
-d_val[91]=8277;	 a_val[91]=89;	b_val[91]=1;  r_val[91]=356;
-d_val[92]= 235;	 a_val[92]=15;	b_val[92]=1;  r_val[92]=10;
-d_val[93]=8645;	 a_val[93]=91;	b_val[93]=1;  r_val[93]=364;
-d_val[94]= 138;	 a_val[94]=12;	b_val[94]=1;  r_val[94]=6;
-d_val[95]=9021;	 a_val[95]=93;	b_val[95]=1;  r_val[95]=372;
-d_val[96]=  47;	 a_val[96]= 7;	b_val[96]=1;  r_val[96]=2;
-d_val[97]=1045;	 a_val[97]=33;	b_val[97]=1;  r_val[97]=44;
-/* v1=98	    INVALID */
-d_val[99]=9797;	 a_val[99]=97;	b_val[99]=1;  r_val[99]=388;
-d_val[100]=  51; a_val[100]= 7; b_val[100]=1; r_val[100]=2;
-
-if (config("resource_debug") & 3) {
-    print "d_val[100] defined";
-    print "a_val[100] defined";
-    print "b_val[100] defined";
-    print "r_val[100] defined";
-}

cal/mersenne.cal

@@ -19,10 +19,6 @@
  * 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: mersenne.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/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

@@ -17,10 +17,6 @@
  * 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: mfactor.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/mfactor.cal,v $
- *
  * Under source code control:	1996/07/06 06:09:40
  * File existed as early as:	1996
  *

cal/mod.cal

@@ -17,10 +17,6 @@
  * 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: mod.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/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

@@ -17,10 +17,6 @@
  * 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: natnumset.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/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

@@ -17,10 +17,6 @@
  * 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: pell.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/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

@@ -17,10 +17,6 @@
  * 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: pi.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/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

@@ -17,10 +17,6 @@
  * 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: pix.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/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

@@ -17,10 +17,6 @@
  * 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: pollard.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/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

@@ -17,10 +17,6 @@
  * 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: poly.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/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

@@ -17,10 +17,6 @@
  * 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: prompt.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/prompt.cal,v $
- *
  * Under source code control:	1995/12/18 04:43:25
  * File existed as early as:	1995
  *

cal/psqrt.cal

@@ -17,10 +17,6 @@
  * 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: psqrt.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/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

@@ -20,10 +20,6 @@
  * 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: qtime.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/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

@@ -17,10 +17,6 @@
  * 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: quat.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/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 +51,8 @@ define quat(a,b,c,d)
 
 define quat_print(a)
 {
-	print "quat(" : a.s : ", " : a.v[0] : ", " : a.v[1] : ", " : a.v[2] : ")" :;
+	print "quat(" : a.s : ", " : a.v[0] : ", " :
+	      a.v[1] : ", " : a.v[2] : ")" :;
 }
 
 

cal/randbitrun.cal

@@ -17,10 +17,6 @@
  * 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: randbitrun.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/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

@@ -17,10 +17,6 @@
  * 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: randmprime.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/randmprime.cal,v $
- *
  * Under source code control:	1994/03/14 23:11:21
  * File existed as early as:	1994
  *

cal/randombitrun.cal

@@ -17,10 +17,6 @@
  * 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: randombitrun.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/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

@@ -17,10 +17,6 @@
  * 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: randomrun.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/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

@@ -17,10 +17,6 @@
  * 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: randrun.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/randrun.cal,v $
- *
  * Under source code control:	1995/02/12 20:00:06
  * File existed as early as:	1995
  *

cal/regress.cal

@@ -1,7 +1,7 @@
 /*
  * regress - calc regression and correctness test suite
  *
- * Copyright (C) 1999-2006  David I. Bell and Landon Curt Noll
+ * Copyright (C) 1999-2017  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
@@ -17,10 +17,6 @@
  * 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.5 $
- * @(#) $Id: regress.cal,v 30.5 2008/10/24 07:09:41 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/regress.cal,v $
- *
  * Under source code control:	1990/02/15 01:50:36
  * File existed as early as:	before 1990
  *
@@ -403,14 +399,14 @@ define test_config()
 					'512: config("trace") == 0');
 	vrfy(config("maxprint") == 16,
 					'513: config("maxprint") == 16');
-	vrfy(config("mul2") == 1780,
-					'514: config("mul2") == 1780');
-	vrfy(config("sq2") == 3388,
-					'515: config("sq2") == 3388');
-	vrfy(config("pow2") == 176,
-					'516: config("pow2") == 176');
-	vrfy(config("redc2") == 220,
-					'517: config("redc2") == 220');
+	vrfy(config("mul2") == 28,
+					'514: config("mul2") == 28');
+	vrfy(config("sq2") == 28,
+					'515: config("sq2") == 28');
+	vrfy(config("pow2") == 20,
+					'516: config("pow2") == 20');
+	vrfy(config("redc2") == 25,
+					'517: config("redc2") == 25');
 	vrfy(config("tilde"),
 					'518: config("tilde")');
 	vrfy(config("tab"),
@@ -768,6 +764,8 @@ print '016: parsed test_bignums()';
 
 /*
  * Test many of the built-in functions.
+ *
+ * See test_functionss() starting at test 9000 for more built-in function tests.
  */
 define test_functions()
 {
@@ -1397,7 +1395,8 @@ define test_functions()
 	vrfy(quomod(10,-3,a,b,12) == 1, '1193: vrfy(quomod(10,-3,a,b,12) == 1');
 	vrfy(a == -3,			'1194: a == -3');
 	vrfy(b == 1,			'1195: b == 1');
-	vrfy(quomod(-10,-3,a,b,13) == 1,'1196: vrfy(quomod(-10,-3,a,b,13) == 1');
+	vrfy(quomod(-10,-3,a,b,13) == 1,
+	    '1196: vrfy(quomod(-10,-3,a,b,13) == 1');
 	vrfy(a == 4,			'1197: a == 4');
 	vrfy(b == 2,			'1198: b == 2');
 	vrfy(quomod(10,3,a,b,14) == 1,	'1199: vrfy(quomod(10,3,a,b,14) == 1');
@@ -1444,7 +1443,12 @@ define test_functions()
 	vrfy(jacobi(-1,-1) == 0,	'1236: jacobi(-1,-1) == 0');
 	vrfy(jacobi(0,-1) == 0,		'1237: jacobi(0,-1) == 0');
 
-	print '1238: Ending test_functions';
+	/*
+	 * NOTE: Function tests are continued in test_functionss()
+	 *	 starting at test 9000.
+	 */
+
+	print '1293: Ending test_functions';
 }
 print '017: parsed test_functions()';
 
@@ -1461,14 +1465,14 @@ define _test_underscore()
 	local _a = 27;
 	local __a = 23209;
 
-	print "1290: Beginning _test_underscore";
+	print "1294: Beginning _test_underscore";
 
-	vrfy(_a == 27,			    '1291: _a == 27');
-	vrfy(_ == 49,			    '1292: _ == 49');
-	vrfy(__ == 63,			    '1293: __ == 63');
-	vrfy(__a == 23209,		    '1294: __a == 23209');
+	vrfy(_a == 27,			    '1295: _a == 27');
+	vrfy(_ == 49,			    '1296: _ == 49');
+	vrfy(__ == 63,			    '1297: __ == 63');
+	vrfy(__a == 23209,		    '1298: __a == 23209');
 
-	print "1295: Ending _test_underscore";
+	print "1299: Ending _test_underscore";
 }
 print '020: parsed _test_underscore';
 
@@ -1509,8 +1513,10 @@ define test_assoc()
 	vrfy(isnull(search(a,16)),	'1312: isnull(search(a,16))');
 	a["curds","whey"] = "spider";
 	print				'1313: a["curds","whey"] = "spider"';
-	vrfy(a["curds","whey"] == "spider", '1314: a["curds","whey"] == "spider"');
-	vrfy(a[[rsearch(a,"spider")]] == "spider", '1315: a[[rsearch(a,"spider")]] == "spider"');
+	vrfy(a["curds","whey"] == "spider",
+		'1314: a["curds","whey"] == "spider"');
+	vrfy(a[[rsearch(a,"spider")]] == "spider",
+		'1315: a[[rsearch(a,"spider")]] == "spider"');
 	b = a;
 	print				'1316: b = a';
 	vrfy(b[17] == 19,		'1317: b[17] == 19');
@@ -3221,9 +3227,9 @@ define test_error()
 
 	print '3600: Beginning test_error';
 
-	/* bump ecnt up by 148 */
-	ecnt += 148;
-	print				'3601: ecnt += 148';
+	/* bump ecnt up by 156 */
+	ecnt += 156;
+	print				'3601: ecnt += 156';
 
 	strx = "x";
 	print				'3602: strx = "x"';
@@ -3412,11 +3418,15 @@ define test_error()
 	n = 8191;
 	print				'3727: n = 8191';
 	/* test 3728 removed due to non-portable strerror() output */
+	vrfy(tan(2e9i) == error(10435),	'3729: tan(2e9i) == error(10435)');
+	vrfy(cot(2e9i) == error(10437),	'3730: cot(2e9i) == error(10437)');
+	vrfy(sec(2e9i) == error(10439),	'3731: sec(2e9i) == error(10439)');
+	vrfy(csc(2e9i) == error(10440),	'3732: csc(2e9i) == error(10440)');
 
 	/* errmax and errcount should be bumped up the 148 errors above */
-	vrfy(errcount() == ecnt,	'3729: errcount() == ecnt');
+	vrfy(errcount() == ecnt,	'3733: errcount() == ecnt');
 
-	print '3730: Ending test_error';
+	print '3734: Ending test_error';
 }
 print '054: parsed test_error()';
 
@@ -4096,38 +4106,46 @@ define test_strprintf()
 			'4821: strprintf("%b", 27/29) == "0b11011/0b11101"');
 	vrfy(strprintf("%e", 12345) == "~1.23e4",
 			'4822: strprintf("%e", 12345) == "~1.23e4"');
+	vrfy(strprintf("%g", .385) == "~.38",
+			'4823: strprintf("%g", .385) == "~.38"');
+	vrfy(strprintf("%g", 385) == "~3.8e2",
+			'4824: strprintf("%g", 385) == "~3.8e2"');
 
 	/* mode tests with tilde == 0 */
 	c = config("tilde", 0);
-	print		'4823: c = config("tilde", 0)';
+	print		'4825: c = config("tilde", 0)';
 	vrfy(strprintf("%e", 12345) == "1.23e4",
-			'4824: strprintf("%e", 12345) == "1.23e4"');
+			'4826: strprintf("%e", 12345) == "1.23e4"');
 	vrfy(strprintf("%.3e", 12345) == "1.234e4",
-			'4825: strprintf("%.3e", 12345) == "1.234e4"');
+			'4827: strprintf("%.3e", 12345) == "1.234e4"');
 	vrfy(strprintf("%e", .00012345) == "1.23e-4",
-			'4826: strprintf("%e", .00012345) == "1.23e-4"');
+			'4828: strprintf("%e", .00012345) == "1.23e-4"');
 	vrfy(strprintf("%d %d", 27) == "27 ",
-			'4827: strprintf("%d %d", 27) == "27 "');
+			'4829: strprintf("%d %d", 27) == "27 "');
 	vrfy(strprintf("%d", 27, 29) == "27",
-			'4828: strprintf("%d", 27, 29) == "27"');
+			'4830: strprintf("%d", 27, 29) == "27"');
 	vrfy(strprintf("%r = %f", 27/29, 27/29) == "27/29 = .93",
-		'4829: strprintf("%r = %f", 27/29, 27/29) == "27/29 = .93"');
+		'4831: strprintf("%r = %f", 27/29, 27/29) == "27/29 = .93"');
 	vrfy(strprintf("%s", "abc") == "abc",
-		'4830: strprintf("%s", "abc") == "abc"');
+		'4832: strprintf("%s", "abc") == "abc"');
 	vrfy(strprintf("%f", "abc") == "abc",
-		'4831: strprintf("%f", "abc") == "abc"');
+		'4833: strprintf("%f", "abc") == "abc"');
 	vrfy(strprintf("%e", "abc") == "abc",
-		'4832: strprintf("%e", "abc") == "abc"');
+		'4834: strprintf("%e", "abc") == "abc"');
 	vrfy(strprintf("%5s", "abc") == "  abc",
-		'4833: strprintf("%5s", "abc") == "  abc"');
+		'4835: strprintf("%5s", "abc") == "  abc"');
 	vrfy(strprintf("%-5s", "abc") == "abc  ",
-		'4834: strprintf("%-5s", "abc") == "abc	 "');
+		'4836: strprintf("%-5s", "abc") == "abc	 "');
+	vrfy(strprintf("%g", .385) == ".38",
+			'4837: strprintf("%g", .385) == ".38"');
+	vrfy(strprintf("%g", 385) == "3.8e2",
+			'4838: strprintf("%g", 385) == "3.8e2"');
 
 	/* restore config */
 	c = config("all", callcfg);
-	print				    '4835: c = config("all", callcfg)';
+	print				    '4839: c = config("all", callcfg)';
 
-	print '4836: Ending test_strprintf';
+	print '4840: Ending test_strprintf';
 }
 print '088: parsed test_fileop()';
 
@@ -4892,7 +4910,8 @@ define test_newsyn()
 		vrfy(s5500 == 55,		  '5510: s5500 == 45');
 		vrfy(i == 11,		  '5511: i == 11');
 	}
-	print "5512: { local i; for (s5500 = 0, i = 0; i < 10; i++) s5500 += i; ... }";
+	print "5512: { local i; for (s5500 = 0, i = 0; i < 10; i++) ":
+	      "s5500 += i; ... }";
 	vrfy(s5500 == 55,			  '5513: s5500 == 55');
 	vrfy(i == 11,			  '5514: i == 11');
 
@@ -5027,7 +5046,7 @@ vrfy(i == 9,		'151: i == 9');
 
 
 /*
- * test_commaeq - test changes to , and =
+ * test_commaeq - test changes to = and ,
  */
 obj xx5600 {} xx5600;
 print '152: obj xx5600 {} xx5600';
@@ -6506,7 +6525,8 @@ define test_blk()
 	/* A second named block */
 
 	B1 = blk("+++6700", 15, 10) = {1,2,3,4,5};
-	print				  '6746: B1 = blk("+++6700", 15 , 10) = {1,2,3,4,5};';
+	print
+	    '6746: B1 = blk("+++6700", 15 , 10) = {1,2,3,4,5};';
 	vrfy(size(B1) == 15,		  '6747: size(B1) == 15');
 	vrfy(sizeof(B1) == 20,		  '6748: sizeof(B1) == 20');
 	vrfy(test(B1) == 1,		  '6749: test(B1) == 1');
@@ -6871,7 +6891,8 @@ define test_sha1()
 
 
 	z = sha1(list(1,2,3), "curds and whey", 2^21701-1, pi(1e-100));
-	print '7210: z = sha1(list(1,2,3), "curds and whey", 2^21701-1, pi(1e-100));';
+	print '7210: z = sha1(list(1,2,3), "curds and whey",',
+	      '2^21701-1, pi(1e-100));';
 	vrfy(sha1(z) == 0x158cc87deeb9dd478ca14e3ab359205b0fb15b83,
 		'7211: sha1(z) == 0x158cc87deeb9dd478ca14e3ab359205b0fb15b83');
 
@@ -7914,6 +7935,137 @@ return test_exponentiation();
 /* 88xx: test exponentiation */
 
 
+/*
+ * calc resource functions by Christoph Zurnieden
+ */
+print;
+print '8900: Starting test of calc resource functions by Christoph Zurnieden';
+print '8901: read -once "test8900"';
+read -once "test8900";
+print '8902: about to run test8900(1,,8903)';
+testnum = test8900(1,,8903);
+print '8999: ecnt = 211;'
+ecnt = 211;
+/* 89xx: test calc resource functions by Christoph Zurnieden */
+
+
+/*
+ * Test more of the built-in functions.
+ *
+ * See test_functions() (test 700 - 1238) for other built-in function tests.
+ */
+define test_functions2()
+{
+	print '9001: Beginning test_functions2';
+
+	/* ctype function tests */
+	vrfy(isalnum("A") == 1,		'9002: isalnum("A") == 1');
+	vrfy(isalnum("a") == 1,		'9003: isalnum("a") == 1');
+	vrfy(isalnum("2") == 1,		'9004: isalnum("2") == 1');
+	vrfy(isalnum("\t") == 0,	'9005: isalnum("\\t") == 0');
+
+	vrfy(isalpha("A") == 1,		'9006: isalpha("A") == 1');
+	vrfy(isalpha("a") == 1,		'9007: isalpha("a") == 1');
+	vrfy(isalpha("2") == 0,		'9008: isalpha("2") == 0');
+	vrfy(isalpha("\t") == 0,	'9009: isalpha("\\t") == 0');
+
+	vrfy(iscntrl("A") == 0,		'9010: iscntrl("A") == 0');
+	vrfy(iscntrl("a") == 0,		'9011: iscntrl("a") == 0');
+	vrfy(iscntrl("2") == 0,		'9012: iscntrl("2") == 0');
+	vrfy(iscntrl("\t") == 1,	'9013: iscntrl("\\t") == 1');
+
+	vrfy(isdigit("A") == 0,		'9014: isdigit("A") == 0');
+	vrfy(isdigit("a") == 0,		'9015: isdigit("a") == 0');
+	vrfy(isdigit("2") == 1,		'9016: isdigit("2") == 1');
+	vrfy(isdigit("\t") == 0,	'9017: isdigit("\\t") == 0');
+
+	vrfy(isgraph("A") == 1,		'9018: isgraph("A") == 1');
+	vrfy(isgraph("a") == 1,		'9019: isgraph("a") == 1');
+	vrfy(isgraph("2") == 1,		'9020: isgraph("2") == 1');
+	vrfy(isgraph("\t") == 0,	'9021: isgraph("\\t") == 0');
+
+	vrfy(islower("A") == 0,		'9022: islower("A") == 0');
+	vrfy(islower("a") == 1,		'9023: islower("a") == 1');
+	vrfy(islower("1") == 0,		'9024: islower("1") == 0');
+
+	vrfy(isprint("A") == 1,		'9025: isprint("A") == 1');
+	vrfy(isprint("a") == 1,		'9026: isprint("a") == 1');
+	vrfy(isprint(" ") == 1,		'9027: isprint(" ") == 1');
+	vrfy(isprint("\t") == 0,	'9028: isprint("\\t") == 0');
+
+	vrfy(ispunct("A") == 0,		'9029: ispunct("A") == 0');
+	vrfy(ispunct("a") == 0,		'9030: ispunct("a") == 0');
+	vrfy(ispunct(" ") == 0,		'9031: ispunct(" ") == 0');
+	vrfy(ispunct("?") == 1,		'9032: ispunct("?") == 1');
+
+	vrfy(isspace("A") == 0,		'9033: isspace("A") == 0');
+	vrfy(isspace("Krik") == 0,	'9034: isspace("Krik") == 0');
+	vrfy(isspace(" ") == 1,		'9035: isspace(" ") == 1');
+	vrfy(isspace("?") == 0,		'9036: isspace("?") == 0');
+
+	vrfy(isupper("A") == 1,		'9037: isupper("A") == 1');
+	vrfy(isupper("a") == 0,		'9038: isupper("a") == 0');
+	vrfy(isupper("1") == 0,		'9039: isupper("1") == 0');
+
+	vrfy(isxdigit("A") == 1,	'9040: isxdigit("A") == 1');
+	vrfy(isxdigit("f") == 1,	'9041: isxdigit("f") == 1');
+	vrfy(isxdigit("2") == 1,	'9042: isxdigit("2") == 1');
+	vrfy(isxdigit("x") == 0,	'9043: isxdigit("x") == 0');
+
+	vrfy(strcasecmp("ab", "aBc") == -1,
+			     '9044: strcasecmp("ab", "aBc") == -1');
+	vrfy(strcasecmp("abc", "aBb") == 1,
+			     '9045: strcasecmp("abc", "aBb") == 1');
+	vrfy(strcasecmp("abc", "abc") == 0,
+			     '9046: strcasecmp("abc", "abc") == 0');
+	vrfy(strcasecmp("abc", "aBc") == 0,
+			     '9047: strcasecmp("abc", "aBc") == 0');
+	vrfy(strcasecmp("abc", "aBd") == -1,
+			     '9048: strcasecmp("abc", "aBd") == -1');
+	vrfy(strcasecmp("abc\0", "aBc") == 1,
+			     '9049: strcasecmp("a8c\\0", "aBc") == 1');
+	vrfy(strcasecmp("a\0b", "A\0c") == -1,
+			     '9050: strcasecmp("a\\0b", "A\\0c") == -1');
+
+	vrfy(strncasecmp("abc", "xyz", 0) == 0,
+			     '9051: strncasecmp("abc", "xyz", 0) == 0');
+	vrfy(strncasecmp("abc", "xyz", 1) == -1,
+			     '9052: strncasecmp("abc", "xyz", 1) == -1');
+	vrfy(strncasecmp("abc", "", 1) == 1,
+			     '9053: strncasecmp("abc", "", 1) == 1');
+	vrfy(strncasecmp("a", "b", 2) == -1,
+			     '9054: strncasecmp("a", "b", 2) == -1');
+	vrfy(strncasecmp("ab", "Ac", 2) == -1,
+			     '9055: strncasecmp("ab", "Ac", 2) == -1');
+	vrfy(strncasecmp("\0ac", "\0b", 2) == -1,
+			     '9056: strncasecmp("\\0ac", "\\0b", 2) == -1');
+	vrfy(strncasecmp("ab", "aBc", 2) == 0,
+			     '9057: strncasecmp("ab", "aBc", 2) == 0');
+	vrfy(strncasecmp("abc", "abd", 2) == 0,
+			     '9058: strncasecmp("abc", "abd", 2) == 0');
+
+	local s1 = " gnu lesser general public license";
+	print '9059: local s1 = " gnu lesser general public license";';
+
+	vrfy(strcmp(strtolower(" GNU Lesser General Public License"), s1) == 0,
+	    '9060: strcmp(strtolower(" GNU Lesser General Public License"),' +
+	    ' s1) == 0');
+
+	local s2 = " GNU LESSER GENERAL PUBLIC LICENSE";
+	print '9061: local s2 = " GNU LESSER GENERAL PUBLIC LICENSE";';
+
+	vrfy(strcmp(strtoupper(" GNU Lesser General Public License"), s2) == 0,
+	    '9062: strcmp(strtoupper(" GNU Lesser General Public License"),' +
+	    ' s2) == 0');
+
+	print '9063: Ending test_functions2';
+}
+print;
+print '9000: parsed test_functions2()';
+print;
+return test_functions2();
+
+
 /*
  * read various calc resource files
  *
@@ -7924,7 +8076,6 @@ return test_exponentiation();
  *	hello.cal	- designed to go into an infinite loop
  *	lucal.cal	- already read by this file
  *	lucas_chk.cal	- already read by this file
- *	lucas_tbl.cal	- duplicatres code already read by another file
  *	regress.cal	- this file
  *	surd.cal	- already read by this file
  *	test9999.cal	- files of this form are already read by this file
@@ -7997,8 +8148,6 @@ read -once intfile;
 print	'9830: read -once intfile';
 read -once lucas;
 print	'9831: read -once lucas';
-read -once lucas_tbl;
-print	'9832: read -once lucas_tbl';
 read -once natnumset;
 print	'9833: read -once natnumset';
 read -once repeat;
@@ -8012,7 +8161,11 @@ print	'9838: skipping read -once hello.cal because it is an infinite loop';
 print	'9839: skipping read -once xx_print.cal because it is a printing demo';
 read -once sumtimes;
 print	'9840: read -once sumtimes';
-print	'9841: Ending read of selected calc resource files';
+read -once dms;
+print	'9841: read -once dms';
+read -once hms;
+print	'9842: read -once hms';
+print	'9843: Ending read of selected calc resource files';
 
 
 /*

cal/repeat.cal

@@ -17,10 +17,6 @@
  * 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: repeat.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/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,10 +15,6 @@
  * NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR  IN
  * CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *
- * @(#) $Revision: 30.2 $
- * @(#) $Id: screen.cal,v 30.2 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/screen.cal,v $
- *
  * This file is not covered under version 2.1 of the GNU LGPL.
  *
  * Under source code control:	2006/03/08 05:54:09

cal/seedrandom.cal

@@ -17,10 +17,6 @@
  * 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: seedrandom.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/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

@@ -17,10 +17,6 @@
  * received a copy with calc; if not, write to Free Software Foundation, Inc.
  * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *
- * @(#) $Revision: 30.1 $
- * @(#) $Id: set8700.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/set8700.cal,v $
- *
  * Under source code control:	2006/05/20 14:10:11
  * File existed as early as:	2006
  *

cal/set8700.line

@@ -17,10 +17,6 @@
 ## received a copy with calc; if not, write to Free Software Foundation, Inc.
 ## 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 ##
-## @(#) $Revision: 30.1 $
-## @(#) $Id: set8700.line,v 30.1 2007/03/16 11:09:54 chongo Exp $
-## @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/set8700.line,v $
-##
 ## Under source code control:	2006/05/20 14:10:11
 ## File existed as early as:	2006
 ##

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

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

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

@@ -17,10 +17,6 @@
  * 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: sumsq.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/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

@@ -17,10 +17,6 @@
  * 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/cmd/calc/cal/RCS/sumtimes.cal,v $
- *
  * Under source code control:	2006/06/22 17:29
  * File existed as early as:	2006
  *

cal/surd.cal

@@ -17,10 +17,6 @@
  * 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: surd.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/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

@@ -17,10 +17,6 @@
  * 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: test1700.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/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

@@ -17,10 +17,6 @@
  * 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: test2300.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/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

@@ -19,10 +19,6 @@
  * 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: test2600.cal,v 30.2 2007/07/11 22:57:23 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test2600.cal,v $
- *
  * Under source code control:	1995/10/13 00:13:14
  * File existed as early as:	1995
  *
@@ -91,7 +87,8 @@ define testismult(str, n, verbose)
 		if (!ismult(c,a)) {
 			m++;
 			if (verbose > 1) {
-				printf("*** Failure with:\na = %d\nb = %d\n", a,b);
+				printf("*** Failure with:\na = %d\nb = %d\n",
+				       a,b);
 			}
 		}
 	}
@@ -133,7 +130,8 @@ define testsqrt(str, n, eps, verbose)
 		if (abs(c) > 1) {
 			m++;
 			if (verbose > 1) {
-				printf("*** Failure with:\na = %d\neps = %d\n", a,eps);
+				printf("*** Failure with:\na = %d\neps = %d\n",
+				       a,eps);
 			}
 		}
 	}
@@ -178,7 +176,8 @@ define testexp(str, n, eps, verbose)
 		if (abs(c) > 0.02) {
 			m++;
 			if (verbose > 1) {
-				printf("*** Failure with:\na = %d\neps = %d\n", a,eps);
+				printf("*** Failure with:\na = %d\neps = %d\n",
+				       a,eps);
 			}
 		}
 	}
@@ -235,7 +234,8 @@ define testln(str, n, eps, verbose)
 		if (abs(c) > 0.5) {
 			m++;
 			if (verbose > 1) {
-				printf("*** Failure with:\na = %d\neps = %d\n", a,eps);
+				printf("*** Failure with:\na = %d\neps = %d\n",
+				       a,eps);
 			}
 		}
 	}

cal/test2700.cal

@@ -19,10 +19,6 @@
  * 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: test2700.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test2700.cal,v $
- *
  * Under source code control:	1995/11/01 22:52:25
  * File existed as early as:	1995
  *
@@ -127,7 +123,8 @@ define testcsqrt(str, n, verbose)
 			if (p) {
 			if (verbose > 0)
 				printf(
-				 "*** Type %d failure for x = %r, y = %r, z = %d\n",
+				 "*** Type %d failure for x = %r, "
+				 "y = %r, z = %d\n",
 				    p, x, y, z);
 				m++;
 			}

cal/test3100.cal

@@ -19,10 +19,6 @@
  * 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: test3100.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/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

@@ -19,10 +19,6 @@
  * 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: test3300.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test3300.cal,v $
- *
  * Under source code control:	1995/12/02 04:27:41
  * File existed as early as:	1995
  *

cal/test3400.cal

@@ -19,10 +19,6 @@
  * 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: test3400.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test3400.cal,v $
- *
  * Under source code control:	1995/12/02 05:20:11
  * File existed as early as:	1995
  *

cal/test3500.cal

@@ -19,10 +19,6 @@
  * 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: test3500.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test3500.cal,v $
- *
  * Under source code control:	1995/12/18 22:50:46
  * File existed as early as:	1995
  *

cal/test4000.cal

@@ -19,10 +19,6 @@
  * 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: test4000.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test4000.cal,v $
- *
  * Under source code control:	1996/03/13 02:38:45
  * File existed as early as:	1996
  *
@@ -199,7 +195,8 @@ define ctimes(str, N, n, count, skip, verbose)
 		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++;
 			}
 		}
@@ -306,7 +303,8 @@ define ntimes(str, N, n, count, skip, residue, modulus, verbose)
 	}
 	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

@@ -19,10 +19,6 @@
  * 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: test4100.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test4100.cal,v $
- *
  * Under source code control:	1996/03/13 03:53:22
  * File existed as early as:	1996
  *

cal/test4600.cal

@@ -19,10 +19,6 @@
  * 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: test4600.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test4600.cal,v $
- *
  * Under source code control:	1996/07/02 20:04:40
  * File existed as early as:	1996
  *

cal/test5100.cal

@@ -19,10 +19,6 @@
  * 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: test5100.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test5100.cal,v $
- *
  * Under source code control:	1996/12/02 23:57:10
  * File existed as early as:	1996
  *

cal/test5200.cal

@@ -19,10 +19,6 @@
  * 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: test5200.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test5200.cal,v $
- *
  * Under source code control:	1997/02/07 02:48:10
  * File existed as early as:	1997
  *

cal/test8400.cal

@@ -17,10 +17,6 @@
  * 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: test8400.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/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

@@ -19,10 +19,6 @@
  * 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: test8500.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test8500.cal,v $
- *
  * Under source code control:	1999/11/12 20:59:59
  * File existed as early as:	1999
  *
@@ -134,8 +130,8 @@ define onetest_8500(a,b,rnd) {
  * The rounding parameter is randomly chosen.
  *
  * After a run of divmod_8500 the a, b, rnd values which gave failure are
- * stored in the list L_8500.  L_8500[0], L_8500[1], L_8500[2] are a, b, rnd for the first
- * test, etc.
+ * stored in the list L_8500.  L_8500[0], L_8500[1], L_8500[2] are a, b,
+ * rnd for the first* test, etc.
  */
 define divmod_8500(N = 10, M1 = 2^128, M2 = 2^64, testnum = 0)
 {

cal/test8600.cal

@@ -19,10 +19,6 @@
  * 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: test8600.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
- * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test8600.cal,v $
- *
  * Under source code control:	2000/12/04 19:57:02
  * File existed as early as:	2000
  *