diff --git a/BUGS b/BUGS index 491f1f4..2a2e6a0 100644 --- a/BUGS +++ b/BUGS @@ -147,7 +147,7 @@ mis-features in calc: ## ## @(#) $Revision: 30.2 $ ## @(#) $Id: BUGS,v 30.2 2013/08/11 01:09:27 chongo Exp $ -## @(#) $Source: /usr/local/src/cmd/calc/RCS/BUGS,v $ +## @(#) $Source: /usr/local/src/bin/calc/RCS/BUGS,v $ ## ## Under source code control: 1994/03/18 14:06:13 ## File existed as early as: 1994 diff --git a/CHANGES b/CHANGES index 854e0a5..6847249 100644 --- a/CHANGES +++ b/CHANGES @@ -17,7 +17,7 @@ The following are the changes from calc version 2.12.4.6 to date: Fixed typo in redeclaration warnings. Thanks to Christoph Zurnieden for this report. - Added a number of calc resource functions by + Added a number of calc resource files by Christoph Zurnieden including: bernpoly.cal - Computes the nth Bernoulli polynomial at z for any n,z @@ -31,15 +31,13 @@ The following are the changes from calc version 2.12.4.6 to date: toomcook.cal - Multiply by way of the Toom-Cook algorithm zeta2.cal - Calculate the value of the Hurwitz Zeta function + Fixed a makefile bug that prevented the those new calc resource + files from being installed. + Improved the formatting of the output from: help resource - Cleaned up old DOS-like CRLF line terminators in some - help files. Thanks goes to to Michael Somos - - for pointing this out. - We replaced COPYING-LGPL with the version that is found at http://www.gnu.org/licenses/lgpl-2.1.txt because that version contans some whitespace formatting cleanup. Otherwise the @@ -51,6 +49,18 @@ The following are the changes from calc version 2.12.4.6 to date: NOTE: Fixes to grammar, spelling and minor formatting problems are welcome. Please send us your patches! + With the exception of 3 source files, we became "picky" about + line lengths and other issues reported by the picky tool: + + cal/test8900.cal + cal/set8700.line + help/errorcodes.sed + + The above 3 files now pass picky -w (OK except for line length). + For more information about the picky tool, see: + + http://cis.csuohio.edu/~somos/picky.html + The following are the changes from calc version 2.12.4.3 to 2.12.4.5: @@ -6871,8 +6881,8 @@ Following is a list of visible changes to calc from version 1.24.7 to 1.26.1: ## 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.28 $ -## @(#) $Id: CHANGES,v 30.28 2013/08/11 01:18:56 chongo Exp chongo $ +## @(#) $Revision: 30.32 $ +## @(#) $Id: CHANGES,v 30.32 2013/08/11 09:10:11 chongo Exp $ ## @(#) $Source: /usr/local/src/bin/calc/RCS/CHANGES,v $ ## ## Under source code control: 1993/06/02 18:12:57 diff --git a/Makefile b/Makefile index 47a96d3..845031e 100644 --- a/Makefile +++ b/Makefile @@ -39,8 +39,8 @@ # received a copy with calc; if not, write to Free Software Foundation, Inc. # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. # -MAKEFILE_REV= $$Revision: 30.53 $$ -# @(#) $Id: Makefile.ship,v 30.53 2013/08/11 01:16:36 chongo Exp $ +MAKEFILE_REV= $$Revision: 30.54 $$ +# @(#) $Id: Makefile.ship,v 30.54 2013/08/11 05:40:18 chongo Exp $ # @(#) $Source: /usr/local/src/cmd/calc/RCS/Makefile.ship,v $ # # Under source code control: 1990/02/15 01:48:41 @@ -997,7 +997,7 @@ EXT= # The default calc versions # -VERSION= 2.12.4.9 +VERSION= 2.12.4.10 VERS= 2.12.4 VER= 2.12 VE= 2 @@ -2552,8 +2552,10 @@ have_fpos.h: have_fpos.c ${MAKE_FILE} ${Q} echo '' >> have_fpos.h ${Q} echo '/* do we have fgetpos & fsetpos functions? */' >> have_fpos.h ${Q} ${RM} -f have_fpos.o have_fpos${EXT} - -${Q} ${LCC} ${HAVE_FPOS} ${ICFLAGS} have_fpos.c -c >/dev/null 2>&1; ${TRUE} - -${Q} ${LCC} ${ILDFLAGS} have_fpos.o -o have_fpos${EXT} >/dev/null 2>&1; ${TRUE} + -${Q} ${LCC} ${HAVE_FPOS} ${ICFLAGS} have_fpos.c -c \ + >/dev/null 2>&1; ${TRUE} + -${Q} ${LCC} ${ILDFLAGS} have_fpos.o -o have_fpos${EXT} \ + >/dev/null 2>&1; ${TRUE} -${Q} ${SHELL} -c "./have_fpos${EXT} > fpos_tmp 2>/dev/null" \ >/dev/null 2>&1; ${TRUE} -${Q} if [ -s fpos_tmp ]; then \ @@ -2638,8 +2640,9 @@ fposval.h: fposval.c have_fpos.h have_fpos_pos.h have_offscl.h have_posscl.h \ ${Q} echo '/* what are our file position & size types? */' >> fposval.h ${Q} ${RM} -f fposval.o fposval${EXT} -${Q} ${LCC} ${ICFLAGS} ${FPOS_BITS} ${OFF_T_BITS} \ - ${DEV_BITS} ${INODE_BITS} fposval.c -c >/dev/null 2>&1; ${TRUE} - -${Q} ${LCC} ${ILDFLAGS} fposval.o -o fposval${EXT} >/dev/null 2>&1; ${TRUE} + ${DEV_BITS} ${INODE_BITS} fposval.c -c >/dev/null 2>&1; ${TRUE} + -${Q} ${LCC} ${ILDFLAGS} fposval.o -o fposval${EXT} >/dev/null \ + 2>&1; ${TRUE} ${Q} ${SHELL} -c "./fposval${EXT} fposv_tmp >> fposval.h 2>/dev/null" \ >/dev/null 2>&1; ${TRUE} ${Q} echo '' >> fposval.h @@ -2673,7 +2676,8 @@ have_const.h: have_const.c ${MAKE_FILE} ${Q} ${RM} -f have_const.o have_const${EXT} -${Q} ${LCC} ${ICFLAGS} ${HAVE_CONST} have_const.c -c \ >/dev/null 2>&1; ${TRUE} - -${Q} ${LCC} ${ILDFLAGS} have_const.o -o have_const${EXT} >/dev/null 2>&1; ${TRUE} + -${Q} ${LCC} ${ILDFLAGS} have_const.o -o have_const${EXT} \ + >/dev/null 2>&1; ${TRUE} -${Q} ${SHELL} -c "./have_const${EXT} > const_tmp 2>/dev/null" \ >/dev/null 2>&1; ${TRUE} -${Q} if [ -s const_tmp ]; then \ @@ -2807,7 +2811,8 @@ align32.h: align32.c longbits.h have_unistd.h ${MAKE_FILE} ${RM} -f align32.o align32${EXT}; \ ${LCC} ${ICFLAGS} ${ALIGN32} align32.c -c >/dev/null 2>&1; \ ${LCC} ${ILDFLAGS} align32.o -o align32${EXT} >/dev/null 2>&1; \ - ${SHELL} -c "./align32${EXT} >align32_tmp 2>/dev/null" >/dev/null 2>&1; \ + ${SHELL} -c \ + "./align32${EXT} >align32_tmp 2>/dev/null" >/dev/null 2>&1; \ if [ -s align32_tmp ]; then \ ${CAT} align32_tmp >> align32.h; \ else \ @@ -2848,7 +2853,8 @@ have_uid_t.h: have_uid_t.c have_unistd.h ${MAKE_FILE} ${Q} ${RM} -f have_uid_t.o have_uid_t${EXT} -${Q} ${LCC} ${ICFLAGS} ${HAVE_UID_T} have_uid_t.c -c \ >/dev/null 2>&1; ${TRUE} - -${Q} ${LCC} ${ILDFLAGS} have_uid_t.o -o have_uid_t${EXT} >/dev/null 2>&1; ${TRUE} + -${Q} ${LCC} ${ILDFLAGS} have_uid_t.o -o have_uid_t${EXT} \ + >/dev/null 2>&1; ${TRUE} -${Q} ${SHELL} -c "./have_uid_t${EXT} > uid_tmp 2>/dev/null" \ >/dev/null 2>&1; ${TRUE} -${Q} if [ -s uid_tmp ]; then \ @@ -3036,7 +3042,8 @@ have_getpgid.h: have_getpgid.c ${MAKE_FILE} ${Q} ${RM} -f getpgid_tmp have_getpgid.h ${Q} echo 'forming have_getpgid.h' ${Q} echo '/*' > have_getpgid.h - ${Q} echo ' * DO NOT EDIT -- generated by the Makefile' >> have_getpgid.h + ${Q} echo ' * DO NOT EDIT -- generated by the Makefile' >> \ + have_getpgid.h ${Q} echo ' */' >> have_getpgid.h ${Q} echo '' >> have_getpgid.h ${Q} echo '' >> have_getpgid.h @@ -3076,7 +3083,8 @@ have_gettime.h: have_gettime.c ${MAKE_FILE} ${Q} ${RM} -f gettime_tmp have_gettime.h ${Q} echo 'forming have_gettime.h' ${Q} echo '/*' > have_gettime.h - ${Q} echo ' * DO NOT EDIT -- generated by the Makefile' >> have_gettime.h + ${Q} echo ' * DO NOT EDIT -- generated by the Makefile' >> \ + have_gettime.h ${Q} echo ' */' >> have_gettime.h ${Q} echo '' >> have_gettime.h ${Q} echo '' >> have_gettime.h @@ -3116,7 +3124,8 @@ have_getprid.h: have_getprid.c ${MAKE_FILE} ${Q} ${RM} -f getprid_tmp have_getprid.h ${Q} echo 'forming have_getprid.h' ${Q} echo '/*' > have_getprid.h - ${Q} echo ' * DO NOT EDIT -- generated by the Makefile' >> have_getprid.h + ${Q} echo ' * DO NOT EDIT -- generated by the Makefile' >> \ + have_getprid.h ${Q} echo ' */' >> have_getprid.h ${Q} echo '' >> have_getprid.h ${Q} echo '' >> have_getprid.h @@ -3156,7 +3165,8 @@ have_urandom.h: ${MAKE_FILE} ${Q} ${RM} -f have_urandom.h ${Q} echo 'forming have_urandom.h' ${Q} echo '/*' > have_urandom.h - ${Q} echo ' * DO NOT EDIT -- generated by the Makefile' >> have_urandom.h + ${Q} echo ' * DO NOT EDIT -- generated by the Makefile' >> \ + have_urandom.h ${Q} echo ' */' >> have_urandom.h ${Q} echo '' >> have_urandom.h ${Q} echo '' >> have_urandom.h @@ -3192,7 +3202,8 @@ have_rusage.h: have_rusage.c ${MAKE_FILE} ${Q} ${RM} -f rusage_tmp have_rusage.h ${Q} echo 'forming have_rusage.h' ${Q} echo '/*' > have_rusage.h - ${Q} echo ' * DO NOT EDIT -- generated by the Makefile' >> have_rusage.h + ${Q} echo ' * DO NOT EDIT -- generated by the Makefile' >> \ + have_rusage.h ${Q} echo ' */' >> have_rusage.h ${Q} echo '' >> have_rusage.h ${Q} echo '' >> have_rusage.h @@ -3283,14 +3294,16 @@ args.h: have_stdvs.c have_varvs.c have_string.h have_unistd.h have_string.h ${Q} ${RM} -f have_stdvs.o have_stdvs${EXT} -${Q} ${LCC} ${ICFLAGS} ${HAVE_VSPRINTF} have_stdvs.c -c \ >/dev/null 2>&1; ${TRUE} - -${Q} ${LCC} ${ILDFLAGS} have_stdvs.o -o have_stdvs${EXT} >/dev/null 2>&1; ${TRUE} + -${Q} ${LCC} ${ILDFLAGS} have_stdvs.o -o have_stdvs${EXT} \ + >/dev/null 2>&1; ${TRUE} -${Q} if ./have_stdvs${EXT} >>args.h 2>/dev/null; then \ ${TOUCH} have_args.sh; \ else \ ${TRUE}; \ fi -${Q} if [ ! -f have_args.sh ] && [ X"${HAVE_VSPRINTF}" = X ]; then \ - ${RM} -f have_stdvs.o have_stdvs${EXT} have_varvs.o have_varvs${EXT}; \ + ${RM} -f have_stdvs.o have_stdvs${EXT} have_varvs.o; \ + ${RM} -f have_varvs${EXT}; \ ${LCC} ${ICFLAGS} ${HAVE_VSPRINTF} have_varvs.c -c \ 2>/dev/null; \ ${LCC} ${ILDFLAGS} have_varvs.o -o have_varvs${EXT} 2>/dev/null; \ @@ -3314,7 +3327,8 @@ args.h: have_stdvs.c have_varvs.c have_string.h have_unistd.h have_string.h ${Q} echo '' >> args.h ${Q} echo '' >> args.h ${Q} echo '#endif /* !__ARGS_H__ */' >> args.h - ${Q} ${RM} -f have_stdvs.o have_varvs.o have_varvs${EXT} have_args.sh core + ${Q} ${RM} -f have_stdvs.o have_varvs.o have_varvs${EXT} have_args.sh + ${Q} ${RM} -f core ${Q} echo 'args.h formed' -@if [ -z "${Q}" ]; then \ echo ''; \ @@ -3388,7 +3402,8 @@ no_implicit.arg: no_implicit.c ${MAKE_FILE} else \ ${LCC} -Wno-implicit ${ICFLAGS} -DHAVE_NO_IMPLICIT \ no_implicit.c -c >/dev/null 2>&1; \ - ${LCC} ${ILDFLAGS} no_implicit.o -o no_implicit${EXT} >/dev/null 2>&1; \ + ${LCC} ${ILDFLAGS} no_implicit.o -o no_implicit${EXT} \ + >/dev/null 2>&1; \ ${SHELL} -c "./no_implicit${EXT} > no_implicit.arg 2>/dev/null" \ >/dev/null 2>&1; ${TRUE}; \ fi @@ -3673,7 +3688,8 @@ depend: custom/Makefile hsrc ${Q} echo forming new ${MAKE_FILE} ${Q} ${RM} -f ${MAKE_FILE}.bak ${Q} ${MV} ${MAKE_FILE} ${MAKE_FILE}.bak - ${Q} ${SED} -n '1,/^# DO NOT DELETE THIS LINE/p' ${MAKE_FILE}.bak > ${MAKE_FILE} + ${Q} ${SED} -n '1,/^# DO NOT DELETE THIS LINE/p' \ + ${MAKE_FILE}.bak > ${MAKE_FILE} ${Q} ${GREP} -v '^#' skel/makedep.out >> ${MAKE_FILE} ${Q} ${RM} -rf skel -${Q} if ${CMP} -s ${MAKE_FILE}.bak ${MAKE_FILE}; then \ @@ -4148,7 +4164,8 @@ rpm-unhide-static: rpm-chk-static: ${V} echo '=-=-=-=-= ${MAKE_FILE} start of $@ rule =-=-=-=-=' - ${CALC_ENV} ./calc-static${EXT} -d -q read regress 2>&1 | ${AWK} -f check.awk + ${CALC_ENV} ./calc-static${EXT} -d -q read regress 2>&1 | \ + ${AWK} -f check.awk ${V} echo '=-=-=-=-= ${MAKE_FILE} end of $@ rule =-=-=-=-=' rpm-clean-static: @@ -4547,7 +4564,8 @@ endif continue; \ fi; \ ${RM} -f tmp; \ - ${SED} -e 's/^\(#[ ]*include[ ][ ]*\)"/\1"calc\//' $$i > tmp; \ + ${SED} -e 's/^\(#[ ]*include[ ][ ]*\)"/\1"calc\//' \ + $$i > tmp; \ if ${CMP} -s tmp ${T}${CALC_INCDIR}/$$i; then \ ${TRUE}; \ else \ @@ -4670,7 +4688,7 @@ uninstall: custom/Makefile -${Q} if [ -f "${T}${LIBDIR}/libcustcalc${LIB_EXT_VE}" ]; then \ ${RM} -f "${T}${LIBDIR}/libcustcalc${LIB_EXT_VE}"; \ if [ -f "${T}${LIBDIR}/libcustcalc${LIB_EXT_VE}" ]; then \ - echo "cannot uninstall ${T}${LIBDIR}/libcustcalc${LIB_EXT_VE}"; \ + echo "cannot uninstall ${T}${LIBDIR}/libcustcalc${LIB_EXT_VE}";\ else \ echo "uninstalled ${T}${LIBDIR}/libcustcalc${LIB_EXT_VE}"; \ fi; \ @@ -4678,7 +4696,8 @@ uninstall: custom/Makefile -${Q} if [ -f "${T}${LIBDIR}/libcustcalc${LIB_EXT_VER}" ]; then \ ${RM} -f "${T}${LIBDIR}/libcustcalc${LIB_EXT_VER}"; \ if [ -f "${T}${LIBDIR}/libcustcalc${LIB_EXT_VER}" ]; then \ - echo "cannot uninstall ${T}${LIBDIR}/libcustcalc${LIB_EXT_VER}"; \ + echo -n "cannot uninstall "; \ + echo "${T}${LIBDIR}/libcustcalc${LIB_EXT_VER}"; \ else \ echo "uninstalled ${T}${LIBDIR}/libcustcalc${LIB_EXT_VER}"; \ fi; \ @@ -4686,7 +4705,8 @@ uninstall: custom/Makefile -${Q} if [ -f "${T}${LIBDIR}/libcustcalc${LIB_EXT_VERS}" ]; then \ ${RM} -f "${T}${LIBDIR}/libcustcalc${LIB_EXT_VERS}"; \ if [ -f "${T}${LIBDIR}/libcustcalc${LIB_EXT_VERS}" ]; then \ - echo "cannot uninstall ${T}${LIBDIR}/libcustcalc${LIB_EXT_VERS}"; \ + echo \ + "cannot uninstall ${T}${LIBDIR}/libcustcalc${LIB_EXT_VERS}"; \ else \ echo "uninstalled ${T}${LIBDIR}/libcustcalc${LIB_EXT_VERS}"; \ fi; \ @@ -4694,9 +4714,10 @@ uninstall: custom/Makefile -${Q} if [ -f "${T}${LIBDIR}/libcustcalc${LIB_EXT_VERSION}" ]; then \ ${RM} -f "${T}${LIBDIR}/libcustcalc${LIB_EXT_VERSION}"; \ if [ -f "${T}${LIBDIR}/libcustcalc${LIB_EXT_VERSION}" ]; then \ - echo "cannot uninstall ${T}${LIBDIR}/libcustcalc${LIB_EXT_VERSION}"; \ + echo \ + "cannot uninstall ${T}${LIBDIR}/libcustcalc${LIB_EXT_VERSION}";\ else \ - echo "uninstalled ${T}${LIBDIR}/libcustcalc${LIB_EXT_VERSION}"; \ + echo "uninstalled ${T}${LIBDIR}/libcustcalc${LIB_EXT_VERSION}";\ fi; \ fi -${Q} if [ -f "${T}${LIBDIR}/libcalc${LIB_EXT}" ]; then \ @@ -4734,7 +4755,8 @@ uninstall: custom/Makefile -${Q} if [ -f "${T}${LIBDIR}/libcalc${LIB_EXT_VERSION}" ]; then \ ${RM} -f "${T}${LIBDIR}/libcalc${LIB_EXT_VERSION}"; \ if [ -f "${T}${LIBDIR}/libcalc${LIB_EXT_VERSION}" ]; then \ - echo "cannot uninstall ${T}${LIBDIR}/libcalc${LIB_EXT_VERSION}"; \ + echo -n "cannot uninstall " \ + echo "${T}${LIBDIR}/libcalc${LIB_EXT_VERSION}"; \ else \ echo "uninstalled ${T}${LIBDIR}/libcalc${LIB_EXT_VERSION}"; \ fi; \ @@ -4852,15 +4874,20 @@ calc-symlink: done -${Q} if [ -n "${CATDIR}" ]; then \ if [ -e "${T}${CATDIR}/calc.${CATEXT}" ]; then \ - if [ ! -L "${CATDIR}/calc.${CATEXT}" -a "${T}${CATDIR}/calc.${CATEXT}" -ef "${CATDIR}/calc.${CATEXT}" ]; then \ - echo "ERROR: ${T}${CATDIR}/calc.${CATEXT} is the same as ${CATDIR}/calc.${CATEXT}" 1>&2; \ + if [ ! -L "${CATDIR}/calc.${CATEXT}" -a \ + "${T}${CATDIR}/calc.${CATEXT}" -ef \ + "${CATDIR}/calc.${CATEXT}" ]; then \ + echo -n "ERROR: ${T}${CATDIR}/calc.${CATEXT}" 2>&1; \ + echo "is the same as ${CATDIR}/calc.${CATEXT}" 1>&2; \ else \ if [ -e "${CATDIR}/calc.${CATEXT}" ]; then \ echo ${RM} -f "${CATDIR}/calc.${CATEXT}"; \ ${RM} -f "${CATDIR}/calc.${CATEXT}"; \ fi; \ - echo ${LN} -s "${T}${CATDIR}/calc.${CATEXT}" "${CATDIR}/calc.${CATEXT}"; \ - ${LN} -s "${T}${CATDIR}/calc.${CATEXT}" "${CATDIR}/calc.${CATEXT}"; \ + echo ${LN} -s "${T}${CATDIR}/calc.${CATEXT}" \ + "${CATDIR}/calc.${CATEXT}"; \ + ${LN} -s "${T}${CATDIR}/calc.${CATEXT}" \ + "${CATDIR}/calc.${CATEXT}"; \ fi; \ fi; \ fi @@ -4889,7 +4916,8 @@ calc-unsymlink: echo ${RM} -f "${CATDIR}/calc.${CATEXT}"; \ ${RM} -f "${CATDIR}/calc.${CATEXT}"; \ else \ - echo "Warning: ignoring non-symlink: ${CATDIR}/calc.${CATEXT}" 1>&2; \ + echo "Warning: ignoring non-symlink: ${CATDIR}/calc.${CATEXT}" \ + 1>&2; \ fi; \ fi diff --git a/Makefile.simple b/Makefile.simple index 48a52a8..87f2270 100644 --- a/Makefile.simple +++ b/Makefile.simple @@ -39,8 +39,8 @@ # received a copy with calc; if not, write to Free Software Foundation, Inc. # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. # -MAKEFILE_REV= $$Revision: 30.53 $$ -# @(#) $Id: Makefile.ship,v 30.53 2013/08/11 01:16:36 chongo Exp $ +MAKEFILE_REV= $$Revision: 30.54 $$ +# @(#) $Id: Makefile.ship,v 30.54 2013/08/11 05:40:18 chongo Exp $ # @(#) $Source: /usr/local/src/cmd/calc/RCS/Makefile.ship,v $ # # Under source code control: 1990/02/15 01:48:41 @@ -974,7 +974,7 @@ EXT= # The default calc versions # -VERSION= 2.12.4.9 +VERSION= 2.12.4.10 VERS= 2.12.4 VER= 2.12 VE= 2 @@ -2127,8 +2127,10 @@ have_fpos.h: have_fpos.c ${MAKE_FILE} ${Q} echo '' >> have_fpos.h ${Q} echo '/* do we have fgetpos & fsetpos functions? */' >> have_fpos.h ${Q} ${RM} -f have_fpos.o have_fpos${EXT} - -${Q} ${LCC} ${HAVE_FPOS} ${ICFLAGS} have_fpos.c -c >/dev/null 2>&1; ${TRUE} - -${Q} ${LCC} ${ILDFLAGS} have_fpos.o -o have_fpos${EXT} >/dev/null 2>&1; ${TRUE} + -${Q} ${LCC} ${HAVE_FPOS} ${ICFLAGS} have_fpos.c -c \ + >/dev/null 2>&1; ${TRUE} + -${Q} ${LCC} ${ILDFLAGS} have_fpos.o -o have_fpos${EXT} \ + >/dev/null 2>&1; ${TRUE} -${Q} ${SHELL} -c "./have_fpos${EXT} > fpos_tmp 2>/dev/null" \ >/dev/null 2>&1; ${TRUE} -${Q} if [ -s fpos_tmp ]; then \ @@ -2213,8 +2215,9 @@ fposval.h: fposval.c have_fpos.h have_fpos_pos.h have_offscl.h have_posscl.h \ ${Q} echo '/* what are our file position & size types? */' >> fposval.h ${Q} ${RM} -f fposval.o fposval${EXT} -${Q} ${LCC} ${ICFLAGS} ${FPOS_BITS} ${OFF_T_BITS} \ - ${DEV_BITS} ${INODE_BITS} fposval.c -c >/dev/null 2>&1; ${TRUE} - -${Q} ${LCC} ${ILDFLAGS} fposval.o -o fposval${EXT} >/dev/null 2>&1; ${TRUE} + ${DEV_BITS} ${INODE_BITS} fposval.c -c >/dev/null 2>&1; ${TRUE} + -${Q} ${LCC} ${ILDFLAGS} fposval.o -o fposval${EXT} >/dev/null \ + 2>&1; ${TRUE} ${Q} ${SHELL} -c "./fposval${EXT} fposv_tmp >> fposval.h 2>/dev/null" \ >/dev/null 2>&1; ${TRUE} ${Q} echo '' >> fposval.h @@ -2248,7 +2251,8 @@ have_const.h: have_const.c ${MAKE_FILE} ${Q} ${RM} -f have_const.o have_const${EXT} -${Q} ${LCC} ${ICFLAGS} ${HAVE_CONST} have_const.c -c \ >/dev/null 2>&1; ${TRUE} - -${Q} ${LCC} ${ILDFLAGS} have_const.o -o have_const${EXT} >/dev/null 2>&1; ${TRUE} + -${Q} ${LCC} ${ILDFLAGS} have_const.o -o have_const${EXT} \ + >/dev/null 2>&1; ${TRUE} -${Q} ${SHELL} -c "./have_const${EXT} > const_tmp 2>/dev/null" \ >/dev/null 2>&1; ${TRUE} -${Q} if [ -s const_tmp ]; then \ @@ -2382,7 +2386,8 @@ align32.h: align32.c longbits.h have_unistd.h ${MAKE_FILE} ${RM} -f align32.o align32${EXT}; \ ${LCC} ${ICFLAGS} ${ALIGN32} align32.c -c >/dev/null 2>&1; \ ${LCC} ${ILDFLAGS} align32.o -o align32${EXT} >/dev/null 2>&1; \ - ${SHELL} -c "./align32${EXT} >align32_tmp 2>/dev/null" >/dev/null 2>&1; \ + ${SHELL} -c \ + "./align32${EXT} >align32_tmp 2>/dev/null" >/dev/null 2>&1; \ if [ -s align32_tmp ]; then \ ${CAT} align32_tmp >> align32.h; \ else \ @@ -2423,7 +2428,8 @@ have_uid_t.h: have_uid_t.c have_unistd.h ${MAKE_FILE} ${Q} ${RM} -f have_uid_t.o have_uid_t${EXT} -${Q} ${LCC} ${ICFLAGS} ${HAVE_UID_T} have_uid_t.c -c \ >/dev/null 2>&1; ${TRUE} - -${Q} ${LCC} ${ILDFLAGS} have_uid_t.o -o have_uid_t${EXT} >/dev/null 2>&1; ${TRUE} + -${Q} ${LCC} ${ILDFLAGS} have_uid_t.o -o have_uid_t${EXT} \ + >/dev/null 2>&1; ${TRUE} -${Q} ${SHELL} -c "./have_uid_t${EXT} > uid_tmp 2>/dev/null" \ >/dev/null 2>&1; ${TRUE} -${Q} if [ -s uid_tmp ]; then \ @@ -2611,7 +2617,8 @@ have_getpgid.h: have_getpgid.c ${MAKE_FILE} ${Q} ${RM} -f getpgid_tmp have_getpgid.h ${Q} echo 'forming have_getpgid.h' ${Q} echo '/*' > have_getpgid.h - ${Q} echo ' * DO NOT EDIT -- generated by the Makefile' >> have_getpgid.h + ${Q} echo ' * DO NOT EDIT -- generated by the Makefile' >> \ + have_getpgid.h ${Q} echo ' */' >> have_getpgid.h ${Q} echo '' >> have_getpgid.h ${Q} echo '' >> have_getpgid.h @@ -2651,7 +2658,8 @@ have_gettime.h: have_gettime.c ${MAKE_FILE} ${Q} ${RM} -f gettime_tmp have_gettime.h ${Q} echo 'forming have_gettime.h' ${Q} echo '/*' > have_gettime.h - ${Q} echo ' * DO NOT EDIT -- generated by the Makefile' >> have_gettime.h + ${Q} echo ' * DO NOT EDIT -- generated by the Makefile' >> \ + have_gettime.h ${Q} echo ' */' >> have_gettime.h ${Q} echo '' >> have_gettime.h ${Q} echo '' >> have_gettime.h @@ -2691,7 +2699,8 @@ have_getprid.h: have_getprid.c ${MAKE_FILE} ${Q} ${RM} -f getprid_tmp have_getprid.h ${Q} echo 'forming have_getprid.h' ${Q} echo '/*' > have_getprid.h - ${Q} echo ' * DO NOT EDIT -- generated by the Makefile' >> have_getprid.h + ${Q} echo ' * DO NOT EDIT -- generated by the Makefile' >> \ + have_getprid.h ${Q} echo ' */' >> have_getprid.h ${Q} echo '' >> have_getprid.h ${Q} echo '' >> have_getprid.h @@ -2731,7 +2740,8 @@ have_urandom.h: ${MAKE_FILE} ${Q} ${RM} -f have_urandom.h ${Q} echo 'forming have_urandom.h' ${Q} echo '/*' > have_urandom.h - ${Q} echo ' * DO NOT EDIT -- generated by the Makefile' >> have_urandom.h + ${Q} echo ' * DO NOT EDIT -- generated by the Makefile' >> \ + have_urandom.h ${Q} echo ' */' >> have_urandom.h ${Q} echo '' >> have_urandom.h ${Q} echo '' >> have_urandom.h @@ -2767,7 +2777,8 @@ have_rusage.h: have_rusage.c ${MAKE_FILE} ${Q} ${RM} -f rusage_tmp have_rusage.h ${Q} echo 'forming have_rusage.h' ${Q} echo '/*' > have_rusage.h - ${Q} echo ' * DO NOT EDIT -- generated by the Makefile' >> have_rusage.h + ${Q} echo ' * DO NOT EDIT -- generated by the Makefile' >> \ + have_rusage.h ${Q} echo ' */' >> have_rusage.h ${Q} echo '' >> have_rusage.h ${Q} echo '' >> have_rusage.h @@ -2858,14 +2869,16 @@ args.h: have_stdvs.c have_varvs.c have_string.h have_unistd.h have_string.h ${Q} ${RM} -f have_stdvs.o have_stdvs${EXT} -${Q} ${LCC} ${ICFLAGS} ${HAVE_VSPRINTF} have_stdvs.c -c \ >/dev/null 2>&1; ${TRUE} - -${Q} ${LCC} ${ILDFLAGS} have_stdvs.o -o have_stdvs${EXT} >/dev/null 2>&1; ${TRUE} + -${Q} ${LCC} ${ILDFLAGS} have_stdvs.o -o have_stdvs${EXT} \ + >/dev/null 2>&1; ${TRUE} -${Q} if ./have_stdvs${EXT} >>args.h 2>/dev/null; then \ ${TOUCH} have_args.sh; \ else \ ${TRUE}; \ fi -${Q} if [ ! -f have_args.sh ] && [ X"${HAVE_VSPRINTF}" = X ]; then \ - ${RM} -f have_stdvs.o have_stdvs${EXT} have_varvs.o have_varvs${EXT}; \ + ${RM} -f have_stdvs.o have_stdvs${EXT} have_varvs.o; \ + ${RM} -f have_varvs${EXT}; \ ${LCC} ${ICFLAGS} ${HAVE_VSPRINTF} have_varvs.c -c \ 2>/dev/null; \ ${LCC} ${ILDFLAGS} have_varvs.o -o have_varvs${EXT} 2>/dev/null; \ @@ -2889,7 +2902,8 @@ args.h: have_stdvs.c have_varvs.c have_string.h have_unistd.h have_string.h ${Q} echo '' >> args.h ${Q} echo '' >> args.h ${Q} echo '#endif /* !__ARGS_H__ */' >> args.h - ${Q} ${RM} -f have_stdvs.o have_varvs.o have_varvs${EXT} have_args.sh core + ${Q} ${RM} -f have_stdvs.o have_varvs.o have_varvs${EXT} have_args.sh + ${Q} ${RM} -f core ${Q} echo 'args.h formed' -@if [ -z "${Q}" ]; then \ echo ''; \ @@ -2963,7 +2977,8 @@ no_implicit.arg: no_implicit.c ${MAKE_FILE} else \ ${LCC} -Wno-implicit ${ICFLAGS} -DHAVE_NO_IMPLICIT \ no_implicit.c -c >/dev/null 2>&1; \ - ${LCC} ${ILDFLAGS} no_implicit.o -o no_implicit${EXT} >/dev/null 2>&1; \ + ${LCC} ${ILDFLAGS} no_implicit.o -o no_implicit${EXT} \ + >/dev/null 2>&1; \ ${SHELL} -c "./no_implicit${EXT} > no_implicit.arg 2>/dev/null" \ >/dev/null 2>&1; ${TRUE}; \ fi @@ -3236,7 +3251,8 @@ depend: custom/Makefile hsrc ${Q} echo forming new ${MAKE_FILE} ${Q} ${RM} -f ${MAKE_FILE}.bak ${Q} ${MV} ${MAKE_FILE} ${MAKE_FILE}.bak - ${Q} ${SED} -n '1,/^# DO NOT DELETE THIS LINE/p' ${MAKE_FILE}.bak > ${MAKE_FILE} + ${Q} ${SED} -n '1,/^# DO NOT DELETE THIS LINE/p' \ + ${MAKE_FILE}.bak > ${MAKE_FILE} ${Q} ${GREP} -v '^#' skel/makedep.out >> ${MAKE_FILE} ${Q} ${RM} -rf skel -${Q} if ${CMP} -s ${MAKE_FILE}.bak ${MAKE_FILE}; then \ @@ -3685,7 +3701,8 @@ rpm-unhide-static: rpm-chk-static: ${V} echo '=-=-=-=-= ${MAKE_FILE} start of $@ rule =-=-=-=-=' - ${CALC_ENV} ./calc-static${EXT} -d -q read regress 2>&1 | ${AWK} -f check.awk + ${CALC_ENV} ./calc-static${EXT} -d -q read regress 2>&1 | \ + ${AWK} -f check.awk ${V} echo '=-=-=-=-= ${MAKE_FILE} end of $@ rule =-=-=-=-=' rpm-clean-static: @@ -4067,7 +4084,8 @@ install: custom/Makefile ${LIB_H_SRC} ${BUILD_H_SRC} calc.1 all continue; \ fi; \ ${RM} -f tmp; \ - ${SED} -e 's/^\(#[ ]*include[ ][ ]*\)"/\1"calc\//' $$i > tmp; \ + ${SED} -e 's/^\(#[ ]*include[ ][ ]*\)"/\1"calc\//' \ + $$i > tmp; \ if ${CMP} -s tmp ${T}${CALC_INCDIR}/$$i; then \ ${TRUE}; \ else \ @@ -4190,7 +4208,7 @@ uninstall: custom/Makefile -${Q} if [ -f "${T}${LIBDIR}/libcustcalc${LIB_EXT_VE}" ]; then \ ${RM} -f "${T}${LIBDIR}/libcustcalc${LIB_EXT_VE}"; \ if [ -f "${T}${LIBDIR}/libcustcalc${LIB_EXT_VE}" ]; then \ - echo "cannot uninstall ${T}${LIBDIR}/libcustcalc${LIB_EXT_VE}"; \ + echo "cannot uninstall ${T}${LIBDIR}/libcustcalc${LIB_EXT_VE}";\ else \ echo "uninstalled ${T}${LIBDIR}/libcustcalc${LIB_EXT_VE}"; \ fi; \ @@ -4198,7 +4216,8 @@ uninstall: custom/Makefile -${Q} if [ -f "${T}${LIBDIR}/libcustcalc${LIB_EXT_VER}" ]; then \ ${RM} -f "${T}${LIBDIR}/libcustcalc${LIB_EXT_VER}"; \ if [ -f "${T}${LIBDIR}/libcustcalc${LIB_EXT_VER}" ]; then \ - echo "cannot uninstall ${T}${LIBDIR}/libcustcalc${LIB_EXT_VER}"; \ + echo -n "cannot uninstall "; \ + echo "${T}${LIBDIR}/libcustcalc${LIB_EXT_VER}"; \ else \ echo "uninstalled ${T}${LIBDIR}/libcustcalc${LIB_EXT_VER}"; \ fi; \ @@ -4206,7 +4225,8 @@ uninstall: custom/Makefile -${Q} if [ -f "${T}${LIBDIR}/libcustcalc${LIB_EXT_VERS}" ]; then \ ${RM} -f "${T}${LIBDIR}/libcustcalc${LIB_EXT_VERS}"; \ if [ -f "${T}${LIBDIR}/libcustcalc${LIB_EXT_VERS}" ]; then \ - echo "cannot uninstall ${T}${LIBDIR}/libcustcalc${LIB_EXT_VERS}"; \ + echo \ + "cannot uninstall ${T}${LIBDIR}/libcustcalc${LIB_EXT_VERS}"; \ else \ echo "uninstalled ${T}${LIBDIR}/libcustcalc${LIB_EXT_VERS}"; \ fi; \ @@ -4214,9 +4234,10 @@ uninstall: custom/Makefile -${Q} if [ -f "${T}${LIBDIR}/libcustcalc${LIB_EXT_VERSION}" ]; then \ ${RM} -f "${T}${LIBDIR}/libcustcalc${LIB_EXT_VERSION}"; \ if [ -f "${T}${LIBDIR}/libcustcalc${LIB_EXT_VERSION}" ]; then \ - echo "cannot uninstall ${T}${LIBDIR}/libcustcalc${LIB_EXT_VERSION}"; \ + echo \ + "cannot uninstall ${T}${LIBDIR}/libcustcalc${LIB_EXT_VERSION}";\ else \ - echo "uninstalled ${T}${LIBDIR}/libcustcalc${LIB_EXT_VERSION}"; \ + echo "uninstalled ${T}${LIBDIR}/libcustcalc${LIB_EXT_VERSION}";\ fi; \ fi -${Q} if [ -f "${T}${LIBDIR}/libcalc${LIB_EXT}" ]; then \ @@ -4254,7 +4275,8 @@ uninstall: custom/Makefile -${Q} if [ -f "${T}${LIBDIR}/libcalc${LIB_EXT_VERSION}" ]; then \ ${RM} -f "${T}${LIBDIR}/libcalc${LIB_EXT_VERSION}"; \ if [ -f "${T}${LIBDIR}/libcalc${LIB_EXT_VERSION}" ]; then \ - echo "cannot uninstall ${T}${LIBDIR}/libcalc${LIB_EXT_VERSION}"; \ + echo -n "cannot uninstall " \ + echo "${T}${LIBDIR}/libcalc${LIB_EXT_VERSION}"; \ else \ echo "uninstalled ${T}${LIBDIR}/libcalc${LIB_EXT_VERSION}"; \ fi; \ @@ -4372,15 +4394,20 @@ calc-symlink: done -${Q} if [ -n "${CATDIR}" ]; then \ if [ -e "${T}${CATDIR}/calc.${CATEXT}" ]; then \ - if [ ! -L "${CATDIR}/calc.${CATEXT}" -a "${T}${CATDIR}/calc.${CATEXT}" -ef "${CATDIR}/calc.${CATEXT}" ]; then \ - echo "ERROR: ${T}${CATDIR}/calc.${CATEXT} is the same as ${CATDIR}/calc.${CATEXT}" 1>&2; \ + if [ ! -L "${CATDIR}/calc.${CATEXT}" -a \ + "${T}${CATDIR}/calc.${CATEXT}" -ef \ + "${CATDIR}/calc.${CATEXT}" ]; then \ + echo -n "ERROR: ${T}${CATDIR}/calc.${CATEXT}" 2>&1; \ + echo "is the same as ${CATDIR}/calc.${CATEXT}" 1>&2; \ else \ if [ -e "${CATDIR}/calc.${CATEXT}" ]; then \ echo ${RM} -f "${CATDIR}/calc.${CATEXT}"; \ ${RM} -f "${CATDIR}/calc.${CATEXT}"; \ fi; \ - echo ${LN} -s "${T}${CATDIR}/calc.${CATEXT}" "${CATDIR}/calc.${CATEXT}"; \ - ${LN} -s "${T}${CATDIR}/calc.${CATEXT}" "${CATDIR}/calc.${CATEXT}"; \ + echo ${LN} -s "${T}${CATDIR}/calc.${CATEXT}" \ + "${CATDIR}/calc.${CATEXT}"; \ + ${LN} -s "${T}${CATDIR}/calc.${CATEXT}" \ + "${CATDIR}/calc.${CATEXT}"; \ fi; \ fi; \ fi @@ -4409,7 +4436,8 @@ calc-unsymlink: echo ${RM} -f "${CATDIR}/calc.${CATEXT}"; \ ${RM} -f "${CATDIR}/calc.${CATEXT}"; \ else \ - echo "Warning: ignoring non-symlink: ${CATDIR}/calc.${CATEXT}" 1>&2; \ + echo "Warning: ignoring non-symlink: ${CATDIR}/calc.${CATEXT}" \ + 1>&2; \ fi; \ fi diff --git a/alloc.h b/alloc.h index 3cae2fe..25b05a2 100644 --- a/alloc.h +++ b/alloc.h @@ -17,8 +17,8 @@ * 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 $ + * @(#) $Revision: 30.3 $ + * @(#) $Id: alloc.h,v 30.3 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/alloc.h,v $ * * Under source code control: 1990/02/15 01:48:29 @@ -53,7 +53,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 +83,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 diff --git a/assocfunc.c b/assocfunc.c index 7044f05..f230fe4 100644 --- a/assocfunc.c +++ b/assocfunc.c @@ -17,8 +17,8 @@ * 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 $ + * @(#) $Revision: 30.2 $ + * @(#) $Id: assocfunc.c,v 30.2 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/assocfunc.c,v $ * * Under source code control: 1993/07/20 23:04:27 @@ -332,7 +332,8 @@ assoccopy(ASSOC *oldap) oldep = oldep->e_next) { ep = (ASSOCELEM *) malloc(ELEMSIZE(oldep->e_dim)); if (ep == NULL) { - math_error("Cannot allocate association element"); + math_error("Cannot allocate " + "association element"); /*NOTREACHED*/ } ep->e_dim = oldep->e_dim; @@ -340,7 +341,8 @@ assoccopy(ASSOC *oldap) ep->e_value.v_type = V_NULL; ep->e_value.v_subtype = V_NOSUBTYPE; for (i = 0; i < ep->e_dim; i++) - copyvalue(&oldep->e_indices[i], &ep->e_indices[i]); + copyvalue(&oldep->e_indices[i], + &ep->e_indices[i]); copyvalue(&oldep->e_value, &ep->e_value); listhead = &ap->a_table[ep->e_hash % ap->a_size]; ep->e_next = *listhead; diff --git a/blkcpy.c b/blkcpy.c index 47fb29c..7e86020 100644 --- a/blkcpy.c +++ b/blkcpy.c @@ -19,8 +19,8 @@ * 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 $ + * @(#) $Revision: 30.2 $ + * @(#) $Id: blkcpy.c,v 30.2 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/blkcpy.c,v $ * * Under source code control: 1997/04/18 20:41:26 @@ -374,7 +374,8 @@ copyblk2mat(BLOCK *blk, long ssi, long num, MATRIX *dmat, long dsi) * copymat2blk - copy matrix to block */ int -copymat2blk(MATRIX *smat, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc) +copymat2blk(MATRIX *smat, long ssi, long num, BLOCK *dblk, long dsi, + BOOL noreloc) { long i; long newlen; @@ -720,7 +721,8 @@ copystr2file(STRING *str, long ssi, long num, FILEID id, long dsi) * copyblk2blk - copy block to block */ int -copyblk2blk(BLOCK *sblk, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc) +copyblk2blk(BLOCK *sblk, long ssi, long num, BLOCK *dblk, long dsi, + BOOL noreloc) { long newlen; long newsize; @@ -762,7 +764,8 @@ copyblk2blk(BLOCK *sblk, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc * copystr2blk - copy string to block */ int -copystr2blk(STRING *str, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc) +copystr2blk(STRING *str, long ssi, long num, BLOCK *dblk, long dsi, + BOOL noreloc) { long len; long newlen; @@ -982,7 +985,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 +1037,8 @@ copynum2blk(NUMBER *snum, long ssi, long num, BLOCK *dblk, long dsi, BOOL norelo * copyblk2num - copy block to number */ int -copyblk2num(BLOCK *sblk, long ssi, long num, NUMBER *dnum, long dsi, NUMBER **res) +copyblk2num(BLOCK *sblk, long ssi, long num, NUMBER *dnum, long dsi, + NUMBER **res) { size_t newlen; NUMBER *ret; /* cloned and modified numerator */ diff --git a/byteswap.c b/byteswap.c index 6372c3b..96fbd58 100644 --- a/byteswap.c +++ b/byteswap.c @@ -17,8 +17,8 @@ * 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 $ + * @(#) $Revision: 30.2 $ + * @(#) $Id: byteswap.c,v 30.2 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/byteswap.c,v $ * * Under source code control: 1995/10/11 04:44:01 @@ -102,7 +102,8 @@ swap_b8_in_ZVALUE(ZVALUE *dest, ZVALUE *src, BOOL all) */ dest = malloc(sizeof(ZVALUE)); if (dest == NULL) { - math_error("swap_b8_in_ZVALUE: swap_b8_in_ZVALUE: Not enough memory"); + math_error("swap_b8_in_ZVALUE: swap_b8_in_ZVALUE: " + "Not enough memory"); /*NOTREACHED*/ } diff --git a/cal/Makefile b/cal/Makefile index 1834cfa..6e23b45 100644 --- a/cal/Makefile +++ b/cal/Makefile @@ -18,8 +18,8 @@ # 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: Makefile,v 30.5 2011/05/23 22:50:18 chongo Exp $ +# @(#) $Revision: 30.7 $ +# @(#) $Id: Makefile,v 30.7 2013/08/11 09:07:26 chongo Exp $ # @(#) $Source: /usr/local/src/bin/calc/cal/RCS/Makefile,v $ # # Under source code control: 1991/07/21 05:00:54 @@ -182,19 +182,21 @@ TOUCH= touch # The calc files to install # -CALC_FILES= README bigprime.cal deg.cal ellip.cal lucas.cal lucas_chk.cal \ - lucas_tbl.cal mersenne.cal mod.cal pell.cal pi.cal pix.cal \ - pollard.cal poly.cal psqrt.cal quat.cal regress.cal solve.cal \ - sumsq.cal surd.cal unitfrac.cal varargs.cal chrem.cal mfactor.cal \ - bindings randmprime.cal test1700.cal randrun.cal linear.cal \ - randbitrun.cal bernoulli.cal test2300.cal test2600.cal \ - test2700.cal test3100.cal test3300.cal test3400.cal prompt.cal \ - test3500.cal seedrandom.cal test4000.cal test4100.cal test4600.cal \ - beer.cal hello.cal test5100.cal test5200.cal randombitrun.cal \ - randomrun.cal repeat.cal xx_print.cal natnumset.cal qtime.cal \ - test8400.cal test8500.cal test8600.cal chi.cal intfile.cal screen.cal \ - dotest.cal set8700.cal set8700.line alg_config.cal sumtimes.cal \ - dms.cal hms.cal gvec.cal +CALC_FILES= alg_config.cal beer.cal bernoulli.cal bernpoly.cal \ + bigprime.cal bindings brentsolve.cal chi.cal chrem.cal constants.cal \ + deg.cal dms.cal dotest.cal ellip.cal factorial2.cal factorial.cal \ + gvec.cal hello.cal hms.cal intfile.cal lambertw.cal linear.cal \ + lnseries.cal lucas.cal lucas_chk.cal lucas_tbl.cal mersenne.cal \ + mfactor.cal mod.cal natnumset.cal pell.cal pi.cal pix.cal pollard.cal \ + poly.cal prompt.cal psqrt.cal qtime.cal quat.cal randbitrun.cal \ + randmprime.cal randombitrun.cal randomrun.cal randrun.cal README \ + regress.cal repeat.cal screen.cal seedrandom.cal set8700.cal \ + set8700.line solve.cal specialfunctions.cal statistics.cal sumsq.cal \ + sumtimes.cal surd.cal test1700.cal test2300.cal test2600.cal \ + test2700.cal test3100.cal test3300.cal test3400.cal test3500.cal \ + test4000.cal test4100.cal test4600.cal test5100.cal test5200.cal \ + test8400.cal test8500.cal test8600.cal test8900.cal toomcook.cal \ + unitfrac.cal varargs.cal xx_print.cal zeta2.cal # These files are found (but not built) in the distribution # @@ -293,7 +295,7 @@ 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 diff --git a/cal/alg_config.cal b/cal/alg_config.cal index c6f1dda..4c2c81b 100644 --- a/cal/alg_config.cal +++ b/cal/alg_config.cal @@ -17,8 +17,8 @@ * 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 $ + * @(#) $Revision: 30.2 $ + * @(#) $Id: alg_config.cal,v 30.2 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/alg_config.cal,v $ * * Under source code control: 2006/06/07 14:10:11 @@ -80,7 +80,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"; } } @@ -378,7 +379,8 @@ define best_mul2() } } while (ratio >= 1.0); if (config("user_debug") > 0) { - printf("alg1/alg2 ratio now < 1.0, starting binary search between %d and %d\n", + printf("alg1/alg2 ratio now < 1.0, starting binary search " + "between %d and %d\n", low, high); } @@ -472,7 +474,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"; } } @@ -769,7 +772,8 @@ define best_sq2() } } while (ratio >= 1.0); if (config("user_debug") > 0) { - printf("alg1/alg2 ratio now < 1.0, starting binary search between %d and %d\n", + printf("alg1/alg2 ratio now < 1.0, starting binary search " + "between %d and %d\n", low, high); } @@ -866,7 +870,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) { @@ -1151,7 +1156,8 @@ define best_pow2() 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); @@ -1205,8 +1211,8 @@ define best_pow2() looped = 1; } 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("alg1/alg2 ratio now < 1.0, starting binary search " + "between %d and %d\n", low, high); } /* diff --git a/cal/bernpoly.cal b/cal/bernpoly.cal new file mode 100644 index 0000000..d462c86 --- /dev/null +++ b/cal/bernpoly.cal @@ -0,0 +1,59 @@ +/* + * bernpoly- Bernoully polynomials B_n(z) for arbitrary n,z.. + * + * Copyright (C) 2013 Christoph Zurnieden + * + * bernpoly 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. + * + * bernpoly 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.3 $ + * @(#) $Id: bernpoly.cal,v 30.3 2013/08/11 08:41:38 chongo Exp $ + * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/bernpoly.cal,v $ + * + * Under source code control: 2013/08/11 01:31:28 + * File existed as early as: 2013 + */ + + +static resource_debug_level; +resource_debug_level = config("resource_debug", 0); + + +read -once zeta2 + + +/* Idea by Don Zagier */ +define bernpoly(n,z){ + local h s c k; + if(isint(n) && n>=0){ + h=0;s=0;c=-1; + for(k=1;k<=n+1;k++){ + c*=1-(n+2)/k; + s+=z^n; + z++; + h+=c*s/k; + } + return h; + } + else return -n*hurwitzzeta(1-n,z); +} + + +/* + * restore internal function from resource debugging + */ +config("resource_debug", resource_debug_level),; +if (config("resource_debug") & 3) { + print "bernpoly(n,z)"; +} diff --git a/cal/brentsolve.cal b/cal/brentsolve.cal new file mode 100644 index 0000000..a50d700 --- /dev/null +++ b/cal/brentsolve.cal @@ -0,0 +1,257 @@ +/* + * brentsolve- Root finding with the Brent-Dekker trick. + * + * Copyright (C) 2013 Christoph Zurnieden + * + * brentsolve 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. + * + * brentsolve 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.3 $ + * @(#) $Id: brentsolve.cal,v 30.3 2013/08/11 08:41:38 chongo Exp $ + * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/brentsolve.cal,v $ + * + * Under source code control: 2013/08/11 01:31:28 + * File existed as early as: 2013 + */ + +static resource_debug_level; +resource_debug_level = config("resource_debug", 0); + + +/* + A short explanation is at http://en.wikipedia.org/wiki/Brent%27s_method + I tried to follow the description at wikipedia as much as possible to make + the slight changes I did more visible. + You may give http://people.sc.fsu.edu/~jburkardt/cpp_src/brent/brent.html a + short glimpse (Brent's originl Fortran77 versions and some translations of + it). +*/ + +static true = 1; +static false = 0; +define brentsolve(low, high,eps){ + local a b c d fa fb fc fa2 fb2 fc2 s fs tmp tmp2 mflag i places; + a = low; + b = high; + c = 0; + + if(isnull(eps)) + eps = epsilon(epsilon()*1e-3); + places = highbit(1 + int( 1/epsilon() ) ) + 1; + + d = 1/eps; + + fa = f(a); + fb = f(b); + + fc = 0; + s = 0; + fs = 0; + + if(fa * fb >= 0){ + if(fa < fb){ + epsilon(eps); + return a; + } + else{ + epsilon(eps); + return b; + } + } + + if(abs(fa) < abs(fb)){ + tmp = a; a = b; b = tmp; + tmp = fa; fa = fb; fb = tmp; + } + + c = a; + fc = fa; + mflag = 1; + i = 0; + + while(!(fb==0) && (abs(a-b) > eps)){ + if((fa != fc) && (fb != fc)){ + /* Inverse quadratic interpolation*/ + fc2 = fc^2; + fa2 = fa^2; + s = bround(((fb^2*((fc*a)-(c*fa)))+(fb*((c*fa2)-(fc2*a)))+(b*((fc2*fa) + -(fc*fa2))))/((fc - fb)*(fa - fb)*(fc - fa)),places++); + } + else{ + /* Secant Rule*/ + s =bround( b - fb * (b - a) / (fb - fa),places++); + } + tmp2 = (3 * a + b) / 4; + if( (!( ((s > tmp2) && (s < b))||((s < tmp2) && (s > b)))) + || (mflag && (abs(s - b) >= (abs(b - c) / 2))) + || (!mflag && (abs(s - b) >= (abs(c - d) / 2)))) { + s = (a + b) / 2; + mflag = true; + } + else{ + if( (mflag && (abs(b - c) < eps)) + || (!mflag && (abs(c - d) < eps))) { + s = (a + b) / 2; + mflag = true; + } + else + mflag = false; + } + fs = f(s); + c = b; + fc = fb; + if (fa * fs < 0){ + b = s; + fb = fs; + } + else { + a = s; + fa = fs; + } + + if (abs(fa) < abs(fb)){ + tmp = a; a = b; b = tmp; + tmp = fa; fa = fb; fb = tmp; + } + i++; + if (i > 1000){ + epsilon(eps); + return newerror("brentsolve: does not converge"); + } + } + epsilon(eps); + return b; +} + +/* + A variation of the solver to accept functions named differently from "f". The + code should explain it. +*/ +define brentsolve2(low, high,which,eps){ + local a b c d fa fb fc fa2 fb2 fc2 s fs tmp tmp2 mflag i places; + a = low; + b = high; + c = 0; + + switch(param(0)){ + case 0: + case 1: return newerror("brentsolve2: not enough argments"); + case 2: eps = epsilon(epsilon()*1e-2); + which = 0;break; + case 3: eps = epsilon(epsilon()*1e-2);break; + default: break; + }; + places = highbit(1 + int(1/epsilon())) + 1; + + d = 1/eps; + + switch(which){ + case 1: fa = __CZ__invbeta(a); + fb = __CZ__invbeta(b); break; + case 2: fa = __CZ__invincgamma(a); + fb = __CZ__invincgamma(b); break; + + default: fa = f(a);fb = f(b); break; + }; + + fc = 0; + s = 0; + fs = 0; + + if(fa * fb >= 0){ + if(fa < fb) + return a; + else + return b; + } + + if(abs(fa) < abs(fb)){ + tmp = a; a = b; b = tmp; + tmp = fa; fa = fb; fb = tmp; + } + + c = a; + fc = fa; + mflag = 1; + i = 0; + + while(!(fb==0) && (abs(a-b) > eps)){ + + if((fa != fc) && (fb != fc)){ + /* Inverse quadratic interpolation*/ + fc2 = fc^2; + fa2 = fa^2; + s = bround(((fb^2*((fc*a)-(c*fa)))+(fb*((c*fa2)-(fc2*a)))+(b*((fc2*fa) + -(fc*fa2))))/((fc - fb)*(fa - fb)*(fc - fa)),places); + places++; + } + else{ + /* Secant Rule*/ + s =bround( b - fb * (b - a) / (fb - fa),places); + places++; + } + tmp2 = (3 * a + b) / 4; + if( (!( ((s > tmp2) && (s < b))||((s < tmp2) && (s > b)))) + || (mflag && (abs(s - b) >= (abs(b - c) / 2))) + || (!mflag && (abs(s - b) >= (abs(c - d) / 2)))) { + s = (a + b) / 2; + mflag = true; + } + else{ + if( (mflag && (abs(b - c) < eps)) + || (!mflag && (abs(c - d) < eps))) { + s = (a + b) / 2; + mflag = true; + } + else + mflag = false; + } + switch(which){ + case 1: fs = __CZ__invbeta(s); break; + case 2: fs = __CZ__invincgamma(s); break; + + default: fs = f(s); break; + }; + c = b; + fc = fb; + if (fa * fs < 0){ + b = s; + fb = fs; + } + else { + a = s; + fa = fs; + } + + if (abs(fa) < abs(fb)){ + tmp = a; a = b; b = tmp; + tmp = fa; fa = fb; fb = tmp; + } + i++; + if (i > 1000){ + return newerror("brentsolve2: does not converge"); + } + } + return b; +} + + +/* + * restore internal function from resource debugging + */ +config("resource_debug", resource_debug_level),; +if (config("resource_debug") & 3) { + print "brentsolve(low, high,eps)"; + print "brentsolve2(low, high,which,eps)"; +} diff --git a/cal/constants.cal b/cal/constants.cal new file mode 100644 index 0000000..7dba7ff --- /dev/null +++ b/cal/constants.cal @@ -0,0 +1,104 @@ +/* + * constants - implementation of different constants to arbitrary precision + * + * Copyright (C) 2013 Christoph Zurnieden + * + * constants 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. + * + * constants 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.3 $ + * @(#) $Id: constants.cal,v 30.3 2013/08/11 08:41:38 chongo Exp $ + * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/constants.cal,v $ + * + * Under source code control: 2013/08/11 01:31:28 + * File existed as early as: 2013 + */ + + +static resource_debug_level; +resource_debug_level = config("resource_debug", 0); + + +static __CZ__euler_mascheroni = 0; +static __CZ__euler_mascheroni_prec = 0; + + +define e(){ + local k temp1 temp2 ret eps factor upperlimit prec; + + prec = digits(1/epsilon()); + if(__CZ__euler_mascheroni != 0 && __CZ__euler_mascheroni_prec >= prec) + return __CZ__euler_mascheroni; + if(prec<=20) return 2.718281828459045235360287471; + if(prec<=1800){ + __CZ__euler_mascheroni = exp(1); + __CZ__euler_mascheroni_prec = prec; + } + + eps=epsilon(1e-20); + factor = 1; + k = 0; + upperlimit = prec * ln(10); + while(k= 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()"; +} diff --git a/cal/factorial.cal b/cal/factorial.cal new file mode 100644 index 0000000..93e67aa --- /dev/null +++ b/cal/factorial.cal @@ -0,0 +1,204 @@ +/* + * factorial - implementation of different algorithms for the factorial + * + * Copyright (C) 2013 Christoph Zurnieden + * + * factorial 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. + * + * factorial 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.3 $ + * @(#) $Id: factorial.cal,v 30.3 2013/08/11 08:41:38 chongo Exp $ + * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/factorial.cal,v $ + * + * Under source code control: 2013/08/11 01:31:28 + * File existed as early as: 2013 + */ + + +/* + * hide internal function from resource debugging + */ +static resource_debug_level; +resource_debug_level = config("resource_debug", 0); + + +/* + get dependencies +*/ +read -once toomcook; + + +/* A simple list to keep things...uhm...simple?*/ +static __CZ__primelist = list(); + +/* Helper for primorial: fill list with primes in range a,b */ +define __CZ__fill_prime_list(a,b) +{ + local k; + k=a; + if(isprime(k))k--; + while(1){ + k = nextprime(k); + if(k > b) break; + append(__CZ__primelist,k ); + } +} + +/* Helper for factorial: how often prime p divides the factorial of n */ +define __CZ__prime_divisors(n,p) +{ + local q,m; + q = n; + m = 0; + if (p > n) return 0; + if (p > n/2) return 1; + while (q >= p) { + q = q//p; + m += q; + } + return m; +} + +/* + Wrapper. Please set cut-offs to own taste and hardware. +*/ +define factorial(n){ + local prime result shift prime_list k k1 k2 expo_list pix cut primorial; + + result = 1; + prime = 2; + + if(!isint(n)) { + return newerror("factorial(n): n is not an integer"); ## or gamma(n)? + } + if(n < 0) return newerror("factorial(n): n < 0"); + if(n < 9000 && !isdefined("test8900")) { + ## builtin is implemented with splitting but only with + ## Toom-Cook 2 (by Karatsuba (the father)) + return n!; + } + + shift = __CZ__prime_divisors(n,prime); + prime = 3; + cut = n//2; + pix = pix(cut); + prime_list = mat[pix]; + expo_list = mat[pix]; + + k = 0; +/* + Peter Borwein's algorithm + + @Article{journals/jal/Borwein85, + author = {Borwein, Peter B.}, + title = {On the Complexity of Calculating Factorials.}, + journal = {J. Algorithms}, + year = {1985}, + number = {3}, + url = {http://dblp.uni-trier.de/db/journals/jal/jal6.html#Borwein85} +*/ + + do { + prime_list[k] = prime; + expo_list[k++] = __CZ__prime_divisors(n,prime); + prime = nextprime(prime); + }while(prime <= cut); + + /* size of the largest exponent in bits */ + k1 = highbit(expo_list[0]); + k2 = size(prime_list)-1; + + for(;k1>=0;k1--){ + /* + the cut-off for T-C-4 ist still to low, using T-C-3 here + TODO: check cutoffs + */ + result = toomcook3square(result); + /* + almost all time is spend in this loop, so cutting of the + upper half of the primes makes sense + */ + for(k=0; k<=k2; k++) { + if((expo_list[k] & (1 << k1)) != 0) { + result *= prime_list[k]; + } + } + + } + primorial = primorial( cut, n); + result *= primorial; + result <<= shift; + return result; +} + +/* + Helper for primorial: do the product with binary splitting + TODO: do it without the intermediate list +*/ +define __CZ__primorial__lowlevel( a, b ,p) +{ + local c; + if( b == a) return p ; + if( b-a > 1){ + c= (b + a) >> 1; + return __CZ__primorial__lowlevel( a , c , __CZ__primelist[a] ) + * __CZ__primorial__lowlevel( c+1 , b , __CZ__primelist[b] ) ; + } + return __CZ__primelist[a] * __CZ__primelist[b]; +} + +/* + Primorial, Product of consecutive primes in range a,b + + Originally meant to do primorials with a start different from 2, but + found out that this is faster at about a=1,b>=10^5 than the builtin + function pfact(). With the moderately small list a=1,b=10^6 (78498 + primes) it is 3 times faster. A quick look-up showed what was already + guessed: pfact() does it linearly. (BTW: what is the time complexity + of the primorial with the naive algorithm?) +*/ +define primorial(a,b) +{ + local C1 C2; + if(!isint(a)) return newerror("primorial(a,b): a is not an integer"); + else if(!isint(b)) return newerror("primorial(a,b): b is not an integer"); + else if(a < 0) return newerror("primorial(a,b): a < 0"); + else if( b < 2 ) return newerror("primorial(a,b): b < 2"); + else if( b < a) return newerror("primorial(a,b): b < a"); + else{ + /* last prime < 2^32 is also max. prime for nextprime()*/ + if(b >= 4294967291) return newerror("primorial(a,b): max. prime exceeded"); + if(b == 2) return 2; + /* + Can be extended by way of pfact(b)/pfact(floor(a-1/2)) for small a + */ + if(a<=2 && b < 10^5) return pfact(b); + /* TODO: use pix() and a simple array (mat[])instead*/ + __CZ__primelist = list(); + __CZ__fill_prime_list(a,b); + C1 = size(__CZ__primelist)-1; + return __CZ__primorial__lowlevel( 0, C1,1) + } +} + + +/* + * restore internal function from resource debugging + * report important interface functions + */ +config("resource_debug", resource_debug_level),; +if (config("resource_debug") & 3) { + print "factorial(n)"; + print "primorial(a, b)"; +} diff --git a/cal/factorial2.cal b/cal/factorial2.cal new file mode 100644 index 0000000..c1e5a05 --- /dev/null +++ b/cal/factorial2.cal @@ -0,0 +1,723 @@ +/* + * factorial2 - implementation of different factorial related functions + * + * Copyright (C) 2013 Christoph Zurnieden + * + * factorial2 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. + * + * factorial2 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 factorial2 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.3 $ + * @(#) $Id: factorial2.cal,v 30.3 2013/08/11 08:41:38 chongo Exp $ + * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/factorial2.cal,v $ + * + * Under source code control: 2013/08/11 01:31:28 + * File existed as early as: 2013 + */ + + +/* + * hide internal function from resource debugging + */ +static resource_debug_level; +resource_debug_level = config("resource_debug", 0); + + +/* + get dependencies +*/ +read -once factorial toomcook specialfunctions; + + +/* + Factorize a factorial and put the result in a 2-column matrix with pi(n) rows + mat[ primes , exponent ] + Result can be restricted to start at a prime different from 2 with the second + argument "start". That arguments gets taken at face value if it prime and + smaller than n, otherwise the next larger prime is taken if that prime is + smaller than n. +*/ + +define __CZ__factor_factorial(n,start){ + local prime prime_list k pix stop; + + + if(!isint(n)) return + newerror("__CZ__factor_factorial(n,start): n is not integer"); + if(n < 0) return newerror("__CZ__factor_factorial(n,start): n < 0"); + if(n == 1) return newerror("__CZ__factor_factorial(n,start): n == 1"); + + if(start){ + if(!isint(start) && start < 0 && start > n) + return newerror("__CZ__factor_factorial(n,start): value of " + "parameter 'start' out of range"); + if(start == n && isprime(n)){ + prime_list = mat[1 , 2]; + prime_list[0,0] = n; + prime_list[0,1] = 1; + } + else if(!isprime(start) && nextprime(start) >n) + return newerror("__CZ__factor_factorial(n,start): value of parameter " + "'start' out of range"); + else{ + if(!isprime(start)) prime = nextprime(start); + else prime = start; + } + } + else + prime = 2; + + pix = pix(n); + if(start){ + pix -= pix(prime) -1; + } + prime_list = mat[pix , 2]; + + k = 0; + + do { + prime_list[k ,0] = prime; + prime_list[k++,1] = __CZ__prime_divisors(n,prime); + prime = nextprime(prime); + }while(prime <= n); + + return prime_list; +} + +/* + + subtracts exponents of n_1! from exponents of n_2! with n_1<=n_2 + + Does not check for size or consecutiveness of the primes or a carry +*/ + +define __CZ__subtract_factored_factorials(matrix_2n,matrix_n){ + local k ret len1,len2,tmp count p e; + len1 = size(matrix_n)/2; + len2 = size(matrix_2n)/2; + if(len2 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=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(n5e4) + 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 && __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= 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)"; +} diff --git a/cal/lambertw.cal b/cal/lambertw.cal new file mode 100644 index 0000000..7f782f1 --- /dev/null +++ b/cal/lambertw.cal @@ -0,0 +1,288 @@ +/* + * lambertw- Lambert's W-function + * + * Copyright (C) 2013 Christoph Zurnieden + * + * lambertw 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. + * + * lambertw 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.3 $ + * @(#) $Id: lambertw.cal,v 30.3 2013/08/11 08:41:38 chongo Exp $ + * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/lambertw.cal,v $ + * + * Under source code control: 2013/08/11 01:31:28 + * File existed as early as: 2013 + */ + + +static resource_debug_level; +resource_debug_level = config("resource_debug", 0); + + +/* + + R. M. Corless and G. H. Gonnet and D. E. G. Hare and D. J. Jeffrey and + D. E. Knuth, "On the Lambert W Function", Advances n Computational + Mathematics, 329--359, (1996) + http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.112.6117 + + D. J. Jeffrey, D. E. G. Hare, R. M. Corless, "Unwinding the branches of the + Lambert W function", The Mathematical Scientist, 21, pp 1-7, (1996) + http://www.apmaths.uwo.ca/~djeffrey/Offprints/wbranch.pdf + + Darko Verebic, "Having Fun with Lambert W(x) Function" + arXiv:1003.1628v1, March 2010, http://arxiv.org/abs/1003.1628 + + Winitzki, S. "Uniform Approximations for Transcendental Functions", + In Part 1 of Computational Science and its Applications - ICCSA 2003, + Lecture Notes in Computer Science, Vol. 2667, Springer-Verlag, + Berlin, 2003, 780-789. DOI 10.1007/3-540-44839-X_82 + A copy may be found by Google. + + +*/ +static true = 1; +static false = 0; + +/* Branch 0, Winitzki (2003) , the well known Taylor series*/ +define __CZ__lambertw_0(z,eps){ + local a=2.344e0, b=0.8842e0, c=0.9294e0, d=0.5106e0, e=-1.213e0; + local y=sqrt(2*exp(1)*z+2); + return (2*ln(1+b*y)-ln(1+c*ln(1+d*y))+e)/(1+1/(2*ln(1+b*y)+2*a)); +} +/* branch -1 */ +define __CZ__lambertw_m1(z,eps){ + local wn k; + /* Cut-off found in Maxima */ + if(z < 0.3) return __CZ__lambertw_app(z,eps); + wn = z; + /* Verebic (2010) eqs. 16-18*/ + for(k=0;k<10;k++){ + wn = ln(-z)-ln(-wn); + } + return wn; +} + +/* + generic approximation + + series for 1+W((z-2)/(2 e)) + + Corless et al (1996) (4.22) + Verebic (2010) eqs. 35-37; more coefficients given at the end of sect. 3.1 + or online + http://www.wolframalpha.com/input/? + i=taylor+%28+1%2Bproductlog%28+%28z-2%29%2F%282*e%29+%29+%29 + or by using the function lambertw_series_print() after running + lambertw_series(z,eps,branch,terms) at least once with the wanted number of + terms and z = 1 (which might throw an error because the series will not + converge in anybodies lifetime for something that far from the branchpoint). + + +*/ +define __CZ__lambertw_app(z,eps){ + local b0=-1, b1=1, b2=-1/3, b3=11/72; + local y=sqrt(2*exp(1)*z+2); + return b0 + ( y * (b1 + (y * (b2 + (b3 * y))))); +} + +static __CZ__Ws_a; +static __CZ__Ws_c; +static __CZ__Ws_len=0; + +define lambertw_series_print(){ + local k; + for(k=0;k<__CZ__Ws_len;k++){ + print num(__CZ__Ws_c[k]):"/":den(__CZ__Ws_c[k]):"*p^":k; + } +} + +/* + The series is fast but only if _very_ close to the branchpoint + The exact branch must be given explicitly, e.g.: + +; lambertw(-exp(-1)+.001)-lambertw_series(-exp(-1)+.001,epsilon()*1e-10,0) + -0.14758879113205794065490184399030194122136720202792- + 0.00000000000000000000000000000000000000000000000000i +; lambertw(-exp(-1)+.001)-lambertw_series(-exp(-1)+.001,epsilon()*1e-10,1) + 0.00000000000000000000000000000000000000000000000000- + 0.00000000000000000000000000000000000000000000000000i + */ +define lambertw_series(z,eps,branch,terms){ + local k l limit tmp sum A C P PP epslocal; + if(!isnull(terms)) + limit = terms; + else + limit = 100; + + if(isnull(eps)) + eps = epsilon(epsilon()*1e-10); + epslocal = epsilon(eps); + + P = sqrt(2*(exp(1)*z+1)); + if(branch != 0) P = -P; + tmp=0;sum=0;PP=P; + + __CZ__Ws_a = mat[limit+1]; + __CZ__Ws_c = mat[limit+1]; + __CZ__Ws_len = limit; + /* + c0 = -1; c1 = 1 + a0 = 2; a1 =-1 + */ + __CZ__Ws_c[0] = -1; __CZ__Ws_c[1] = 1; + __CZ__Ws_a[0] = 2; __CZ__Ws_a[1] = -1; + sum += __CZ__Ws_c[0]; + sum += __CZ__Ws_c[1] * P; + PP *= P; + for(k=2;kbranchpoint && 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()"; +} diff --git a/cal/lnseries.cal b/cal/lnseries.cal new file mode 100644 index 0000000..ded4702 --- /dev/null +++ b/cal/lnseries.cal @@ -0,0 +1,112 @@ +/* + * special_functions - special functions (e.g.: gamma, zeta, psi) + * + * Copyright (C) 2013 Christoph Zurnieden + * + * lnseries.cal 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. + * + * lnseries.cal 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.3 $ + * @(#) $Id: lnseries.cal,v 30.3 2013/08/11 08:41:38 chongo Exp $ + * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/lnseries.cal,v $ + * + * Under source code control: 2013/08/11 01:31:28 + * File existed as early as: 2013 + */ + + +/* + * hide internal function from resource debugging + */ +static resource_debug_level; +resource_debug_level = config("resource_debug", 0); + + +static __CZ__int_logs; +static __CZ__int_logs_limit; +static __CZ__int_logs_prec; + + +define deletelnseries(){ + free(__CZ__int_logs,__CZ__int_logs_limit,__CZ__int_logs_prec); +} + +define lnfromseries(n){ + if( isnull(__CZ__int_logs) + || __CZ__int_logs_limit < n + || __CZ__int_logs_prec < log(1/epsilon())){ + + lnseries(n+1); + } + return __CZ__int_logs[n,0]; +} + +define lnseries(limit){ + local k j eps ; + if( isnull(__CZ__int_logs) + || __CZ__int_logs_limit < limit + || __CZ__int_logs_prec < log(1/epsilon())){ + __CZ__int_logs = mat[limit+1,2]; + __CZ__int_logs_limit = limit; + __CZ__int_logs_prec = log(1/epsilon()); + + /* probably still too much */ + eps = epsilon(epsilon()*10^(-(5+log(limit)))); + k =2; + while(1){ + /* the prime itself, compute logarithm */ + __CZ__int_logs[k,0] = ln(k); + __CZ__int_logs[k,1] = k; + + for(j = 2*k;j<=limit;j+=k){ + /* multiples of prime k, add logarithm of k computed earlier */ + __CZ__int_logs[j,0] += __CZ__int_logs[k,0]; + /* First hit, set counter to number */ + if(__CZ__int_logs[j,1] ==0) + __CZ__int_logs[j,1]=j; + /* reduce counter by prime added */ + __CZ__int_logs[j,1] //= __CZ__int_logs[k,1]; + } + + k++; + if(k>=limit) break; + /* Erastothenes-sieve: look for next prime. */ + while(__CZ__int_logs[k,0]!=0){ + k++; + if(k>=limit) break; + } + } + /* Second run to include the last factor */ + for(k=1;k<=limit;k++){ + if(__CZ__int_logs[k,1] != k){ + __CZ__int_logs[k,0] +=__CZ__int_logs[ __CZ__int_logs[k,1],0]; + __CZ__int_logs[k,1] = 0; + } + } + + epsilon(eps); + } + return 1; +} + + +/* + * restore internal function from resource debugging + */ +config("resource_debug", resource_debug_level),; +if (config("resource_debug") & 3) { + print "lnseries(limit)"; + print "lnfromseries(n)"; + print "deletelnseries()"; +} diff --git a/cal/quat.cal b/cal/quat.cal index 9e42448..bf8cd32 100644 --- a/cal/quat.cal +++ b/cal/quat.cal @@ -17,8 +17,8 @@ * 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 $ + * @(#) $Revision: 30.2 $ + * @(#) $Id: quat.cal,v 30.2 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/quat.cal,v $ * * Under source code control: 1990/02/15 01:50:35 @@ -55,7 +55,8 @@ define quat(a,b,c,d) define quat_print(a) { - print "quat(" : a.s : ", " : a.v[0] : ", " : a.v[1] : ", " : a.v[2] : ")" :; + print "quat(" : a.s : ", " : a.v[0] : ", " : + a.v[1] : ", " : a.v[2] : ")" :; } diff --git a/cal/regress.cal b/cal/regress.cal index 680db32..b765a8a 100644 --- a/cal/regress.cal +++ b/cal/regress.cal @@ -17,8 +17,8 @@ * 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.7 $ - * @(#) $Id: regress.cal,v 30.7 2013/08/11 02:57:22 chongo Exp $ + * @(#) $Revision: 30.8 $ + * @(#) $Id: regress.cal,v 30.8 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/regress.cal,v $ * * Under source code control: 1990/02/15 01:50:36 @@ -1397,7 +1397,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'); @@ -1509,8 +1510,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'); @@ -4892,7 +4895,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'); @@ -6506,7 +6510,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 +6876,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'); @@ -7923,7 +7929,6 @@ print '8901: read -once "test8900"'; read -once "test8900"; print '8902: about to run test8900(1,,8903)'; testnum = test8900(1,,8903); -print testnum: ": End of test of calc resource functions by Christoph Zurnieden"; /* 89xx: test calc resource functions by Christoph Zurnieden */ diff --git a/cal/solve.cal b/cal/solve.cal index 65ae2a1..5656780 100644 --- a/cal/solve.cal +++ b/cal/solve.cal @@ -17,8 +17,8 @@ * 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 $ + * @(#) $Revision: 30.3 $ + * @(#) $Id: solve.cal,v 30.3 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/solve.cal,v $ * * Under source code control: 1990/02/15 01:50:37 @@ -52,7 +52,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); diff --git a/cal/specialfunctions.cal b/cal/specialfunctions.cal new file mode 100644 index 0000000..448f4d1 --- /dev/null +++ b/cal/specialfunctions.cal @@ -0,0 +1,1394 @@ +/* + * special_functions - special functions (e.g.: gamma, zeta, psi) + * + * Copyright (C) 2013 Christoph Zurnieden + * + * special_functions 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. + * + * special_functions is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser + * General Public License for more details. + * + * A copy of version 2.1 of the GNU Lesser General Public License is + * distributed with calc under the filename COPYING-LGPL. You should have + * received a copy with calc; if not, write to Free Software Foundation, Inc. + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + * + * @(#) $Revision: 30.4 $ + * @(#) $Id: specialfunctions.cal,v 30.4 2013/08/11 08:41:38 chongo Exp $ + * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/specialfunctions.cal,v $ + * + * Under source code control: 2013/08/11 01:31:28 + * File existed as early as: 2013 + */ + + +/* + * hide internal function from resource debugging + */ +static resource_debug_level; +resource_debug_level = config("resource_debug", 0); + + +/* + get dependencies +*/ +read -once zeta2; + + +/* + zeta2(x,s) is in the extra file "zeta2.cal" because of a different license: + GPL instead of LGPL. +*/ +define zeta(s) +{ + /* Not the best way, I'm afraid, but a way. */ + return hurwitzzeta(s,1); +} + +define psi0(z){ + local i k m x y eps_digits eps ret; + + /* + One can use the Stirling series, too, which might be faster for some + values. The series used here converges very fast but needs a lot of + bernoulli numbers which are quite expensive to compute. + */ + + eps = epsilon(); + epsilon(eps*1e-3); + if(isint(z) && z<=0)return newerror("psi(z); z is a negative integer or 0"); + if(re(z) < 0){ + return ( pi() * cot(pi() * (0-z) ) ) + psi0(1-z); + } + eps_digits = digits(1/epsilon()); + /* + R.W. Gosper has r = .41 as the relation, empirical tests showed that + for d<100 r = .375 is sufficient and r = .396 for d<200. + It does not save much time but for a long series even a little + can grow large. + */ + if(eps_digits < 100) + k = 2 * ceil(.375 * eps_digits); + else if(eps_digits < 200) + k = 2 * ceil(.395 * eps_digits); + else + k = 2 * ceil(11/27 * eps_digits); + m = 0; + y = (z+k)^2; + x = 0.0; + /* + There is a chance to speed up the first partial sum with binary splitting. + The second partial sum is dominated by the calculation of the Bernoulli + numbers but can profit from binary splitting when the Bernoulli numbers are + already cached. + */ + for(i = 1; i <= (k/2); i++){ + m = 1 / ( z + 2*i - 1) + 1 / ( z + 2*i -2 ) + m; + x = ( x + bernoulli(k-2*i+2) / (k-2*i+2) ) / y ; + } + ret = ln(z+k) - 1 / ( 2 * (z+k) ) - x - m ; + epsilon(eps); + return ret; +} + +define psi(z) +{ + return psi0(z); +} + +define polygamma(m,z) +{ + /* + TODO: + http://functions.wolfram.com/GammaBetaErf/PolyGamma2/16/01/01/0002/ + */ + if(!isint(m))return newerror("polygamma(m,z); m not an integer"); + if( m<0 )return newerror("polygamma(m,z); m is < 0"); + /* + Reflection formula not implemented yet, needs cot-differentiation + http://functions.wolfram.com/ElementaryFunctions/Cot/20/02/0003/ + which is not implemented yet. + */ + if( m == 0){ + return psi0(z); + } + /* + use factorial for m a (small) integer? + use lngamma for m large? + */ + if(isodd(m+1)){ + return (-1)* gamma(m+1) * hurwitzzeta(m+1,z) + } + return gamma(m+1) * hurwitzzeta(m+1,z); +} + +/* + Cache for the variable independent coefficients in the sum for the + Gamma-function. +*/ +static __CZ__Ck; +/* + Log-Gamma function for Re(z) > 0. +*/ +define __CZ__lngammarp(z) +{ + local epsilon accuracy a factrl sum n ret holds_enough term; + + epsilon = epsilon(); + accuracy = digits(int(1/epsilon)) + 3; + + epsilon(1e-18); + a = ceil(1.252850440912568095810522965 * accuracy); + + epsilon(epsilon*10^(-(digits(1/epsilon)//2))); + + holds_enough = 0; + + if(size( __CZ__Ck) != a) { + __CZ__Ck = mat[a]; + holds_enough = 1; + } + + factrl = 1.0; + + __CZ__Ck[0] = sqrt(2*pi()); /* c_0*/ + for(n = 1; n < a; n++){ + if(holds_enough == 1){ + __CZ__Ck[n] = (a - n)^(n - 0.5) * exp(a - n) /factrl; + factrl *= -n + } + } + sum = __CZ__Ck[0]; + for (n = 1; n < a; n++){ + sum += __CZ__Ck[n]/(z+n); + } + + ret = ln(sum)+(-(z+a)) + ln(z+a)*( z+0.5); + ret = ret-ln(z); + + /* + Will take some time for large im(z) but almost all time is spend above + in that case. + */ + if(im(ret)) + ret = re(ret) + ln( exp( im(ret) *1i ) ); + + epsilon(epsilon); + return ret; +} + +/* Simple lngamma with low precision*/ +define __CZ__lngamma_lanczos(z){ + local a k g zghalf lanczos; + mat lanczos[15] = { + 9.9999999999999709182e-1, + 5.7156235665862923516e1, + -5.9597960355475491248e1, + 1.4136097974741747173e1, + -4.9191381609762019978e-1, + 3.3994649984811888638e-5, + 4.6523628927048576010e-5, + -9.8374475304879566105e-5, + 1.5808870322491249322e-4, + -2.1026444172410489480e-4, + 2.1743961811521265523e-4, + -1.6431810653676390482e-4, + 8.4418223983852751308e-5, + -2.6190838401581411237e-5, + 3.6899182659531626821e-6 + }; + g = 607/128; + z = z-1; + a = 0; + for(k = 12; k >= 1; k--){ + a += lanczos[k]/(z+k); + } + a += lanczos[0]; + zghalf = z + g + .5; + return ( ln(sqrt(2*pi())) + ln(a) -zghalf ) + (z+.5)*ln( zghalf ); +} + +/* Prints the Spouge coefficients actually in use. */ +define __CZ__print__CZ__Ck(){ + local k; + if(size(__CZ__Ck) <=1){ + __CZ__lngammarp(2.2-2.2i); + } + for(k=0;k= mat[0,2]*/ +static __CZ__stirling_params; + +define __CZ__lngstirling(z,n){ + local k head sum z2 bernterm zz; + head = (z-1/2)*ln(z)-z+(ln(2*pi())/2); + sum = 0; + bernterm=0; + zz = z; + z2 = z^2; + + if(size(__CZ__precomp_stirling) 0){ + flag = 0; + eps = epsilon(); + epsilon(eps*1e-3); + + /* Compute values on the real line with Spouge's algorithm*/ + if(!im(z)){# + ret = __CZ__lngammarp(z); + epsilon(eps); + return ret; + } + /* Do the rest with the Stirling series.*/ + /* This code repeats down under. Booh! */ + /* Make it a positive im(z) */ + if(im(z)<0){ + z = conj(z); + flag = 1; + } + /* Evaluate the number of terms needed */ + decdigits = floor( digits(1/eps) ); + /* 20 dec. digits is the default in calc(?)*/ + if(decdigits <= 21){ + /* set 20 as the minimum */ + epsilon(1e-22); + increasedby = 0; + /* inflate z */ + Z=z; + while(abs(z) < 10){ + z++; + increasedby++; + } + + ret = __CZ__lngstirling(z,11); + /* deflate z */ + if(increasedby > 1){ + for(k=0;k 0 produces the rest as a by-product. + Nevertheless we could use a faster asymptotic approximation. + + We increment the number of terms "k" in R(z,k) until the result + quits incrementing (it may even get smaller!). If the result is + still smaller than the current precision we increment "z" with + fixed "k" untill the result quits incrementing. + The results, the current precision, abs(re(z)) and "k" are kept. + + BTW: incrementing the number of terms might be more costly than + incrementing "z" -- computing large Bernoulli numbers vs. + computing a large number of complex logarithms is a fight with + a hard to know result -- and that the series isn't convergent + is of not much help either. E.g: + R(25,68) = 71 max + R(50,55) = 101 + R(50,145) = 140 max + R(60,170) = 167 max + R(70,209) = 195 max + R(75,173) = 200 max + R(80,147) = 200 max + R(90,124) = 200 max + R(100,111) = 200 max + Bernoulli(222) has a denominator of 9388 with a 254 digit + numerator. Computing up to 100 complex logarithms on the + other side ... + + D.E.G. Hare has found the bounds + |im(z)| > .37d or re(z) >= 0 and |z| > .52d + to be usefull to compute "z" to d digits accuracy. The numbers + correspond to the table above. + + To avoid repeated expensive computation, the result is cached + together with the current precision. It might be a good idea + to keep it more permanently in a config-file? + */ + d37 = decdigits * .37; + d52 = decdigits * .52; + termcount = ceil(d52); + if(abs(z) >= d52){ + if(abs(im(z))>= d37 ) + termcount = ceil(d37); + else + termcount = ceil(d52); + } + + Z=z; + increasedby = 0; + /* inflate z */ + if( abs(im(z))>= d37){ + while(abs(z) < d52+1){ + z++; + increasedby++; + } + } + else{ + tmp = R(z,termcount); + tmp2 = tmp; + while(tmp2 < decdigits){ + z++; + increasedby++; + tmp2 = R(z,termcount); + if(tmp2 < tmp) + return newerror("lngamma(1): something happend that " + "should not have happend"); + } + } + + corr = ceil( re(z)/2 -3/4 - kroneckerdelta(im(z))/4); + + ret = __CZ__lngstirling(z,termcount); + + /* deflate z */ + if(increasedby > 1){ + for(k=0;k 0) */ + else{/* re(z)<0 */ + eps = epsilon(); + epsilon(eps*1e-3); + + /* Use Spouge's approximation on the real line */ + if(!im(z)){ + /* reflection */ + ret = ln( pi() / sin(pi() *z ) ) - __CZ__lngammarp(1-z); + /* it is log(gamma) and im(log(even(-x))) = k\pi, therefore: */ + if(abs(z) <= 1/2) + ret = re(ret) - pi()*1i; + else if( isodd(floor(abs(re(z)))) ){ + ret = re(ret) + ( ceil(abs(z)) * pi() * 1i); + } + else if( iseven(floor(abs(re(z)))) ){ + /* < n+1/2 */ + if(iseven(floor(abs(z)))){ + ret = re(ret) + ( ceil(abs(z)-1/2 -1 ) * pi() * 1i); + } + else{ + ret = re(ret) + ( ceil(abs(z) -1/2 ) * pi() * 1i); + } + } + epsilon(eps); + return ret; + }/*if(!im(z))*/ + /* Use Stirlinsg approximation for the rest of the complex plane */ + else{ + /* Make it a positive im(z) */ + if(im(z)<0){ + z = conj(z); + flag = 1; + } + /* Evaluate the number of terms needed */ + decdigits = floor( digits(1/eps) ); + /* + Evaluate the correction term for the imaginary part needed because + of the reflection. + See + D. E. G. Hare, "Computing the Principal Branch of log-Gamma", + Journal of Algorithms 25(2):221-236 (1997) + http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.84.2063 + */ + + /* 20 dec. digits is the default in calc(?)*/ + if(decdigits <= 21){ + /* set 20 as the minimum */ + epsilon(1e-22); + termcount = 11; + increasedby = 0; + Z=z; + /* inflate z */ + if( im(z)>= digits(1/epsilon()) * .37){ + while(abs(1-z) < 10){ + /* making z more negative makes 1-z more positive. */ + z--; + increasedby++; + } + } + else{ + tmp = R(1-z,termcount); + tmp2 = tmp; + while(tmp2 < 21){ + z--; + increasedby++; + tmp2 = R(1-z,termcount); + if(tmp2 < tmp) + return newerror("lngamma(1): something happend " + "that should not have happend"); + } + } + + corr = ceil( re(z)/2 -3/4 - kroneckerdelta(im(z))/4); + + /* reflection */ + ret = ln( pi() / sin(pi() * z ) ) - __CZ__lngstirling(1-z,termcount); + + /* deflate z */ + if(increasedby > 0){ + for(k=0;k= d52){ + if(abs(im(z))>= d37 ) + termcount = ceil(d37); + else + termcount = ceil(d52); + } + increasedby = 0; + ##print "Z 1: ",z; + Z=z; + /* inflate z */ + if( abs(im(z))>= d37){ + while(abs(1-z) < d52+1){ + /* making z more negative makes 1-z more positive. */ + z--; + increasedby++; + } + } + else{ + tmp = R(1-z,termcount); + tmp2 = tmp; + while(tmp2 < decdigits){ + z--; + increasedby++; + tmp2 = R(1-z,termcount); + if(tmp2 < tmp) + return newerror("lngamma(1): something happend that " + "should not have happend"); + } + } + corr = ceil( re(z)/2 -3/4 - kroneckerdelta(im(z))/4); + /* reflection */ + ret = ln( pi() / sin(pi() *(z) ) ) - + __CZ__lngstirling(1-z,termcount); + /* deflate z */ + if(increasedby > 0){ + for(k=0;k 0){...} else */ + }/*if(isint(z)){...} else*/ +} + +/* Warning about large values? */ +define gamma(z) +{ + + /* exp(log(gamma(z))) = exp(lngamma(z)), so use Spouge here?*/ + local ret eps; + if(isint(z)){ + if(z <=0) + return newerror("gamma(z): z is a negative integer"); + else{ + /* may hold up accuracy a bit longer, but YMMV */ + if(z < 20) + return (z-1)!*1.0; + else{ + eps = epsilon(epsilon()*1e-2); + ret = exp(lngamma(z)); + epsilon(eps); + return ret; + } + } + } + else{ + eps = epsilon(epsilon()*1e-2); + ret = exp(lngamma(z)); + epsilon(eps); + return ret; + } +} + +define __CZ__harmonicF( a, b ,s) +{ + local c; + if( b == a) return s ; + if( b-a > 1){ + c= (b + a) >> 1; + return( __CZ__harmonicF(a, c,1/a) + __CZ__harmonicF(c+1, b,1/b)); + } + return (1/a+1/b); +} + +define harmonic(limit) +{ + if( !isint(limit) ) + return newerror("harmonic(limit): limit is not an integer"); + if( limit <= 0 ) + return newerror("harmonic(limit): limit is <=0"); + /* The binary splitting algorithm returns 0 for f(1,1,0) */ + if( limit == 1 ) return 1; + return __CZ__harmonicF( 1, limit ,0); +} + +/* lower incomplete gamma function */ + +/* lower + for z <= 1.1 + */ +define __CZ__gammainc_series_lower(a,z){ + local k ret tmp eps fact; + ret = 0; + k=0; + tmp=1; + fact = 1; + eps = epsilon(); + while(abs(tmp-ret) > eps){ + tmp = ret; + ret += (z^(k+a))/( (a+k)*fact ); + k++; + fact *= -k; + } + return gamma(a)-ret; +} + +/* lower + for z > 1.1 + */ +define __CZ__gammainc_cf(a,z,n){ + local ret k num1 denom1 num2 denom2 ; + ret = 0; + for(k=n+1;k>1;k--){ + ret = ((1-k)*(k-1-a))/(2*k-1+z-a+ret); + } + return ((z^a*exp(-z))/(1+z-a+ret)); +} + +/* G(n,z) lower*/ +define __CZ__gammainc_integer_a(a,z){ + local k sum fact zz; + for(k=0;k G(a,z) +*/ +define __CZ__endcf(n,a,z,P){ + local ret; + + ret = P*ln(10)+ln(4*pi()*sqrt(n)) + re(z+(3/2-a)*ln(z)-lngamma(1-a)); + ret = ret /( sqrt( 8*(abs(z)+re(z)) ) ); + return ret^2; + +} + +/* lower incomplete gamma function */ define gammainc(a,z){ + local ret nterms eps epsilon tmp_before tmp_after n A B C sum k; + if(z == 0) + return 1; + if(isint(a)){ + if(a>0){ + if(a==1) return exp(-z); return __CZ__gammainc_integer_a(a,z); + } else{ + if(a==0){ + return -expoint(-z)+1/2*( ln(-z) - ln(-1/z) ) -ln(z); + } else if(a==-1){ + return expoint(-z)+1/2*(ln(-1/z)-ln(-z))+ln(z)+(exp(-z)/z); + } else{ + A = (-1)^((-a)-1)/((-a)!); B = + expoint(-z)-1/2*(ln(-z)-ln(1/-z))+ln(z); C = exp(-z); sum =0; + for(k=1;k<-a;k++){ + sum += (z^(k-a-1))/( fallingfactorial(-a,k) ); + } return A * B - C *sum; + } + } + } if(re(z)<=1.1|| re(z) < a+1){##print "series"; + eps = epsilon(epsilon()*1e-10); ret = + __CZ__gammainc_series_lower(a,z); epsilon(eps); return ret; + } else{##print "cf"; + eps = epsilon(epsilon()*1e-10); if(abs(exp(-z)) <= eps) return 0; + tmp_before = 0; tmp_after = 1; n = 1; while(ceil(tmp_before) != + ceil(tmp_after)){ + tmp_before = tmp_after; tmp_after = + __CZ__endcf(n++,a,z,digits(1/eps)); /* a still quite arbitrary + limit */ if(n > 10){ + return newerror("gammainc: evaluating limit for continued " + "fraction does not converge"); + } + } ret = __CZ__gammainc_cf(a,z,ceil(tmp_after)); epsilon(eps); + return ret; + } +} + +define heavisidestep(x){ + return (1+sign(x))/2; +} + +define NUMBER_POSITIVE_INFINITY(){ return 1/epsilon();} + +define NUMBER_NEGATIVE_INFINITY(){ return -(1/epsilon());} + +static TRUE = 1; +static FALSE = 0; + +define g(prec){ + local eps ret; + if(!isnull(prec)){ + eps = epsilon(prec); + ret = -psi(1); + epsilon(eps); + return ret; + } + return -psi(1); +} + +define __CZ__series_converged(new,old,max){ + local eps; + if(isnull(max)) + eps = epsilon(); + else + eps = max; + if( abs(re(new - old)) <= eps * abs(re(new)) + && abs(im(new - old)) <= eps * abs(im(new))) + return TRUE; + return FALSE; +} + +define __CZ__ei_power(z){ + local tmp ei k old; + ei = g() + ln(abs(z)) + sgn(im(z)) * 1i * abs(arg(z)); + ##ei = g() + ln(z) -1i*pi()*floor( (arg(z)+pi()) / (2*pi()) ); + tmp = 1; + k = 1; + while(k){ + tmp *= z / k; + old = ei; + ei += tmp / k; + if (__CZ__series_converged(ei,old)) break; + k++; + } + return ei; +} + +define __CZ__ei_asymp(z){ + local ei old tmp k; + ei = sgn(im(z)) * 1i * pi(); + tmp = exp(z) / z; + for(k=1; k<=floor(abs(z))+1; k++){ + old = ei; + ei += tmp; + if (__CZ__series_converged(ei, old)) return ei; + tmp *= k / z; + } + return newerror("expoint: asymptotic series does not converge"); +} + +define __CZ__ei_cf(z){ + local ei c d k old; + ei = sgn(im(z)) * 1i * pi(); + if(ei != 0){ + c = 1 / ei; + d = 0; + c = 1 / (1 - z - exp(z) * c); + d = 1 / (1 - z - exp(z) * d); + ei *= d / c; + } + else{ + c = NUMBER_POSITIVE_INFINITY(); + d = 0; + c = 0; + d = 1 / (1 - z - exp(z) * d); + ei = d * (- exp(z)); + } + k = 1; + while(1){ + c = 1 / (2 * k + 1 - z - k * k * c); + d = 1 / (2 * k + 1 - z - k * k * d); + old = ei; + ei *= d / c; + if (__CZ__series_converged(ei, old)) break; + k++; + } + return ei; +} + +define expoint(z){ + local ei eps ret; + eps=epsilon(epsilon()*1e-5); + if(abs(z) >= NUMBER_POSITIVE_INFINITY()){ + if (config("user_debug") > 0) { + print "expoint: abs(z) > +inf"; + } + ret = sgn(im(z)) * 1i * pi() + exp(z) / z; + epsilon(eps); + return ret; + } + if(abs(z) > 2 - 1.035 * log(epsilon())){ + if (config("user_debug") > 0) { + print "expoint: using asymptotic series"; + } + ei = __CZ__ei_asymp(z); + if (!iserror(ei)){ + ret = ei; + epsilon(eps); + return ret; + } + } + if(abs(z) > 1 && (re(z) < 0 || abs(im(z)) > 1)){ + if (config("user_debug") > 0) { + print "expoint: using continued fraction"; + } + ret = __CZ__ei_cf(z); + epsilon(eps); + return ret; + } + if(abs(z) > 0){ + if (config("user_debug") > 0) { + print "expoint: using power series"; + } + ret = __CZ__ei_power(z); + epsilon(eps); + return ret; + } + if(abs(z) == 0){ + if (config("user_debug") > 0) { + print "expoint: abs(z) = zero "; + } + epsilon(eps); + return NUMBER_NEGATIVE_INFINITY(); + } +} + +define erf(z){ + return sqrt(z^2)/z * ( 1-1/sqrt(pi()) *gammainc(1/2,z^2) ); +} + +define erfc(z){ + return 1-erf(z); +} + +define erfi(z){ + return -1i*erf(1i*z); +} + +define faddeeva(z){ + return exp(-z^2)*erfc(-1i*z); +} + +define gammap(a,z){ + return gammainc(a,z)/gamma(a); +} + +define gammaq(a,z){ + return 1-gammap(a,z); +} + +define lnbeta(a,b){ + local ret eps; + eps=epsilon(epsilon()*1e-3); + ret = (lngamma(a)+lngamma(b))-lngamma(a+b); + epsilon(eps); + return ret; +} + +define beta(a,b){ + return exp(lnbeta(a,b)); +} + +define __CZ__ibetacf_a(a,b,z,n){ + local A B m places; + if(n==1) return 1; + m=n-1; + places = highbit(1 + int(1/epsilon())) + 1; + A = bround((a+m-1) * (a+b+m-1) * m * (b-m) * z^2,places++); + B = bround((a+2*(m)-1)^2,places++); + return A/B; +} + +define __CZ__ibetacf_b(a,b,z,n){ + local A B m places; + places = highbit(1 + int(1/epsilon())) + 1; + m=n-1; + A = bround((m*(b-m)*z)/(a+2*m-1),places++); + B = bround(( (a+m) * (a-(a+b)*z+1+m*(2-z)) )/(a+2*m+1),places++); + return m+A+B; +} + +/* Didonato-Morris */ +define __CZ__ibeta_cf_var_dm(a,b,z,max){ + local m f c d check del h qab qam qap eps places; + + eps= epsilon(); + + if(isnull(max)) max = 100; + places = highbit(1 + int(1/epsilon())) + 1; + f = eps; + c = f; + d = 0; + for(m=1;m<=max;m++){ + d =bround( __CZ__ibetacf_b(a,b,z,m)+__CZ__ibetacf_a(a,b,z,m)*d,places++); + if(abs(d) max) return newerror("ibeta: continous fraction does not converge"); + return f; +} + +define betainc_complex(z,a,b){ + local factor ret eps cf sum k N places tmp tmp2; + + if(z == 0){ + if(re(a) > 0) return 0; + if(re(a) < 0) return newerror("betainc_complex: z == 0 and re(a) < 0"); + } + if(z == 1){ + if(re(b)>0) return 1; + else return newerror("betainc_complex: z == 1 and re(b) < 0"); + } + if(b<=0){ + if(isint(b)) return 0; + else return newerror("betainc_complex: b <= 0"); + } + if(z==1/2 && (a==b)){return 1/2; + } + ##if(2==1){ + if(isint(a) && isint(b)){ + eps=epsilon(epsilon()*1e-10); + N = a+b-1; + sum = 0; + for(k=a;k<=N;k++){ + tmp = ln(z)*k+ln(1-z)*(N-k); + tmp2 = exp(ln(comb(N,k))+tmp); + sum += tmp2; + } + epsilon(eps); + return sum + } + else if(re(z) <= re((a+1)/(a+b+2))){ + eps=epsilon(epsilon()*1e-10); + places = highbit(1 + int(1/epsilon())) + 1; + factor = bround(( ln(z^a*(1-z)^b ) - lnbeta(a,b) ),places); + cf =bround( __CZ__ibeta_cf_var_dm(a,b,z),places); + ret = factor + ln(cf); + if(abs(ret//ln(2)) >= places) + ret = 0; + else + ret = bround(exp(factor + ln(cf)),places); + epsilon(eps); + return ret; + } + else if( re(z) > re( (a+1)/(a+b+2) ) || re(1-z) < re( (b+1)/(a+b+2) ) ){ + ret = 1 - betainc_complex(1-z,b,a); + } + return ret; +} + + +/******************************************************************************/ +/* + Purpose: + + __CZ__ibetaas63 computes the incomplete Beta function ratio. + + Licensing: + + This code is distributed under the GNU LGPL license. + + Modified: + + 2013-08-03 20:52:05 +0000 + + Author: + + Original FORTRAN77 version by KL Majumder, GP Bhattacharjee. + C version by John Burkardt + Calc version by Christoph Zurnieden + + Reference: + + KL Majumder, GP Bhattacharjee, + Algorithm AS 63: + The incomplete Beta Integral, + Applied Statistics, + Volume 22, Number 3, 1973, pages 409-411. + + Parameters: + + Input, x, the argument, between 0 and 1. + + Input, a, b, the parameters, which + must be positive. + + + Output, the value of the incomplete + Beta function ratio. +*/ +define __CZ__ibetaas63(x, a, b,beta){ + local ai betain cx indx ns aa asb bb rx temp term value xx acu places; + acu = epsilon(); + + value = x; + /* inverse incbeta calculates it already */ + if(isnull(beta)) + beta = lnbeta(a,b); + + if ( a <= 0.0 || b <= 0.0 ){ + return newerror("betainc: domain error: a < 0 and/or b < 0"); + } + if ( x < 0.0 || 1.0 < x ){ + return newerror("betainc: domain error: x<0 or x>1"); + } + if ( x == 0.0 || x == 1.0 ){ + return value; + } + asb = a + b; + cx = 1.0 - x; + + if ( a < asb * x ){ + xx = cx; + cx = x; + aa = b; + bb = a; + indx = 1; + } + else{ + xx = x; + aa = a; + bb = b; + indx = 0; + } + + term = 1.0; + ai = 1.0; + value = 1.0; + ns = floor( bb + cx * asb ); + + rx = xx / cx; + temp = bb - ai; + if ( ns == 0 ){ + rx = xx; + } + places = highbit(1 + int(1/acu)) + 1; + while(1){ + term = bround(term * temp * rx / ( aa + ai ),places++); + value = value + term;; + temp = abs ( term ); + + if ( temp <= acu && temp <= abs(acu * value) ){ + value = value * exp ( aa * ln ( xx ) + + ( bb - 1.0 ) * ln ( cx ) - beta ) / aa; + + if ( indx ){ + value = 1.0 - value; + } + break; + } + + ai = ai + 1.0; + ns = ns - 1; + + if ( 0 <= ns ) { + temp = bb - ai; + if ( ns == 0 ) { + rx = xx; + } + } + else { + temp = asb; + asb = asb + 1.0; + } + } + epsilon(acu); + return value; +} + +/* + z + / + [ b - 1 a - 1 + 1/beta(a,b) * I (1 - t) t dt + ] + / + 0 + +*/ + +define betainc(z,a,b){ + local factor ret eps cf sum k N places tmp tmp2; + + if(im(z) || im(a) || im(b)) + return betainc_complex(z,a,b); + + if(z == 0){ + if(re(a) > 0) return 0; + if(re(a) < 0) return newerror("betainc: z == 0 and re(a) < 0"); + } + if(z == 1){ + if(re(b)>0) return 1; + else return newerror("betainc: z == 1 and re(b) < 0"); + } + if(b<=0){ + if(isint(b)) return 0; + else return newerror("betainc: b <= 0"); + } + if(z==1/2 && a==b){ + return 1/2; + } + return __CZ__ibetaas63(z,a,b); + +} + +define __CZ__erfinvapprox(x){ + local a; + a =0.147; + return sgn(x)*sqrt(sqrt((2/(pi()*a)+(ln(1-x^2))/2)^2-(ln(1-x^2))/a)- + (2/(pi()*a)+(ln(1-x^2))/2)); +} + +/* complementary inverse errror function, faster at about x < 1-.91 + Henry E. Fettis. "A stable algorithm for computing the inverse error function + in the 'tail-end' region" Math. Comp., 28:585-587, 1974. +*/ +define __CZ__inverffettis(x,n){ + local y sqrtpi oldy k places; + if (isnull(n)) + n = 205; + y = erfinvapprox(1-x); + places = highbit(1 + int(1/epsilon())) + 1; + sqrtpi = sqrt(pi()); + do + { + oldy = y;k++; + y = bround((ln( __CZ__fettiscf(y,n) / (sqrtpi * x)))^(1/2),places); + } while( abs(y - oldy)/y > epsilon()); + return y; +} + +/* cf for erfc() */ +define __CZ__fettiscf(y,n){ + local k t tt r a b ; + t = 1/y; + tt = t^2/2; + for (k=n;k> 0;k--){ + a = 1; + b = k*tt; + r = b / (a + r); + } + return t / (1+r); +} + +/* inverse errror function, faster at about x<=.91*/ +define __CZ__inverfbin(x){ + local places approx flow fhigh eps high low mid fmid epsilon; + approx = erfinvapprox(x); + epsilon = epsilon(); + high = approx + 1e-4; + low = -1; + places = highbit(1 + int(1/epsilon)) + 1; + fhigh = x-erf(high); + flow = x-erf(low); + while(1){ + mid = bround(high - fhigh * (high - low) / (fhigh - flow), places); + if ((mid == low) || (mid == high)) + places++; + fmid = x-erf(mid); + if (abs(fmid) < epsilon) + return mid; + if (sgn(fmid) == sgn(flow)) { + low = mid; + flow = fmid; + } + else { + high = mid; + fhigh = fmid; + } + } +} + +define erfinv(x){ + local ret approx a eps y old places errfunc sqrtpihalf flag k; + if(x<-1 || x > 1) return newerror("erfinv: input out of domain (-1<=x<=1)"); + if(x == 0) return 0; + if(x == -1) return NUMBER_NEGATIVE_INFINITY(); + if(x == +1) return NUMBER_POSITIVE_INFINITY(); + + if(x<0){ + x = -x; + flag = 1; + } + /* No need for full pecision */ + eps=epsilon(1e-20); + if(eps >= 1e-40){ + /* Winitzki, Sergei (6 February 2008). "A handy approximation for the error + function and its inverse"*/ + a = 0.147; + y = sgn(x)*sqrt(sqrt((2/(pi()*a) + +(ln(1-x^2))/2)^2 + -(ln(1-x^2))/a) + -(2/(pi()*a)+(ln(1-x^2))/2)); + + } + else { + /* 20 digits instead of 5 */ + if(x <= .91) + y = __CZ__inverfbin(x); + else + y = __CZ__inverffettis(1-x); + + if(eps <= 1e-20){ + epsilon(eps); + return y; + } + } + epsilon(eps); + /* binary digits in number (here: number = epsilon()) */ + places = highbit(1 + int(1/eps)) + 1; + sqrtpihalf = 2/sqrt(pi()); + k = 0; + /* + Do some Newton-Raphson steps to reach final accuracy. + Only a couple of steps are necessary but calculating the error function at + higher precision is quite costly; + */ + do{ + old = y; + errfunc = bround( erf(y),places); + if( abs(errfunc-x) <= eps ) break; + y = bround(y-( errfunc -x) / ( sqrtpihalf * exp(-y^2)),places); + k++; + }while(1); + /* + This is not really necessary but e.g: + ; epsilon(1e-50) + 0.00000000000000000000000000000000000000000000000001 + ; erfinv(.9999999999999999999999999999999) + 8.28769266865549025938 + ; erfinv(.999999999999999999999999999999) + 8.14861622316986460738453487549552168842204512959346 + ; erf(8.28769266865549025938) + 0.99999999999999999999999999999990000000000000000000 + ; erf(8.14861622316986460738453487549552168842204512959346) + 0.99999999999999999999999999999900000000000000000000 + The precision "looks too short". + */ + if(k == 0) + y = bround(y-( errfunc -x) / ( sqrtpihalf * exp(-y^2)),places); + if(flag == 1) + y = -y; + return y; +} + + +/* + * restore internal function from resource debugging + */ +config("resource_debug", resource_debug_level),; +if (config("resource_debug") & 3) { + print "zeta(z)"; + print "psi(z)"; + print "polygamma(m,z)"; + print "lngamma(z)"; + print "gamma(z)"; + print "harmonic(limit)"; + print "gammainc(a,z)"; + print "heavisidestep(x)"; + print "expoint(z)"; + print "erf(z)"; + print "erfinv(x)"; + print "erfc(z)"; + print "erfi(z)"; + print "erfinv(x)"; + print "faddeeva(z)"; + print "gammap(a,z)"; + print "gammaq(a,z)"; + print "beta(a,b)"; + print "lnbeta(a,b)"; + print "betainc(z,a,b)"; +} diff --git a/cal/statistics.cal b/cal/statistics.cal new file mode 100644 index 0000000..2f4ca16 --- /dev/null +++ b/cal/statistics.cal @@ -0,0 +1,502 @@ +/* + * statistics - Some assorted statistics functions. + * + * Copyright (C) 2013 Christoph Zurnieden + * + * statistics 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. + * + * statistics 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.3 $ + * @(#) $Id: statistics.cal,v 30.3 2013/08/11 08:41:38 chongo Exp $ + * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/statistics.cal,v $ + * + * Under source code control: 2013/08/11 01:31:28 + * File existed as early as: 2013 + */ + + +static resource_debug_level; +resource_debug_level = config("resource_debug", 0); + + +/* + get dependencies +*/ +read -once factorial2 brentsolve + + +/******************************************************************************* + * + * + * Continuous distributions + * + * + ******************************************************************************/ + +/* regularized incomplete gamma function like in Octave, hence the name */ +define gammaincoctave(z,a){ + local tmp; + tmp = gamma(z); + return (tmp-gammainc(a,z))/tmp; +} + +/* Inverse incomplete beta function. Old and slow. */ +static __CZ__invbeta_a; +static __CZ__invbeta_b; +static __CZ__invbeta_x; +define __CZ__invbeta(x){ + return __CZ__invbeta_x-__CZ__ibetaas63(x,__CZ__invbeta_a,__CZ__invbeta_b); +} + +define invbetainc_slow(x,a,b){ + local flag ret eps; + /* place checks and balances here */ + eps = epsilon(); + if(.5 < x){ + __CZ__invbeta_x = 1 - x; + __CZ__invbeta_a = b; + __CZ__invbeta_b = a; + flag = 1; + } + else{ + __CZ__invbeta_x = x; + __CZ__invbeta_a = a; + __CZ__invbeta_b = b; + flag = 0; + } + + ret = brentsolve2(0,1,1); + + if(flag == 1) + ret = 1-ret; + epsilon(eps); + return ret; +} + +/* Inverse incomplete beta function. Still old but not as slow as the function + above. */ +/* + Purpose: + + invbetainc computes inverse of the incomplete Beta function. + + Licensing: + + This code is distributed under the GNU LGPL license. + + Modified: + + 10 August 2013 + + Author: + + Original FORTRAN77 version by GW Cran, KJ Martin, GE Thomas. + C version by John Burkardt. + Calc version by Christoph Zurnieden + + Reference: + + GW Cran, KJ Martin, GE Thomas, + Remark AS R19 and Algorithm AS 109: + A Remark on Algorithms AS 63: The Incomplete Beta Integral + and AS 64: Inverse of the Incomplete Beta Integeral, + Applied Statistics, + Volume 26, Number 1, 1977, pages 111-114. + + Parameters: + + Input, P, Q, the parameters of the incomplete + Beta function. + + Input, BETA, the logarithm of the value of + the complete Beta function. + + Input, ALPHA, the value of the incomplete Beta + function. 0 <= ALPHA <= 1. + + Output, the argument of the incomplete + Beta function which produces the value ALPHA. + + Local Parameters: + + Local, SAE, the most negative decimal exponent + which does not cause an underflow. +*/ +define invbetainc(x,a,b){ + return __CZ__invbetainc(a,b,lnbeta(a,b),x); +} + +define __CZ__invbetainc(p,q,beta,alpha){ + local a acu adj fpu g h iex indx pp prev qq r s sae sq t tx value; + local w xin y yprev places eps; + + /* Dirty trick, don't try at home */ + eps= epsilon(epsilon()^2); + sae = -((log(1/epsilon())/log(2))//2); + fpu = 10.0^sae; + + places = highbit(1 + int(1/epsilon())) + 1; + value = alpha; + if( p <= 0.0 ){ + epsilon(eps); + return newerror("invbeta: argument p <= 0"); + } + if( q <= 0.0 ){ + epsilon(eps); + return newerror("invbeta: argument q <= 0"); + } + + if( alpha < 0.0 || 1.0 < alpha ){ + epsilon(eps); + return newerror("invbeta: argument alpha out of domain"); + } + if( alpha == 0.0 ){ + epsilon(eps); + return 0; + } + if( alpha == 1.0 ){ + epsilon(eps); + return 1; + } + if ( 0.5 < alpha ){ + a = 1.0 - alpha; + pp = q; + qq = p; + indx = 1; + } + else{ + a = alpha; + pp = p; + qq = q; + indx = 0; + } + r = sqrt ( - ln ( a * a ) ); + + y = r-(2.30753+0.27061*r)/(1.0+(0.99229+0.04481*r)*r); + + if ( 1.0 < pp && 1.0 < qq ){ + r = ( y * y - 3.0 ) / 6.0; + s = 1.0 / ( pp + pp - 1.0 ); + t = 1.0 / ( qq + qq - 1.0 ); + h = 2.0 / ( s + t ); + w = y*sqrt(h+r)/h-(t-s)*(r+5.0/6.0-2.0/(3.0*h)); + value = pp / ( pp + qq * exp ( w + w ) ); + } + else{ + r = qq + qq; + t = 1.0 / ( 9.0 * qq ); + t = r * ( 1.0 - t + y * sqrt ( t )^ 3 ); + + if ( t <= 0.0 ){ + value = 1.0 - exp ( ( ln ( ( 1.0 - a ) * qq ) + beta ) / qq ); + } + else{ + t = ( 4.0 * pp + r - 2.0 ) / t; + + if ( t <= 1.0 ) { + value = exp ( ( ln ( a * pp ) + beta ) / pp ); + } + else{ + value = 1.0 - 2.0 / ( t + 1.0 ); + } + } + } + r = 1.0 - pp; + t = 1.0 - qq; + yprev = 0.0; + sq = 1.0; + prev = 1.0; + + if ( value < 0.0001 ) + value = 0.0001; + + if ( 0.9999 < value ) + value = 0.9999; + + acu = 10^sae; + + for ( ; ; ){ + y = bround(__CZ__ibetaas63( value, pp, qq, beta),places); + xin = value; + y = bround(exp(ln(y-a)+(beta+r*ln(xin)+t*ln(1.0- xin ) )),places); + + if ( y * yprev <= 0.0 ) { + prev = max ( sq, fpu ); + } + + g = 1.0; + + for ( ; ; ){ + for ( ; ; ){ + adj = g * y; + sq = adj * adj; + if ( sq < prev ){ + tx = value - adj; + if ( 0.0 <= tx && tx <= 1.0 ) break; + } + g = g / 3.0; + } + if ( prev <= acu ){ + if ( indx ) + value = 1.0 - value; + epsilon(eps); + return value; + } + if ( y * y <= acu ){ + if ( indx ) + value = 1.0 - value; + epsilon(eps); + return value; + } + if ( tx != 0.0 && tx != 1.0 ) + break; + g = g / 3.0; + } + if ( tx == value ) break; + value = tx; + yprev = y; + } + if ( indx ) + value = 1.0 - value; + + epsilon(eps); + return value; +} + +/******************************************************************************* + * + * + * Beta distribution + * + * + ******************************************************************************/ + +define betapdf(x,a,b){ + if(x<0 || x>1) return newerror("betapdf: parameter x out of domain"); + if(a<=0) return newerror("betapdf: parameter a out of domain"); + if(b<=0) return newerror("betapdf: parameter b out of domain"); + + return 1/beta(a,b) *x^(a-1)*(1-x)^(b-1); +} + +define betacdf(x,a,b){ + if(x<0 || x>1) return newerror("betacdf: parameter x out of domain"); + if(a<=0) return newerror("betacdf: parameter a out of domain"); + if(b<=0) return newerror("betacdf: parameter b out of domain"); + + return betainc(x,a,b); +} + +define betacdfinv(x,a,b){ + return invbetainc(x,a,b); +} + +define betamedian(a,b){ + local t106 t104 t103 t105 approx ret; + if(a == b) return 1/2; + if(a == 1 && b > 0) return 1-(1/2)^(1/b); + if(a > 0 && b == 1) return (1/2)^(1/a); + if(a == 3 && b == 2){ + /* Yes, the author is not ashamed to ask Maxima for the exact solution + of a quartic equation. */ + t103 = ( (2^(3/2))/27 +4/27 )^(1/3); + t104 = sqrt( ( 9*t103^2 + 4*t103 + 2 )/(t103) )/3; + t105 = -t103-2/(9*t103) +8/9; + t106 = sqrt( (27*t104*t105+16)/(t104) )/(2*3^(3/2)); + return -t106+t104/2+1/3; + } + if(a == 2 && b == 3){ + t103 = ( (2^(3/2))/27 +4/27 )^(1/3); + t104 = sqrt( ( 9*t103^2 + 4*t103 + 2 )/(t103) )/3; + t105 = -t103-2/(9*t103) +8/9; + t106 = sqrt( (27*t104*t105+16)/(t104) )/(2*3^(3/2)); + return 1-(-t106+t104/2+1/3); + } + return invbetainc(1/2,a,b); +} + +define betamode(a,b){ + if(a + b == 2) return newerror("betamod: a + b = 2 = division by zero"); + return (a-1)/(a+b-2); +} + +define betavariance(a,b){ + return (a*b)/( (a+b)^2*(a+b+1) ); +} + +define betalnvariance(a,b){ + return polygamma(1,a)-polygamma(a+b); +} + +define betaskewness(a,b){ + return (2*(b-a)*sqrt(a+b+1))/( (a+b+1)*sqrt(a*b) ); +} + +define betakurtosis(a,b){ + local num denom; + + num = 6*( (a-b)^2*(a+b+1)-a*b*(a+b+2)); + denom = a*b*(a+b+2)*(a+b+3); + return num/denom; +} + +define betaentropy(a,b){ + return lnbeta(a,b)-(a-1)*psi(a)-(b-1)*psi(b)+(a+b+1)*psi(a+b); + +} + +/******************************************************************************* + * + * + * Normal (Gaussian) distribution + * + * + ******************************************************************************/ + + +define normalpdf(x,mu,sigma){ + return 1/(sqrt(2*pi()*sigma^2))*exp( ( (x-mu)^2 )/( 2*sigma^2 ) ); +} + +define normalcdf(x,mu,sigma){ + return 1/2*(1+erf( ( x-mu )/( sqrt(2*sigma^2) ) ) ); +} + +define probit(p){ + if(p<0 || p > 1) return newerror("probit: p out of domain 0<=p<=1"); + return sqrt(2)*ervinv(2*p-1); +} + +define normalcdfinv(p,mu,sigma){ + if(p<0 || p > 1) return newerror("normalcdfinv: p out of domain 0<=p<=1"); + return mu+ sigma*probit(p); +} + +define normalmean(mu,sigma){return mu;} + +define normalmedian(mu,sigma){return mu;} + +define normalmode(mu,sigma){return mu;} + +define normalvariance(mu,sigma){return sigma^2;} + +define normalskewness(mu,sigma){return 0;} + +define normalkurtosis(mu,sigma){return 0;} + +define normalentropy(mu,sigma){ + return 1/3*ln( 2*pi()*exp(1)*sigma^2 ); +} + +/* moment generating f. */ +define normalmgf(mu,sigma,t){ + return exp(mu*t+1/2*sigma^2*t^2); +} + +/* characteristic f. */ +define normalcf(mu,sigma,t){ + return exp(mu*t-1/2*sigma^2*t^2); +} + + +/******************************************************************************* + * + * + * Chi-squared distribution + * + * + ******************************************************************************/ + +define chisquaredpdf(x,k){ + if(!isint(k) || k<0) return newerror("chisquaredpdf: k not in N"); + if(im(x) || x<0) return newerror("chisquaredpdf: x not in +R"); + /* The gamma function does not check for half integers, do it here? */ + return 1/(2^(k/2)*gamma(k/2))*x^((k/2)-1)*exp(-x/2); +} + +define chisquaredpcdf(x,k){ + if(!isint(k) || k<0) return newerror("chisquaredcdf: k not in N"); + if(im(x) || x<0) return newerror("chisquaredcdf: x not in +R"); + + return 1/(gamma(k/2))*gammainc(k/2,x/2); +} + +define chisquaredmean(x,k){return k;} + +define chisquaredmedian(x,k){ + /* TODO: implement a FAST inverse incomplete gamma-{q,p} function */ + return k*(1-2/(9*k))^3; +} + +define chisquaredmode(x,k){return max(k-2,0);} +define chisquaredvariance(x,k){return 2*k;} +define chisquaredskewness(x,k){return sqrt(8/k);} +define chisquaredkurtosis(x,k){return 12/k;} +define chisquaredentropy(x,k){ + return k/2+ln(2*gamma(k/2)) + (1-k/2)*psi(k/2); +} + +define chisquaredmfg(k,t){ + if(t>=1/2)return newerror("chisquaredmfg: t >= 1/2"); + return (1-2*t)^(k/2); +} + +define chisquaredcf(k,t){ + return (1-2*1i*t)^(k/2); +} + + +/* + * restore internal function from resource debugging + */ +config("resource_debug", resource_debug_level),; +if (config("resource_debug") & 3) { + print "gammaincoctave(z,a)"; + print "invbetainc(x,a,b)"; + print "betapdf(x,a,b)"; + print "betacdf(x,a,b)"; + print "betacdfinv(x,a,b)"; + print "betamedian(a,b)"; + print "betamode(a,b)"; + print "betavariance(a,b)"; + print "betalnvariance(a,b)"; + print "betaskewness(a,b)"; + print "betakurtosis(a,b)"; + print "betaentropy(a,b)"; + print "normalpdf(x,mu,sigma)"; + print "normalcdf(x,mu,sigma)"; + print "probit(p)"; + print "normalcdfinv(p,mu,sigma)"; + print "normalmean(mu,sigma)"; + print "normalmedian(mu,sigma)"; + print "normalmode(mu,sigma)"; + print "normalvariance(mu,sigma)"; + print "normalskewness(mu,sigma)"; + print "normalkurtosis(mu,sigma)"; + print "normalentropy(mu,sigma)"; + print "normalmgf(mu,sigma,t)"; + print "normalcf(mu,sigma,t)"; + print "chisquaredpdf(x,k)"; + print "chisquaredpcdf(x,k)"; + print "chisquaredmean(x,k)"; + print "chisquaredmedian(x,k)"; + print "chisquaredmode(x,k)"; + print "chisquaredvariance(x,k)"; + print "chisquaredskewness(x,k)"; + print "chisquaredkurtosis(x,k)"; + print "chisquaredentropy(x,k)"; + print "chisquaredmfg(k,t)"; + print "chisquaredcf(k,t)"; +} + diff --git a/cal/test2600.cal b/cal/test2600.cal index c51a7e2..7929bd9 100644 --- a/cal/test2600.cal +++ b/cal/test2600.cal @@ -19,8 +19,8 @@ * 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 $ + * @(#) $Revision: 30.3 $ + * @(#) $Id: test2600.cal,v 30.3 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test2600.cal,v $ * * Under source code control: 1995/10/13 00:13:14 @@ -91,7 +91,8 @@ define testismult(str, n, verbose) if (!ismult(c,a)) { m++; if (verbose > 1) { - printf("*** Failure with:\na = %d\nb = %d\n", a,b); + printf("*** Failure with:\na = %d\nb = %d\n", + a,b); } } } @@ -133,7 +134,8 @@ define testsqrt(str, n, eps, verbose) if (abs(c) > 1) { m++; if (verbose > 1) { - printf("*** Failure with:\na = %d\neps = %d\n", a,eps); + printf("*** Failure with:\na = %d\neps = %d\n", + a,eps); } } } @@ -178,7 +180,8 @@ define testexp(str, n, eps, verbose) if (abs(c) > 0.02) { m++; if (verbose > 1) { - printf("*** Failure with:\na = %d\neps = %d\n", a,eps); + printf("*** Failure with:\na = %d\neps = %d\n", + a,eps); } } } @@ -235,7 +238,8 @@ define testln(str, n, eps, verbose) if (abs(c) > 0.5) { m++; if (verbose > 1) { - printf("*** Failure with:\na = %d\neps = %d\n", a,eps); + printf("*** Failure with:\na = %d\neps = %d\n", + a,eps); } } } diff --git a/cal/test2700.cal b/cal/test2700.cal index 615fc5a..f704840 100644 --- a/cal/test2700.cal +++ b/cal/test2700.cal @@ -19,8 +19,8 @@ * 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 $ + * @(#) $Revision: 30.2 $ + * @(#) $Id: test2700.cal,v 30.2 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test2700.cal,v $ * * Under source code control: 1995/11/01 22:52:25 @@ -127,7 +127,8 @@ define testcsqrt(str, n, verbose) if (p) { if (verbose > 0) printf( - "*** Type %d failure for x = %r, y = %r, z = %d\n", + "*** Type %d failure for x = %r, " + "y = %r, z = %d\n", p, x, y, z); m++; } diff --git a/cal/test4000.cal b/cal/test4000.cal index 5d223d8..dca03b5 100644 --- a/cal/test4000.cal +++ b/cal/test4000.cal @@ -19,8 +19,8 @@ * 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 $ + * @(#) $Revision: 30.2 $ + * @(#) $Id: test4000.cal,v 30.2 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test4000.cal,v $ * * Under source code control: 1996/03/13 02:38:45 @@ -199,7 +199,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 +307,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); } } diff --git a/cal/test8500.cal b/cal/test8500.cal index 5d3c107..c790430 100644 --- a/cal/test8500.cal +++ b/cal/test8500.cal @@ -19,8 +19,8 @@ * 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 $ + * @(#) $Revision: 30.2 $ + * @(#) $Id: test8500.cal,v 30.2 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test8500.cal,v $ * * Under source code control: 1999/11/12 20:59:59 @@ -134,8 +134,8 @@ define onetest_8500(a,b,rnd) { * The rounding parameter is randomly chosen. * * After a run of divmod_8500 the a, b, rnd values which gave failure are - * stored in the list L_8500. L_8500[0], L_8500[1], L_8500[2] are a, b, rnd for the first - * test, etc. + * stored in the list L_8500. L_8500[0], L_8500[1], L_8500[2] are a, b, + * rnd for the first* test, etc. */ define divmod_8500(N = 10, M1 = 2^128, M2 = 2^64, testnum = 0) { diff --git a/cal/test8900.cal b/cal/test8900.cal new file mode 100644 index 0000000..866b769 --- /dev/null +++ b/cal/test8900.cal @@ -0,0 +1,1641 @@ +/* + * test8900 - 8900 series of the regress.cal test suite + * + * Copyright (C) 2013 Christoph Zurnieden + * + * test8900 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. + * + * test8900 is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General + * Public License for more details. + * + * A copy of version 2.1 of the GNU Lesser General Public License is + * distributed with calc under the filename COPYING-LGPL. You should have + * received a copy with calc; if not, write to Free Software Foundation, Inc. + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + * + * @(#) $Revision: 30.4 $ + * @(#) $Id: test8900.cal,v 30.4 2013/08/11 08:22:01 chongo Exp $ + * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test8900.cal,v $ + * + * Under source code control: 2013/08/11 01:31:28 + * File existed as early as: 2013 + */ + + +static __CZ__eps = 1e-20; + + +/* + * load once, the calc resource functions contribued by Christoph Zurnieden + */ +read -once bernpoly.cal; +read -once brentsolve.cal; +read -once constants.cal; +read -once factorial.cal; +read -once factorial2.cal; +read -once lambertw.cal; +read -once lnseries.cal; +read -once specialfunctions.cal; +read -once statistics.cal; +read -once toomcook.cal; +read -once zeta2.cal; + + +/* + * tests of correctness of the functions implemented by the above listed + * author. All values tested against have been computed with at least two + * independant algorithms where possible (indicated if not). + * + * test 01 tests gamma(z) for the following values + * + * z gamma(z) + * 5 24 + * -5 error + * -5.5 0.01091265478190986298673234429 + * 5.5 52.34277778455352018114900849 + * 5.5+5.5i -3.760669488993539011972109411 - 1.068828791178021218008599278i + * -5.5+5.5i -0.0000000031513765339396-0.00000000565396294185819i + * -5.5-5.5i -0.0000000031513765339396+0.00000000565396294185819i + */ +define t01(){ + local eps; + eps = epsilon(1e-20); + if(gamma( 5 ) != 24){ + epsilon(eps); + return 1; + } + if(!iserror(gamma( -5 ))){ + epsilon(eps); + return 2; + } + if( abs(gamma( -5.5 ) - 0.01091265478190986298673234429) > __CZ__eps){ + epsilon(eps); + return 3; + } + if( abs(gamma( 5.5+5.5i ) - ( -3.760669488993539011972109411 - 1.068828791178021218008599278i) ) > __CZ__eps ){ + epsilon(eps); + return 4; + } + if( abs(gamma(-5.5+5.5i ) - ( -0.0000000031513765339396-0.00000000565396294185819i)) > __CZ__eps ){ + epsilon(eps); + return 5; + } + if( abs(gamma(-5.5-5.5i ) - ( -0.0000000031513765339396+0.00000000565396294185819i)) > __CZ__eps ){ + epsilon(eps); + return 5; + } + epsilon(eps); + return 0; +} + +/* + test 02 tests lngamma(z) as ln(gamma(z))for a lot of values. Twice. + */ +define t02(type){ + local eps k; + eps = epsilon(1e-20); + + if(!isnull(type)){ + /* test lngamma to higher precision */ + epsilon(1e-50) + } + + if(!iserror(lngamma( -5 ))){ + epsilon(eps); + return 1; + } + +if(abs(lngamma(-4.400)-(-2.602796356578054085860353775504851660134124890968895310513467506473714622544820472104292219110230249 + 9.424777960769379715387930149838508652591508198125317462924833776923449218858626995884104476026351204i))>__CZ__eps){epsilon(eps);return 2;} +if(abs(lngamma(-3.400)-(-1.121191815653838606981937409307733431762519256939740603086867679323926364369546808053508062204356381 + 12.56637061435917295385057353311801153678867759750042328389977836923126562514483599451213930136846827i))>__CZ__eps){epsilon(eps);return 3;} +if(abs(lngamma(-2.400)-(0.1025836159682770986668378753392054643000824013774864622977221670841872237237267082284529277399669559 + 3.141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117068i))>__CZ__eps){epsilon(eps);return 4;} +if(abs(lngamma(-1.400)-(0.9780523533221770342957880219518966655729718736522287003611286282342897731740673416836614584533568090 + 6.283185307179586476925286766559005768394338798750211641949889184615632812572417997256069650684234136i))>__CZ__eps){epsilon(eps);return 5;} +if(abs(lngamma(-0.4000)-(1.314524589943389964800381432168888755684455248965572166907870886697690648218478844841186078948048725 - 3.141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117068i))>__CZ__eps){epsilon(eps);return 6;} +if(abs(lngamma(0.6000)-(0.3982338580692348996168542204008776842343540290573096991159030047169052824805157958169155278512878019))>__CZ__eps){epsilon(eps);return 7;} +if(abs(lngamma(1.600)-(-0.1125917656967557835886598759027842506437567673884585710620505531197794120085330019396025954281597201))>__CZ__eps){epsilon(eps);return 8;} +if(abs(lngamma(2.600)-(0.3574118635489797700622771552455578140571422814237894693873415838862224661928933802478535074679167317))>__CZ__eps){epsilon(eps);return 9;} +if(abs(lngamma(3.600)-(1.312923308576416131515005263584688779336808871915478863893739203075508145809645795017294292815226610))>__CZ__eps){epsilon(eps);return 10;} +if(abs(lngamma(4.600)-(2.593857154038480449121968525661729117181688767652715299571159988369711366508900679740255251345929864))>__CZ__eps){epsilon(eps);return 11;} +if(abs(lngamma(5.600)-(4.119913457533529765327962024245737596098467728224633319657147474378525624786041213308522465405745068))>__CZ__eps){epsilon(eps);return 12;} +if(abs(lngamma(55.60)-(166.7223317072393882706908269355038474520093709166026699584513154552836509334829850057167659670012639))>__CZ__eps){epsilon(eps);return 13;} +if(abs(lngamma(56.60)-(170.7405149084959249626960846426113801630018663570495614063334260781461204332651070777194774772127133))>__CZ__eps){epsilon(eps);return 14;} +if(abs(lngamma(57.60)-(174.7765238937050622127413124561803327282766985056825002949575310911332447187196730943026770843388737))>__CZ__eps){epsilon(eps);return 15;} +if(abs(lngamma(58.60)-(178.8300464614069077680172042040900793384235789388607577471176719144010224272977068414490913508552517))>__CZ__eps){epsilon(eps);return 16;} +if(abs(lngamma(59.60)-(182.9007811579898746993562851336763898891277522424839489727522724518580350673446123920541122890199408))>__CZ__eps){epsilon(eps);return 17;} +if(abs(lngamma(60.60)-(186.9884367320611787751651861970124993055337357937686536527498446663842215358944473992957092336243941))>__CZ__eps){epsilon(eps);return 18;} +if(abs(lngamma(61.60)-(191.0927316251364475428438703676218265275465075845204901325031564702495487250077424730438712170869034))>__CZ__eps){epsilon(eps);return 19;} +if(abs(lngamma(62.60)-(195.2133934956759216362448715987203010536306980824917612825098264568303104679047801204881771995770675))>__CZ__eps){epsilon(eps);return 20;} +if(abs(lngamma(63.60)-(199.3501587737819744783228775747513237676781959965605134887455422103180944212479269262219348433842737))>__CZ__eps){epsilon(eps);return 21;} +if(abs(lngamma(64.60)-(203.5027722441280509386790647389348961712355630873862180757363981319928079826720627026059399915871661))>__CZ__eps){epsilon(eps);return 22;} +if(abs(lngamma(65.60)-(207.6709866549166071043368674554696886045355440070025739596589482148102142728295335076020593653472294))>__CZ__eps){epsilon(eps);return 23;} +if(abs(lngamma(-4.400 + 0.3000i)-(-3.012170168780542935643977654089900903230224118194902800776851727432284095641464658518601854851344898 - 14.99564777393185122018415183045294761009634547976949786064819095927447593149803400353030993001915991i))>__CZ__eps){epsilon(eps);return 24;} +if(abs(lngamma(-3.400 + 0.3000i)-(-1.528246633748315285937279325345084965509129720585190019314960293887747778837456936578769751560985664 - 11.92213157860005745711732356944470292065688993724217768645448047733482574053965183811067307157775230i))>__CZ__eps){epsilon(eps);return 25;} +if(abs(lngamma(-2.400 + 0.3000i)-(-0.3005935437424605000037786760819116140529426068492461805203781927935976448288181308985439318381596952 - 8.868546298538004987033402729320673427755364814142190988797063840212310735937181268214394292554900060i))>__CZ__eps){epsilon(eps);return 26;} +if(abs(lngamma(-1.400 + 0.3000i)-(0.5826272868794220627005984935520030051588811118590927143468349409451458662284723277539288886528086450 - 5.851308639494973183602114195205041569131365606536889257737233367020216597078539028210070061526136323i))>__CZ__eps){epsilon(eps);return 27;} +if(abs(lngamma(-0.4000 + 0.3000i)-(0.9415471834545804679163683919994364115087855350642294160794624408446520586077774828141571932957935576 - 2.920809319127926491981735554074137897979665407716375596072277390961511222457641860173214769101172656i))>__CZ__eps){epsilon(eps);return 28;} +if(abs(lngamma(0.6000 + 0.3000i)-(0.2484000028946351584991362705412598434332854007039741619587824313512584366380827672082938662993748700 - 0.4227177743314176403219013995119576518240065994565821579629389173672072909830539502579967884603383370i))>__CZ__eps){epsilon(eps);return 29;} +if(abs(lngamma(1.600 + 0.3000i)-(-0.1508538452142506468232302806074848397575248529677905013835271902417303859668318638390206449299015341 + 0.04092983466938847589235483194925675020453045482953810584799417135299057318268775504260349552454955558i))>__CZ__eps){epsilon(eps);return 30;} +if(abs(lngamma(2.600 + 0.3000i)-(0.3364259747848147735313925008357736575841632119933041850635335895367888151813894675073790612700505879 + 0.2262777846650832407783807931778013947197968935401072992199235544837899389522014207849355554882625959i))>__CZ__eps){epsilon(eps);return 31;} +if(abs(lngamma(3.600 + 0.3000i)-(1.298550300921881734471375776754435965027429987521072727511666654821378388789308042958948517595253549 + 0.3411543900819823748030570769218348455327276444896884230183971946457411721008725773217180753903992058i))>__CZ__eps){epsilon(eps);return 32;} +if(abs(lngamma(4.600 + 0.3000i)-(2.582944367806232942740645241786647084583876190810680103630192209049779956753319578558317563774905357 + 0.4242956219704236047137253915726161430638589851177078492530246610417385784376111802634549132794141632i))>__CZ__eps){epsilon(eps);return 33;} +if(abs(lngamma(5.600 + 0.3000i)-(4.111122815491445860748560095878127604065278239877556104114455014234622116537919385723568609843827948 + 0.4894207853048094882972548755277837179650295466696997973257275457157790873793738934257725102317212982i))>__CZ__eps){epsilon(eps);return 34;} +if(abs(lngamma(0.6000 - 4.700i)-(-6.309230474426685182917699027589840248465208901823736044071406089970016624762071282414477519533446805 - 2.738444603265429259406748249023722438146218314171151425663490122832827447160142404453785215790720172i))>__CZ__eps){epsilon(eps);return 35;} +if(abs(lngamma(0.6000 - 3.700i)-(-4.762470602521331200619631143446813610218360030381255868867915275850062167138589945759181147587314347 - 1.307861859626688811743330143389568763790196226980935860137256735840654999917008199152740741948205653i))>__CZ__eps){epsilon(eps);return 36;} +if(abs(lngamma(0.6000 - 2.700i)-(-3.223449159729432378435059551332376261824297133470481664344109285143389820463721600269079600439653415 - 0.1525473639596832094518944287785664759918133343972275457487506548230474276833315783298300402230230813i))>__CZ__eps){epsilon(eps);return 37;} +if(abs(lngamma(0.6000 - 1.700i)-(-1.699851882736550416690203691424396333903393386464266356507295865152155081643217138332174570080627273 + 0.6188153536675997046951505463300498363352953733225308151601485284481801957104097451434473124727600220i))>__CZ__eps){epsilon(eps);return 38;} +if(abs(lngamma(0.6000 - 0.7000i)-(-0.2316312495202586116986763277644377512618333134657045421405330360600955017822181674931032957595291466 + 0.7368909799768367142682353753277667339824288570492360448564102775206851329939159562896886641611904396i))>__CZ__eps){epsilon(eps);return 39;} +if(abs(lngamma(0.6000 + 0.3000i)-(0.2484000028946351584991362705412598434332854007039741619587824313512584366380827672082938662993748700 - 0.4227177743314176403219013995119576518240065994565821579629389173672072909830539502579967884603383370i))>__CZ__eps){epsilon(eps);return 40;} +if(abs(lngamma(0.6000 + 1.300i)-(-1.099689479936482253001126014071250387866864940802593030985946176338010292319634681754351711277201146 - 0.7725489931464399068598744386748572974573591452933440189885272843948051378865258815608409462651759038i))>__CZ__eps){epsilon(eps);return 41;} +if(abs(lngamma(0.6000 + 2.300i)-(-2.611386294578008388513457987969729601048026532835562114605241252682747719092183552611868952700620418 - 0.2111094845860104400425314901146665256344806614559790152507363455424499006701362134714576901668862615i))>__CZ__eps){epsilon(eps);return 42;} +if(abs(lngamma(0.6000 + 3.300i)-(-4.145670522984067490152016613422534092269675011415945298652917864316934507837553864106231837873639178 + 0.8081928951523762121254890981027647840025857144095024771821231809903327928035320700978580016020901134i))>__CZ__eps){epsilon(eps);return 43;} +if(abs(lngamma(0.6000 + 4.300i)-(-5.689842576036527320491763306963824853139907301029281610305682566179799260941238598307788211198739464 + 2.137677242374957442527694027866746053575410791317320138931932495148003411548291173248963052605469029i))>__CZ__eps){epsilon(eps);return 44;} +if(abs(lngamma(0.6000 + 5.300i)-(-7.239654605052715210182073623536904206104308839659326676113824586592039321903083835369930675115629685 + 3.702857758072432142072497796069521049678127217607403327232198098820227725661161561592679775128000025i))>__CZ__eps){epsilon(eps);return 45;} +if(abs(lngamma(-4.400 - 4.700i)-(-14.73413592903136179653960750100174060012531669119348359739188295824251395007186551726647596156181555 + 7.340768981905845672138265648506833394433043135824981559003634708099656882118068273562871737379370475i))>__CZ__eps){epsilon(eps);return 46;} +if(abs(lngamma(-3.400 - 3.700i)-(-10.55018529022399813119005433743831737900085357229525796426165531407012201466806460571733582857505851 + 6.763336971725381912118912702208512629733112628981673298740213483902378792635376051758399397079352018i))>__CZ__eps){epsilon(eps);return 47;} +if(abs(lngamma(-2.400 - 2.700i)-(-6.624262018571684573249747079902924251345023570085621326982177263497895441273594383174099568266569519 + 5.911914743873792313808731773611192661709672638901754910693406148730587535650933379128561953202673305i))>__CZ__eps){epsilon(eps);return 48;} +if(abs(lngamma(-1.400 - 1.700i)-(-3.046912030520906458689035477846643788289090086345259335810096962280997399307737870754170013561799449 + 4.680423062668151424886705499811285399248102868605621987762747421929868283337463368954255366241853210i))>__CZ__eps){epsilon(eps);return 49;} +if(abs(lngamma(-0.4000 - 0.7000i)-(-0.01623979147403148300780826047582666582616647435129398527305183616134471962089965927196036143676539809 + 2.826833421018256285271011446520969788549353956082297248294374573272383543521074785692812327220178392i))>__CZ__eps){epsilon(eps);return 50;} +if(abs(lngamma(0.6000 + 0.3000i)-(0.2484000028946351584991362705412598434332854007039741619587824313512584366380827672082938662993748700 - 0.4227177743314176403219013995119576518240065994565821579629389173672072909830539502579967884603383370i))>__CZ__eps){epsilon(eps);return 51;} +if(abs(lngamma(1.600 + 1.300i)-(-0.7407695833613238477853561156238169815169605175974563292533186764385040999403295266941234066342162332 + 0.3658395580779188724109027663961707196451841638334886679433275092947016221102693596315391546217532826i))>__CZ__eps){epsilon(eps);return 52;} +if(abs(lngamma(2.600 + 2.300i)-(-0.7153017561016750689453931991025219163388411460412682694249821466060642237596449041248795522730872166 + 2.067498782269003991801228117457494590355245722719424742293508630734960101015275647841102899818854810i))>__CZ__eps){epsilon(eps);return 53;} +if(abs(lngamma(3.600 + 3.300i)-(-0.2006290139452759775010107586460283514303264993274887714022222695834519457636026071215877177908693236 + 4.221969149213679168621678150696738907045553787288427746366287484331266798399726999903762441109724197i))>__CZ__eps){epsilon(eps);return 54;} +if(abs(lngamma(4.600 + 4.300i)-(0.6404767304085869581018213364351326853699331839312207180878789327971980401993755873561609797726810192 + 6.685149323469513776483323494807052342570441936959315816148292880724186611261236847208887542115434303i))>__CZ__eps){epsilon(eps);return 55;} +if(abs(lngamma(5.600 + 5.300i)-(1.727112476786098959996727579157495580048033035060833670179296378163352191130662743702237851099320091 + 9.383383918093155327986445451264543368751338171298232916305123349159206537551156601182421044554298994i))>__CZ__eps){epsilon(eps);return 56;} +if(abs(lngamma(55.60 + 0.3000i)-(166.7215150367733897769155930653789348483780044274716818154610861234389078719805189264594918732382586 + 1.202750513929718332820270669742686561426457642272968981346017082644807076333571537491197745615077294i))>__CZ__eps){epsilon(eps);return 57;} +if(abs(lngamma(56.60 + 0.3000i)-(170.7397127945179968376917410624766834622909691036136375973004131040276663262707416475336111420149831 + 1.208146145021640303895693686064781770317635078049891748154048007544470593526254839683637064897097838i))>__CZ__eps){epsilon(eps);return 58;} +if(abs(lngamma(57.60 + 0.3000i)-(174.7757358264026770962028712327193919190938819848539820911816742522615118513515101187002268498256953 + 1.213446448743774292811195505423481449339002192187714949283070433230478839177211462927645118751139388i))>__CZ__eps){epsilon(eps);return 59;} +if(abs(lngamma(58.60 + 0.3000i)-(178.8292719572886165808686582437464130998008894472168186351028467401004239585080660700434170533848267 + 1.218654734982846161251085553080214761347285268088604785438095878385945771674273185064368369032315536i))>__CZ__eps){epsilon(eps);return 60;} +if(abs(lngamma(59.60 + 0.3000i)-(182.9000197581041057641595126649840680882966589651420637344563598630410760508053004418106210806480514 + 1.223774144183534973445316592347337056808910609419286930794193524682491346969634027786839155163892724i))>__CZ__eps){epsilon(eps);return 61;} +if(abs(lngamma(60.60 + 0.3000i)-(186.9876880003631981031020807195926428903734785341818284861483167023505345362582553713940653353951410 + 1.228807658719925269995511830298415601718771597558190350507883496810540525070275863955647504172442604i))>__CZ__eps){epsilon(eps);return 62;} +if(abs(lngamma(61.60 + 0.3000i)-(191.0919951469889337316641602771633017764510692037723749796543523708549224640669741133145902737781006 + 1.233758113328768712483862353815791968059294457847368072259148050293157549143123712613333613763784674i))>__CZ__eps){epsilon(eps);return 63;} +if(abs(lngamma(62.60 + 0.3000i)-(195.2126688764702481772276457650023207176714432948785485345860994461920670783769886309746108133330257 + 1.238628204695931980600482702688969918429374403006592554012319844898454093596574259217162870691749038i))>__CZ__eps){epsilon(eps);return 64;} +if(abs(lngamma(63.60 + 0.3000i)-(199.3494456376687238313417632202369605922807314239672719385369875900976176399328184235160742022894634 + 1.243420500277190605198320894289870930154643596582155076044919162631888476221718725167773691679060391i))>__CZ__eps){epsilon(eps);return 65;} +if(abs(lngamma(64.60 + 0.3000i)-(203.5020702328465376706204035728796350972376926574607893322136594379996117055188038514446315204059032 + 1.248137446425596312819515029227444652080011390838575181737724990020365851808034508613690412166704588i))>__CZ__eps){epsilon(eps);return 66;} +if(abs(lngamma(65.60 + 0.3000i)-(207.6702954267142863859185793548246421433863939380928954872956462639690979311998038217156277177658497 + 1.252781375889819416329161991660565854615382764835522506641801626851934424429479695919682707858812249i))>__CZ__eps){epsilon(eps);return 67;} +if(abs(lngamma(55.60 - 4.700i)-(166.5221258272035253961542734005976077004749775938844000662776938982124117149831619415891292027559084 - 18.84875483296568553194454925345602004591801239160222174651330953176747978241113581568341389313614184i))>__CZ__eps){epsilon(eps);return 68;} +if(abs(lngamma(56.60 - 3.700i)-(170.6185921690853207517443064939778892985245375960964842072277769261987939958711192180080496388759790 - 14.90313021223193465377855573208445845565931668639004077631447433024105216208357598284073272963526083i))>__CZ__eps){epsilon(eps);return 69;} +if(abs(lngamma(57.60 - 2.700i)-(174.7127139121008307648437631979262499901446251937177073309638635680981878307625357907205057992110826 - 10.92201102864604767334040466047947450750373806537116051068380101221240925743684470549656839673533788i))>__CZ__eps){epsilon(eps);return 70;} +if(abs(lngamma(58.60 - 1.700i)-(178.8051797102056562439362100160978710660289490095968327611173555143739460179913989993096167790463432 - 6.905945104548951236229262516275118301863000955218208856630289945072933677322889363909280822011545321i))>__CZ__eps){epsilon(eps);return 71;} +if(abs(lngamma(59.60 - 0.7000i)-(182.8966358377199778625865269072085032936485484956150669021166926511020935207431114192228211953931100 - 2.855486362253577342667404413778192112579790386732841204180813534474139545940894056117527731737226582i))>__CZ__eps){epsilon(eps);return 72;} +if(abs(lngamma(60.60 + 0.3000i)-(186.9876880003631981031020807195926428903734785341818284861483167023505345362582553713940653353951410 + 1.228807658719925269995511830298415601718771597558190350507883496810540525070275863955647504172442604i))>__CZ__eps){epsilon(eps);return 73;} +if(abs(lngamma(61.60 + 1.300i)-(191.0789031896982469942903294770974306494712752019213395010059816712212959534694477736544779643613606 + 5.346377998474074192830409565498522421021695288142347615450028628516451152858671821236062551519577511i))>__CZ__eps){epsilon(eps);return 74;} +if(abs(lngamma(62.60 + 2.300i)-(195.1708115544608858783580589279983618518227865792619427244597031395608221351124418855807139544387844 + 9.496666208022148051357709844128014322980249562957453155498216739528300001626643515787555547645875216i))>__CZ__eps){epsilon(eps);return 75;} +if(abs(lngamma(63.60 + 3.300i)-(199.2639082667972359747356775354901044881033064193665592320100330065828589091059656379848180952180576 + 13.67911603585439751926438073480939520547347569839795064532158720371833242545216773892848304348649828i))>__CZ__eps){epsilon(eps);return 76;} +if(abs(lngamma(64.60 + 4.300i)-(203.3586553654963869814883298543618854726441450377694569990857332006085635938056596309090099303930334 + 17.89317489050227754715433149549722038188972541358048335428889588525290414035694955077798780767484079i))>__CZ__eps){epsilon(eps);return 77;} +if(abs(lngamma(65.60 + 5.300i)-(207.4554835618873492047512087924156663776620358356581503938661139973023305384540970489546974722608112 + 22.13829509931977678201875089030163451926720764548437834522489362621805878564584156804449041165307769i))>__CZ__eps){epsilon(eps);return 78;} +if(abs(lngamma(0.6000 + 55.30i)-(-85.54482235577983941284251852323648610691188392673393393659117312998074429939423249453201268385415968 + 166.7640845362830899082977628513038941147191508645382670512065838817570593346370195934584098731608163i))>__CZ__eps){epsilon(eps);return 79;} +if(abs(lngamma(0.6000 + 56.30i)-(-87.11382647385499402990266927218873826677912515510914330975238159375338785735675613885474681911555455 + 170.7858332456548897964755419202916477033408200711519690015167519320073811710594461413312890867212396i))>__CZ__eps){epsilon(eps);return 80;} +if(abs(lngamma(0.6000 + 57.30i)-(-88.68286214812485690627962462529848906043953388486922638389109935077387260509105638054210646253252466 + 174.8253452895478184840703539752269094932785103410249518116087112411324582420889387891648827483331167i))>__CZ__eps){epsilon(eps);return 81;} +if(abs(lngamma(0.6000 + 58.30i)-(-90.25192828651651583800480958344256221682554088740576313673589889163710837899207764032711716706627583 + 178.8823106163841131771861511088137077830986146286084489346147229324383955058792053361236598271019023i))>__CZ__eps){epsilon(eps);return 82;} +if(abs(lngamma(0.6000 + 59.30i)-(-91.82102385268587759734139136217993540696936010920994984591658423038715645418137316213497147316787354 + 182.9564298132977973838333574465352695792546867284831679902458633771250846205990521337322037599865490i))>__CZ__eps){epsilon(eps);return 83;} +if(abs(lngamma(0.6000 + 60.30i)-(-93.39014786228910598458529398231928177449383105033168028035758106697089023386753079638127787148822458 + 187.0474135677690289293542062291360648608774972285628443252781312026960680153689550595593442583564361i))>__CZ__eps){epsilon(eps);return 84;} +if(abs(lngamma(0.6000 + 61.30i)-(-94.95929937956076993888890535139227785932447324700640489970555152485771091160984562939060645206100132 + 191.1549821649831349987910547767822679603735412036380108781321752841569185871421007366309694487409486i))>__CZ__eps){epsilon(eps);return 85;} +if(abs(lngamma(0.6000 + 62.30i)-(-96.52847751416891464599424930795884732518087496093651555404283351659612698836352323452352710420599104 + 195.2788650179992458972186470030422322640959550214072444870291693388786130688229112380191390257821807i))>__CZ__eps){epsilon(eps);return 86;} +if(abs(lngamma(0.6000 + 63.30i)-(-98.09768141832058996231194071903760307280235519603364210034375642851432112362859092795643468479700327 + 199.4188002280943140128727971292337826315387363387763786270696435128423987623771787363214987887073743i))>__CZ__eps){epsilon(eps);return 87;} +if(abs(lngamma(0.6000 + 64.30i)-(-99.66691028409427522125385963825011409754630863598190917300304121976114751378659089137971202438172887 + 203.5745341728981030650825963445356527935331129342248469636074322780853587222584902429706178725686242i))>__CZ__eps){epsilon(eps);return 88;} +if(abs(lngamma(0.6000 + 65.30i)-(-101.2361633409781854893699037629524761308029390440175099023860977120545945724838225634129393108607355 + 207.7458211201573236805249632667291754315339341665724958026196877950249917227554119187871060871559697i))>__CZ__eps){epsilon(eps);return 89;} +if(abs(lngamma(55.60 + 60.30i)-(138.3405218869058217717201182836422027677382184890964165590417353499219822226519181484044703575835292 + 250.9485307086751713133102893231808151265549690071705472539067848281998391909656358247103271742719578i))>__CZ__eps){epsilon(eps);return 90;} +if(abs(lngamma(56.60 + 60.30i)-(142.7474976121018701984157500679190442966110797769323173557040709858649026362568015560276025151255956 + 251.7744588650459198825346353772080509751313819470548658242804227289838197861524419605491386182133953i))>__CZ__eps){epsilon(eps);return 91;} +if(abs(lngamma(57.60 + 60.30i)-(147.1627435319602425515209166358781832064023544924212637636653157301087891743636771772442175547092138 + 252.5914974493805839443768868968642526869013797892608722844298827478025786612090804469713284568207639i))>__CZ__eps){epsilon(eps);return 92;} +if(abs(lngamma(58.60 + 60.30i)-(151.5862689029682042031606617640450220740985775964639233206719519919454468746790090892789062856833994 + 253.3997923739994162421416717294147634900873392644324912633837005280001593924100149032670755229086402i))>__CZ__eps){epsilon(eps);return 93;} +if(abs(lngamma(59.60 + 60.30i)-(156.0180803184689022095120622630277425180433295653817951699970902688810769976218882558288617606286722 + 254.1994872924291535134537002289372877256760561545266240447182119613107490480996768753107944444566663i))>__CZ__eps){epsilon(eps);return 94;} +if(abs(lngamma(60.60 + 60.30i)-(160.4581818322128207752571131620498333645831099884594593949166210067133473205367535408753892850882553 + 254.9907235879958949246830907372060458378867915677707498070916381728065006920567219761323639093065907i))>__CZ__eps){epsilon(eps);return 95;} +if(abs(lngamma(61.60 + 60.30i)-(164.9065750781912363906196189745577497508505165621357938820065182107142960571733194288330116576903125 + 255.7736403669080425654455012237246051402306640891736322674732329084396310656024722092859071945872444i))>__CZ__eps){epsilon(eps);return 96;} +if(abs(lngamma(62.60 + 60.30i)-(169.3632593867220799863942253592790131010186217605278241383032664772260920373282624028529879975286350 + 256.5483744554910528044048617005478717965073680654042053866320357723837630372594401312206968901830105i))>__CZ__eps){epsilon(eps);return 97;} +if(abs(lngamma(63.60 + 60.30i)-(173.8282318967764198928263540479369804154959334380883398727474568650558868155342724620418729191066897 + 257.3150604012511380535676929646281795055983167823336193389524424552595441364148246393785125517847376i))>__CZ__eps){epsilon(eps);return 98;} +if(abs(lngamma(64.60 + 60.30i)-(178.3014876645497005489995740718100489155558324227755847007898254349773686020549399461464731246888811 + 258.0738304774605436591436026066009539042787457216911291577832446476517821930895032617238958674099152i))>__CZ__eps){epsilon(eps);return 99;} +if(abs(lngamma(65.60 + 60.30i)-(182.7830197682960267239662260557525833694506977039319737802533196097442483852152832046887750759565943 + 258.8248146909724805417993325211754807069936951454932977542761597422795687852878109079207208588308147i))>__CZ__eps){epsilon(eps);return 100;} +if(abs(lngamma(55.60 + 55.30i)-(142.3862162791589253462657451176275726003857264651343509950957693660793746863734326554521916865294160 + 229.0474972316203435288188174128389032017308276896396827258188412666555426184444346078935151648963593i))>__CZ__eps){epsilon(eps);return 101;} +if(abs(lngamma(56.60 + 56.30i)-(145.9655713474689753168556009847734887663033552824290632709719191874805473283966808702482716223823799 + 234.2012259525622513896404861908422505950646506577988340677531054697523114853375505771896176207845654i))>__CZ__eps){epsilon(eps);return 102;} +if(abs(lngamma(57.60 + 57.30i)-(149.5627523253413003508200851967083007076485608754907532209664548084707244359306524068411586608941471 + 239.3727177204530395107173394215426561501560159557014103102685030670438401066317331091766069662051511i))>__CZ__eps){epsilon(eps);return 103;} +if(abs(lngamma(58.60 + 58.30i)-(153.1774470047839472501216057736005131302626263510371392880103904697841471694103329293425078496549758 + 244.5616624984797644536433102063654140139237547865421532878830803720762552799643139942619380524890401i))>__CZ__eps){epsilon(eps);return 104;} +if(abs(lngamma(59.60 + 59.30i)-(156.8093539260984043245770025957276995010069796775703177529274656935406571580476095484467127733135084 + 249.7677608875474964335171539461488545902215228674008981574984941307449419367892141512085156904698398i))>__CZ__eps){epsilon(eps);return 105;} +if(abs(lngamma(60.60 + 60.30i)-(160.4581818322128207752571131620498333645831099884594593949166210067133473205367535408753892850882553 + 254.9907235879958949246830907372060458378867915677707498070916381728065006920567219761323639093065907i))>__CZ__eps){epsilon(eps);return 106;} +if(abs(lngamma(61.60 + 61.30i)-(164.1236491593380218382957487779642572534385362007999916281283947968048913383213154195181013057822234 + 260.2302708970324395553848679531333038493595454481482560493315410820180244948561636909552645533403618i))>__CZ__eps){epsilon(eps);return 107;} +if(abs(lngamma(62.60 + 62.30i)-(167.8054835609733823774016164868506426238263526697353479782755961582196176989205680074917215202127864 + 265.4861322389681286058365065491944749198017327500214219083439023895059621709769558317157193105864721i))>__CZ__eps){epsilon(eps);return 108;} +if(abs(lngamma(63.60 + 63.30i)-(171.5034214625769205528980449555097665172285302158028025423161481941008052930058651761908875732005816 + 270.7580457256222186188843213325906832500862444373572311661827574319274457824608027119111557496467876i))>__CZ__eps){epsilon(eps);return 109;} +if(abs(lngamma(64.60 + 64.30i)-(175.2172076444693933495200678808489471651335658562522069741003825794583284267731429819984320358705804 + 276.0457577445122795003295082894754935609216218032287116765827545233934750440738775983322565095055686i))>__CZ__eps){epsilon(eps);return 110;} +if(abs(lngamma(65.60 + 65.30i)-(178.9465948507696967449494536146172974534191430062324139747191513973655253559309515112484546085877718 + 281.3490225726683461623186324992570909685317567794418009098339817182638759202079343286582580534821206i))>__CZ__eps){epsilon(eps);return 111;} +if(abs(lngamma(0.6000 + 4.700i)-(-6.309230474426685182917699027589840248465208901823736044071406089970016624762071282414477519533446805 + 2.738444603265429259406748249023722438146218314171151425663490122832827447160142404453785215790720172i))>__CZ__eps){epsilon(eps);return 112;} +if(abs(lngamma(0.6000 + 3.700i)-(-4.762470602521331200619631143446813610218360030381255868867915275850062167138589945759181147587314347 + 1.307861859626688811743330143389568763790196226980935860137256735840654999917008199152740741948205653i))>__CZ__eps){epsilon(eps);return 113;} +if(abs(lngamma(0.6000 + 2.700i)-(-3.223449159729432378435059551332376261824297133470481664344109285143389820463721600269079600439653415 + 0.1525473639596832094518944287785664759918133343972275457487506548230474276833315783298300402230230813i))>__CZ__eps){epsilon(eps);return 114;} +if(abs(lngamma(0.6000 + 1.700i)-(-1.699851882736550416690203691424396333903393386464266356507295865152155081643217138332174570080627273 - 0.6188153536675997046951505463300498363352953733225308151601485284481801957104097451434473124727600220i))>__CZ__eps){epsilon(eps);return 115;} +if(abs(lngamma(0.6000 + 0.7000i)-(-0.2316312495202586116986763277644377512618333134657045421405330360600955017822181674931032957595291466 - 0.7368909799768367142682353753277667339824288570492360448564102775206851329939159562896886641611904396i))>__CZ__eps){epsilon(eps);return 116;} +if(abs(lngamma(0.6000 - 0.3000i)-(0.2484000028946351584991362705412598434332854007039741619587824313512584366380827672082938662993748700 + 0.4227177743314176403219013995119576518240065994565821579629389173672072909830539502579967884603383370i))>__CZ__eps){epsilon(eps);return 117;} +if(abs(lngamma(0.6000 - 1.300i)-(-1.099689479936482253001126014071250387866864940802593030985946176338010292319634681754351711277201146 + 0.7725489931464399068598744386748572974573591452933440189885272843948051378865258815608409462651759038i))>__CZ__eps){epsilon(eps);return 118;} +if(abs(lngamma(0.6000 - 2.300i)-(-2.611386294578008388513457987969729601048026532835562114605241252682747719092183552611868952700620418 + 0.2111094845860104400425314901146665256344806614559790152507363455424499006701362134714576901668862615i))>__CZ__eps){epsilon(eps);return 119;} +if(abs(lngamma(0.6000 - 3.300i)-(-4.145670522984067490152016613422534092269675011415945298652917864316934507837553864106231837873639178 - 0.8081928951523762121254890981027647840025857144095024771821231809903327928035320700978580016020901134i))>__CZ__eps){epsilon(eps);return 120;} +if(abs(lngamma(0.6000 - 4.300i)-(-5.689842576036527320491763306963824853139907301029281610305682566179799260941238598307788211198739464 - 2.137677242374957442527694027866746053575410791317320138931932495148003411548291173248963052605469029i))>__CZ__eps){epsilon(eps);return 121;} +if(abs(lngamma(0.6000 - 5.300i)-(-7.239654605052715210182073623536904206104308839659326676113824586592039321903083835369930675115629685 - 3.702857758072432142072497796069521049678127217607403327232198098820227725661161561592679775128000025i))>__CZ__eps){epsilon(eps);return 122;} +if(abs(lngamma(-4.400 + 4.700i)-(-14.73413592903136179653960750100174060012531669119348359739188295824251395007186551726647596156181555 - 7.340768981905845672138265648506833394433043135824981559003634708099656882118068273562871737379370475i))>__CZ__eps){epsilon(eps);return 123;} +if(abs(lngamma(-3.400 + 3.700i)-(-10.55018529022399813119005433743831737900085357229525796426165531407012201466806460571733582857505851 - 6.763336971725381912118912702208512629733112628981673298740213483902378792635376051758399397079352018i))>__CZ__eps){epsilon(eps);return 124;} +if(abs(lngamma(-2.400 + 2.700i)-(-6.624262018571684573249747079902924251345023570085621326982177263497895441273594383174099568266569519 - 5.911914743873792313808731773611192661709672638901754910693406148730587535650933379128561953202673305i))>__CZ__eps){epsilon(eps);return 125;} +if(abs(lngamma(-1.400 + 1.700i)-(-3.046912030520906458689035477846643788289090086345259335810096962280997399307737870754170013561799449 - 4.680423062668151424886705499811285399248102868605621987762747421929868283337463368954255366241853210i))>__CZ__eps){epsilon(eps);return 126;} +if(abs(lngamma(-0.4000 + 0.7000i)-(-0.01623979147403148300780826047582666582616647435129398527305183616134471962089965927196036143676539809 - 2.826833421018256285271011446520969788549353956082297248294374573272383543521074785692812327220178392i))>__CZ__eps){epsilon(eps);return 127;} +if(abs(lngamma(0.6000 - 0.3000i)-(0.2484000028946351584991362705412598434332854007039741619587824313512584366380827672082938662993748700 + 0.4227177743314176403219013995119576518240065994565821579629389173672072909830539502579967884603383370i))>__CZ__eps){epsilon(eps);return 128;} +if(abs(lngamma(1.600 - 1.300i)-(-0.7407695833613238477853561156238169815169605175974563292533186764385040999403295266941234066342162332 - 0.3658395580779188724109027663961707196451841638334886679433275092947016221102693596315391546217532826i))>__CZ__eps){epsilon(eps);return 129;} +if(abs(lngamma(2.600 - 2.300i)-(-0.7153017561016750689453931991025219163388411460412682694249821466060642237596449041248795522730872166 - 2.067498782269003991801228117457494590355245722719424742293508630734960101015275647841102899818854810i))>__CZ__eps){epsilon(eps);return 130;} +if(abs(lngamma(3.600 - 3.300i)-(-0.2006290139452759775010107586460283514303264993274887714022222695834519457636026071215877177908693236 - 4.221969149213679168621678150696738907045553787288427746366287484331266798399726999903762441109724197i))>__CZ__eps){epsilon(eps);return 131;} +if(abs(lngamma(4.600 - 4.300i)-(0.6404767304085869581018213364351326853699331839312207180878789327971980401993755873561609797726810192 - 6.685149323469513776483323494807052342570441936959315816148292880724186611261236847208887542115434303i))>__CZ__eps){epsilon(eps);return 132;} +if(abs(lngamma(5.600 - 5.300i)-(1.727112476786098959996727579157495580048033035060833670179296378163352191130662743702237851099320091 - 9.383383918093155327986445451264543368751338171298232916305123349159206537551156601182421044554298994i))>__CZ__eps){epsilon(eps);return 133;} +if(abs(lngamma(55.60 - 0.3000i)-(166.7215150367733897769155930653789348483780044274716818154610861234389078719805189264594918732382586 - 1.202750513929718332820270669742686561426457642272968981346017082644807076333571537491197745615077294i))>__CZ__eps){epsilon(eps);return 134;} +if(abs(lngamma(56.60 - 0.3000i)-(170.7397127945179968376917410624766834622909691036136375973004131040276663262707416475336111420149831 - 1.208146145021640303895693686064781770317635078049891748154048007544470593526254839683637064897097838i))>__CZ__eps){epsilon(eps);return 135;} +if(abs(lngamma(57.60 - 0.3000i)-(174.7757358264026770962028712327193919190938819848539820911816742522615118513515101187002268498256953 - 1.213446448743774292811195505423481449339002192187714949283070433230478839177211462927645118751139388i))>__CZ__eps){epsilon(eps);return 136;} +if(abs(lngamma(58.60 - 0.3000i)-(178.8292719572886165808686582437464130998008894472168186351028467401004239585080660700434170533848267 - 1.218654734982846161251085553080214761347285268088604785438095878385945771674273185064368369032315536i))>__CZ__eps){epsilon(eps);return 137;} +if(abs(lngamma(59.60 - 0.3000i)-(182.9000197581041057641595126649840680882966589651420637344563598630410760508053004418106210806480514 - 1.223774144183534973445316592347337056808910609419286930794193524682491346969634027786839155163892724i))>__CZ__eps){epsilon(eps);return 138;} +if(abs(lngamma(60.60 - 0.3000i)-(186.9876880003631981031020807195926428903734785341818284861483167023505345362582553713940653353951410 - 1.228807658719925269995511830298415601718771597558190350507883496810540525070275863955647504172442604i))>__CZ__eps){epsilon(eps);return 139;} +if(abs(lngamma(61.60 - 0.3000i)-(191.0919951469889337316641602771633017764510692037723749796543523708549224640669741133145902737781006 - 1.233758113328768712483862353815791968059294457847368072259148050293157549143123712613333613763784674i))>__CZ__eps){epsilon(eps);return 140;} +if(abs(lngamma(62.60 - 0.3000i)-(195.2126688764702481772276457650023207176714432948785485345860994461920670783769886309746108133330257 - 1.238628204695931980600482702688969918429374403006592554012319844898454093596574259217162870691749038i))>__CZ__eps){epsilon(eps);return 141;} +if(abs(lngamma(63.60 - 0.3000i)-(199.3494456376687238313417632202369605922807314239672719385369875900976176399328184235160742022894634 - 1.243420500277190605198320894289870930154643596582155076044919162631888476221718725167773691679060391i))>__CZ__eps){epsilon(eps);return 142;} +if(abs(lngamma(64.60 - 0.3000i)-(203.5020702328465376706204035728796350972376926574607893322136594379996117055188038514446315204059032 - 1.248137446425596312819515029227444652080011390838575181737724990020365851808034508613690412166704588i))>__CZ__eps){epsilon(eps);return 143;} +if(abs(lngamma(65.60 - 0.3000i)-(207.6702954267142863859185793548246421433863939380928954872956462639690979311998038217156277177658497 - 1.252781375889819416329161991660565854615382764835522506641801626851934424429479695919682707858812249i))>__CZ__eps){epsilon(eps);return 144;} +if(abs(lngamma(55.60 - 4.700i)-(166.5221258272035253961542734005976077004749775938844000662776938982124117149831619415891292027559084 - 18.84875483296568553194454925345602004591801239160222174651330953176747978241113581568341389313614184i))>__CZ__eps){epsilon(eps);return 145;} +if(abs(lngamma(56.60 - 3.700i)-(170.6185921690853207517443064939778892985245375960964842072277769261987939958711192180080496388759790 - 14.90313021223193465377855573208445845565931668639004077631447433024105216208357598284073272963526083i))>__CZ__eps){epsilon(eps);return 146;} +if(abs(lngamma(57.60 - 2.700i)-(174.7127139121008307648437631979262499901446251937177073309638635680981878307625357907205057992110826 - 10.92201102864604767334040466047947450750373806537116051068380101221240925743684470549656839673533788i))>__CZ__eps){epsilon(eps);return 147;} +if(abs(lngamma(58.60 - 1.700i)-(178.8051797102056562439362100160978710660289490095968327611173555143739460179913989993096167790463432 - 6.905945104548951236229262516275118301863000955218208856630289945072933677322889363909280822011545321i))>__CZ__eps){epsilon(eps);return 148;} +if(abs(lngamma(59.60 - 0.7000i)-(182.8966358377199778625865269072085032936485484956150669021166926511020935207431114192228211953931100 - 2.855486362253577342667404413778192112579790386732841204180813534474139545940894056117527731737226582i))>__CZ__eps){epsilon(eps);return 149;} +if(abs(lngamma(60.60 + 0.3000i)-(186.9876880003631981031020807195926428903734785341818284861483167023505345362582553713940653353951410 + 1.228807658719925269995511830298415601718771597558190350507883496810540525070275863955647504172442604i))>__CZ__eps){epsilon(eps);return 150;} +if(abs(lngamma(61.60 + 1.300i)-(191.0789031896982469942903294770974306494712752019213395010059816712212959534694477736544779643613606 + 5.346377998474074192830409565498522421021695288142347615450028628516451152858671821236062551519577511i))>__CZ__eps){epsilon(eps);return 151;} +if(abs(lngamma(62.60 + 2.300i)-(195.1708115544608858783580589279983618518227865792619427244597031395608221351124418855807139544387844 + 9.496666208022148051357709844128014322980249562957453155498216739528300001626643515787555547645875216i))>__CZ__eps){epsilon(eps);return 152;} +if(abs(lngamma(63.60 + 3.300i)-(199.2639082667972359747356775354901044881033064193665592320100330065828589091059656379848180952180576 + 13.67911603585439751926438073480939520547347569839795064532158720371833242545216773892848304348649828i))>__CZ__eps){epsilon(eps);return 153;} +if(abs(lngamma(64.60 + 4.300i)-(203.3586553654963869814883298543618854726441450377694569990857332006085635938056596309090099303930334 + 17.89317489050227754715433149549722038188972541358048335428889588525290414035694955077798780767484079i))>__CZ__eps){epsilon(eps);return 154;} +if(abs(lngamma(65.60 + 5.300i)-(207.4554835618873492047512087924156663776620358356581503938661139973023305384540970489546974722608112 + 22.13829509931977678201875089030163451926720764548437834522489362621805878564584156804449041165307769i))>__CZ__eps){epsilon(eps);return 155;} +if(abs(lngamma(0.6000 - 55.30i)-(-85.54482235577983941284251852323648610691188392673393393659117312998074429939423249453201268385415968 - 166.7640845362830899082977628513038941147191508645382670512065838817570593346370195934584098731608163i))>__CZ__eps){epsilon(eps);return 156;} +if(abs(lngamma(0.6000 - 56.30i)-(-87.11382647385499402990266927218873826677912515510914330975238159375338785735675613885474681911555455 - 170.7858332456548897964755419202916477033408200711519690015167519320073811710594461413312890867212396i))>__CZ__eps){epsilon(eps);return 157;} +if(abs(lngamma(0.6000 - 57.30i)-(-88.68286214812485690627962462529848906043953388486922638389109935077387260509105638054210646253252466 - 174.8253452895478184840703539752269094932785103410249518116087112411324582420889387891648827483331167i))>__CZ__eps){epsilon(eps);return 158;} +if(abs(lngamma(0.6000 - 58.30i)-(-90.25192828651651583800480958344256221682554088740576313673589889163710837899207764032711716706627583 - 178.8823106163841131771861511088137077830986146286084489346147229324383955058792053361236598271019023i))>__CZ__eps){epsilon(eps);return 159;} +if(abs(lngamma(0.6000 - 59.30i)-(-91.82102385268587759734139136217993540696936010920994984591658423038715645418137316213497147316787354 - 182.9564298132977973838333574465352695792546867284831679902458633771250846205990521337322037599865490i))>__CZ__eps){epsilon(eps);return 160;} +if(abs(lngamma(0.6000 - 60.30i)-(-93.39014786228910598458529398231928177449383105033168028035758106697089023386753079638127787148822458 - 187.0474135677690289293542062291360648608774972285628443252781312026960680153689550595593442583564361i))>__CZ__eps){epsilon(eps);return 161;} +if(abs(lngamma(0.6000 - 61.30i)-(-94.95929937956076993888890535139227785932447324700640489970555152485771091160984562939060645206100132 - 191.1549821649831349987910547767822679603735412036380108781321752841569185871421007366309694487409486i))>__CZ__eps){epsilon(eps);return 162;} +if(abs(lngamma(0.6000 - 62.30i)-(-96.52847751416891464599424930795884732518087496093651555404283351659612698836352323452352710420599104 - 195.2788650179992458972186470030422322640959550214072444870291693388786130688229112380191390257821807i))>__CZ__eps){epsilon(eps);return 163;} +if(abs(lngamma(0.6000 - 63.30i)-(-98.09768141832058996231194071903760307280235519603364210034375642851432112362859092795643468479700327 - 199.4188002280943140128727971292337826315387363387763786270696435128423987623771787363214987887073743i))>__CZ__eps){epsilon(eps);return 164;} +if(abs(lngamma(0.6000 - 64.30i)-(-99.66691028409427522125385963825011409754630863598190917300304121976114751378659089137971202438172887 - 203.5745341728981030650825963445356527935331129342248469636074322780853587222584902429706178725686242i))>__CZ__eps){epsilon(eps);return 165;} +if(abs(lngamma(0.6000 - 65.30i)-(-101.2361633409781854893699037629524761308029390440175099023860977120545945724838225634129393108607355 - 207.7458211201573236805249632667291754315339341665724958026196877950249917227554119187871060871559697i))>__CZ__eps){epsilon(eps);return 166;} +if(abs(lngamma(55.60 - 60.30i)-(138.3405218869058217717201182836422027677382184890964165590417353499219822226519181484044703575835292 - 250.9485307086751713133102893231808151265549690071705472539067848281998391909656358247103271742719578i))>__CZ__eps){epsilon(eps);return 167;} +if(abs(lngamma(56.60 - 60.30i)-(142.7474976121018701984157500679190442966110797769323173557040709858649026362568015560276025151255956 - 251.7744588650459198825346353772080509751313819470548658242804227289838197861524419605491386182133953i))>__CZ__eps){epsilon(eps);return 168;} +if(abs(lngamma(57.60 - 60.30i)-(147.1627435319602425515209166358781832064023544924212637636653157301087891743636771772442175547092138 - 252.5914974493805839443768868968642526869013797892608722844298827478025786612090804469713284568207639i))>__CZ__eps){epsilon(eps);return 169;} +if(abs(lngamma(58.60 - 60.30i)-(151.5862689029682042031606617640450220740985775964639233206719519919454468746790090892789062856833994 - 253.3997923739994162421416717294147634900873392644324912633837005280001593924100149032670755229086402i))>__CZ__eps){epsilon(eps);return 170;} +if(abs(lngamma(59.60 - 60.30i)-(156.0180803184689022095120622630277425180433295653817951699970902688810769976218882558288617606286722 - 254.1994872924291535134537002289372877256760561545266240447182119613107490480996768753107944444566663i))>__CZ__eps){epsilon(eps);return 171;} +if(abs(lngamma(60.60 - 60.30i)-(160.4581818322128207752571131620498333645831099884594593949166210067133473205367535408753892850882553 - 254.9907235879958949246830907372060458378867915677707498070916381728065006920567219761323639093065907i))>__CZ__eps){epsilon(eps);return 172;} +if(abs(lngamma(61.60 - 60.30i)-(164.9065750781912363906196189745577497508505165621357938820065182107142960571733194288330116576903125 - 255.7736403669080425654455012237246051402306640891736322674732329084396310656024722092859071945872444i))>__CZ__eps){epsilon(eps);return 173;} +if(abs(lngamma(62.60 - 60.30i)-(169.3632593867220799863942253592790131010186217605278241383032664772260920373282624028529879975286350 - 256.5483744554910528044048617005478717965073680654042053866320357723837630372594401312206968901830105i))>__CZ__eps){epsilon(eps);return 174;} +if(abs(lngamma(63.60 - 60.30i)-(173.8282318967764198928263540479369804154959334380883398727474568650558868155342724620418729191066897 - 257.3150604012511380535676929646281795055983167823336193389524424552595441364148246393785125517847376i))>__CZ__eps){epsilon(eps);return 175;} +if(abs(lngamma(64.60 - 60.30i)-(178.3014876645497005489995740718100489155558324227755847007898254349773686020549399461464731246888811 - 258.0738304774605436591436026066009539042787457216911291577832446476517821930895032617238958674099152i))>__CZ__eps){epsilon(eps);return 176;} +if(abs(lngamma(65.60 - 60.30i)-(182.7830197682960267239662260557525833694506977039319737802533196097442483852152832046887750759565943 - 258.8248146909724805417993325211754807069936951454932977542761597422795687852878109079207208588308147i))>__CZ__eps){epsilon(eps);return 177;} +if(abs(lngamma(55.60 - 55.30i)-(142.3862162791589253462657451176275726003857264651343509950957693660793746863734326554521916865294160 - 229.0474972316203435288188174128389032017308276896396827258188412666555426184444346078935151648963593i))>__CZ__eps){epsilon(eps);return 178;} +if(abs(lngamma(56.60 - 56.30i)-(145.9655713474689753168556009847734887663033552824290632709719191874805473283966808702482716223823799 - 234.2012259525622513896404861908422505950646506577988340677531054697523114853375505771896176207845654i))>__CZ__eps){epsilon(eps);return 179;} +if(abs(lngamma(57.60 - 57.30i)-(149.5627523253413003508200851967083007076485608754907532209664548084707244359306524068411586608941471 - 239.3727177204530395107173394215426561501560159557014103102685030670438401066317331091766069662051511i))>__CZ__eps){epsilon(eps);return 180;} +if(abs(lngamma(58.60 - 58.30i)-(153.1774470047839472501216057736005131302626263510371392880103904697841471694103329293425078496549758 - 244.5616624984797644536433102063654140139237547865421532878830803720762552799643139942619380524890401i))>__CZ__eps){epsilon(eps);return 181;} +if(abs(lngamma(59.60 - 59.30i)-(156.8093539260984043245770025957276995010069796775703177529274656935406571580476095484467127733135084 - 249.7677608875474964335171539461488545902215228674008981574984941307449419367892141512085156904698398i))>__CZ__eps){epsilon(eps);return 182;} +if(abs(lngamma(60.60 - 60.30i)-(160.4581818322128207752571131620498333645831099884594593949166210067133473205367535408753892850882553 - 254.9907235879958949246830907372060458378867915677707498070916381728065006920567219761323639093065907i))>__CZ__eps){epsilon(eps);return 183;} +if(abs(lngamma(61.60 - 61.30i)-(164.1236491593380218382957487779642572534385362007999916281283947968048913383213154195181013057822234 - 260.2302708970324395553848679531333038493595454481482560493315410820180244948561636909552645533403618i))>__CZ__eps){epsilon(eps);return 184;} +if(abs(lngamma(62.60 - 62.30i)-(167.8054835609733823774016164868506426238263526697353479782755961582196176989205680074917215202127864 - 265.4861322389681286058365065491944749198017327500214219083439023895059621709769558317157193105864721i))>__CZ__eps){epsilon(eps);return 185;} +if(abs(lngamma(63.60 - 63.30i)-(171.5034214625769205528980449555097665172285302158028025423161481941008052930058651761908875732005816 - 270.7580457256222186188843213325906832500862444373572311661827574319274457824608027119111557496467876i))>__CZ__eps){epsilon(eps);return 186;} +if(abs(lngamma(64.60 - 64.30i)-(175.2172076444693933495200678808489471651335658562522069741003825794583284267731429819984320358705804 - 276.0457577445122795003295082894754935609216218032287116765827545233934750440738775983322565095055686i))>__CZ__eps){epsilon(eps);return 187;} +if(abs(lngamma(65.60 - 65.30i)-(178.9465948507696967449494536146172974534191430062324139747191513973655253559309515112484546085877718 - 281.3490225726683461623186324992570909685317567794418009098339817182638759202079343286582580534821206i))>__CZ__eps){epsilon(eps);return 188;} + + /* some large integers */ + if(abs(lngamma( 10^2 +1 )-( ln((10^2)!) ) ) > __CZ__eps ){epsilon(eps);return 189;} + ##if(abs(lngamma( 10^10 +1 )-( ln((10^10)!) ) > __CZ__eps ){epsilon(eps);return 190;} + ##epsilon(1e-140) if(abs(lngamma( 10^100 )-( ln((10^100)!) ) > __CZ__eps ){epsilon(eps);return 191;} + epsilon(eps); + if(isnull(type))t02(1); + + epsilon(eps); + return 0; +} + +/* test 03 tests psi(z) for the following values + * + * z psi(z) + * 5 1.506117668431800472726821243 + * -5 error + * -5.5 1.792911330399932941915445023 + * 5.5 1.611093148581751123733626842 + * 5.5+5.5i 2.005864860662911769895523042 + 0.8322301014098247099090843855i + * -5.5+5.5i 2.096773951572002678986432133 + 2.400271643089053271126857721i + * -5.5-5.5i 2.096773951572002678986432133 - 2.400271643089053271126857721i + */ +define t03(){ + local eps; + eps = epsilon(1e-20); + if( abs(psi( 5 ) - 1.506117668431800472726821243) > __CZ__eps ){ + epsilon(eps); + return 1; + } + if(!iserror(psi( -5 ))){ + epsilon(eps); + return 2; + } + if( abs(psi( -5.5 ) - (1.792911330399932941915445023)) > __CZ__eps){ + epsilon(eps); + return 3; + } + if( abs(psi( 5.5 ) - (1.611093148581751123733626842)) > __CZ__eps){ + epsilon(eps); + return 4; + } + if( abs(psi( 5.5+5.5i ) - ( 2.005864860662911769895523042 + 0.8322301014098247099090843855i )) > __CZ__eps ){ + epsilon(eps); + return 5; + } + if( abs(psi(-5.5+5.5i ) - ( 2.096773951572002678986432133 + 2.400271643089053271126857721i )) > __CZ__eps ){ + epsilon(eps); + return 6; + } + if( abs(psi(-5.5-5.5i ) - ( 2.096773951572002678986432133 - 2.400271643089053271126857721i )) > __CZ__eps ){ + epsilon(eps); + return 7; + } + epsilon(eps); + return 0; +} + +/* test 04 tests polygamma(m,z) for the following values (m==0 gets computed by psi()) + * Values tested against were computed with Mathematica(TM) only + * (z in the left complex halfplane does not get computed yet) + * + * m z polygamma(m,z) + * 2 5 -0.048789732245114496725 + * 2 -5 error + * 2 -5.5 -0.02758791070687679879 + * 2 5.5 -0.03960894752130204297 + * 2 5.5+5.5i 0.00163921986957704426 + 0.01803230748452131112i + * 2 -5.5+5.5i -0.00136603933402926677 - 0.015027048280671555719i + * 2 -5.5-5.5i -0.00136603933402926677 + 0.015027048280671555719i + * + * + * 5.2+5.6i 2.2+2.6i -8.8027566465576501667921604e6-2.66541164009580321614666448e7i + */ +define t04(){ + local eps; + eps = epsilon(1e-20); + if( abs(polygamma( 2,5 ) - (-0.048789732245114496725)) > __CZ__eps ){ + epsilon(eps); + return 1; + } + if(!iserror(polygamma( 2,-5 ))){ + epsilon(eps); + return 2; + } + if( abs(polygamma( 2,-5.5 ) - ( -0.02758791070687679879 )) > __CZ__eps){ + epsilon(eps); + return 3; + } + if( abs(polygamma( 2,5.5 ) - ( -0.03960894752130204297 )) > __CZ__eps){ + epsilon(eps); + return 4; + } + if( abs(polygamma( 2,5.5+5.5i ) - ( 0.00163921986957704426 + 0.01803230748452131112i )) > __CZ__eps ){ + epsilon(eps); + return 5; + } + if( abs(polygamma( 2,-5.5+5.5i ) - ( -0.00136603933402926677 - 0.015027048280671555719i )) > __CZ__eps ){ + epsilon(eps); + return 6; + } + if( abs(polygamma( 2,-5.5-5.5i ) - ( -0.00136603933402926677 + 0.015027048280671555719i )) > __CZ__eps ){ + epsilon(eps); + return 7; + } + epsilon(eps); + return 0; +} + +/* test 05 tests hurwitzzeta(s,a) for the following values. the first two test if + * the arguments are in the right order. + * + * s a hurwitzzeta(s,a) + * 2 5 0.2213229557371153253613040555 + * 5 2 0.03692775514336992633136548646 + * 2.2 5 0.1363459661171646798298971735 + * 2.2 5.2 0.1294703948013920875737274341 + * -2.2 5.2 -43.62740512741650992650645550 + * -2.2 -5.2 65.71970386778362403451264243 + 47.73828461458444658816112446i + * 2.2 5.2+5.6i 0.03844077315966546674827814485-0.06625016367377721995234763811i + * 2.2 5.2-5.6i 0.03844077315966546674827814485+0.06625016367377721995234763811i + * 2.2 -5.2+5.6i -0.06570771621451414059240507315-0.02045673968185922880458837166i + * 2.2 -5.2-5.6i -0.06570771621451414059240507315+0.02045673968185922880458837166i + * -2.2 5.2+5.6i 171.3023982201237034174265227 - 61.37099215219445965540875817i + * -2.2 5.2-5.6i 171.3023982201237034174265227 - 61.37099215219445965540875820i + * -2.2 -5.2+5.6i -69.18353604795857246443145272 - 231.4707567406623523296345557i + * -2.2 -5.2-5.6i -69.18353604795857246443145272 + 231.4707567406623523296345557i + * + * 5.2+5.6i 2.2 -0.002865569533484339556271871050+0.0148003604570643921348488531i + * 5.2-5.6i 2.2 -0.002865569533484339556271871050-0.0148003604570643921348488531i + * -5.2+5.6i 2.2 -1.837761873462765905576370048 + 3.192719531152431336748963871i + * -5.2-5.6i 2.2 -1.837761873462765905576346060 - 3.192719531152431336748963871i + * 5.2+5.6i -2.2 95348834359.70315397408796804 - 162510500631.4367394107265635i + * 5.2-5.6i -2.2 0.9651349278612417712864108926 - 3.036274517135684343726981739i + * -5.2+5.6i -2.2 2002299780.711849103677017204 - 1543130375.266699195007479145i + * -5.2-5.6i -2.2 -0.2104165672779048392846890114 + 1.106842659781205784424725697i + * + * 5.2+5.6i 2.2+2.6i 0.1022857746468810493351322652 + 0.2344359367956833252781356236 i + * 5.2+5.6i 2.2-2.6i -0.000005879828833971610476305738830 -0.000001047520361040864830120054308i + * 5.2+5.6i -2.2+2.6i 254.99648763579325576522195-33.268146747986445163579145i + * 5.5+5.6i -2.2-2.6i -0.00000006966837525188576927163757061-0.000000051720089075957906725862754i + * test all combinations? + */ +define t05(){ + local eps; + eps = epsilon(1e-20); + if( abs(hurwitzzeta( 2,5 ) - ( 0.2213229557371153253613040555 )) > __CZ__eps){ + epsilon(eps); + return 1; + } + if( abs(hurwitzzeta( 5,2 ) - ( 0.03692775514336992633136548646 )) > __CZ__eps){ + epsilon(eps); + return 2; + } + if( abs(hurwitzzeta( 2.2,5 ) - ( 0.1363459661171646798298971735 )) > __CZ__eps){ + epsilon(eps); + return 3; + } + if( abs(hurwitzzeta( 2.2,5.2 ) - ( 0.1294703948013920875737274341 )) > __CZ__eps){ + epsilon(eps); + return 4; + } + if( abs(hurwitzzeta( -2.2,5.2 ) - ( -43.62740512741650992650645550 )) > __CZ__eps){ + epsilon(eps); + return 5; + } + if( abs(hurwitzzeta( -2.2,-5.2 ) - ( 65.71970386778362403451264243 + 47.73828461458444658816112446i )) > __CZ__eps){ + epsilon(eps); + return 6; + } + if( abs(hurwitzzeta( 2.2,5.2+5.6i ) - ( 0.038440773159665466748278144 - 0.0662501636737772199523476381i )) > __CZ__eps){ + epsilon(eps); + return 7; + } + if( abs(hurwitzzeta( 2.2,5.2-5.6i ) - ( 0.038440773159665466748278144 + 0.06625016367377721995234763811i )) > __CZ__eps){ + epsilon(eps); + return 8; + } + if( abs(hurwitzzeta( 2.2,-5.2+5.6i ) - ( -0.06570771621451414059240507315-0.02045673968185922880458837166i )) > __CZ__eps){ + epsilon(eps); + return 9; + } + if( abs(hurwitzzeta( 2.2,-5.2-5.6i ) - ( -0.06570771621451414059240507315+0.02045673968185922880458837166i )) > __CZ__eps){ + epsilon(eps); + return 10; + } + if( abs(hurwitzzeta( -2.2,5.2+5.6i ) - ( 171.3023982201237034174265227 - 61.37099215219445965540875817i )) > __CZ__eps){ + epsilon(eps); + return 11; + } + if( abs(hurwitzzeta( -2.2,5.2-5.6i ) - ( 171.3023982201237034174265227 + 61.37099215219445965540875820i )) > __CZ__eps){ + epsilon(eps); + return 12; + } + if( abs(hurwitzzeta( -2.2,-5.2+5.6i ) - ( -69.18353604795857246443145272 - 231.4707567406623523296345557i )) > __CZ__eps){ + epsilon(eps); + return 13; + } + if( abs(hurwitzzeta( -2.2,-5.2-5.6i ) - ( -69.18353604795857246443145272 + 231.4707567406623523296345557i )) > __CZ__eps){ + epsilon(eps); + return 14; + } + if( abs(hurwitzzeta( 5.2+5.6i,2.2 ) - ( -0.002865569533484339556271871050+0.0148003604570643921348488531i )) > __CZ__eps){ + epsilon(eps); + return 15; + } + if( abs(hurwitzzeta( 5.2-5.6i,2.2 ) - ( -0.002865569533484339556271871050-0.0148003604570643921348488531i )) > __CZ__eps){ + epsilon(eps); + return 16; + } + if( abs(hurwitzzeta( -5.2+5.6i,2.2 ) - ( -1.837761873462765905576370048 + 3.192719531152431336748963871i )) > __CZ__eps){ + epsilon(eps); + return 17; + } + if( abs(hurwitzzeta( -5.2-5.6i,2.2 ) - ( -1.837761873462765905576346060 - 3.192719531152431336748963871i )) > __CZ__eps){ + epsilon(eps); + return 18; + } + + if( abs(hurwitzzeta( 5.2+5.6i,-2.2 ) - ( 95348834359.70315397408796804 - 162510500631.4367394107265635i )) > __CZ__eps){ + epsilon(eps); + ##return 19; + } + if( abs(hurwitzzeta( 5.2-5.6i,-2.2 ) - ( 0.9651349278612417712864108926 - 3.036274517135684343726981739i )) > __CZ__eps){ + epsilon(eps); + return 20; + } + + if( abs(hurwitzzeta( -5.2+5.6i,-2.2 ) - ( 2002299780.711849103677017204 - 1543130375.266699195007479145i )) > __CZ__eps){ + epsilon(eps); + ##return 21; + } + if( abs(hurwitzzeta( -5.2-5.6i,-2.2 ) - ( -0.2104165672779048392846890114 + 1.106842659781205784424725697i )) > __CZ__eps){ + epsilon(eps); + return 22; + } + if( abs(hurwitzzeta( 5.2+5.6i,2.2+2.6i ) - ( 0.10228577464688104933513226525 + 0.2344359367956833252781356235i )) > __CZ__eps){ + epsilon(eps); + return 23; + } + if( abs(hurwitzzeta( 5.2+5.6i,2.2-2.6i ) - ( -0.000005879828833971610476305738830 -0.000001047520361040864830120054308i )) > __CZ__eps){ + epsilon(eps); + return 24; + } + if( abs(hurwitzzeta( 5.2+5.6i,-2.2+2.6i ) - ( 330.37403168831191021183 + 207.41259747950966196661i )) > __CZ__eps){ + epsilon(eps); + ##return 25; + } + if( abs(hurwitzzeta( 5.2+5.6i,-2.2-2.6i ) - ( -0.0000000696683752518857692716375 - 0.0000000517200890759579067258627i )) > __CZ__eps){ + epsilon(eps); + ##return 26; + } + epsilon(eps); + return 0; +} + +/* test 06 tests zeta(s) for the following values. + * + * 2 1.644934066848226436472415167 + * 1 error + * 3 1.202056903159594285399738162 + * -3 1/120 + * 5.5+5.6i 0.9829916458246897306781279065 + 0.01804690180657353497603622245i + * 5.2-5.6i 0.9829916458246897306781279065 - 0.01804690180657353497603622245 + * -5.2+5.6i -1.101851386544252162781870264 - 0.1426833937495229821744935458i + * -5.2-5.6i -1.101851386544252162781870264 + 0.1426833937495229821744935458i + * + * Zero with smallest imaginary part + * 1/2+14.13472514173469379045725198i 0 + */ +define t06(){ + local eps; + eps = epsilon(1e-20); + if( abs(zeta( 2 )-( 1.644934066848226436472415167)) > __CZ__eps){ + epsilon(eps); + return 1; + } + if( !iserror(zeta( 1 ) )){ + epsilon(eps); + return 2; + } + if( abs(zeta( 3 )-( 1.202056903159594285399738162)) > __CZ__eps){ + epsilon(eps); + return 3; + } + if( abs(zeta( -3 )-( 1/120)) > __CZ__eps){ + epsilon(eps); + return 4; + } + if( abs(zeta( 5.5+5.6i )-( 0.985921045907062298613817 + 0.014724913951794894908415i )) > __CZ__eps){ + epsilon(eps); + return 5; + } + if( abs(zeta( 5.2-5.6i )-( 0.9829916458246897306781279065 - 0.01804690180657353497603622245i)) > __CZ__eps){ + epsilon(eps); + return 6; + } + if( abs(zeta( -5.2+5.6i )-( -1.101851386544252162781870264 - 0.1426833937495229821744935458i)) > __CZ__eps){ + epsilon(eps); + return 7; + } + if( abs(zeta( -5.2-5.6i )-( -1.101851386544252162781870264 + 0.1426833937495229821744935458i)) > __CZ__eps){ + epsilon(eps); + return 8; + } + epsilon(eps); + return 0; +} + +/* test 07 tests harmonic(limit) for the following values. + * + * 0 error + * 1 1 + * 3 11/6 + * 10 7381/2520 + * 100 14466636279520351160221518043104131447711/2788815009188499086581352357412492142272 + */ +define t07(){ + local eps; + eps = epsilon(1e-20); + if( !iserror(harmonic( 0 ) )){ + epsilon(eps); + return 1; + } + if( harmonic( 1 ) - 1 != 0){ + epsilon(eps); + return 2; + } + if( harmonic( 3 ) - 11/6 != 0){ + epsilon(eps); + return 3; + } + if( harmonic( 10 ) - 7381/2520 != 0){ + epsilon(eps); + return 4; + } + if( harmonic( 100 ) - (14466636279520351160221518043104131447711/2788815009188499086581352357412492142272) != 0){ + epsilon(eps); + return 5; + } + epsilon(eps); + return 0; +} + +/* test 08 tests doublefactorial(n) for the following values + * + * 10 3840 + * 11 10395 + * -11 1/3 + * -10 error + * 111 3853986162502645785712150546541904653309504195240303679678670940619904075006404195556640625 + * -111 -1/34720596058582394465875230149026168047833371128291024141249287753332469144201839599609375 + * 5.2 18.37288214375756118207669378072506887684550012806364822857845 + * -5.2 0.310704476688173329838586027938765271259515590892296917353047 + * + */ +define t08(){ + local eps; + eps = epsilon(1e-20); + if( (doublefactorial( 10 ) - 3840) != 0){ + epsilon(eps); + return 1; + } + + if( (doublefactorial(11 ) - 10395) != 0){ + epsilon(eps); + return 2; + } + + if( abs((doublefactorial(-11 ) - (-1/945))) > __CZ__eps){ + epsilon(eps); + return 3; + } + + if( !iserror(doublefactorial(-10))){ + epsilon(eps); + return 4; + } + + if( (doublefactorial(111 ) - 3853986162502645785712150546541904653309504195240303679678670940619904075006404195556640625) != 0){ + epsilon(eps); + return 5; + } + + if( abs((doublefactorial(-111 ) - -1/34720596058582394465875230149026168047833371128291024141249287753332469144201839599609375))> __CZ__eps){ + epsilon(eps); + return 6; + } + + if( abs((doublefactorial(5.2 ) - 18.37288214375756118207669378072506887684550012806364822857845))> __CZ__eps ){ + epsilon(eps); + return 7; + } + if( abs((doublefactorial(-5.2 ) - 0.310704476688173329838586027938765271259515590892296917353047))> __CZ__eps ){ + epsilon(eps); + return 8; + } + epsilon(eps); + return 0; +} + +/* test 09 tests stirling1(n,m) for the following values + * + * n m + * 10 0 0 + * 0 10 0 + * 0 0 1 + * 10 10 1 + * 10 1 -362880 + * 10 5 -269325 + * 100 50 3183222782352964384744354120729686064175609439397055063\ + * 717578668769227113071836382198739697421125692626030268475 + */ +define t09(){ + local eps; + eps = epsilon(1e-20); + if( (stirling1(10,0)-(0))!=0){ + epsilon(eps); + return 1; + } + if( (stirling1(0,10)-(0))!=0){ + epsilon(eps); + return 2; + } + if( (stirling1(0,0)-(1))!=0){ + epsilon(eps); + return 3; + } + if( (stirling1(10,10)-(1))!=0){ + epsilon(eps); + return 4; + } + if( (stirling1(10,1)-(-362880))!=0){ + epsilon(eps); + return 5; + } + if( (stirling1(10,5)-(-269325))!=0){ + epsilon(eps); + return 6; + } + if( (stirling1(100,50)-(3183222782352964384744354120729686064175609439397055063717578668769227113071836382198739697421125692626030268475))!=0){ + epsilon(eps); + return 7; + } + epsilon(eps); + return 0; +} + +/* test 10 tests stirling2(n,m) for the following values + * + * n m + * 10 0 1 + * 0 10 0 + * 0 0 1 + * 10 10 1 + * 10 1 1 + * 10 5 42525 + * 100 50 43098323700936634042151430154725869594352028961434061391244174113128031\ + * 9058853783145598261659992013900 + */ +define t010(){ + local eps; + eps = epsilon(1e-20); + if( (stirling2(10,0)-(0))!=0){ + epsilon(eps); + return 1; + } + if( (stirling2(0,10)-(0))!=0){ + epsilon(eps); + return 2; + } + if( (stirling2(0,0)-(1))!=0){ + epsilon(eps); + return 3; + } + if( (stirling2(10,10)-(1))!=0){ + epsilon(eps); + return 4; + } + if( (stirling2(10,1)-(1))!=0){ + epsilon(eps); + return 5; + } + if( (stirling2(10,5)-(42525))!=0){ + epsilon(eps); + return 6; + } + if( (stirling2(100,50)-( 430983237009366340421514301547258695943520289614340613912441741131280319058853783145598261659992013900 ))!=0){ + epsilon(eps); + return 7; + } + epsilon(eps); + return 0; +} + +/* test 11 tests stirling2caching(n,m) for the following values + * + * n m + * 10 0 0 + * 0 10 0 + * 0 0 1 + * 10 10 1 + * 10 1 1 + * 10 5 42525 + * 100 50 43098323700936634042151430154725869594352028961434061391244174113128031\ + * 9058853783145598261659992013900 + */ +define t011(){ + local eps; + eps = epsilon(1e-20); + if( (stirling2caching(10,0)-(0))!=0){ + epsilon(eps); + return 1; + } + if( (stirling2caching(0,10)-(0))!=0){ + epsilon(eps); + return 2; + } + if( (stirling2caching(0,0)-(1))!=0){ + epsilon(eps); + return 3; + } + if( (stirling2caching(10,10)-(1))!=0){ + epsilon(eps); + return 4; + } + if( (stirling2caching(10,1)-(1))!=0){ + epsilon(eps); + return 5; + } + if( (stirling2caching(10,5)-(42525))!=0){ + epsilon(eps); + return 6; + } + if( (stirling2caching(100,50)-( 430983237009366340421514301547258695943520289614340613912441741131280319058853783145598261659992013900 ))!=0){ + epsilon(eps); + return 7; + } + epsilon(eps); + return 0; +} + +/* test 12 tests bell(n) for the following values + * + * 0 1 + * 1 1 + * 2 2 + * 5 52 + * 10 115975 + * 100 47585391276764833658790768841387207826363669686825611466616334637559114\ + * 497892442622672724044217756306953557882560751 + */ +define t012(){ + local eps; + eps = epsilon(1e-20); + if( (bell(0)-(1))!=0){ + epsilon(eps); + return 1; + } + if( (bell(1)-(1))!=0){ + epsilon(eps); + return 2; + } epsilon(eps); + if( (bell(2)-(2))!=0){ + epsilon(eps); + return 3; + } + if( (bell(5)-(52))!=0){ + epsilon(eps); + return 4; + } + if( (bell(10)-(115975))!=0){ + epsilon(eps); + return 5; + } + if( (bell(100)-( 47585391276764833658790768841387207826363669686825611466616334637559114497892442622672724044217756306953557882560751 ))!=0){ + epsilon(eps); + return 6; + } + return 0; +} + +/* test 13 tests subfactorial(n) for the following values + * + * 0 1 + * 1 0 + * 10 1334961 + * 100 3433279598416380476519597752677614203236578380537578498354340028268\ + * 5180793327632432791396429850988990237345920155783984828001486412574\ + * 060553756854137069878601 + */ +define t013(){ + local eps; + eps = epsilon(1e-20); + if( (subfactorial(0)-(1))!=0){ + epsilon(eps); + return 1; + } + if( (subfactorial(1)-(0))!=0){ + epsilon(eps); + return 2; + } + if( (subfactorial(10)-(1334961))!=0){ + epsilon(eps); + return 3; + } + if( (subfactorial(100)-( 34332795984163804765195977526776142032365783805375784983543400282685180793327632432791396429850988990237345920155783984828001486412574060553756854137069878601 ))!=0){ + epsilon(eps); + return 4; + } + + epsilon(eps); + return 0; +} + +/* test 14 tests risingfactorial(x,n) for the following values + * + * x n + * 1 0 1 + * 10 5 240240 + * 10.5 5.5 1153886.265503555482030983579 + * 5.5+5.6i 2.2+2.6i 3.368463696973104283045428256 + 14.07030243790744467421234172i + * + */ +define t014(){ + local eps; + eps = epsilon(1e-20); + if( (risingfactorial(1,0)-(1))!=0){ + epsilon(eps); + return 1; + } + if( (risingfactorial(10,5)-(240240))!=0){ + epsilon(eps); + return 2; + } + if( abs(risingfactorial(10.5,5.5)-( 1153886.265503555482030983579 ))> __CZ__eps){ + epsilon(eps); + ##return 3; + } + if( abs(risingfactorial( 5.5+5.6i,2.2+2.6i )-( 3.368463696973104283045428256 + 14.07030243790744467421234172i )) > __CZ__eps){ + epsilon(eps); + return 4; + } + epsilon(eps); + return 0; +} + +/* test 15 tests bigcatalan(n) for the following values + * + * 0 1 + * 1 1 + * 10 16796 + * 100 896519947090131496687170070074100632420837521538745909320 + * + */ +define t015(){ + local eps; + eps = epsilon(1e-20); + if( (bigcatalan(0)-(1))!=0){ + epsilon(eps); + return 1; + } + if( (bigcatalan(1)-(1))!=0){ + epsilon(eps); + return 2; + } + if( (bigcatalan(10)-(16796 ))!=0){ + epsilon(eps); + return 3; + } + if( (bigcatalan(100)-( 896519947090131496687170070074100632420837521538745909320 ))!=0){ + epsilon(eps); + return 4; + } + epsilon(eps); + return 0; +} + +/* test 16 tests binomial(n,k) for the following values + * + * n k + * 0 0 1 + * 1 0 1 + * 10 5 252 + * 100 50 100891344545564193334812497256 + * + */ +define t016(){ + local eps; + eps = epsilon(1e-20); + if( (binomial(0,0)-(1))!=0){ + epsilon(eps); + return 1; + } + if( (binomial(1,0)-(1))!=0){ + epsilon(eps); + return 2; + } + if( (binomial(10,5)-(252))!=0){ + epsilon(eps); + return 3; + } + if( (binomial(100,50)-( 100891344545564193334812497256 ))!=0){ + epsilon(eps); + return 4; + } + if( (binomial(1000,500)-( comb(1000,500) ))!=0){ + epsilon(eps); + return 5; + } + epsilon(eps); + return 0; +} + +/* test 17 tests factorial(n) for the following values + * + * 20 2432902008176640000 + * 100 9332621544394415268169923885626670049071596826438162146859296389521\ + * 7599993229915608941463976156518286253697920827223758251185210916864\ + * 000000000000000000000000 + */ +define t017(){ + local eps; + eps = epsilon(1e-20); + + if( (factorial(20)-( 2432902008176640000 ))!=0){ + epsilon(eps); + return 1; + } + if( (factorial(100)-(100!))!=0){ + epsilon(eps); + return 2; + } + epsilon(eps); + return 0; +} + +/* test 18 tests primorial(a,b) for the following values + * + * a b + * 3 100 1152783981972759212376551073665878035 + * 0 100 2305567963945518424753102147331756070 + * 50 100 3749562977351496827 + * + */ +define t018(){ + local eps; + eps = epsilon(1e-20); + if( (primorial(3,100)-(1152783981972759212376551073665878035))!=0){ + epsilon(eps); + return 1; + } + if( (primorial(0,20000)-(pfact(20000)))!=0){ + epsilon(eps); + return 2; + } + if( (primorial(50,100)-(3749562977351496827))!=0){ + epsilon(eps); + return 3; + } + epsilon(eps); + return 0; +} + +/* test 19 tests toomcook3(a,b) for the following value + * + * a b + * 161! 171! (161!*171!) + * + */ +define t019(){ + local eps; + eps = epsilon(1e-20); + if( ( toomcook3( 161!,171! )-( 161!*171! ))!=0){ + epsilon(eps); + return 1; + } + epsilon(eps); + return 0; +} + +/* test 20 tests toomcook3square(a) for the following value + * + * a + * 161! (161!^2) + * + */ +define t020(){ + local eps; + eps = epsilon(1e-20); + if( ( toomcook3square( 161! )-( 161!^2 ))!=0){ + epsilon(eps); + return 1; + } + epsilon(eps); + return 0; +} + +/* test 21 tests toomcook4(a,b) for the following value + * + * a b + * 561! 571! (561!*571!) + * + */ +define t021(){ + local eps; + eps = epsilon(1e-20); + if( ( toomcook4( 561!,571! )-( 561!*571! ))!=0){ + epsilon(eps); + return 1; + } + epsilon(eps); + return 0; +} + +/* test 22 tests toomcook4square(a) for the following value + * + * a + * 561! (561!^2) + * + */ +define t022(){ + local eps; + eps = epsilon(1e-20); + if( ( toomcook4square( 561! )-( 561!^2 ))!=0){ + epsilon(eps); + return 1; + } + epsilon(eps); + return 0; +} + +define t023(){ + local eps; + eps = epsilon(1e-20); + if( (fallingfactorial(1,0)-( 1 ))!=0){ + epsilon(eps); + return 1; + } + if( (fallingfactorial(10,5)-( 30240 ))!=0){ + epsilon(eps); + return 2; + } + if( abs(fallingfactorial(10.5,5.5)-( 99161.85903301873714177523949 ))> __CZ__eps){ + epsilon(eps); + return 3; + } + if( abs(fallingfactorial( 5.5+5.6i,2.2+2.6i )-( 9.29931208830258420309197062886 + 1.28691176641462072673306933720i )) > __CZ__eps){ + epsilon(eps); + return 4; + } + epsilon(eps); + return 0; +} + +/* lower incomplete gamma function g(a,z) for arbitrary a,z */ +define t024(){ + local eps; + eps = epsilon(1e-20); + if( abs(gammainc(10.5,5.5)-( 1.0911054922884267714587707298319763515031034460618e6 ))> __CZ__eps){ + epsilon(eps); + return 1; + } + + if( abs(gammainc(-10.5,5.5)-( 4.2078651459391823080015064331563180161168802280640e-12 ))> __CZ__eps){ + epsilon(eps); + return 2; + } + + if( abs(gammainc( -10.5,-5.5 )-( -2.6401218205477163162463853253112404396824684325226e-7 - 9.9525091595256241288827723005552353976489914201570e-7i ))> __CZ__eps){ + epsilon(eps); + return 3; + } + if( abs(gammainc( 1.5,.5 )-( 0.71009105827755696037984229929040777357378308627454 ))> __CZ__eps){ + epsilon(eps); + return 4; + } + if( abs(gammainc( 1.5,-.5 )-( 0.88622692545275801364908374167057259139877472806119 + 0.32085932483101833896117715124223338525178610972460i ))> __CZ__eps){ + epsilon(eps); + return 5; + } + if( abs(gammainc( -1.5,-.5 )-( 2.3632718012073547030642233111215269103967326081632 + 3.9644835083455478417145204862038235291784113581824i ))> __CZ__eps){ + epsilon(eps); + return 6; + } + if( abs(gammainc( 1.6+2.3i, 2.3+1.4i)-( -0.023112977574442024349110845737131658924522434973607 + 0.070013601354006150597855752670117927127985847641410i ))> __CZ__eps){ + epsilon(eps); + return 7; + } + if( abs(gammainc( -1.6+2.3i, 2.3+1.4i )-( 0.00129628045952650890786497724124399230099593819048313 + 0.00015977289383944841440851534670535231366264702893907i ))> __CZ__eps){ + epsilon(eps); + return 8; + } + if( abs(gammainc( 1.6+2.3i, -2.3+1.4i )-( 0.08011526555206793146266272247818512925483090324121 + 0.18864341054002800687777400618294098230871057870324i ))> __CZ__eps){ + epsilon(eps); + return 9; + } + if( abs(gammainc( -1.6+2.3i, -2.3+1.4i )-( -0.0011066646302249434949283340601015297970855623709232 + 0.0066140667340761534747256896056105993963563038859892i ))> __CZ__eps){ + epsilon(eps); + return 10; + } + if( abs(gammainc( -1.6+2.3i, -2.3-1.4i )-( -192.26502410894853081990761345498010642885875566887 - 9.20687819570448375251655049593050937346609469761i ))> __CZ__eps){ + epsilon(eps); + return 11; + } + if( abs(gammainc( -1.6-2.3i, -2.3-1.4i )-( -0.0011066646302249434949283340601015297970855623709232 - 0.0066140667340761534747256896056105993963563038859892i ))> __CZ__eps){ + epsilon(eps); + return 11; + } + epsilon(eps); + return 0; +} + +/* exponential integral Ei(z) for arbitrary z */ +define t025(){ + local eps; + eps = epsilon(1e-20); + if( abs(expoint( 12)-( 14959.5326663975288522924618760575328096988328805595 ))> __CZ__eps){ + epsilon(eps); + return 1; + } + if( abs(expoint(-12 )-( -4.75108182467249393259461269666144183573679127590926e-7 ))> __CZ__eps){ + epsilon(eps); + return 2; + } + if( abs(expoint(1.2 )-( 2.44209228519265163972909726430649285323724645317842 ))> __CZ__eps){ + epsilon(eps); + return 3; + } + if( abs(expoint(-1.2 )-( -0.158408436851462561424955970710861738534157976840579 ))> __CZ__eps){ + epsilon(eps); + return 4; + } + if( abs(expoint( 12+12i)-( 1705.83261134074122070523718220504604600321580158721 -9839.85856317985996646693634577761869375870438645474i ))> __CZ__eps){ + epsilon(eps); + return 5; + } + if( abs(expoint(12-12i )-( 1705.83261134074122070523718220504604600321580158721 +9839.85856317985996646693634577761869375870438645474i ))> __CZ__eps){ + epsilon(eps); + return 6; + } + if( abs(expoint(-12+12i )-( -3.4169734885007076190668662199892409755505147e-7 +3.14159259071528119035402366471290026841357196537325i ))> __CZ__eps){ + epsilon(eps); + return 7; + } + if( abs(expoint(12i )-( -0.04978000688411367559592120873699061022711118653376 + 3.07576756832126998975847022375791405102780057904392i ))> __CZ__eps){ + epsilon(eps); + return 8; + } + if( abs(expoint( -12i)-( -0.04978000688411367559592120873699061022711118653376 - 3.07576756832126998975847022375791405102780057904392i ))> __CZ__eps){ + epsilon(eps); + return 9; + } + /* problem with checking, result is correct for more than 20 dec. digits starting from the left */ + if( abs(expoint( 120+12i)-( 8.56859444638801538211461026892024105606765234361709e49 - 6.74517461831409343681783273107064901497483026647260e49i ))> __CZ__eps){ + ##epsilon(eps); + ##return 10; + } + if( abs(expoint( -120+12i)-( + 3.14159265358979323846264338327950288419716939937511i ))> __CZ__eps){ + epsilon(eps); + return 11; + } + if( abs(expoint( -120-12i)-( - 3.14159265358979323846264338327950288419716939937511i ))> __CZ__eps){ + epsilon(eps); + return 12; + } + epsilon(eps); + return 0; +} + +/* error function erf(z) -2.3-1.4*I */ +define t026(){ + local eps; + eps = epsilon(1e-20); + + if( abs(erf( -120-12i)-( -1 ))> __CZ__eps){ + epsilon(eps); + return 1; + } + if( abs(erf( 99.99)-( 1 ))> __CZ__eps){ + epsilon(eps); + return 2; + } + /* 45 dec. digits for eps=1e-50 */ + if( abs(erf( 9.99)-( 0.9999999999999999999999999999999999999999999974468 ))> __CZ__eps){ + epsilon(eps); + return 3; + } + if( abs(erf( -2.3-1.4i)-( -0.99424424422056398724487886415624629344477362313756 - 0.00438943284364679943396666714992729629504347523747i ))> __CZ__eps){ + epsilon(eps); + return 4; + } + if( abs(erf( -2.3)-( -0.99885682340264334853465254061923085980585130855731 ))> __CZ__eps){ + epsilon(eps); + return 5; + } + if( abs(erf( 2.3)-( 0.99885682340264334853465254061923085980585130855731 ))> __CZ__eps){ + epsilon(eps); + return 6; + } + if( abs(erf(.99)-( 0.83850806955536980357979023052992329627081601140813 ))> __CZ__eps){ + epsilon(eps); + return 7; + } + + epsilon(eps); + return 0; +} + +/* The rest of the error functions are just slight variations and get only one test + to check if they are implemented at all. */ +/* complementary error function erfc(z) */ +define t027(){ + local eps; + eps = epsilon(1e-20); + if( abs(erfc(.99)-( 0.16149193044463019642020976947007670372918398859187 ))> __CZ__eps){ + epsilon(eps); + return 1; + } + epsilon(eps); + return 0; +} + +/* imaginary error function erfi(z) */ +define t028(){ + local eps; + eps = epsilon(1e-20); + if( abs(erfi(.99)-( 1.6200569163157349040754017322766470558922229178510 ))> __CZ__eps){ + epsilon(eps); + return 1; + } + epsilon(eps); + return 0; +} + +/* complex error function or Faddeeva function w(z) */ +define t029(){ + local eps; + eps = epsilon(1e-20); + if( abs(faddeeva(.99)-( 0.37527356961800734273134990254630990179418484551111 + 0.60796454197014723823608088189149188617146675891187i ))> __CZ__eps){ + epsilon(eps); + return 1; + } + epsilon(eps); + return 0; +} + +/* + The beta function is implemented by way of the gamma function, so only one + check if it is implemented at all. + Such the author thought but had the surprise of an rounding error and had to + raise the precision internally for the beta function. + And the moral of the story is... +*/ +/* beta function */ +define t030(){ + local eps; + eps = epsilon(1e-20); + if( abs(beta( 1.3+2.4i,-4.5-5.6i )-( 0.000034922633369217658778094854951087306276597448077494 - 0.000016960351329535510681653275397511166236842713819260i ))> __CZ__eps){ + epsilon(eps); + return 1; + } + epsilon(eps); + return 0; +} + +/* regularized incomplete beta function */ +define t031(){ + local eps ; + eps = epsilon(1e-20); + if( abs(betainc(1/2 , 3, 2 )-( 5/16 ))> __CZ__eps){ + epsilon(eps); + return 1; + } + if( abs(betainc(1/2 ,3.2 , 2.2 )-( 0.32023348284114229739228778858728452204329664688830 ))> __CZ__eps){ + epsilon(eps); + return 2; + } + if( abs(betainc(1/exp(1) , 3.2 ,2.2 )-( 0.143501414415760044882767192140002923147960247904570923787840 ))> __CZ__eps){ + epsilon(eps); + return 3; + } + if( abs(betainc(1/exp(1) ,3.2+2.2i , 2.2+3.2i )-( 0.1920631154241732316251688573913064389571283459161802570675+0.05732686873367104592514061113957628848615221217965454321767i ))> __CZ__eps){ + epsilon(eps); + return 4; + } + if( abs(betainc( 1/exp(1),3.2-2.2i,2.2+3.2i )-( -1.607827926223643076788007453936176458240169077851360442476+0.3252661246098073645694057662278573284778244036835313591942i ))> __CZ__eps){ + epsilon(eps); + return 5; + } + if( abs(betainc( 1/exp(1),3.2-2.2i,2.2-3.2i )-( 0.1920631154241732316251688573913064389571283459161802570675 -0.05732686873367104592514061113957628848615221217965454321767i ))> __CZ__eps){ + epsilon(eps); + return 6; + } + + if( abs(betainc(.3+.2i ,3.2-2.2i,2.2-3.2i )-( 0.14627145927962494526466549157120107465791647692488861570015 +0.34598256304551640762453165549710979002810660424791884148625i ))> __CZ__eps){ + epsilon(eps); + return 7; + } + epsilon(eps); + return 0; +} + +/* Bernoully polynomials */ +define t032(){ + local eps; + eps = epsilon(1e-20); + if( abs( bernpoly(1,10) ) - ( 19/2 )> __CZ__eps){ + epsilon(eps); + return 1; + } + if( abs( bernpoly(10,10) ) - ( 379041290105/66 )> __CZ__eps){ + epsilon(eps); + return 2; + } + if( abs( bernpoly(-10,10) ) - ( 0.00000000015893950304018571788968681852452102762225 )> __CZ__eps){ + epsilon(eps); + return 3; + } + if( abs( bernpoly(1.1,10) ) - ( 11.89799882840077795855328366923295539944336494342302 )> __CZ__eps){ + epsilon(eps); + return 4; + } + if( abs( bernpoly(3,1.1) ) - ( 33/500 )> __CZ__eps){ + epsilon(eps); + return 5; + } + if( abs( bernpoly(3,1.1+2.2i) ) - ( -8.646-8.822i )> __CZ__eps){ + epsilon(eps); + return 6; + } + + epsilon(eps); + return 0; +} + +/* Lambert's W function */ +define t033(){ + local eps epsexp EM1; + eps = epsilon(1e-20); + /* The Omega-constant */ + if( abs( lambertw(1,0) - (0.567143290409783872999968662210355549753815787186512508135131 ))> __CZ__eps){ + epsilon(eps); + return 1; + } + if( abs( lambertw(-1,0) - ( -0.3181315052047641353126542515876645172035176138713998669223 +1.337235701430689408901162143193710612539502138460512418876i ))> __CZ__eps){ + epsilon(eps); + return 2; + } + if( abs( lambertw(-exp(-1),0) - ( -1 ))> __CZ__eps){ + epsilon(eps); + return 3; + } +/* + We have to calculate -exp(1-) with higher precision here because the + numbers we test against have been calculated with Mathematica(tm) and, + where possible, with the series, too with epsilon = 1e-200. +*/ + epsexp = epsilon(epsilon()*1e-10); + EM1 = -exp(-1); + epsilon(epsexp); + if( abs( lambertw(EM1+.001,0) - ( -0.92802015005456704876004302525492122474886334787070023086031 ))> __CZ__eps){ + epsilon(eps); + return 4; + } + + if( abs( lambertw(EM1-.001,0) - ( -0.998190161498609890007959968479276047800779184376006463826 +0.0736719118893463857740469900181632551190421844567768514726i))> __CZ__eps){ + epsilon(eps); + return 5; + } + + if( abs( lambertw_series(EM1-.001,epsilon(),0) - ( -0.998190161498609890007959968479276047800779184376006463826 +0.0736719118893463857740469900181632551190421844567768514726i ))> __CZ__eps){ + epsilon(eps); + return 6; + } + if( abs( lambertw(-2.2-3.2i,-3) - ( -1.6104280970561586263262514675217857074068306154494786722437 -19.368888979715570028505505411206710993669557347359767961957i ))> __CZ__eps){ + epsilon(eps); + return 1; + } + epsilon(eps); + return 0; +} + +/* Test the logarithm list, a bit different from the tests above.*/ +define t034(){ + local eps sum k; + eps = epsilon(1e-20); + + sum = 0; + lnseries(10000); + for(k=1;k<10000;k++){ + sum +=lnfromseries(k); + } + + if( abs( sum - lngamma(10000) )> __CZ__eps){ + epsilon(eps); + return 1; + } + epsilon(eps); + return 0; +} + +/* */ +define t035(){ + local eps; + eps = epsilon(1e-20); + if( abs( invbetainc(0,1,2) - ( 0 ) )> __CZ__eps){ + epsilon(eps); + return 1; + } + if( abs( invbetainc(1,1,2) - ( 1 ) )> __CZ__eps){ + epsilon(eps); + return 2; + } + if( abs( invbetainc(.6,2,2) - ( 0.567068922852268236254340214074933386511229358602804986856523 ) )> __CZ__eps){ + epsilon(eps); + return 3; + } + if( abs( invbetainc(.6,200,200) - 0.50633738276018061834297937341956576111427477636401902379793 )> __CZ__eps){ + epsilon(eps); + return 4; + } + if( abs( invbetainc(.6,200,100) - 0.673912010450469394843418496081985274734344595591643614514860 )> __CZ__eps){ + epsilon(eps); + return 5; + } + if( abs( invbetainc(.6,100,200) - 0.339884769324050809456643025345905001680568878491743324211449 + )> __CZ__eps){ + epsilon(eps); + return 6; + } +/* Percentiles. Numbers shamlessly stolen from a question at stackoverflow*/ + if( abs( invbetainc(0.025,10008, 151744) - 0.060703546312525377697082321820950758320207425674954679415395 )> __CZ__eps){ + epsilon(eps); + return 7; + } + if( abs( invbetainc(0.5,10008, 151744) - 0.061870690413044293003568412977601333629269461143858842860376 )> __CZ__eps){ + epsilon(eps); + return 8; + } + if( abs( invbetainc(0.975,10008, 151744) - 0.063051707940007549704137764265896313422520123493324715525400 )> __CZ__eps){ + epsilon(eps); + return 9; + } + /* 3 sigma. But _way_ too slow. */ + if( abs( invbetainc(0.997,10008, 151744) - 0.06353033717730117616403237097166742264875876591597)> __CZ__eps){ + epsilon(eps); + return 10; + } + + epsilon(eps); + return 0; +} + +/* */ +/*define t036(){ + local eps; + eps = epsilon(1e-20); + if( abs( ) - ( )> __CZ__eps){ + epsilon(eps); + return 1; + } + + epsilon(eps); + return 0; +}*/ + +/* + * The main test8900 test section harness + * + * The regress.cal calls this function as: + * + * testnum = test8900(1,, 8903); + */ +define test8900(verbose=0, tnum, testnum=8903) +{ + local n; + local err;/* do not forget to delete!*/ + local i, old_errmax; + + /* + * parse args + */ + n = 35; /* number of subtests */ + if (isnull(verbose)) { + verbose = 0; + } + if (isnull(tnum)) { + tnum = 1; /* initial test number */ + } + + /* + * run just one test + */ + else{ + err = eval( strcat("t0",str(tnum),"()" ) ); + if(verbose){ + if(err){ + print "*** error", err, + ": found in test8900.cal function test",strcat("t0",str(tnum) ); + } + else{ + print "no errors in test", strcat("t0",str(tnum) ); + } + } + return tnum; + } + + /* We will cause erors intentionally. A lot of them. */ + old_errmax = errmax(-1); + + /* + * test a lot of stuff + */ + for (i=0; i < n; ++i) { + + /* run a test */ + err += eval( strcat("t0",str(tnum++),"()" ) ); + + if(verbose) { + if (err) { + print "*** error", err, "in test", testnum: ":", + strcat("t0",str(tnum-1),"()" ), + " - ",eval( strcat("t0",str (tnum-1),"()" ) ) ; + } else { + print testnum: ": no errors in test", strcat("t0",str(tnum) ); + } + } + ++testnum; + } + if (verbose) { + if (err) { + print "***", testnum: ":", err, "error(s) found in test8900.cal"; + } else { + print testnum: ":", "no errors in test8900.cal"; + } + } + ++testnum; + + /* restore error maximum */ + errmax(old_errmax); + return testnum; +} diff --git a/cal/toomcook.cal b/cal/toomcook.cal new file mode 100644 index 0000000..857b934 --- /dev/null +++ b/cal/toomcook.cal @@ -0,0 +1,362 @@ +/* + * Toom-Cook - implementation of Toom-Cook(3,4) multiplication algorithm + * + * Copyright (C) 2013 Christoph Zurnieden + * + * Toom-Cook 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. + * + * Toom-Cook 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.3 $ + * @(#) $Id: toomcook.cal,v 30.3 2013/08/11 08:41:38 chongo Exp $ + * @(#) $Source: /usr/local/src/bin/calc/cal/RCS/toomcook.cal,v $ + * + * Under source code control: 2013/08/11 01:31:28 + * File existed as early as: 2013 + */ + +/* + * hide internal function from resource debugging + */ +static resource_debug_level; +resource_debug_level = config("resource_debug", 0); + + +/* */ +define toomcook3(a,b){ + local alen blen a0 a1 a2 b0 b1 b2 m ret sign mask; + local S0 S1 S2 S3 S4 T1 T2; + + if(!isint(a) || !isint(b)) + return newerror("toomcook3(a,b): a and/or b is not an integer"); + + alen = digits(a,2); + blen = digits(b,2); + + sign = sgn(a) * sgn(b); + /* sgn(x) returns 0 if x = 0 */ + if(sign == 0) return 0; + + m = min(alen,blen)//3; + mask = ~-(1<>m) & mask; + a2 = (a>>(2*m)); + + b0 = b & mask; + b1 = (b>>m) & mask; + b2 = (b>>(2*m)); + + /* + Zimmermann + */ + + S0 = toomcook3(a0 , b0); + S1 = toomcook3((a2+a1+a0) , (b2+b1+b0)); + S2 = toomcook3(((a2<<2)+(a1<<1)+a0) , ((b2<<2)+(b1<<1)+b0)); + S3 = toomcook3((a2-a1+a0) , (b2-b1+b0)); + S4 = toomcook3(a2,b2); + T1 = (S3<<1) + S2; + T1 /= 3; + T1 += S0; + T1 >>= 1; + T1 -= S4<<1; + T2 = (S1 + S3)>>1; + S1 -= T1; + S2 = T2 - S0 - S4; + S3 = T1 - T2; + + ret = (S4<<(4*m)) + (S3<<(3*m)) + (S2<<(2*m)) + (S1<<(1*m)) + S0; + + + ret = sign *ret; + + return ret; +} + +define toomcook3square(a){ + local alen a0 a1 a2 m tmp tmp2 ret sign S0 S1 S2 S3 S4 T1 mask; + + if(!isint(a))return newerror("toomcook3square(a): a is not integer"); + + alen = digits(a,2); + + sign = sgn(a) * sgn(a); + if(sign == 0) return 0; + + m = alen//3; + mask = ~-(1<>m) & mask; + a2 = (a>>(2*m)); + + /* + Bodrato/Zanoni + */ + S0 = toomcook3square(a0); + S1 = toomcook3square(a2+a1+a0); + S2 = toomcook3square(a2-a1+a0); + S3 = toomcook3(a1<<1,a2); + S4 = toomcook3square(a2); + + T1 = (S1 + S2)>>1; + S1 = S1 - T1 - S3; + S2 = T1 - S4 -S0; + + + S1 = S1<<(1*m); + S2 = S2<<(2*m); + S3 = S3<<(3*m); + S4 = S4<<(4*m); + + ret = S0 + S1 + S2 + S3 + S4; + ret = sign *ret; + + return ret; +} + +define toomcook4(a,b) +{ + + local a0 a1 a2 a3 b0 b1 b2 b3 b4 ret tmp tmp2 tmp3 sign; + local m alen blen mask; + local w1, w2, w3, w4, w5, w6, w7; + + if(!isint(a) || !isint(b)) + return newerror("toomcook4(a,b): a and/or b is not integer"); + + alen = digits(a,2); + blen = digits(b,2); + + sign = sgn(a) * sgn(b); + + if(sign == 0) return 0; + + m = min(alen//4,blen//4); + mask = ~-(1<>m) & mask; + a2 = (a>>(2*m)) & mask; + a3 = (a>>(3*m)); + + b0 = b & mask; + b1 = (b>>m) & mask; + b2 = (b>>(2*m)) & mask; + b3 = (b>>(3*m)); + + /* + Bodrato / Zanoni + */ + + w3 = a3 + (a1 + (a2 + a0)); + w7 = b3 + (b1 + (b2 + b0)); + + w4 = -a3 + (-a1 + (a2 + a0)); + w5 = -b3 + (-b1 + (b2 + b0)); + + w3 = toomcook4(w3, w7); + w4 = toomcook4(w4, w5); + + w5 = a3 + ((a1<<2) + ((a2<<1) + (a0<<3))); + w2 = b3 + ((b1<<2) + ((b2<<1) + (b0<<3))); + + w6 = -a3 + (-(a1<<2) + ((a2<<1) + (a0<<3))); + w7 = -b3 + (-(b1<<2) + ((b2<<1) + (b0<<3))); + + w5 = toomcook4(w5, w2); + w6 = toomcook4(w6, w7); + + + w2 = (a3<<3) + ((a1<<1) + ((a2<<2) + a0)); + w7 = (b3<<3) + ((b1<<1) + ((b2<<2) + b0)); + + + w2 = toomcook4(w2, w7); + + w1 = toomcook4(a3, b3); + w7 = toomcook4(a0, b0); + + w2 = w2 + w5; + w6 = w5 - w6; + w4 = w3 - w4; + w5 = w5 - w1; + w5 -= w7 << 6; + w4 = w4>>1; + w3 = w3 - w4; + w5 = w5<<1; + w5 = w5 - w6; + w2 -= w3 * 65; + w3 = w3 - w7; + w3 = w3 - w1; + w2 += w3 * 45; + w5 -= w3<<3; + w5 = w5//24; + w6 = w6 - w2; + w2 -= w4<<4; + w2 = w2//18; + w3 = w3 - w5; + w4 = w4 - w2; + w6 += w2 * 30; + w6 = w6//60; + w2 = w2 - w6; + + + ret = w7 + (w6<>m) & mask; + a2 = (a>>(2*m)) & mask; + a3 = (a>>(3*m)) ; + + /* + Bodrato / Zanoni + */ + + S1 = toomcook4square(a0); + S2 = toomcook4(a0<<1,a1); + S3 = toomcook4((a0 + a1 - a2 - a3 ) , (a0 - a1 - a2 + a3 )); + S4 = toomcook4square(a0 + a1 + a2 + a3 ); + S5 = toomcook4( (a0 - a2 )<<1 , (a1 - a3 )); + S6 = toomcook4(a3<<1 , a2); + S7 = toomcook4square(a3); + + T1 = S3 + S4; + T2 = (T1 + S5 )>>1; + T3 = S2 + S6; + T4 = T2 - T3; + T5 = T3 - S5; + T6 = T4 - S3; + T7 = T4 - S1; + T8 = T6 - S7; + + ret = (S7<<(6*m)) + (S6<<(5*m)) + (T7<<(4*m)) + + (T5<<(3*m)) + (T8<<(2*m)) + (S2<<(1*m)) + S1; + + ret = sign *ret; + + return ret; +} + +/* + TODO: Implement the asymmetric variations +*/ + +/* + produce_long_random_number(n) returns large pseudorandom numbers. Really large + numbers, e.g.: + produce_long_random_number(16) + is ca 4,128,561 bits (ca 1,242,821 dec. digits) large. Exact length is not + predeterminable because of the chaotic output of the function random(). +*/ +define __CZ__produce_long_random_number(n) +{ + local ret k; + ret = 1; + if(!isint(n) || n<1) + return newerror("__CZ__produce_long_random_number(n): " + "n is not an integer >=1"); + for(k=0;k1.5){ + tmp=floor(realpart_a-0.5); + sum1 = 0; + for( i = 1 ; i <= tmp ; i++){ + sum1 += ( a - i )^( -s ); + } + epsilon(eps); + return (hurwitzzeta(s,a-tmp)-sum1); + } + if(realpart_a<=0){ + tmp=ceil(-realpart_a+0.5); + for( i = 0 ; i <= tmp-1 ; i++){ + sum2 += ( a + i )^( -s ); + } + epsilon(eps); + return (hurwitzzeta(s,a+tmp)+sum2); + } + precision=digits(1/epsilon()); + realpart_a=re(s); + imagpart_s=im(s); + epsilon(1e-9); + result=s-1.; + if(abs(result)<0.1){ + result=-1; + } + else + result=ln(result); + limit=(precision*ln(10)-re((s-.5)*result)+(1.*realpart_a)*ln(2.*pi()))/2; + limit=max(2,ceil(max(limit,abs(s*1.)/2))); + limit_function=ceil(sqrt((limit+realpart_a/2-.25)^2+(imagpart_s*1.)^2/4)/ + pi()); + if (config("user_debug") > 0) { + print "limit_function = " limit_function; + print "limit = " limit; + print "prec = " precision; + } + /* Full precison plus 5 digits angstzuschlag*/ + epsilon( (10^(-precision)) * 1e-5); + tmp3=(a+limit_function+0.)^(-s); + sum3 = tmp3/2; + for(n=0;n<=limit_function-1;n++){ + sum3 += (a+n)^(-s); + } + result=sum3; + offset=a+limit_function; + offset_squared=1./(offset*offset); + tmp1=2*s-1; + tmp2=s*(s-1); + rest_sum=bernoulli(2*limit); + for(k=2*limit-2;k>=2;k-=2){ + rest_sum=bernoulli(k)+offset_squared* + (k*k+tmp1*k+tmp2)*rest_sum/((k+1)*(k+2)); + } + rest_sum=offset*(1+offset_squared*tmp2*rest_sum/2); + result+=rest_sum*tmp3/(s-1); + epsilon(eps); + return result; +} + + +/* + * restore internal function from resource debugging + * report important interface functions + */ +config("resource_debug", resource_debug_level),; +if (config("resource_debug") & 3) { + print "hurwitzzeta(s,a)"; +} diff --git a/calc.h b/calc.h index 743c323..06238e0 100644 --- a/calc.h +++ b/calc.h @@ -17,8 +17,8 @@ * 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: calc.h,v 30.2 2007/07/10 17:44:52 chongo Exp $ + * @(#) $Revision: 30.3 $ + * @(#) $Id: calc.h,v 30.3 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/calc.h,v $ * * Under source code control: 1990/02/15 01:48:31 @@ -140,7 +140,8 @@ E_FUNC int ftellid(FILEID id, ZVALUE *res); E_FUNC int fseekid(FILEID id, ZVALUE offset, int whence); E_FUNC int isattyid(FILEID id); E_FUNC int fsearch(FILEID id, char *str, ZVALUE start, ZVALUE end, ZVALUE *res); -E_FUNC int frsearch(FILEID id, char *str, ZVALUE first, ZVALUE last, ZVALUE *res); +E_FUNC int frsearch(FILEID id, char *str, ZVALUE first, ZVALUE last, + ZVALUE *res); E_FUNC void showconstants(void); E_FUNC void freeconstant(unsigned long); E_FUNC void freestringconstant(long); @@ -151,7 +152,8 @@ E_FUNC void trimconstants(void); */ E_FUNC int openstring(char *str, size_t num); E_FUNC int openterminal(void); -E_FUNC int opensearchfile(char *name, char *pathlist, char *exten, int reopen_ok); +E_FUNC int opensearchfile(char *name, char *pathlist, char *exten, + int reopen_ok); E_FUNC char *nextline(void); E_FUNC int nextchar(void); E_FUNC void reread(void); diff --git a/calc.man b/calc.man index 0c7fdb2..911583b 100644 --- a/calc.man +++ b/calc.man @@ -15,9 +15,9 @@ .\" received a copy with calc; if not, write to Free Software Foundation, Inc. .\" 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. .\" -.\" @(#) $Revision: 30.4 $ -.\" @(#) $Id: calc.man,v 30.4 2013/08/11 01:09:56 chongo Exp $ -.\" @(#) $Source: /usr/local/src/cmd/calc/RCS/calc.man,v $ +.\" @(#) $Revision: 30.5 $ +.\" @(#) $Id: calc.man,v 30.5 2013/08/11 08:41:38 chongo Exp $ +.\" @(#) $Source: /usr/local/src/bin/calc/RCS/calc.man,v $ .\" .\" Under source code control: 1991/07/23 05:48:26 .\" File existed as early as: 1991 @@ -1164,8 +1164,10 @@ Send bug reports and bug fixes to: .nf calc-bugs 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: Replace 'at' with @, 'dot' is with . ]] +[[ and remove the spaces ]] +[[ NOTE: The EMail address uses 'asthe' and +[[ the web site URL uses 'isthe' ]] .fi .in -0.5i .sp diff --git a/calc.spec.in b/calc.spec.in index 69c6fb6..c354ce1 100644 --- a/calc.spec.in +++ b/calc.spec.in @@ -18,8 +18,8 @@ # 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.10 $ -# @(#) $Id: calc.spec.in,v 30.10 2013/05/05 11:57:44 chongo Exp $ +# @(#) $Revision: 30.11 $ +# @(#) $Id: calc.spec.in,v 30.11 2013/08/11 08:41:38 chongo Exp $ # @(#) $Source: /usr/local/src/bin/calc/RCS/calc.spec.in,v $ # # Under source code control: 2003/02/16 20:21:39 @@ -76,38 +76,59 @@ For the latest calc release, see the project home page: %build echo '-=- calc.spec beginning make clobber -=-' -make %{?_smp_mflags} T=%{_buildroot} BINDIR=%{_bindir} LIBDIR=%{_libdir} CALC_SHAREDIR=%{_datadir}/%{name} CALC_INCDIR=%{_includedir}/calc MANDIR=%{_mandir}/man1 EXT= V=@ clobber +make %{?_smp_mflags} T=%{_buildroot} BINDIR=%{_bindir} LIBDIR=%{_libdir} \ + CALC_SHAREDIR=%{_datadir}/%{name} CALC_INCDIR=%{_includedir}/calc \ + MANDIR=%{_mandir}/man1 EXT= V=@ clobber echo '-=- calc.spec ending make clobber -=-' echo '-=- calc.spec beginning make calc-static-only -=-' -make %{?_smp_mflags} T=%{_buildroot} BINDIR=%{_bindir} LIBDIR=%{_libdir} CALC_SHAREDIR=%{_datadir}/%{name} CALC_INCDIR=%{_includedir}/calc MANDIR=%{_mandir}/man1 EXT= V=@ calc-static-only BLD_TYPE=calc-static-only +make %{?_smp_mflags} T=%{_buildroot} BINDIR=%{_bindir} LIBDIR=%{_libdir} \ + CALC_SHAREDIR=%{_datadir}/%{name} CALC_INCDIR=%{_includedir}/calc \ + MANDIR=%{_mandir}/man1 EXT= V=@ calc-static-only BLD_TYPE=calc-static-only echo '-=- calc.spec ending make calc-static-only -=-' echo '-=- calc.spec beginning make rpm-hide-static -=-' -make %{?_smp_mflags} T=%{_buildroot} BINDIR=%{_bindir} LIBDIR=%{_libdir} CALC_SHAREDIR=%{_datadir}/%{name} CALC_INCDIR=%{_includedir}/calc MANDIR=%{_mandir}/man1 EXT= V=@ rpm-hide-static +make %{?_smp_mflags} T=%{_buildroot} BINDIR=%{_bindir} LIBDIR=%{_libdir} \ + CALC_SHAREDIR=%{_datadir}/%{name} CALC_INCDIR=%{_includedir}/calc \ + MANDIR=%{_mandir}/man1 EXT= V=@ rpm-hide-static echo '-=- calc.spec ending make rpm-hide-static -=-' echo '-=- calc.spec beginning make clobber (again) -=-' -make %{?_smp_mflags} T=%{_buildroot} BINDIR=%{_bindir} LIBDIR=%{_libdir} CALC_SHAREDIR=%{_datadir}/%{name} CALC_INCDIR=%{_includedir}/calc MANDIR=%{_mandir}/man1 EXT= V=@ clobber +make %{?_smp_mflags} T=%{_buildroot} BINDIR=%{_bindir} LIBDIR=%{_libdir} \ + CALC_SHAREDIR=%{_datadir}/%{name} CALC_INCDIR=%{_includedir}/calc \ + MANDIR=%{_mandir}/man1 EXT= V=@ clobber echo '-=- calc.spec ending make clobber (again) -=-' echo '-=- calc.spec beginning make calc-dynamic-only -=-' -make %{?_smp_mflags} T=%{_buildroot} BINDIR=%{_bindir} LIBDIR=%{_libdir} CALC_SHAREDIR=%{_datadir}/%{name} CALC_INCDIR=%{_includedir}/calc MANDIR=%{_mandir}/man1 EXT= V=@ calc-dynamic-only BLD_TYPE=calc-dynamic-only LD_SHARE= +make %{?_smp_mflags} T=%{_buildroot} BINDIR=%{_bindir} LIBDIR=%{_libdir} \ + CALC_SHAREDIR=%{_datadir}/%{name} CALC_INCDIR=%{_includedir}/calc \ + MANDIR=%{_mandir}/man1 EXT= V=@ calc-dynamic-only \ + BLD_TYPE=calc-dynamic-only LD_SHARE= echo '-=- calc.spec ending make calc-dynamic-only -=-' echo '-=- calc.spec beginning make chk -=-' -make %{?_smp_mflags} T=%{_buildroot} BINDIR=%{_bindir} LIBDIR=%{_libdir} CALC_SHAREDIR=%{_datadir}/%{name} CALC_INCDIR=%{_includedir}/calc MANDIR=%{_mandir}/man1 EXT= V=@ chk +make %{?_smp_mflags} T=%{_buildroot} BINDIR=%{_bindir} LIBDIR=%{_libdir} \ + CALC_SHAREDIR=%{_datadir}/%{name} CALC_INCDIR=%{_includedir}/calc \ + MANDIR=%{_mandir}/man1 EXT= V=@ chk echo '-=- calc.spec ending make chk -=-' echo '-=- calc.spec beginning make rpm-unhide-static -=-' -make %{?_smp_mflags} T=%{_buildroot} BINDIR=%{_bindir} LIBDIR=%{_libdir} CALC_SHAREDIR=%{_datadir}/%{name} CALC_INCDIR=%{_includedir}/calc MANDIR=%{_mandir}/man1 EXT= V=@ rpm-unhide-static +make %{?_smp_mflags} T=%{_buildroot} BINDIR=%{_bindir} LIBDIR=%{_libdir} \ + CALC_SHAREDIR=%{_datadir}/%{name} CALC_INCDIR=%{_includedir}/calc \ + MANDIR=%{_mandir}/man1 EXT= V=@ rpm-unhide-static echo '-=- calc.spec ending make rpm-unhide-static -=-' echo '-=- calc.spec beginning make rpm-clean-static -=-' -make %{?_smp_mflags} T=%{_buildroot} BINDIR=%{_bindir} LIBDIR=%{_libdir} CALC_SHAREDIR=%{_datadir}/%{name} CALC_INCDIR=%{_includedir}/calc MANDIR=%{_mandir}/man1 EXT= V=@ rpm-clean-static +make %{?_smp_mflags} T=%{_buildroot} BINDIR=%{_bindir} LIBDIR=%{_libdir} \ + CALC_SHAREDIR=%{_datadir}/%{name} CALC_INCDIR=%{_includedir}/calc \ + MANDIR=%{_mandir}/man1 EXT= V=@ rpm-clean-static echo '-=- calc.spec ending make rpm-clean-static -=-' echo '-=- calc.spec beginning make rpm-chk-static -=-' -make %{?_smp_mflags} T=%{_buildroot} BINDIR=%{_bindir} LIBDIR=%{_libdir} CALC_SHAREDIR=%{_datadir}/%{name} CALC_INCDIR=%{_includedir}/calc MANDIR=%{_mandir}/man1 EXT= V=@ rpm-chk-static +make %{?_smp_mflags} T=%{_buildroot} BINDIR=%{_bindir} LIBDIR=%{_libdir} \ + CALC_SHAREDIR=%{_datadir}/%{name} CALC_INCDIR=%{_includedir}/calc \ + MANDIR=%{_mandir}/man1 EXT= V=@ rpm-chk-static echo '-=- calc.spec ending make rpm-chk-static -=-' %install echo '-=- calc.spec beginning make install -=-' rm -rf %{_buildroot} mkdir -p %{_buildroot} -make T=%{_buildroot} BINDIR=%{_bindir} LIBDIR=%{_libdir} CALC_SHAREDIR=%{_datadir}/%{name} CALC_INCDIR=%{_includedir}/calc MANDIR=%{_mandir}/man1 EXT= V=@ install +make T=%{_buildroot} BINDIR=%{_bindir} LIBDIR=%{_libdir} \ + CALC_SHAREDIR=%{_datadir}/%{name} CALC_INCDIR=%{_includedir}/calc \ + MANDIR=%{_mandir}/man1 EXT= V=@ install echo '-=- calc.spec ending make install -=-' %clean diff --git a/codegen.c b/codegen.c index 685cb96..14450f0 100644 --- a/codegen.c +++ b/codegen.c @@ -19,9 +19,9 @@ * 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: codegen.c,v 30.3 2013/07/12 22:41:33 chongo Exp $ - * @(#) $Source: /usr/local/src/cmd/calc/RCS/codegen.c,v $ + * @(#) $Revision: 30.4 $ + * @(#) $Id: codegen.c,v 30.4 2013/08/11 08:41:38 chongo Exp $ + * @(#) $Source: /usr/local/src/bin/calc/RCS/codegen.c,v $ * * Under source code control: 1990/02/15 01:48:13 * File existed as early as: before 1990 @@ -453,7 +453,8 @@ getsimplebody(void) */ /*ARGSUSED*/ S_FUNC void -getbody(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *defaultlabel) +getbody(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, + LABEL *defaultlabel) { int oldmode; @@ -617,7 +618,8 @@ getonevariable(int symtype) * defaultlabel label for default case */ S_FUNC void -getstatement(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *defaultlabel) +getstatement(LABEL *contlabel, LABEL *breaklabel, + LABEL *nextcaselabel, LABEL *defaultlabel) { LABEL label; LABEL label1, label2, label3, label4; /* locations for jumps */ @@ -1104,7 +1106,8 @@ getobjdeclaration(int symtype) newindices = (int *) malloc(maxindices * sizeof(int)); if (newindices == NULL) { - scanerror(T_SEMICOLON, "Out of memory for indices malloc"); + scanerror(T_SEMICOLON, + "Out of memory for indices malloc"); (void) tokenmode(oldmode); return; } @@ -1117,7 +1120,8 @@ getobjdeclaration(int symtype) maxindices * sizeof(int)); if (newindices == NULL) { free(indices); - scanerror(T_SEMICOLON, "Out of memory for indices realloc"); + scanerror(T_SEMICOLON, + "Out of memory for indices realloc"); (void) tokenmode(oldmode); return; } @@ -1129,7 +1133,9 @@ getobjdeclaration(int symtype) if (indices[i] == index) { if (indices != quickindices) free(indices); - scanerror(T_SEMICOLON, "Duplicate element name \"%s\"", tokensymbol()); + scanerror(T_SEMICOLON, + "Duplicate element name \"%s\"", + tokensymbol()); (void) tokenmode(oldmode); return; } @@ -1141,7 +1147,8 @@ getobjdeclaration(int symtype) if (gettoken() != T_RIGHTBRACE) { if (indices != quickindices) free(indices); - scanerror(T_SEMICOLON, "Bad object type definition"); + scanerror(T_SEMICOLON, + "Bad object type definition"); (void) tokenmode(oldmode); return; } @@ -1415,7 +1422,8 @@ getinitlist(void) oldmode = tokenmode(TM_DEFAULT); if (gettoken() != T_LEFTBRACE) { - scanerror(T_SEMICOLON, "Missing left brace for initialization list"); + scanerror(T_SEMICOLON, + "Missing left brace for initialization list"); (void) tokenmode(oldmode); return -1; } @@ -1450,7 +1458,7 @@ getinitlist(void) default: scanerror(T_SEMICOLON, - "Missing right brace for initialization list"); + "Missing right brace for initialization list"); (void) tokenmode(oldmode); return -1; } @@ -2364,11 +2372,13 @@ getfilename(char *name, size_t namelen, BOOL *once) /* use symbol VALUE string */ symstr = val.v_str->s_str; if (symstr == NULL) { - math_error("string value pointer is NULL!!"); + math_error( + "string value pointer is NULL!!"); /*NOTREACHED*/ } } else { - math_error("a filename variable must be a string"); + math_error( + "a filename variable must be a string"); /*NOTREACHED*/ } } else { @@ -2637,7 +2647,8 @@ definesymbol(char *name, int symtype) break; } if (conf->dupvar_warn) { - warning("both static and parameter \"%s\" defined", name); + warning("both static and parameter \"%s\" defined", + name); } } if (symtype == SYM_LOCAL) diff --git a/config.c b/config.c index 596da37..87b903a 100644 --- a/config.c +++ b/config.c @@ -19,8 +19,8 @@ * 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: config.c,v 30.2 2007/07/05 13:30:38 chongo Exp $ + * @(#) $Revision: 30.3 $ + * @(#) $Id: config.c,v 30.3 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/config.c,v $ * * Under source code control: 1991/07/20 00:21:56 @@ -948,7 +948,8 @@ setconfig(int type, VALUE *vp) } else if (vp->v_type == V_STR) { temp = lookup_long(truth, vp->v_str->s_str); if (temp < 0) { - math_error("Illegal truth value for redecl_warn"); + math_error("Illegal truth value for " + "redecl_warn"); /*NOTREACHED*/ } conf->redecl_warn = (int)temp; @@ -962,7 +963,8 @@ setconfig(int type, VALUE *vp) } else if (vp->v_type == V_STR) { temp = lookup_long(truth, vp->v_str->s_str); if (temp < 0) { - math_error("Illegal truth value for dupvar_warn"); + math_error("Illegal truth value for " + "dupvar_warn"); /*NOTREACHED*/ } conf->dupvar_warn = (int)temp; @@ -1153,7 +1155,8 @@ config_value(CONFIG *cfg, int type, VALUE *vp) vp->v_type = V_STR; p = lookup_name(modes, cfg->outmode2); if (p == NULL) { - math_error("invalid secondary output mode: %d", cfg->outmode2); + math_error("invalid secondary output mode: %d", + cfg->outmode2); /*NOTREACHED*/ } vp->v_str = makenewstring(p); diff --git a/cscript/Makefile b/cscript/Makefile index 633276f..9a75550 100644 --- a/cscript/Makefile +++ b/cscript/Makefile @@ -17,8 +17,8 @@ # 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 $ +# @(#) $Revision: 30.4 $ +# @(#) $Id: Makefile,v 30.4 2013/08/11 08:41:38 chongo Exp $ # @(#) $Source: /usr/local/src/bin/calc/cscript/RCS/Makefile,v $ # # Under source code control: 1999/11/29 11:10:26 @@ -315,7 +315,9 @@ depend: if [ X"$$i" != X"/dev/null" ]; then \ echo "$$i: $$i.calc"; \ echo ' @$${RM} -f $$@'; \ - echo ' @$${SED} -e "1s:^#!/usr/local/src/cmd/calc/calc:#!$${BINDIR}/calc:" $$?>$$@'; \ + echo -n ' @$${SED} -e "1s:'; \ + echo "^#!/usr/local/src/cmd/calc/calc:#!$${BINDIR}/calc:" \ + $$?>$$@'; \ echo ' @$${CHMOD} +x $$@'; \ fi; \ done >> makedep.out @@ -323,7 +325,8 @@ depend: ${Q} echo forming new cscript/${MAKE_FILE} ${Q} ${RM} -f ${MAKE_FILE}.bak ${Q} ${MV} ${MAKE_FILE} ${MAKE_FILE}.bak - ${Q} ${SED} -n '1,/^# DO NOT DELETE THIS LINE/p' ${MAKE_FILE}.bak > ${MAKE_FILE} + ${Q} ${SED} -n '1,/^# DO NOT DELETE THIS LINE/p' \ + ${MAKE_FILE}.bak > ${MAKE_FILE} ${Q} echo "" >> ${MAKE_FILE} ${Q} ${CAT} makedep.out >> ${MAKE_FILE} ${Q} ${RM} -f makedep.out diff --git a/custom/Makefile b/custom/Makefile index 0a58a6e..73594fc 100644 --- a/custom/Makefile +++ b/custom/Makefile @@ -18,8 +18,8 @@ # 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.27 $ -# @(#) $Id: Makefile.head,v 30.27 2013/08/11 01:16:36 chongo Exp $ +# @(#) $Revision: 30.28 $ +# @(#) $Id: Makefile.head,v 30.28 2013/08/11 05:40:18 chongo Exp $ # @(#) $Source: /usr/local/src/cmd/calc/custom/RCS/Makefile.head,v $ # # Under source code control: 1997/03/09 02:28:54 @@ -366,7 +366,7 @@ EXT= # The default calc versions # -VERSION= 2.12.4.9 +VERSION= 2.12.4.10 VERS= 2.12.4 VER= 2.12 VE= 2 @@ -1136,7 +1136,8 @@ depend: ${Q} echo forming new custom/${MAKE_FILE} ${Q} ${RM} -f ${MAKE_FILE}.bak ${Q} ${MV} ${MAKE_FILE} ${MAKE_FILE}.bak - ${Q} ${SED} -n '1,/^# DO NOT DELETE THIS LINE/p' ${MAKE_FILE}.bak > ${MAKE_FILE} + ${Q} ${SED} -n '1,/^# DO NOT DELETE THIS LINE/p' \ + ${MAKE_FILE}.bak > ${MAKE_FILE} ${Q} ${GREP} -v '^#' skel/custom/makedep.out >> ${MAKE_FILE} ${Q} ${RM} -rf skel -${Q} if ${CMP} -s ${MAKE_FILE}.bak ${MAKE_FILE}; then \ @@ -1333,7 +1334,8 @@ install: all ${RM} -f ${T}${CUSTOMHELPDIR}/$$i.new; \ ${CP} -f $$i ${T}${CUSTOMHELPDIR}/$$i.new; \ ${CHMOD} 0444 ${T}${CUSTOMHELPDIR}/$$i.new; \ - ${MV} -f ${T}${CUSTOMHELPDIR}/$$i.new ${T}${CUSTOMHELPDIR}/$$i; \ + ${MV} -f ${T}${CUSTOMHELPDIR}/$$i.new \ + ${T}${CUSTOMHELPDIR}/$$i; \ echo "installed ${T}${CUSTOMHELPDIR}/$$i"; \ fi; \ done diff --git a/custom/Makefile.head b/custom/Makefile.head index 73afb14..b667d4e 100644 --- a/custom/Makefile.head +++ b/custom/Makefile.head @@ -18,8 +18,8 @@ # 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.27 $ -# @(#) $Id: Makefile.head,v 30.27 2013/08/11 01:16:36 chongo Exp $ +# @(#) $Revision: 30.28 $ +# @(#) $Id: Makefile.head,v 30.28 2013/08/11 05:40:18 chongo Exp $ # @(#) $Source: /usr/local/src/cmd/calc/custom/RCS/Makefile.head,v $ # # Under source code control: 1997/03/09 02:28:54 @@ -366,7 +366,7 @@ EXT= # The default calc versions # -VERSION= 2.12.4.9 +VERSION= 2.12.4.10 VERS= 2.12.4 VER= 2.12 VE= 2 diff --git a/custom/Makefile.simple b/custom/Makefile.simple index 305bfcd..43f0acd 100644 --- a/custom/Makefile.simple +++ b/custom/Makefile.simple @@ -18,8 +18,8 @@ # 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.27 $ -# @(#) $Id: Makefile.head,v 30.27 2013/08/11 01:16:36 chongo Exp $ +# @(#) $Revision: 30.28 $ +# @(#) $Id: Makefile.head,v 30.28 2013/08/11 05:40:18 chongo Exp $ # @(#) $Source: /usr/local/src/cmd/calc/custom/RCS/Makefile.head,v $ # # Under source code control: 1997/03/09 02:28:54 @@ -351,7 +351,7 @@ EXT= # The default calc versions # -VERSION= 2.12.4.9 +VERSION= 2.12.4.10 VERS= 2.12.4 VER= 2.12 VE= 2 @@ -729,7 +729,8 @@ depend: ${Q} echo forming new custom/${MAKE_FILE} ${Q} ${RM} -f ${MAKE_FILE}.bak ${Q} ${MV} ${MAKE_FILE} ${MAKE_FILE}.bak - ${Q} ${SED} -n '1,/^# DO NOT DELETE THIS LINE/p' ${MAKE_FILE}.bak > ${MAKE_FILE} + ${Q} ${SED} -n '1,/^# DO NOT DELETE THIS LINE/p' \ + ${MAKE_FILE}.bak > ${MAKE_FILE} ${Q} ${GREP} -v '^#' skel/custom/makedep.out >> ${MAKE_FILE} ${Q} ${RM} -rf skel -${Q} if ${CMP} -s ${MAKE_FILE}.bak ${MAKE_FILE}; then \ @@ -923,7 +924,8 @@ install: all ${RM} -f ${T}${CUSTOMHELPDIR}/$$i.new; \ ${CP} -f $$i ${T}${CUSTOMHELPDIR}/$$i.new; \ ${CHMOD} 0444 ${T}${CUSTOMHELPDIR}/$$i.new; \ - ${MV} -f ${T}${CUSTOMHELPDIR}/$$i.new ${T}${CUSTOMHELPDIR}/$$i; \ + ${MV} -f ${T}${CUSTOMHELPDIR}/$$i.new \ + ${T}${CUSTOMHELPDIR}/$$i; \ echo "installed ${T}${CUSTOMHELPDIR}/$$i"; \ fi; \ done diff --git a/custom/Makefile.tail b/custom/Makefile.tail index ad4d5da..cf73849 100644 --- a/custom/Makefile.tail +++ b/custom/Makefile.tail @@ -227,7 +227,8 @@ depend: ${Q} echo forming new custom/${MAKE_FILE} ${Q} ${RM} -f ${MAKE_FILE}.bak ${Q} ${MV} ${MAKE_FILE} ${MAKE_FILE}.bak - ${Q} ${SED} -n '1,/^# DO NOT DELETE THIS LINE/p' ${MAKE_FILE}.bak > ${MAKE_FILE} + ${Q} ${SED} -n '1,/^# DO NOT DELETE THIS LINE/p' \ + ${MAKE_FILE}.bak > ${MAKE_FILE} ${Q} ${GREP} -v '^#' skel/custom/makedep.out >> ${MAKE_FILE} ${Q} ${RM} -rf skel -${Q} if ${CMP} -s ${MAKE_FILE}.bak ${MAKE_FILE}; then \ @@ -424,7 +425,8 @@ install: all ${RM} -f ${T}${CUSTOMHELPDIR}/$$i.new; \ ${CP} -f $$i ${T}${CUSTOMHELPDIR}/$$i.new; \ ${CHMOD} 0444 ${T}${CUSTOMHELPDIR}/$$i.new; \ - ${MV} -f ${T}${CUSTOMHELPDIR}/$$i.new ${T}${CUSTOMHELPDIR}/$$i; \ + ${MV} -f ${T}${CUSTOMHELPDIR}/$$i.new \ + ${T}${CUSTOMHELPDIR}/$$i; \ echo "installed ${T}${CUSTOMHELPDIR}/$$i"; \ fi; \ done diff --git a/custom/c_sysinfo.c b/custom/c_sysinfo.c index a3c5d5e..1812c44 100644 --- a/custom/c_sysinfo.c +++ b/custom/c_sysinfo.c @@ -17,8 +17,8 @@ * 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: c_sysinfo.c,v 30.2 2007/07/05 19:35:20 chongo Exp $ + * @(#) $Revision: 30.3 $ + * @(#) $Id: c_sysinfo.c,v 30.3 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/custom/RCS/c_sysinfo.c,v $ * * Under source code control: 1997/03/09 23:14:40 @@ -71,93 +71,180 @@ struct infoname { FULL nmbr; /* if str==NULL ==> value fo #define as a FULL */ }; STATIC struct infoname sys_info[] = { - {"S100", "slots in an subtractive 100 table", NULL, (FULL)S100}, - {"BASE", "base for calculations", NULL, (FULL)BASE}, - {"BASE1", "one less than base", NULL, (FULL)BASE}, - {"BASEB", "bits in the calculation base", NULL, (FULL)BASEB}, - {"BASEDIG", "number of digits in base", NULL, (FULL)BASEDIG}, - {"BIG_ENDIAN", "Most Significant Byte first symbol", NULL, (FULL)BIG_ENDIAN}, - {"BLK_CHUNKSIZE", "default allocation chunk size for blocks", NULL, (FULL)BLK_CHUNKSIZE}, - {"BLK_DEF_MAXPRINT", "default block octets to print", NULL, (FULL)BLK_DEF_MAXPRINT}, - {"BLUM_PREGEN", "non-default predefined Blum generators", NULL, (FULL)BLUM_PREGEN}, - {"CALCEXT", "extension for files read in", CALCEXT, (FULL)0}, - {"CALC_BYTE_ORDER", "Byte order (LITTLE_ENDIAN or BIG_ENDIAN)", NULL, (FULL)CALC_BYTE_ORDER}, - {"CUSTOMHELPDIR", "location of the custom help directory", CUSTOMHELPDIR, (FULL)0}, - {"DEFAULTCALCBINDINGS", "default key bindings file", DEFAULTCALCBINDINGS, (FULL)0}, - {"DEFAULTCALCHELP", "help file that -h prints", DEFAULTCALCHELP, (FULL)0}, - {"DEFAULTCALCPAGER", "default pager", DEFAULTCALCPAGER, (FULL)0}, - {"DEFAULTCALCPATH", "default :-separated search path", DEFAULTCALCPATH, (FULL)0}, - {"DEFAULTCALCRC", "default :-separated startup file list", DEFAULTCALCRC, (FULL)0}, - {"DEFAULTSHELL", "default shell to use", DEFAULTSHELL, (FULL)0}, - {"DEV_BITS", "device number size in bits", NULL, (FULL)DEV_BITS}, - {"DISPLAY_DEFAULT", "default digits for float display", NULL, (FULL)DISPLAY_DEFAULT}, - {"EPSILONPREC_DEFAULT", "2^-EPSILON_DEFAULT <= EPSILON_DEFAULT", NULL, (FULL)EPSILONPREC_DEFAULT}, - {"EPSILON_DEFAULT", "allowed error for float calculations", EPSILON_DEFAULT, (FULL)0}, - {"ERRMAX", "default errmax value", NULL, (FULL)ERRMAX}, - {"E_USERDEF", "base of user defined errors", NULL, (FULL)E_USERDEF}, - {"E__BASE", "calc errors start above here", NULL, (FULL)E__BASE}, - {"E__COUNT", "number of calc errors", NULL, (FULL)E__COUNT}, - {"E__HIGHEST", "highest calc error", NULL, (FULL)E__HIGHEST}, - {"FALSE", "boolean false", NULL, (FULL)FALSE}, - {"FILEPOS_BITS", "file position size in bits", NULL, (FULL)FILEPOS_BITS}, - {"FULL_BITS", "bits in a FULL", NULL, (FULL)FULL_BITS}, - {"HELPDIR", "location of the help directory", HELPDIR, (FULL)0}, - {"HIST_BINDING_FILE", "Default binding file", HIST_BINDING_FILE, (FULL)0}, - {"HIST_SIZE", "Default history size", NULL, (FULL)HIST_SIZE}, - {"INIT_J", "initial 1st walking a55 table index", NULL, (FULL)INIT_J}, - {"INIT_K", "initial 2nd walking a55 table index", NULL, (FULL)INIT_K}, - {"INODE_BITS", "inode number size in bits", NULL, (FULL)INODE_BITS}, - {"LITTLE_ENDIAN", "Least Significant Byte first symbol", NULL, (FULL)LITTLE_ENDIAN}, - {"LONG_BITS", "bit length of a long", NULL, (FULL)LONG_BITS}, - {"MAP_POPCNT", "number of odd primes in pr_map", NULL, (FULL)MAP_POPCNT}, - {"MAX_CALCRC", "maximum allowed length of $CALCRC", NULL, (FULL)MAX_CALCRC}, - {"MAXCMD", "max length of command invocation", NULL, (FULL)MAXCMD}, - {"MAXDIM", "max number of dimensions in matrices", NULL, (FULL)MAXDIM}, - {"MAXERROR", "max length of error message string", NULL, (FULL)MAXERROR}, - {"MAXFILES", "max number of opened files", NULL, (FULL)MAXFILES}, - {"MAXFULL", "largest SFULL value", NULL, (FULL)MAXFULL}, - {"MAXHALF", "largest SHALF value", NULL, (FULL)MAXHALF}, - {"MAXLABELS", "max number of user labels in function", NULL, (FULL)MAXLABELS}, - {"MAXLEN", "longest storage size allowed", NULL, (FULL)MAXLEN}, - {"MAXLONG", "largest long val", NULL, (FULL)MAXLONG}, - {"MAXPRINT_DEFAULT", "default number of elements printed", NULL, (FULL)MAXPRINT_DEFAULT}, - {"MAXREDC", "number of entries in REDC cache", NULL, (FULL)MAXREDC}, - {"MAXSCANCOUNT", "default max scan errors before an abort", NULL, (FULL)MAXSCANCOUNT}, - {"MAXSTACK", "max depth of evaluation stack", NULL, (FULL)MAXSTACK}, - {"MAXSTRING", "max size of string constant", NULL, (FULL)MAXSTRING}, - {"MAXUFULL", "largest FULL value", NULL, (FULL)MAXUFULL}, - {"MAXULONG", "largest unsigned long val", NULL, (FULL)MAXULONG}, - {"MAX_MAP_PRIME", "larest prime in pr_map", NULL, (FULL)MAX_MAP_PRIME}, - {"MAX_MAP_VAL", "larest bit in pr_map", NULL, (FULL)MAX_MAP_VAL}, - {"MAX_PFACT_VAL", "max x, for which pfact(x) is a long", NULL, (FULL)MAX_PFACT_VAL}, - {"MAX_SM_PRIME", "larest 32 bit prime", NULL, (FULL)MAX_SM_PRIME}, - {"MAX_SM_VAL", "larest 32 bit value", NULL, (FULL)MAX_SM_VAL}, - {"MUL_ALG2", "default size for alternative multiply", NULL, (FULL)MUL_ALG2}, - {"NXT_MAP_PRIME", "smallest odd prime not in pr_map", NULL, (FULL)NXT_MAP_PRIME}, - {"NXT_PFACT_VAL", "next prime for higher pfact values", NULL, (FULL)NXT_PFACT_VAL}, - {"OFF_T_BITS", "file offset size in bits", NULL, (FULL)OFF_T_BITS}, - {"PIX_32B", "max pix() value", NULL, (FULL)PIX_32B}, - {"POW_ALG2", "default size for using REDC for powers", NULL, (FULL)POW_ALG2}, - {"REDC_ALG2", "default size using alternative REDC alg", NULL, (FULL)REDC_ALG2}, - {"SBITS", "size of additive or shuffle entry in bits", NULL, (FULL)SBITS}, - {"SBYTES", "size of additive or shuffle entry in bytes", NULL, (FULL)SBYTES}, - {"SCNT", "length of additive 55 table in FULLs", NULL, (FULL)SCNT}, - {"SEEDXORBITS", "low bits of a55 seed devoted to xor", NULL, (FULL)SEEDXORBITS}, - {"SHALFS", "size of additive or shuffle entry in HALFs", NULL, (FULL)SHALFS}, - {"SHUFCNT", "size of shuffle table in entries", NULL, (FULL)SHUFCNT}, - {"SHUFLEN", "length of shuffle table in FULLs", NULL, (FULL)SHUFLEN}, - {"SHUFMASK", "mask for shuffle table entry selection", NULL, (FULL)SHUFMASK}, - {"SHUFPOW", "power of 2 size of the shuffle table", NULL, (FULL)SHUFPOW}, - {"SLEN", "number of FULLs in a shuffle table entry", NULL, (FULL)SLEN}, - {"SQ_ALG2", "default size for alternative squaring", NULL, (FULL)SQ_ALG2}, - {"SYMBOLSIZE", "max symbol name size", NULL, (FULL)SYMBOLSIZE}, - {"TEN_MAX", "10^(2^TEN_MAX): largest base10 conversion const", NULL, (FULL)TEN_MAX}, - {"TOPFULL", "highest bit in FULL", NULL, (FULL)TOPFULL}, - {"TOPHALF", "highest bit in a HALF", NULL, (FULL)TOPHALF}, - {"TOPLONG", "top long bit", NULL, (FULL)TOPLONG}, - {"TRUE", "boolean true", NULL, (FULL)TRUE}, - {"USUAL_ELEMENTS", "usual number of elements for objects", NULL, (FULL)USUAL_ELEMENTS}, - {"REGNUM_MAX", "highest custom register number", NULL, (FULL)CUSTOM_REG_MAX}, + {"S100", "slots in an subtractive 100 table", NULL, + (FULL)S100}, + {"BASE", "base for calculations", NULL, + (FULL)BASE}, + {"BASE1", "one less than base", NULL, + (FULL)BASE}, + {"BASEB", "bits in the calculation base", NULL, + (FULL)BASEB}, + {"BASEDIG", "number of digits in base", NULL, + (FULL)BASEDIG}, + {"BIG_ENDIAN", "Most Significant Byte first symbol", NULL, + (FULL)BIG_ENDIAN}, + {"BLK_CHUNKSIZE", "default allocation chunk size for blocks", NULL, + (FULL)BLK_CHUNKSIZE}, + {"BLK_DEF_MAXPRINT", "default block octets to print", NULL, + (FULL)BLK_DEF_MAXPRINT}, + {"BLUM_PREGEN", "non-default predefined Blum generators", NULL, + (FULL)BLUM_PREGEN}, + {"CALCEXT", "extension for files read in", CALCEXT, + (FULL)0}, + {"CALC_BYTE_ORDER", "Byte order (LITTLE_ENDIAN or BIG_ENDIAN)", NULL, + (FULL)CALC_BYTE_ORDER}, + {"CUSTOMHELPDIR", "location of the custom help directory", CUSTOMHELPDIR, + (FULL)0}, + {"DEFAULTCALCBINDINGS", "default key bindings file", DEFAULTCALCBINDINGS, + (FULL)0}, + {"DEFAULTCALCHELP", "help file that -h prints", DEFAULTCALCHELP, + (FULL)0}, + {"DEFAULTCALCPAGER", "default pager", DEFAULTCALCPAGER, + (FULL)0}, + {"DEFAULTCALCPATH", "default :-separated search path", DEFAULTCALCPATH, + (FULL)0}, + {"DEFAULTCALCRC", "default :-separated startup file list", DEFAULTCALCRC, + (FULL)0}, + {"DEFAULTSHELL", "default shell to use", DEFAULTSHELL, + (FULL)0}, + {"DEV_BITS", "device number size in bits", NULL, + (FULL)DEV_BITS}, + {"DISPLAY_DEFAULT", "default digits for float display", NULL, + (FULL)DISPLAY_DEFAULT}, + {"EPSILONPREC_DEFAULT", "2^-EPSILON_DEFAULT <= EPSILON_DEFAULT", NULL, + (FULL)EPSILONPREC_DEFAULT}, + {"EPSILON_DEFAULT", "allowed error for float calculations", + EPSILON_DEFAULT, (FULL)0}, + {"ERRMAX", "default errmax value", NULL, + (FULL)ERRMAX}, + {"E_USERDEF", "base of user defined errors", NULL, + (FULL)E_USERDEF}, + {"E__BASE", "calc errors start above here", NULL, + (FULL)E__BASE}, + {"E__COUNT", "number of calc errors", NULL, + (FULL)E__COUNT}, + {"E__HIGHEST", "highest calc error", NULL, + (FULL)E__HIGHEST}, + {"FALSE", "boolean false", NULL, + (FULL)FALSE}, + {"FILEPOS_BITS", "file position size in bits", NULL, + (FULL)FILEPOS_BITS}, + {"FULL_BITS", "bits in a FULL", NULL, + (FULL)FULL_BITS}, + {"HELPDIR", "location of the help directory", HELPDIR, + (FULL)0}, + {"HIST_BINDING_FILE", "Default binding file", HIST_BINDING_FILE, + (FULL)0}, + {"HIST_SIZE", "Default history size", NULL, + (FULL)HIST_SIZE}, + {"INIT_J", "initial 1st walking a55 table index", NULL, + (FULL)INIT_J}, + {"INIT_K", "initial 2nd walking a55 table index", NULL, + (FULL)INIT_K}, + {"INODE_BITS", "inode number size in bits", NULL, + (FULL)INODE_BITS}, + {"LITTLE_ENDIAN", "Least Significant Byte first symbol", + NULL, (FULL)LITTLE_ENDIAN}, + {"LONG_BITS", "bit length of a long", NULL, + (FULL)LONG_BITS}, + {"MAP_POPCNT", "number of odd primes in pr_map", NULL, + (FULL)MAP_POPCNT}, + {"MAX_CALCRC", "maximum allowed length of $CALCRC", NULL, + (FULL)MAX_CALCRC}, + {"MAXCMD", "max length of command invocation", NULL, + (FULL)MAXCMD}, + {"MAXDIM", "max number of dimensions in matrices", NULL, + (FULL)MAXDIM}, + {"MAXERROR", "max length of error message string", NULL, + (FULL)MAXERROR}, + {"MAXFILES", "max number of opened files", NULL, + (FULL)MAXFILES}, + {"MAXFULL", "largest SFULL value", NULL, + (FULL)MAXFULL}, + {"MAXHALF", "largest SHALF value", NULL, + (FULL)MAXHALF}, + {"MAXLABELS", "max number of user labels in function", NULL, + (FULL)MAXLABELS}, + {"MAXLEN", "longest storage size allowed", NULL, + (FULL)MAXLEN}, + {"MAXLONG", "largest long val", NULL, + (FULL)MAXLONG}, + {"MAXPRINT_DEFAULT", "default number of elements printed", NULL, + (FULL)MAXPRINT_DEFAULT}, + {"MAXREDC", "number of entries in REDC cache", NULL, + (FULL)MAXREDC}, + {"MAXSCANCOUNT", "default max scan errors before an abort", NULL, + (FULL)MAXSCANCOUNT}, + {"MAXSTACK", "max depth of evaluation stack", NULL, + (FULL)MAXSTACK}, + {"MAXSTRING", "max size of string constant", NULL, + (FULL)MAXSTRING}, + {"MAXUFULL", "largest FULL value", NULL, + (FULL)MAXUFULL}, + {"MAXULONG", "largest unsigned long val", NULL, + (FULL)MAXULONG}, + {"MAX_MAP_PRIME", "larest prime in pr_map", NULL, + (FULL)MAX_MAP_PRIME}, + {"MAX_MAP_VAL", "larest bit in pr_map", NULL, + (FULL)MAX_MAP_VAL}, + {"MAX_PFACT_VAL", "max x, for which pfact(x) is a long", NULL, + (FULL)MAX_PFACT_VAL}, + {"MAX_SM_PRIME", "larest 32 bit prime", NULL, + (FULL)MAX_SM_PRIME}, + {"MAX_SM_VAL", "larest 32 bit value", NULL, + (FULL)MAX_SM_VAL}, + {"MUL_ALG2", "default size for alternative multiply", NULL, + (FULL)MUL_ALG2}, + {"NXT_MAP_PRIME", "smallest odd prime not in pr_map", NULL, + (FULL)NXT_MAP_PRIME}, + {"NXT_PFACT_VAL", "next prime for higher pfact values", NULL, + (FULL)NXT_PFACT_VAL}, + {"OFF_T_BITS", "file offset size in bits", NULL, + (FULL)OFF_T_BITS}, + {"PIX_32B", "max pix() value", NULL, + (FULL)PIX_32B}, + {"POW_ALG2", "default size for using REDC for powers", NULL, + (FULL)POW_ALG2}, + {"REDC_ALG2", "default size using alternative REDC alg", NULL, + (FULL)REDC_ALG2}, + {"SBITS", "size of additive or shuffle entry in bits", NULL, + (FULL)SBITS}, + {"SBYTES", "size of additive or shuffle entry in bytes", NULL, + (FULL)SBYTES}, + {"SCNT", "length of additive 55 table in FULLs", NULL, + (FULL)SCNT}, + {"SEEDXORBITS", "low bits of a55 seed devoted to xor", NULL, + (FULL)SEEDXORBITS}, + {"SHALFS", "size of additive or shuffle entry in HALFs", NULL, + (FULL)SHALFS}, + {"SHUFCNT", "size of shuffle table in entries", NULL, + (FULL)SHUFCNT}, + {"SHUFLEN", "length of shuffle table in FULLs", NULL, + (FULL)SHUFLEN}, + {"SHUFMASK", "mask for shuffle table entry selection", NULL, + (FULL)SHUFMASK}, + {"SHUFPOW", "power of 2 size of the shuffle table", NULL, + (FULL)SHUFPOW}, + {"SLEN", "number of FULLs in a shuffle table entry", NULL, + (FULL)SLEN}, + {"SQ_ALG2", "default size for alternative squaring", NULL, + (FULL)SQ_ALG2}, + {"SYMBOLSIZE", "max symbol name size", NULL, + (FULL)SYMBOLSIZE}, + {"TEN_MAX", "10^(2^TEN_MAX): largest base10 conversion const", NULL, + (FULL)TEN_MAX}, + {"TOPFULL", "highest bit in FULL", NULL, + (FULL)TOPFULL}, + {"TOPHALF", "highest bit in a HALF", NULL, + (FULL)TOPHALF}, + {"TOPLONG", "top long bit", NULL, + (FULL)TOPLONG}, + {"TRUE", "boolean true", NULL, + (FULL)TRUE}, + {"USUAL_ELEMENTS", "usual number of elements for objects", NULL, + (FULL)USUAL_ELEMENTS}, + {"REGNUM_MAX", "highest custom register number", NULL, + (FULL)CUSTOM_REG_MAX}, /* must be last */ {NULL, NULL, NULL, (FULL)0} diff --git a/custom/pmodm127.cal b/custom/pmodm127.cal index 7686cc6..cfb25a7 100644 --- a/custom/pmodm127.cal +++ b/custom/pmodm127.cal @@ -17,8 +17,8 @@ * 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: pmodm127.cal,v 30.1 2007/03/16 11:10:04 chongo Exp $ + * @(#) $Revision: 30.2 $ + * @(#) $Id: pmodm127.cal,v 30.2 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/custom/RCS/pmodm127.cal,v $ * * Under source code control: 2004/02/25 14:25:32 @@ -120,7 +120,8 @@ define pmodm127_test2(testcnt, seed) /* compare custom function with its pmod() equivalent */ if (pmod(2, m127, q) != custom("pmodm127", q)) { print "ERROR: pmodm127 failed for ", str(q); - print "ERROR: ", pmod(2,m127,q), " != ", custom("pmodm127", q); + print "ERROR: ", pmod(2,m127,q), " != ", + custom("pmodm127", q); return newerror("pmodm127 failed for " + str(q)); } } @@ -133,5 +134,6 @@ define pmodm127_test2(testcnt, seed) } if ((config("resource_debug") & 3) && !(config("resource_debug") & 8)) { - print "DEBUG: use config('resource_debug',", config("resource_debug")|8:") to enable more debugging"; + print "DEBUG: use config('resource_debug',", + config("resource_debug")|8 : ") to enable more debugging"; } diff --git a/decl.h b/decl.h index cc70e44..4ebf34b 100644 --- a/decl.h +++ b/decl.h @@ -19,8 +19,8 @@ * 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: decl.h,v 30.3 2008/04/15 21:17:57 chongo Exp $ + * @(#) $Revision: 30.4 $ + * @(#) $Id: decl.h,v 30.4 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/decl.h,v $ * * Under source code control: 2007/02/09 05:24:25 @@ -100,7 +100,8 @@ /* Perform printf-style argument type checking for known compilers */ #ifdef __GNUC__ -# define PRINTF_FORMAT(fmt_idx, arg_idx) __attribute__ ((format (printf, fmt_idx, arg_idx))) +# define PRINTF_FORMAT(fmt_idx, arg_idx) __attribute__ \ + ((format (printf, fmt_idx, arg_idx))) #else # define PRINTF_FORMAT(fmt_idx, arg_idx) #endif diff --git a/file.c b/file.c index 10b8e1f..9c2fbdd 100644 --- a/file.c +++ b/file.c @@ -19,8 +19,8 @@ * 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: file.c,v 30.2 2007/07/05 13:30:38 chongo Exp $ + * @(#) $Revision: 30.3 $ + * @(#) $Id: file.c,v 30.3 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/file.c,v $ * * Under source code control: 1991/07/20 00:21:56 @@ -367,7 +367,8 @@ openid(char *name, char *mode) /* - * openpathid - open the specified abse filename, or relative filename along a search path + * openpathid - open the specified abse filename, or + * relative filename along a search path * * given: * name file name @@ -2026,7 +2027,8 @@ showfiles(void) * strptr pointer to where the new field pointer may be found */ S_FUNC void -getscanfield(FILE *fp, BOOL skip, unsigned int width, int scannum, char *scanptr, char **strptr) +getscanfield(FILE *fp, BOOL skip, unsigned int width, int scannum, + char *scanptr, char **strptr) { char *str; /* current string */ unsigned long len; /* current length of string */ @@ -2104,7 +2106,8 @@ getscanfield(FILE *fp, BOOL skip, unsigned int width, int scannum, char *scanptr * strptr pointer to where the new field pointer may be found */ S_FUNC void -getscanwhite(FILE *fp, BOOL skip, unsigned int width, int scannum, char **strptr) +getscanwhite(FILE *fp, BOOL skip, unsigned int width, int scannum, + char **strptr) { char *str; /* current string */ unsigned long len; /* current length of string */ diff --git a/file.h b/file.h index 8d441af..152c0b4 100644 --- a/file.h +++ b/file.h @@ -19,8 +19,8 @@ * 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: file.h,v 30.1 2007/03/16 11:09:46 chongo Exp $ + * @(#) $Revision: 30.2 $ + * @(#) $Id: file.h,v 30.2 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/file.h,v $ * * Under source code control: 1996/05/24 05:55:58 @@ -96,7 +96,8 @@ E_FUNC int fgetposid(FILEID id, FILEPOS *ptr); E_FUNC int fsetposid(FILEID id, FILEPOS *ptr); E_FUNC int get_open_siz(FILE *fp, ZVALUE *res); E_FUNC char* findfname(FILEID); -E_FUNC FILE *f_pathopen(char *name, char *mode, char *pathlist, char **openpath); +E_FUNC FILE *f_pathopen(char *name, char *mode, char *pathlist, + char **openpath); #endif /* !__FILE_H__ */ diff --git a/func.c b/func.c index c197896..53798fa 100644 --- a/func.c +++ b/func.c @@ -19,8 +19,8 @@ * 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: func.c,v 30.3 2008/04/15 21:17:57 chongo Exp $ + * @(#) $Revision: 30.4 $ + * @(#) $Id: func.c,v 30.4 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/func.c,v $ * * Under source code control: 1990/02/15 01:48:15 @@ -2062,7 +2062,8 @@ f_ln(int count, VALUE **vals) } switch (vals[0]->v_type) { case V_NUM: - if (!qisneg(vals[0]->v_num) && !qiszero(vals[0]->v_num)) { + if (!qisneg(vals[0]->v_num) && + !qiszero(vals[0]->v_num)) { result.v_num = qln(vals[0]->v_num, err); result.v_type = V_NUM; return result; @@ -2107,7 +2108,8 @@ f_log(int count, VALUE **vals) } switch (vals[0]->v_type) { case V_NUM: - if (!qisneg(vals[0]->v_num) && !qiszero(vals[0]->v_num)) { + if (!qisneg(vals[0]->v_num) && + !qiszero(vals[0]->v_num)) { result.v_num = qlog(vals[0]->v_num, err); result.v_type = V_NUM; return result; @@ -4842,7 +4844,8 @@ f_rsearch(int count, VALUE **vals) i = listrsearch(v1->v_list, v2, l_start, l_end, &indx); break; case V_ASSOC: - i = assocrsearch(v1->v_assoc, v2, l_start, l_end, &indx); + i = assocrsearch(v1->v_assoc, v2, l_start, + l_end, &indx); break; case V_STR: i = stringrsearch(v1->v_str, v2->v_str, l_start, @@ -8130,7 +8133,8 @@ STATIC CONST struct builtin builtins[] = { {"ceil", 1, 1, 0, OP_NOP, 0, f_ceil, "smallest integer greater than or equal to number"}, {"cfappr", 1, 3, 0, OP_NOP, f_cfappr, 0, - "approximate a within accuracy b using\n\t\t\tcontinued fractions"}, + "approximate a within accuracy b using\n" + "\t\t\tcontinued fractions"}, {"cfsim", 1, 2, 0, OP_NOP, f_cfsim, 0, "simplify number using continued fractions"}, {"char", 1, 1, 0, OP_NOP, 0, f_char, @@ -8230,7 +8234,8 @@ STATIC CONST struct builtin builtins[] = { {"fgets", 1, 1, 0, OP_NOP, 0, f_fgets, "read next line from file, newline is kept"}, {"fgetstr", 1, 1, 0, OP_NOP, 0, f_fgetstr, - "read next null-terminated string from file, null\n\t\t\tcharacter is kept"}, + "read next null-terminated string from file, null\n" + "\t\t\tcharacter is kept"}, {"files", 0, 1, 0, OP_NOP, 0, f_files, "return opened file or max number of opened files"}, {"floor", 1, 1, 0, OP_NOP, 0, f_floor, @@ -8238,7 +8243,8 @@ STATIC CONST struct builtin builtins[] = { {"fopen", 2, 2, 0, OP_NOP, 0, f_fopen, "open file name a in mode b"}, {"fpathopen", 2, 3, 0, OP_NOP, 0, f_fpathopen, - "open file name a in mode b, search for a along\n\t\t\tCALCPATH or path c"}, + "open file name a in mode b, search for a along\n" + "\t\t\tCALCPATH or path c"}, {"fprintf", 2, IN, 0, OP_NOP, 0, f_fprintf, "print formatted output to opened file"}, {"fputc", 2, 2, 0, OP_NOP, 0, f_fputc, @@ -8262,9 +8268,11 @@ STATIC CONST struct builtin builtins[] = { {"freopen", 2, 3, 0, OP_NOP, 0, f_freopen, "reopen a file stream to a named file"}, {"fscan", 2, IN, FA, OP_NOP, 0, f_fscan, - "scan a file for assignments to one or\n\t\t\tmore variables"}, + "scan a file for assignments to one or\n" + "\t\t\tmore variables"}, {"fscanf", 2, IN, FA, OP_NOP, 0, f_fscanf, - "formatted scan of a file for assignment to one\n\t\t\tor more variables"}, + "formatted scan of a file for assignment to one\n" + "\t\t\tor more variables"}, {"fseek", 2, 3, 0, OP_NOP, 0, f_fseek, "seek to position b (offset from c) in file a"}, {"fsize", 1, 1, 0, OP_NOP, 0, f_fsize, @@ -8282,7 +8290,8 @@ STATIC CONST struct builtin builtins[] = { {"getenv", 1, 1, 0, OP_NOP, 0, f_getenv, "value of environment variable (or NULL)"}, {"hash", 1, IN, 0, OP_NOP, 0, f_hash, - "return non-negative hash value for one or\n\t\t\tmore values"}, + "return non-negative hash value for one or\n" + "\t\t\tmore values"}, {"head", 2, 2, 0, OP_NOP, 0, f_head, "return list of specified number at head of a list"}, {"highbit", 1, 1, 0, OP_HIGHBIT, 0, 0, @@ -8376,7 +8385,8 @@ STATIC CONST struct builtin builtins[] = { {"istype", 2, 2, 0, OP_ISTYPE, 0, 0, "whether the type of a is same as the type of b"}, {"jacobi", 2, 2, 0, OP_NOP, qjacobi, 0, - "-1 => a is not quadratic residue mod b\n\t\t\t1 => b is composite, or a is quad residue of b"}, + "-1 => a is not quadratic residue mod b\n" + "\t\t\t1 => b is composite, or a is quad residue of b"}, {"join", 1, IN, 0, OP_NOP, 0, f_join, "join one or more lists into one list"}, {"lcm", 1, IN, 0, OP_NOP, f_lcm, 0, @@ -8450,7 +8460,8 @@ STATIC CONST struct builtin builtins[] = { {"ord", 1, 1, 0, OP_NOP, 0, f_ord, "integer corresponding to character value"}, {"param", 1, 1, 0, OP_ARGVALUE, 0, 0, - "value of parameter n (or parameter count if n\n\t\t\tis zero)"}, + "value of parameter n (or parameter count if n\n" + "\t\t\tis zero)"}, {"perm", 2, 2, 0, OP_NOP, qperm, 0, "permutation number a!/(a-b)!"}, {"prevcand", 1, 5, 0, OP_NOP, f_prevcand, 0, @@ -8470,7 +8481,8 @@ STATIC CONST struct builtin builtins[] = { {"polar", 2, 3, 0, OP_NOP, 0, f_polar, "complex value of polar coordinate (a * exp(b*1i))"}, {"poly", 1, IN, 0, OP_NOP, 0, f_poly, - "evaluates a polynomial given its coefficients\n\t\t\tor coefficient-list"}, + "evaluates a polynomial given its coefficients\n" + "\t\t\tor coefficient-list"}, {"pop", 1, 1, FA, OP_NOP, 0, f_listpop, "pop value from front of list"}, {"popcnt", 1, 2, 0, OP_NOP, f_popcnt, 0, @@ -8492,7 +8504,8 @@ STATIC CONST struct builtin builtins[] = { {"quo", 2, 3, 0, OP_NOP, 0, f_quo, "integer quotient of a by b, rounding type c"}, {"quomod", 4, 5, FA, OP_NOP, 0, f_quomod, - "set c and d to quotient and remainder of a\n\t\t\tdivided by b"}, + "set c and d to quotient and remainder of a\n" + "\t\t\tdivided by b"}, {"rand", 0, 2, 0, OP_NOP, f_rand, 0, "additive 55 random number [0,2^64), [0,a), or [a,b)"}, {"randbit", 0, 1, 0, OP_NOP, f_randbit, 0, @@ -8528,7 +8541,8 @@ STATIC CONST struct builtin builtins[] = { {"round", 1, 3, 0, OP_NOP, 0, f_round, "round value a to b number of decimal places"}, {"rsearch", 2, 4, 0, OP_NOP, 0, f_rsearch, - "reverse search matrix or list for value b\n\t\t\tstarting at index c"}, + "reverse search matrix or list for value b\n" + "\t\t\tstarting at index c"}, {"runtime", 0, 0, 0, OP_NOP, f_runtime, 0, "user and kernel mode cpu time in seconds"}, {"saveval", 1, 1, 0, OP_SAVEVAL, 0, 0, @@ -8536,11 +8550,14 @@ STATIC CONST struct builtin builtins[] = { {"scale", 2, 2, 0, OP_SCALE, 0, 0, "scale value up or down by a power of two"}, {"scan", 1, IN, FA, OP_NOP, 0, f_scan, - "scan standard input for assignment to one\n\t\t\tor more variables"}, + "scan standard input for assignment to one\n" + "\t\t\tor more variables"}, {"scanf", 2, IN, FA, OP_NOP, 0, f_scanf, - "formatted scan of standard input for assignment\n\t\t\tto variables"}, + "formatted scan of standard input for assignment\n" + "\t\t\tto variables"}, {"search", 2, 4, 0, OP_NOP, 0, f_search, - "search matrix or list for value b starting\n\t\t\tat index c"}, + "search matrix or list for value b starting\n" + "\t\t\tat index c"}, {"sec", 1, 2, 0, OP_NOP, 0, f_sec, "sec of a within accuracy b"}, {"sech", 1, 2, 0, OP_NOP, 0, f_sech, @@ -8775,7 +8792,8 @@ builtinfunc(long index, int argcount, VALUE *stck) vpp = valargs; for (i = 0; i < argcount; i++) { if ((*vpp)->v_type != V_NUM) { - math_error("Non-real argument for builtin function %s", bp->b_name); + math_error("Non-real argument for builtin function %s", + bp->b_name); /*NOTREACHED*/ } numargs[i] = (*vpp)->v_num; diff --git a/hash.c b/hash.c index f5141a1..96f8fda 100644 --- a/hash.c +++ b/hash.c @@ -17,8 +17,8 @@ * 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: hash.c,v 30.2 2007/07/05 17:37:41 chongo Exp $ + * @(#) $Revision: 30.3 $ + * @(#) $Id: hash.c,v 30.3 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/hash.c,v $ * * Under source code control: 1995/11/23 05:13:11 @@ -848,7 +848,8 @@ hash_value(int type, void *v, HASH *state) value->v_obj->o_actions->oa_index), state); (state->chkpt)(state); - for (i=value->v_obj->o_actions->oa_count, vp=value->v_obj->o_table; + for (i=value->v_obj->o_actions->oa_count, + vp=value->v_obj->o_table; i-- > 0; vp++) { diff --git a/have_posscl.c b/have_posscl.c index 9c9fc68..041750f 100644 --- a/have_posscl.c +++ b/have_posscl.c @@ -17,8 +17,8 @@ * 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: have_posscl.c,v 30.2 2008/04/15 21:17:57 chongo Exp $ + * @(#) $Revision: 30.3 $ + * @(#) $Id: have_posscl.c,v 30.3 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/have_posscl.c,v $ * * Under source code control: 1996/07/13 12:57:22 @@ -85,7 +85,8 @@ main(void) printf("#undef HAVE_FILEPOS_SCALAR\n"); printf("#define HAVE_FILEPOS_SCALAR /* FILEPOS is a simple value */\n"); #else - printf("#undef HAVE_FILEPOS_SCALAR /* FILEPOS is not a simple value */\n"); + printf("#undef HAVE_FILEPOS_SCALAR " + "/* FILEPOS is not a simple value */\n"); #endif /* exit(0); */ return 0; diff --git a/have_stdvs.c b/have_stdvs.c index 89608d4..8b704f9 100644 --- a/have_stdvs.c +++ b/have_stdvs.c @@ -17,8 +17,8 @@ * 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: have_stdvs.c,v 30.1 2007/03/16 11:09:46 chongo Exp $ + * @(#) $Revision: 30.2 $ + * @(#) $Id: have_stdvs.c,v 30.2 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/have_stdvs.c,v $ * * Under source code control: 1995/09/09 22:41:10 @@ -57,7 +57,8 @@ #endif #undef VSPRINTF_SIZE_T -#if defined(FORCE_STDC) || (defined(__STDC__) && __STDC__ != 0) || defined(__cplusplus) +#if defined(FORCE_STDC) || (defined(__STDC__) && __STDC__ != 0) || \ + defined(__cplusplus) # define VSPRINTF_SIZE_T size_t #else # define VSPRINTF_SIZE_T long @@ -160,8 +161,10 @@ main(void) puts("/*"); puts(" * SIMULATE_STDARG"); puts(" *"); - puts(" * WARNING: This type of stdarg makes assumptions about the stack"); - puts(" * that may not be true on your system. You may want to"); + puts(" * WARNING: This type of stdarg makes assumptions " + "about the stack"); + puts(" * that may not be true on your system. " + "You may want to"); puts(" * define STDARG (if using ANSI C) or VARARGS."); puts(" */"); puts("typedef char *va_list;"); @@ -169,7 +172,8 @@ main(void) puts("#define va_end(ap) (void)((ap) = 0)"); puts("#define va_arg(ap, type) \\"); puts(" (((type*)((ap) = ((ap) + sizeof(type))))[-1])"); - puts("#define SIMULATE_STDARG /* use std_arg.h to simulate */"); + puts("#define SIMULATE_STDARG " + "/* use std_arg.h to simulate */"); #else puts("#define STDARG /* use */"); puts("#include "); diff --git a/have_varvs.c b/have_varvs.c index 44f3d4b..066a011 100644 --- a/have_varvs.c +++ b/have_varvs.c @@ -17,8 +17,8 @@ * 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: have_varvs.c,v 30.1 2007/03/16 11:09:46 chongo Exp $ + * @(#) $Revision: 30.2 $ + * @(#) $Id: have_varvs.c,v 30.2 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/have_varvs.c,v $ * * Under source code control: 1995/09/09 22:41:10 @@ -53,7 +53,8 @@ #endif #undef VSPRINTF_SIZE_T -#if defined(FORCE_STDC) || (defined(__STDC__) && __STDC__ != 0) || defined(__cplusplus) +#if defined(FORCE_STDC) || (defined(__STDC__) && __STDC__ != 0) || \ + defined(__cplusplus) # define VSPRINTF_SIZE_T size_t #else # define VSPRINTF_SIZE_T long diff --git a/help/errorcodes.sed b/help/errorcodes.sed index 8a60833..38c9453 100644 --- a/help/errorcodes.sed +++ b/help/errorcodes.sed @@ -18,7 +18,7 @@ ## ## @(#) $Revision: 30.1 $ ## @(#) $Id: errorcodes.sed,v 30.1 2007/03/16 11:10:42 chongo Exp $ -## @(#) $Source: /usr/local/src/cmd/calc/help/RCS/errorcodes.sed,v $ +## @(#) $Source: /usr/local/src/bin/calc/help/RCS/errorcodes.sed,v $ ## ## Under source code control: 1995/12/18 03:19:11 ## File existed as early as: 1995 diff --git a/help/fpathopen b/help/fpathopen index 14dd6ac..daa1117 100644 --- a/help/fpathopen +++ b/help/fpathopen @@ -1,5 +1,5 @@ NAME - fpathopen - open an absolute filename, or a relative filename along a search path + fpathopen - open an absolute or relative filename along a search path SYNOPSIS fpathopen(filename, mode [,searchpath]) @@ -165,7 +165,8 @@ EXAMPLE FILE 7 "/home/chongo/tmp/output" (writing, pos 0) ; badfile = fpathopen("no_such_file", "r") - ; if (!isfile(badfile)) print "error #" errno(badfile) : ":" : strerror(badfile); + ; if (!isfile(badfile)) print "error #" errno(badfile) : \ + ":" : strerror(badfile); error #2: No such file or directory LIMITS @@ -195,9 +196,9 @@ SEE ALSO ## 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: fpathopen,v 30.1 2007/03/16 11:10:42 chongo Exp $ -## @(#) $Source: /usr/local/src/cmd/calc/help/RCS/fpathopen,v $ +## @(#) $Revision: 30.2 $ +## @(#) $Id: fpathopen,v 30.2 2013/08/11 08:41:38 chongo Exp $ +## @(#) $Source: /usr/local/src/bin/calc/help/RCS/fpathopen,v $ ## ## Under source code control: 2006/05/07 23:56:04 ## File existed as early as: 2006 diff --git a/help/obj.file b/help/obj.file index ca91735..3c0e0bf 100644 --- a/help/obj.file +++ b/help/obj.file @@ -134,7 +134,8 @@ Using objects xx_print 1 print value, default prints elements xx_one 1 multiplicative identity, default is 1 - xx_test 1 logical test (false,true => 0,1), default tests elements + xx_test 1 logical test (false,true => 0,1), + default tests elements xx_add 2 xx_sub 2 xx_neg 1 negative @@ -144,9 +145,11 @@ Using objects xx_abs 2 absolute value within given error xx_norm 1 square of absolute value xx_conj 1 conjugate - xx_pow 2 integer power, default does multiply, square, inverse + xx_pow 2 integer power, default does multiply, + square, inverse xx_sgn 1 sign of value (-1, 0, 1) - xx_cmp 2 equality (equal,nonequal => 0,1), default tests elements + xx_cmp 2 equality (equal,nonequal => 0,1), + default tests elements xx_rel 2 relative order, positive for >, etc. xx_quo 3 integer quotient xx_mod 3 remainder of division @@ -209,9 +212,9 @@ Using objects ## 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: obj.file,v 30.3 2010/09/02 06:36:21 chongo Exp $ -## @(#) $Source: /usr/local/src/cmd/calc/help/RCS/obj.file,v $ +## @(#) $Revision: 30.4 $ +## @(#) $Id: obj.file,v 30.4 2013/08/11 08:41:38 chongo Exp $ +## @(#) $Source: /usr/local/src/bin/calc/help/RCS/obj.file,v $ ## ## Under source code control: 1991/07/21 04:37:22 ## File existed as early as: 1991 diff --git a/input.c b/input.c index 8488e57..eb2eb82 100644 --- a/input.c +++ b/input.c @@ -17,8 +17,8 @@ * 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: input.c,v 30.2 2008/04/15 21:17:57 chongo Exp $ + * @(#) $Revision: 30.3 $ + * @(#) $Id: input.c,v 30.3 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/input.c,v $ * * Under source code control: 1990/02/15 01:48:16 @@ -258,7 +258,7 @@ opensearchfile(char *name, char *pathlist, char *extension, int rd_once) /* - * f_pathopen - open an absolute filename, or a relative filename along a search path + * f_pathopen - open an absolute or relative filename along a search path * * Open a file by possibly searching through a path list. For example: * @@ -277,13 +277,16 @@ opensearchfile(char *name, char *pathlist, char *extension, int rd_once) * and opens the first one that exists and allows the mode. * * name file name to be read - * mode fopen() mode argument (one of "r", "w", "a", "r+", "w+", "a+") + * mode fopen() mode argument + * (one of "r", "w", "a", "r+", "w+", "a+") * pathlist list of colon separated paths (or NULL) - * openpath if non-NULL, and file was opened, set to malloced path used to open + * openpath if non-NULL, and file was opened, set to malloced + * path used to open * * returns: * open file stream, NULL ==> file was not found or error - * If file was open and openpath was non-NULL, changed to point to path used to open + * If file was open and openpath was non-NULL, changed to point + * to path used to open */ FILE * f_pathopen(char *name, char *mode, char *pathlist, char **openpath) @@ -478,7 +481,8 @@ homeexpand(char *name) * * given: * name the filename to open - * mode fopen() mode argument (one of "r", "w", "a", "r+", "w+", "a+") + * mode fopen() mode argument + * (one of "r", "w", "a", "r+", "w+", "a+") */ FILE * f_open(char *name, char *mode) diff --git a/longbits.c b/longbits.c index 547455a..5be5cf1 100644 --- a/longbits.c +++ b/longbits.c @@ -17,8 +17,8 @@ * 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: longbits.c,v 30.1 2007/03/16 11:09:46 chongo Exp $ + * @(#) $Revision: 30.2 $ + * @(#) $Id: longbits.c,v 30.2 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/longbits.c,v $ * * Under source code control: 1994/03/18 03:06:18 @@ -203,7 +203,8 @@ main(int argc, char **argv) "* signed 64 bits *"); putchar('\n'); printf("/%s/\n","* how to form 64 bit constants *"); -#if defined(FORCE_STDC) || (defined(__STDC__) && __STDC__ != 0) || defined(__cplusplus) +#if defined(FORCE_STDC) || (defined(__STDC__) && __STDC__ != 0) || \ + defined(__cplusplus) printf("#define U(x) x ## ULL\n"); printf("#define L(x) x ## LL\n"); #else @@ -307,7 +308,8 @@ main(int argc, char **argv) "* signed 64 bits *"); putchar('\n'); printf("/%s/\n","* how to form 64 bit constants *"); -#if defined(FORCE_STDC) || (defined(__STDC__) && __STDC__ != 0) || defined(__cplusplus) +#if defined(FORCE_STDC) || (defined(__STDC__) && __STDC__ != 0) || \ + defined(__cplusplus) printf("#define U(x) x ## UL\n"); printf("#define L(x) x ## L\n"); #else @@ -324,7 +326,8 @@ main(int argc, char **argv) "* signed 64 bits *"); putchar('\n'); printf("/%s/\n","* how to form 64 bit constants *"); -#if defined(FORCE_STDC) || (defined(__STDC__) && __STDC__ != 0) || defined(__cplusplus) +#if defined(FORCE_STDC) || (defined(__STDC__) && __STDC__ != 0) || \ + defined(__cplusplus) printf("#define U(x) x ## ULL\n"); printf("#define L(x) x ## LL\n"); #else diff --git a/obj.c b/obj.c index e334bcd..d6e0507 100644 --- a/obj.c +++ b/obj.c @@ -17,8 +17,8 @@ * 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: obj.c,v 30.1 2007/03/16 11:09:46 chongo Exp $ + * @(#) $Revision: 30.2 $ + * @(#) $Id: obj.c,v 30.2 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/obj.c,v $ * * Under source code control: 1990/02/15 01:48:19 @@ -71,51 +71,96 @@ STATIC struct objectinfo { char *name; /* name of function to call */ char *comment; /* useful comment if any */ } objectinfo[] = { - {1, A_UNDEF, ERR_PRINT, "print", "print value, default prints elements"}, - {1, A_VALUE, ERR_ONE, "one", "multiplicative identity, default is 1"}, - {1, A_INT, ERR_TEST, "test", "logical test (false,true => 0,1), default tests elements"}, - {2, A_VALUE, ERR_NONE, "add", NULL}, - {2, A_VALUE, ERR_NONE, "sub", NULL}, - {1, A_VALUE, ERR_NONE, "neg", "negative"}, - {2, A_VALUE, ERR_NONE, "mul", NULL}, - {2, A_VALUE, ERR_NONE, "div", "non-integral division"}, - {1, A_VALUE, ERR_NONE, "inv", "multiplicative inverse"}, - {2, A_VALUE, ERR_NONE, "abs", "absolute value within given error"}, - {1, A_VALUE, ERR_NONE, "norm", "square of absolute value"}, - {1, A_VALUE, ERR_NONE, "conj", "conjugate"}, - {2, A_VALUE, ERR_POW, "pow", "integer power, default does multiply, square, inverse"}, - {1, A_VALUE, ERR_NONE, "sgn", "sign of value (-1, 0, 1)"}, - {2, A_INT, ERR_CMP, "cmp", "equality (equal,nonequal => 0,1), default tests elements"}, - {2, A_VALUE, ERR_NONE, "rel", "relative order, positive for >, etc."}, - {3, A_VALUE, ERR_NONE, "quo", "integer quotient"}, - {3, A_VALUE, ERR_NONE, "mod", "remainder of division"}, - {1, A_VALUE, ERR_NONE, "int", "integer part"}, - {1, A_VALUE, ERR_NONE, "frac", "fractional part"}, - {1, A_VALUE, ERR_INC, "inc", "increment, default adds 1"}, - {1, A_VALUE, ERR_DEC, "dec", "decrement, default subtracts 1"}, - {1, A_VALUE, ERR_SQUARE,"square", "default multiplies by itself"}, - {2, A_VALUE, ERR_NONE, "scale", "multiply by power of 2"}, - {2, A_VALUE, ERR_NONE, "shift", "shift left by n bits (right if negative)"}, - {3, A_VALUE, ERR_NONE, "round", "round to given number of decimal places"}, - {3, A_VALUE, ERR_NONE, "bround", "round to given number of binary places"}, - {3, A_VALUE, ERR_NONE, "root", "root of value within given error"}, - {3, A_VALUE, ERR_NONE, "sqrt", "square root within given error"}, - {2, A_VALUE, ERR_NONE, "or", "bitwise or"}, - {2, A_VALUE, ERR_NONE, "and", "bitwise and"}, - {1, A_VALUE, ERR_NONE, "not", "logical not"}, - {1, A_VALUE, ERR_NONE, "fact", "factorial or postfix !"}, - {1, A_VALUE, ERR_VALUE, "min", "value for min(...)"}, - {1, A_VALUE, ERR_VALUE, "max", "value for max(...)"}, - {1, A_VALUE, ERR_VALUE, "sum", "value for sum(...)"}, - {2, A_UNDEF, ERR_ASSIGN, "assign", "assign, defaults to a = b"}, - {2, A_VALUE, ERR_NONE, "xor", "value for binary ~"}, - {1, A_VALUE, ERR_NONE, "comp", "value for unary ~"}, - {1, A_VALUE, ERR_NONE, "content", "unary hash op"}, - {2, A_VALUE, ERR_NONE, "hashop", "binary hash op"}, - {1, A_VALUE, ERR_NONE, "backslash", "unary backslash op"}, - {2, A_VALUE, ERR_NONE, "setminus", "binary backslash op"}, - {1, A_VALUE, ERR_NONE, "plus", "unary + op"}, - {0, 0, 0, NULL, NULL} + {1, A_UNDEF, ERR_PRINT, + "print", "print value, default prints elements"}, + {1, A_VALUE, ERR_ONE, + "one", "multiplicative identity, default is 1"}, + {1, A_INT, ERR_TEST, + "test", "logical test (false,true => 0,1), default tests elements"}, + {2, A_VALUE, ERR_NONE, + "add", NULL}, + {2, A_VALUE, ERR_NONE, + "sub", NULL}, + {1, A_VALUE, ERR_NONE, + "neg", "negative"}, + {2, A_VALUE, ERR_NONE, + "mul", NULL}, + {2, A_VALUE, ERR_NONE, + "div", "non-integral division"}, + {1, A_VALUE, ERR_NONE, + "inv", "multiplicative inverse"}, + {2, A_VALUE, ERR_NONE, + "abs", "absolute value within given error"}, + {1, A_VALUE, ERR_NONE, + "norm", "square of absolute value"}, + {1, A_VALUE, ERR_NONE, + "conj", "conjugate"}, + {2, A_VALUE, ERR_POW, + "pow", "integer power, default does multiply, square, inverse"}, + {1, A_VALUE, ERR_NONE, + "sgn", "sign of value (-1, 0, 1)"}, + {2, A_INT, ERR_CMP, + "cmp", "equality (equal,nonequal => 0,1), default tests elements"}, + {2, A_VALUE, ERR_NONE, + "rel", "relative order, positive for >, etc."}, + {3, A_VALUE, ERR_NONE, + "quo", "integer quotient"}, + {3, A_VALUE, ERR_NONE, + "mod", "remainder of division"}, + {1, A_VALUE, ERR_NONE, + "int", "integer part"}, + {1, A_VALUE, ERR_NONE, + "frac", "fractional part"}, + {1, A_VALUE, ERR_INC, + "inc", "increment, default adds 1"}, + {1, A_VALUE, ERR_DEC, + "dec", "decrement, default subtracts 1"}, + {1, A_VALUE, ERR_SQUARE, + "square", "default multiplies by itself"}, + {2, A_VALUE, ERR_NONE, + "scale", "multiply by power of 2"}, + {2, A_VALUE, ERR_NONE, + "shift", "shift left by n bits (right if negative)"}, + {3, A_VALUE, ERR_NONE, + "round", "round to given number of decimal places"}, + {3, A_VALUE, ERR_NONE, + "bround", "round to given number of binary places"}, + {3, A_VALUE, ERR_NONE, + "root", "root of value within given error"}, + {3, A_VALUE, ERR_NONE, + "sqrt", "square root within given error"}, + {2, A_VALUE, ERR_NONE, + "or", "bitwise or"}, + {2, A_VALUE, ERR_NONE, + "and", "bitwise and"}, + {1, A_VALUE, ERR_NONE, + "not", "logical not"}, + {1, A_VALUE, ERR_NONE, + "fact", "factorial or postfix !"}, + {1, A_VALUE, ERR_VALUE, + "min", "value for min(...)"}, + {1, A_VALUE, ERR_VALUE, + "max", "value for max(...)"}, + {1, A_VALUE, ERR_VALUE, + "sum", "value for sum(...)"}, + {2, A_UNDEF, ERR_ASSIGN, + "assign", "assign, defaults to a = b"}, + {2, A_VALUE, ERR_NONE, + "xor", "value for binary ~"}, + {1, A_VALUE, ERR_NONE, + "comp", "value for unary ~"}, + {1, A_VALUE, ERR_NONE, + "content", "unary hash op"}, + {2, A_VALUE, ERR_NONE, + "hashop", "binary hash op"}, + {1, A_VALUE, ERR_NONE, + "backslash", "unary backslash op"}, + {2, A_VALUE, ERR_NONE, + "setminus", "binary backslash op"}, + {1, A_VALUE, ERR_NONE, + "plus", "unary + op"}, + {0, 0, 0, + NULL, NULL} }; @@ -262,7 +307,8 @@ objcall(int action, VALUE *v1, VALUE *v2, VALUE *v3) val.v_type = V_NULL; break; default: - math_error("Function \"%s\" is undefined", namefunc(index)); + math_error("Function \"%s\" is undefined", + namefunc(index)); /*NOTREACHED*/ } return val; diff --git a/opcodes.c b/opcodes.c index d6089d9..40ca692 100644 --- a/opcodes.c +++ b/opcodes.c @@ -19,8 +19,8 @@ * received a copy with calc; if not, write to Free Software Foundation, Inc. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * - * @(#) $Revision: 30.4 $ - * @(#) $Id: opcodes.c,v 30.4 2008/05/10 13:51:32 chongo Exp $ + * @(#) $Revision: 30.5 $ + * @(#) $Id: opcodes.c,v 30.5 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/opcodes.c,v $ * * Under source code control: 1990/02/15 01:48:19 @@ -168,7 +168,8 @@ S_FUNC void o_globaladdr(FUNC UNUSED *fp, GLOBAL *sp) { if (sp == NULL) { - math_error("Global variable \"%s\" not initialized", sp->g_name); + math_error("Global variable \"%s\" not initialized", + sp->g_name); /*NOTREACHED*/ } stack++; @@ -3557,138 +3558,270 @@ showsizes(void) * Information about each opcode. */ STATIC struct opcode opcodes[MAX_OPCODE+1] = { - {o_nop, OPNUL, "NOP"}, /* no operation */ - {o_localaddr, OPLOC, "LOCALADDR"}, /* address of local variable */ - {o_globaladdr, OPGLB, "GLOBALADDR"}, /* address of global variable */ - {o_paramaddr, OPPAR, "PARAMADDR"}, /* address of parameter variable */ - {o_localvalue, OPLOC, "LOCALVALUE"}, /* value of local variable */ - {o_globalvalue, OPGLB, "GLOBALVALUE"}, /* value of global variable */ - {o_paramvalue, OPPAR, "PARAMVALUE"}, /* value of parameter variable */ - {o_number, OPONE, "NUMBER"}, /* constant real numeric value */ - {o_indexaddr, OPTWO, "INDEXADDR"}, /* array index address */ - {o_printresult, OPNUL, "PRINTRESULT"}, /* print result of top-level expression */ - {o_assign, OPNUL, "ASSIGN"}, /* assign value to variable */ - {o_add, OPNUL, "ADD"}, /* add top two values */ - {o_sub, OPNUL, "SUB"}, /* subtract top two values */ - {o_mul, OPNUL, "MUL"}, /* multiply top two values */ - {o_div, OPNUL, "DIV"}, /* divide top two values */ - {o_mod, OPNUL, "MOD"}, /* take mod of top two values */ - {o_save, OPNUL, "SAVE"}, /* save value for later use */ - {o_negate, OPNUL, "NEGATE"}, /* negate top value */ - {o_invert, OPNUL, "INVERT"}, /* invert top value */ - {o_int, OPNUL, "INT"}, /* take integer part */ - {o_frac, OPNUL, "FRAC"}, /* take fraction part */ - {o_numerator, OPNUL, "NUMERATOR"}, /* take numerator */ - {o_denominator, OPNUL, "DENOMINATOR"}, /* take denominator */ - {o_duplicate, OPNUL, "DUPLICATE"}, /* duplicate top value */ - {o_pop, OPNUL, "POP"}, /* pop top value */ - {o_return, OPRET, "RETURN"}, /* return value of function */ - {o_jumpz, OPJMP, "JUMPZ"}, /* jump if value zero */ - {o_jumpnz, OPJMP, "JUMPNZ"}, /* jump if value nonzero */ - {o_jump, OPJMP, "JUMP"}, /* jump unconditionally */ - {o_usercall, OPTWO, "USERCALL"}, /* call a user function */ - {o_getvalue, OPNUL, "GETVALUE"}, /* convert address to value */ - {o_eq, OPNUL, "EQ"}, /* test elements for equality */ - {o_ne, OPNUL, "NE"}, /* test elements for inequality */ - {o_le, OPNUL, "LE"}, /* test elements for <= */ - {o_ge, OPNUL, "GE"}, /* test elements for >= */ - {o_lt, OPNUL, "LT"}, /* test elements for < */ - {o_gt, OPNUL, "GT"}, /* test elements for > */ - {o_preinc, OPNUL, "PREINC"}, /* add one to variable (++x) */ - {o_predec, OPNUL, "PREDEC"}, /* subtract one from variable (--x) */ - {o_postinc, OPNUL, "POSTINC"}, /* add one to variable (x++) */ - {o_postdec, OPNUL, "POSTDEC"}, /* subtract one from variable (x--) */ - {o_debug, OPONE, "DEBUG"}, /* debugging point */ - {o_print, OPONE, "PRINT"}, /* print value */ - {o_assignpop, OPNUL, "ASSIGNPOP"}, /* assign to variable and pop it */ - {o_zero, OPNUL, "ZERO"}, /* put zero on the stack */ - {o_one, OPNUL, "ONE"}, /* put one on the stack */ - {o_printeol, OPNUL, "PRINTEOL"}, /* print end of line */ - {o_printspace, OPNUL, "PRINTSPACE"}, /* print a space */ - {o_printstring, OPONE, "PRINTSTR"}, /* print constant string */ - {o_dupvalue, OPNUL, "DUPVALUE"}, /* duplicate value of top value */ - {o_oldvalue, OPNUL, "OLDVALUE"}, /* old value from previous calc */ - {o_quo, OPNUL, "QUO"}, /* integer quotient of top values */ - {o_power, OPNUL, "POWER"}, /* value raised to a power */ - {o_quit, OPONE, "QUIT"}, /* quit program */ - {o_call, OPTWO, "CALL"}, /* call built-in routine */ - {o_getepsilon, OPNUL, "GETEPSILON"}, /* get allowed error for calculations */ - {o_and, OPNUL, "AND"}, /* arithmetic and or top two values */ - {o_or, OPNUL, "OR"}, /* arithmetic or of top two values */ - {o_not, OPNUL, "NOT"}, /* logical not or top value */ - {o_abs, OPNUL, "ABS"}, /* absolute value of top value */ - {o_sgn, OPNUL, "SGN"}, /* sign of number */ - {o_isint, OPNUL, "ISINT"}, /* whether number is an integer */ - {o_condorjump, OPJMP, "CONDORJUMP"}, /* conditional or jump */ - {o_condandjump, OPJMP, "CONDANDJUMP"}, /* conditional and jump */ - {o_square, OPNUL, "SQUARE"}, /* square top value */ - {o_string, OPONE, "STRING"}, /* string constant value */ - {o_isnum, OPNUL, "ISNUM"}, /* whether value is a number */ - {o_undef, OPNUL, "UNDEF"}, /* load undefined value on stack */ - {o_isnull, OPNUL, "ISNULL"}, /* whether value is the null value */ - {o_argvalue, OPARG, "ARGVALUE"}, /* load value of arg (parameter) n */ - {o_matcreate, OPONE, "MATCREATE"}, /* create matrix */ - {o_ismat, OPNUL, "ISMAT"}, /* whether value is a matrix */ - {o_isstr, OPNUL, "ISSTR"}, /* whether value is a string */ - {o_getconfig, OPNUL, "GETCONFIG"}, /* get value of configuration parameter */ - {o_leftshift, OPNUL, "LEFTSHIFT"}, /* left shift of integer */ - {o_rightshift, OPNUL, "RIGHTSHIFT"}, /* right shift of integer */ - {o_casejump, OPJMP, "CASEJUMP"}, /* test case and jump if not matched */ - {o_isodd, OPNUL, "ISODD"}, /* whether value is odd integer */ - {o_iseven, OPNUL, "ISEVEN"}, /* whether value is even integer */ - {o_fiaddr, OPNUL, "FIADDR"}, /* 'fast index' matrix address */ - {o_fivalue, OPNUL, "FIVALUE"}, /* 'fast index' matrix value */ - {o_isreal, OPNUL, "ISREAL"}, /* whether value is real number */ - {o_imaginary, OPONE, "IMAGINARY"}, /* constant imaginary numeric value */ - {o_re, OPNUL, "RE"}, /* real part of complex number */ - {o_im, OPNUL, "IM"}, /* imaginary part of complex number */ - {o_conjugate, OPNUL, "CONJUGATE"}, /* complex conjugate */ - {o_objcreate, OPONE, "OBJCREATE"}, /* create object */ - {o_isobj, OPNUL, "ISOBJ"}, /* whether value is an object */ - {o_norm, OPNUL, "NORM"}, /* norm of value (square of abs) */ - {o_elemaddr, OPONE, "ELEMADDR"}, /* address of element of object */ - {o_elemvalue, OPONE, "ELEMVALUE"}, /* value of element of object */ - {o_istype, OPNUL, "ISTYPE"}, /* whether types are the same */ - {o_scale, OPNUL, "SCALE"}, /* scale value by a power of two */ - {o_islist, OPNUL, "ISLIST"}, /* whether value is a list */ - {o_swap, OPNUL, "SWAP"}, /* swap values of two variables */ - {o_issimple, OPNUL, "ISSIMPLE"}, /* whether value is simple type */ - {o_cmp, OPNUL, "CMP"}, /* compare values returning -1, 0, 1 */ - {o_setconfig, OPNUL, "SETCONFIG"}, /* set configuration parameter */ - {o_setepsilon, OPNUL, "SETEPSILON"}, /* set allowed error for calculations */ - {o_isfile, OPNUL, "ISFILE"}, /* whether value is a file */ - {o_isassoc, OPNUL, "ISASSOC"}, /* whether value is an association */ - {o_nop, OPSTI, "INITSTATIC"}, /* once only code for static init */ - {o_eleminit, OPONE, "ELEMINIT"}, /* assign element of matrix or object */ - {o_isconfig, OPNUL, "ISCONFIG"}, /* whether value is a configuration state */ - {o_ishash, OPNUL, "ISHASH"}, /* whether value is a hash state */ - {o_isrand, OPNUL, "ISRAND"}, /* whether value is a rand element */ - {o_israndom, OPNUL, "ISRANDOM"}, /* whether value is a random element */ - {o_show, OPONE, "SHOW"}, /* show current state data */ - {o_initfill, OPNUL, "INITFILL"}, /* initially fill matrix */ - {o_assignback, OPNUL, "ASSIGNBACK"}, /* assign in reverse order */ - {o_test, OPNUL, "TEST"}, /* test that value is "nonzero" */ - {o_isdefined, OPNUL, "ISDEFINED"}, /* whether a string names a function */ - {o_isobjtype, OPNUL, "ISOBJTYPE"}, /* whether a string names an object type */ - {o_isblock, OPNUL, "ISBLK"}, /* whether value is a block */ - {o_ptr, OPNUL, "PTR"}, /* octet pointer */ - {o_deref, OPNUL, "DEREF"}, /* dereference an octet pointer */ - {o_isoctet, OPNUL, "ISOCTET"}, /* whether a value is an octet */ - {o_isptr, OPNUL, "ISPTR"}, /* whether a value is a pointer */ - {o_setsaveval, OPNUL, "SAVEVAL"}, /* enable or disable saving */ - {o_links, OPNUL, "LINKS"}, /* links to number or string */ - {o_bit, OPNUL, "BIT"}, /* whether bit is set */ - {o_comp, OPNUL, "COMP"}, /* complement value */ - {o_xor, OPNUL, "XOR"}, /* xor (~) of values */ - {o_highbit, OPNUL, "HIGHBIT"}, /* highbit of value */ - {o_lowbit, OPNUL, "LOWBIT"}, /* lowbit of value */ - {o_content, OPNUL, "CONTENT"}, /* unary hash op */ - {o_hashop, OPNUL, "HASHOP"}, /* binary hash op */ - {o_backslash, OPNUL, "BACKSLASH"}, /* unary backslash op */ - {o_setminus, OPNUL, "SETMINUS"}, /* binary backslash op */ - {o_plus, OPNUL, "PLUS"}, /* unary + op */ - {o_jumpnn, OPJMP, "JUMPNN"}, /* jump if non-null */ - {o_abort, OPONE, "ABORT"} /* abort operation */ + {o_nop, OPNUL, + "NOP"}, /* no operation */ + {o_localaddr, OPLOC, + "LOCALADDR"}, /* address of local variable */ + {o_globaladdr, OPGLB, + "GLOBALADDR"}, /* address of global variable */ + {o_paramaddr, OPPAR, + "PARAMADDR"}, /* address of parameter variable */ + {o_localvalue, OPLOC, + "LOCALVALUE"}, /* value of local variable */ + {o_globalvalue, OPGLB, + "GLOBALVALUE"}, /* value of global variable */ + {o_paramvalue, OPPAR, + "PARAMVALUE"}, /* value of parameter variable */ + {o_number, OPONE, + "NUMBER"}, /* constant real numeric value */ + {o_indexaddr, OPTWO, + "INDEXADDR"}, /* array index address */ + {o_printresult, OPNUL, + "PRINTRESULT"}, /* print result of top-level expression */ + {o_assign, OPNUL, + "ASSIGN"}, /* assign value to variable */ + {o_add, OPNUL, + "ADD"}, /* add top two values */ + {o_sub, OPNUL, + "SUB"}, /* subtract top two values */ + {o_mul, OPNUL, + "MUL"}, /* multiply top two values */ + {o_div, OPNUL, + "DIV"}, /* divide top two values */ + {o_mod, OPNUL, + "MOD"}, /* take mod of top two values */ + {o_save, OPNUL, + "SAVE"}, /* save value for later use */ + {o_negate, OPNUL, + "NEGATE"}, /* negate top value */ + {o_invert, OPNUL, + "INVERT"}, /* invert top value */ + {o_int, OPNUL, + "INT"}, /* take integer part */ + {o_frac, OPNUL, + "FRAC"}, /* take fraction part */ + {o_numerator, OPNUL, + "NUMERATOR"}, /* take numerator */ + {o_denominator, OPNUL, + "DENOMINATOR"}, /* take denominator */ + {o_duplicate, OPNUL, + "DUPLICATE"}, /* duplicate top value */ + {o_pop, OPNUL, + "POP"}, /* pop top value */ + {o_return, OPRET, + "RETURN"}, /* return value of function */ + {o_jumpz, OPJMP, + "JUMPZ"}, /* jump if value zero */ + {o_jumpnz, OPJMP, + "JUMPNZ"}, /* jump if value nonzero */ + {o_jump, OPJMP, + "JUMP"}, /* jump unconditionally */ + {o_usercall, OPTWO, + "USERCALL"}, /* call a user function */ + {o_getvalue, OPNUL, + "GETVALUE"}, /* convert address to value */ + {o_eq, OPNUL, + "EQ"}, /* test elements for equality */ + {o_ne, OPNUL, + "NE"}, /* test elements for inequality */ + {o_le, OPNUL, + "LE"}, /* test elements for <= */ + {o_ge, OPNUL, + "GE"}, /* test elements for >= */ + {o_lt, OPNUL, + "LT"}, /* test elements for < */ + {o_gt, OPNUL, + "GT"}, /* test elements for > */ + {o_preinc, OPNUL, + "PREINC"}, /* add one to variable (++x) */ + {o_predec, OPNUL, + "PREDEC"}, /* subtract one from variable (--x) */ + {o_postinc, OPNUL, + "POSTINC"}, /* add one to variable (x++) */ + {o_postdec, OPNUL, + "POSTDEC"}, /* subtract one from variable (x--) */ + {o_debug, OPONE, + "DEBUG"}, /* debugging point */ + {o_print, OPONE, + "PRINT"}, /* print value */ + {o_assignpop, OPNUL, + "ASSIGNPOP"}, /* assign to variable and pop it */ + {o_zero, OPNUL, + "ZERO"}, /* put zero on the stack */ + {o_one, OPNUL, + "ONE"}, /* put one on the stack */ + {o_printeol, OPNUL, + "PRINTEOL"}, /* print end of line */ + {o_printspace, OPNUL, + "PRINTSPACE"}, /* print a space */ + {o_printstring, OPONE, + "PRINTSTR"}, /* print constant string */ + {o_dupvalue, OPNUL, + "DUPVALUE"}, /* duplicate value of top value */ + {o_oldvalue, OPNUL, + "OLDVALUE"}, /* old value from previous calc */ + {o_quo, OPNUL, + "QUO"}, /* integer quotient of top values */ + {o_power, OPNUL, + "POWER"}, /* value raised to a power */ + {o_quit, OPONE, + "QUIT"}, /* quit program */ + {o_call, OPTWO, + "CALL"}, /* call built-in routine */ + {o_getepsilon, OPNUL, + "GETEPSILON"}, /* get allowed error for calculations */ + {o_and, OPNUL, + "AND"}, /* arithmetic and or top two values */ + {o_or, OPNUL, + "OR"}, /* arithmetic or of top two values */ + {o_not, OPNUL, + "NOT"}, /* logical not or top value */ + {o_abs, OPNUL, + "ABS"}, /* absolute value of top value */ + {o_sgn, OPNUL, + "SGN"}, /* sign of number */ + {o_isint, OPNUL, + "ISINT"}, /* whether number is an integer */ + {o_condorjump, OPJMP, + "CONDORJUMP"}, /* conditional or jump */ + {o_condandjump, OPJMP, + "CONDANDJUMP"}, /* conditional and jump */ + {o_square, OPNUL, + "SQUARE"}, /* square top value */ + {o_string, OPONE, + "STRING"}, /* string constant value */ + {o_isnum, OPNUL, + "ISNUM"}, /* whether value is a number */ + {o_undef, OPNUL, + "UNDEF"}, /* load undefined value on stack */ + {o_isnull, OPNUL, + "ISNULL"}, /* whether value is the null value */ + {o_argvalue, OPARG, + "ARGVALUE"}, /* load value of arg (parameter) n */ + {o_matcreate, OPONE, + "MATCREATE"}, /* create matrix */ + {o_ismat, OPNUL, + "ISMAT"}, /* whether value is a matrix */ + {o_isstr, OPNUL, + "ISSTR"}, /* whether value is a string */ + {o_getconfig, OPNUL, + "GETCONFIG"}, /* get value of configuration parameter */ + {o_leftshift, OPNUL, + "LEFTSHIFT"}, /* left shift of integer */ + {o_rightshift, OPNUL, + "RIGHTSHIFT"}, /* right shift of integer */ + {o_casejump, OPJMP, + "CASEJUMP"}, /* test case and jump if not matched */ + {o_isodd, OPNUL, + "ISODD"}, /* whether value is odd integer */ + {o_iseven, OPNUL, + "ISEVEN"}, /* whether value is even integer */ + {o_fiaddr, OPNUL, + "FIADDR"}, /* 'fast index' matrix address */ + {o_fivalue, OPNUL, + "FIVALUE"}, /* 'fast index' matrix value */ + {o_isreal, OPNUL, + "ISREAL"}, /* whether value is real number */ + {o_imaginary, OPONE, + "IMAGINARY"}, /* constant imaginary numeric value */ + {o_re, OPNUL, + "RE"}, /* real part of complex number */ + {o_im, OPNUL, + "IM"}, /* imaginary part of complex number */ + {o_conjugate, OPNUL, + "CONJUGATE"}, /* complex conjugate */ + {o_objcreate, OPONE, + "OBJCREATE"}, /* create object */ + {o_isobj, OPNUL, + "ISOBJ"}, /* whether value is an object */ + {o_norm, OPNUL, + "NORM"}, /* norm of value (square of abs) */ + {o_elemaddr, OPONE, + "ELEMADDR"}, /* address of element of object */ + {o_elemvalue, OPONE, + "ELEMVALUE"}, /* value of element of object */ + {o_istype, OPNUL, + "ISTYPE"}, /* whether types are the same */ + {o_scale, OPNUL, + "SCALE"}, /* scale value by a power of two */ + {o_islist, OPNUL, + "ISLIST"}, /* whether value is a list */ + {o_swap, OPNUL, + "SWAP"}, /* swap values of two variables */ + {o_issimple, OPNUL, + "ISSIMPLE"}, /* whether value is simple type */ + {o_cmp, OPNUL, + "CMP"}, /* compare values returning -1, 0, 1 */ + {o_setconfig, OPNUL, + "SETCONFIG"}, /* set configuration parameter */ + {o_setepsilon, OPNUL, + "SETEPSILON"}, /* set allowed error for calculations */ + {o_isfile, OPNUL, + "ISFILE"}, /* whether value is a file */ + {o_isassoc, OPNUL, + "ISASSOC"}, /* whether value is an association */ + {o_nop, OPSTI, + "INITSTATIC"}, /* once only code for static init */ + {o_eleminit, OPONE, + "ELEMINIT"}, /* assign element of matrix or object */ + {o_isconfig, OPNUL, + "ISCONFIG"}, /* whether value is a configuration state */ + {o_ishash, OPNUL, + "ISHASH"}, /* whether value is a hash state */ + {o_isrand, OPNUL, + "ISRAND"}, /* whether value is a rand element */ + {o_israndom, OPNUL, + "ISRANDOM"}, /* whether value is a random element */ + {o_show, OPONE, + "SHOW"}, /* show current state data */ + {o_initfill, OPNUL, + "INITFILL"}, /* initially fill matrix */ + {o_assignback, OPNUL, + "ASSIGNBACK"}, /* assign in reverse order */ + {o_test, OPNUL, + "TEST"}, /* test that value is "nonzero" */ + {o_isdefined, OPNUL, + "ISDEFINED"}, /* whether a string names a function */ + {o_isobjtype, OPNUL, + "ISOBJTYPE"}, /* whether a string names an object type */ + {o_isblock, OPNUL, + "ISBLK"}, /* whether value is a block */ + {o_ptr, OPNUL, + "PTR"}, /* octet pointer */ + {o_deref, OPNUL, + "DEREF"}, /* dereference an octet pointer */ + {o_isoctet, OPNUL, + "ISOCTET"}, /* whether a value is an octet */ + {o_isptr, OPNUL, + "ISPTR"}, /* whether a value is a pointer */ + {o_setsaveval, OPNUL, + "SAVEVAL"}, /* enable or disable saving */ + {o_links, OPNUL, + "LINKS"}, /* links to number or string */ + {o_bit, OPNUL, + "BIT"}, /* whether bit is set */ + {o_comp, OPNUL, + "COMP"}, /* complement value */ + {o_xor, OPNUL, + "XOR"}, /* xor (~) of values */ + {o_highbit, OPNUL, + "HIGHBIT"}, /* highbit of value */ + {o_lowbit, OPNUL, + "LOWBIT"}, /* lowbit of value */ + {o_content, OPNUL, + "CONTENT"}, /* unary hash op */ + {o_hashop, OPNUL, + "HASHOP"}, /* binary hash op */ + {o_backslash, OPNUL, + "BACKSLASH"}, /* unary backslash op */ + {o_setminus, OPNUL, + "SETMINUS"}, /* binary backslash op */ + {o_plus, OPNUL, + "PLUS"}, /* unary + op */ + {o_jumpnn, OPJMP, + "JUMPNN"}, /* jump if non-null */ + {o_abort, OPONE, + "ABORT"} /* abort operation */ }; diff --git a/qmath.c b/qmath.c index 5f5b5bb..f58ed08 100644 --- a/qmath.c +++ b/qmath.c @@ -19,8 +19,8 @@ * 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: qmath.c,v 30.1 2007/03/16 11:09:46 chongo Exp $ + * @(#) $Revision: 30.2 $ + * @(#) $Id: qmath.c,v 30.2 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/qmath.c,v $ * * Under source code control: 1990/02/15 01:48:21 @@ -1260,9 +1260,9 @@ qrel(NUMBER *q1, NUMBER *q2) if (qiszero(q1)) return -1; /* - * Make a quick comparison by calculating the number of words resulting as - * if we multiplied through by the denominators, and then comparing the - * word counts. + * Make a quick comparison by calculating the number of words + * resulting as if we multiplied through by the denominators, + * and then comparing the word counts. */ sign = 1; if (qisneg(q1)) diff --git a/qmath.h b/qmath.h index 731b090..bed9abb 100644 --- a/qmath.h +++ b/qmath.h @@ -17,8 +17,8 @@ * 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: qmath.h,v 30.2 2007/07/05 19:35:20 chongo Exp $ + * @(#) $Revision: 30.3 $ + * @(#) $Id: qmath.h,v 30.3 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/qmath.h,v $ * * Under source code control: 1993/07/30 19:42:47 @@ -165,7 +165,8 @@ E_FUNC long qilog2(NUMBER *q); E_FUNC long qilog10(NUMBER *q); E_FUNC NUMBER *qilog(NUMBER *q, ZVALUE base); E_FUNC BOOL qcmpmod(NUMBER *q1, NUMBER *q2, NUMBER *q3); -E_FUNC BOOL qquomod(NUMBER *q1, NUMBER *q2, NUMBER **quo, NUMBER **mod, long rnd); +E_FUNC BOOL qquomod(NUMBER *q1, NUMBER *q2, NUMBER **quo, NUMBER **mod, + long rnd); E_FUNC FLAG qnear(NUMBER *q1, NUMBER *q2, NUMBER *epsilon); E_FUNC NUMBER *qdigit(NUMBER *q, ZVALUE dpos, ZVALUE base); E_FUNC long qprecision(NUMBER *q); diff --git a/rpm.mk b/rpm.mk index cfce681..996351d 100644 --- a/rpm.mk +++ b/rpm.mk @@ -19,8 +19,8 @@ # received a copy with calc; if not, write to Free Software Foundation, Inc. # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. # -MAKEFILE_REV= $$Revision: 30.10 $$ -# @(#) $Id: rpm.mk,v 30.10 2013/05/05 11:59:51 chongo Exp $ +MAKEFILE_REV= $$Revision: 30.11 $$ +# @(#) $Id: rpm.mk,v 30.11 2013/08/11 08:41:38 chongo Exp $ # @(#) $Source: /usr/local/src/bin/calc/RCS/rpm.mk,v $ # # Under source code control: 2003/02/16 20:21:39 @@ -32,7 +32,8 @@ MAKEFILE_REV= $$Revision: 30.10 $$ # calculator by David I. Bell with help/mods from others # Makefile by Petteri Kettunen with modifications from Landon Curt Noll -# IMPORTANT NOTE: The rpm process assumes that ~/.rpmmacros contains the following: +# IMPORTANT NOTE: The rpm process assumes that ~/.rpmmacros contains +# the following: # # %_signature gpg # %_gpg_path ~/.gnupg @@ -95,7 +96,8 @@ PROJECT= ${PROJECT_NAME}-${PROJECT_VERSION} SPECFILE= ${PROJECT_NAME}.spec TARBALL= ${PROJECT}.${TAR}.bz2 RPM686= ${PROJECT}-${PROJECT_RELEASE}.${TARCH}.rpm -DRPM686= ${PROJECT_NAME}-devel-${PROJECT_VERSION}-${PROJECT_RELEASE}.${TARCH}.rpm +DRPM686= \ + ${PROJECT_NAME}-devel-${PROJECT_VERSION}-${PROJECT_RELEASE}.${TARCH}.rpm SRPM= ${PROJECT}-${PROJECT_RELEASE}.src.rpm RPM_TOP= ${HOME}/rpm/${NAME} TMPDIR= ${RPM_TOP}/tmp diff --git a/str.c b/str.c index ab067ba..5c68f9e 100644 --- a/str.c +++ b/str.c @@ -19,8 +19,8 @@ * 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: str.c,v 30.1 2007/03/16 11:09:46 chongo Exp $ + * @(#) $Revision: 30.2 $ + * @(#) $Id: str.c,v 30.2 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/str.c,v $ * * Under source code control: 1990/02/15 01:48:10 @@ -162,7 +162,8 @@ findstr(STRINGHEAD *hp, char *str) index = 0; while (*test) { testlen = strlen(test); - if ((testlen == len) && (*test == *str) && (strcmp(test, str) == 0)) + if ((testlen == len) && (*test == *str) && + (strcmp(test, str) == 0)) return index; test += (testlen + 1); index++; @@ -263,7 +264,8 @@ addliteral(char *str) if (literals.l_count >= literals.l_maxcount) { count = literals.l_maxcount + STR_TABLECHUNK; if (literals.l_maxcount) - table = (char **) realloc(literals.l_table, count * sizeof(char *)); + table = (char **) realloc(literals.l_table, count * + sizeof(char *)); else table = (char **) malloc(count * sizeof(char *)); if (table == NULL) { @@ -1214,7 +1216,8 @@ addstring(char *str, size_t len) sp = (STRING **) realloc((char *) stringconsttable, sizeof(STRING *) * (stringconstcount + STRCONSTALLOC)); if (sp == NULL) { - math_error("Unable to reallocate string const table"); + math_error("Unable to reallocate string " + "const table"); /*NOTREACHED*/ } stringconsttable = sp; diff --git a/symbol.c b/symbol.c index 9b9e383..42669ae 100644 --- a/symbol.c +++ b/symbol.c @@ -19,8 +19,8 @@ * 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: symbol.c,v 30.1 2007/03/16 11:09:46 chongo Exp $ + * @(#) $Revision: 30.2 $ + * @(#) $Id: symbol.c,v 30.2 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/symbol.c,v $ * * Under source code control: 1990/02/15 01:48:23 @@ -61,7 +61,8 @@ STATIC GLOBAL **statictable; * Hash a symbol name so we can find it in the hash table. * Args are the symbol name and the symbol name size. */ -#define HASHSYM(n, s) ((unsigned)((n)[0]*123 + (n)[s-1]*135 + (s)*157) % HASHSIZE) +#define HASHSYM(n, s) ((unsigned)((n)[0]*123 + (n)[s-1]*135 + (s)*157) % \ + HASHSIZE) /* diff --git a/token.h b/token.h index c6a0e46..89c2c57 100644 --- a/token.h +++ b/token.h @@ -17,8 +17,8 @@ * 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: token.h,v 30.2 2007/07/05 13:30:38 chongo Exp $ + * @(#) $Revision: 30.3 $ + * @(#) $Id: token.h,v 30.3 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/token.h,v $ * * Under source code control: 1990/02/15 01:48:37 @@ -152,18 +152,22 @@ #define EXPR_CONST 0x0002 /* result is constant */ #define EXPR_ASSIGN 0x0004 /* result is an assignment */ -#define isrvalue(n) ((n) & EXPR_RVALUE) /* TRUE if expression is rvalue */ -#define islvalue(n) (((n) & EXPR_RVALUE) == 0) /* TRUE if expr is lvalue */ -#define isconst(n) ((n) & EXPR_CONST) /* TRUE if expr is constant */ -#define isassign(n) ((n) & EXPR_ASSIGN) /* TRUE if expr is an assignment */ +/* TRUE if expression is rvalue */ +#define isrvalue(n) ((n) & EXPR_RVALUE) +/* TRUE if expr is lvalue */ +#define islvalue(n) (((n) & EXPR_RVALUE) == 0) +/* TRUE if expr is constant */ +#define isconst(n) ((n) & EXPR_CONST) +/* TRUE if expr is an assignment */ +#define isassign(n) ((n) & EXPR_ASSIGN) /* * Flags for modes for tokenizing. */ -#define TM_DEFAULT 0x0 /* normal mode */ -#define TM_NEWLINES 0x1 /* treat any newline as a token */ -#define TM_ALLSYMS 0x2 /* treat almost everything as a symbol */ +#define TM_DEFAULT 0x0 /* normal mode */ +#define TM_NEWLINES 0x1 /* treat any newline as a token */ +#define TM_ALLSYMS 0x2 /* treat almost everything as a symbol */ EXTERN long errorcount; /* number of errors found */ diff --git a/value.c b/value.c index eb01990..adf27f2 100644 --- a/value.c +++ b/value.c @@ -17,8 +17,8 @@ * received a copy with calc; if not, write to Free Software Foundation, Inc. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * - * @(#) $Revision: 30.4 $ - * @(#) $Id: value.c,v 30.4 2008/05/10 13:44:28 chongo Exp $ + * @(#) $Revision: 30.5 $ + * @(#) $Id: value.c,v 30.5 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/value.c,v $ * * Under source code control: 1990/02/15 01:48:25 @@ -1941,7 +1941,10 @@ powvalue(VALUE *v1, VALUE *v2, VALUE *vres) *vres = error_value(E_1OVER0); break; } - /* 0 ^ real non-neg is zero, 0 ^ complex is zero */ + /* + * 0 ^ real non-neg is zero + * 0 ^ complex is zero + */ vres->v_type = V_NUM; vres->v_num = qlink(&_qzero_); } diff --git a/value.h b/value.h index 1ce796a..b71857b 100644 --- a/value.h +++ b/value.h @@ -17,8 +17,8 @@ * 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: value.h,v 30.3 2007/07/10 21:18:08 chongo Exp $ + * @(#) $Revision: 30.4 $ + * @(#) $Id: value.h,v 30.4 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/value.h,v $ * * Under source code control: 1993/07/30 19:42:47 @@ -297,7 +297,8 @@ E_FUNC BOOL mattest(MATRIX *m); E_FUNC void matsum(MATRIX *m, VALUE *vres); E_FUNC BOOL matcmp(MATRIX *m1, MATRIX *m2); E_FUNC int matsearch(MATRIX *m, VALUE *vp, long start, long end, ZVALUE *index); -E_FUNC int matrsearch(MATRIX *m, VALUE *vp, long start, long end, ZVALUE *index); +E_FUNC int matrsearch(MATRIX *m, VALUE *vp, long start, long end, + ZVALUE *index); E_FUNC VALUE matdet(MATRIX *m); E_FUNC VALUE matdot(MATRIX *m1, MATRIX *m2); E_FUNC void matfill(MATRIX *m, VALUE *v1, VALUE *v2); @@ -344,7 +345,8 @@ E_FUNC void removelistmiddle(LIST *lp, long index, VALUE *vp); E_FUNC void listfree(LIST *lp); E_FUNC void listprint(LIST *lp, long max_print); E_FUNC int listsearch(LIST *lp, VALUE *vp, long start, long end, ZVALUE *index); -E_FUNC int listrsearch(LIST *lp, VALUE *vp, long start, long end, ZVALUE *index); +E_FUNC int listrsearch(LIST *lp, VALUE *vp, long start, long end, + ZVALUE *index); E_FUNC BOOL listcmp(LIST *lp1, LIST *lp2); E_FUNC VALUE *listfindex(LIST *lp, long index); E_FUNC LIST *listalloc(void); @@ -389,8 +391,10 @@ E_FUNC ASSOC *assocalloc(long initsize); E_FUNC ASSOC *assoccopy(ASSOC *ap); E_FUNC void assocfree(ASSOC *ap); E_FUNC void assocprint(ASSOC *ap, long max_print); -E_FUNC int assocsearch(ASSOC *ap, VALUE *vp, long start, long end, ZVALUE *index); -E_FUNC int assocrsearch(ASSOC *ap, VALUE *vp, long start, long end, ZVALUE *index); +E_FUNC int assocsearch(ASSOC *ap, VALUE *vp, long start, long end, + ZVALUE *index); +E_FUNC int assocrsearch(ASSOC *ap, VALUE *vp, long start, long end, + ZVALUE *index); E_FUNC BOOL assoccmp(ASSOC *ap1, ASSOC *ap2); E_FUNC VALUE *assocfindex(ASSOC *ap, long index); E_FUNC VALUE *associndex(ASSOC *ap, BOOL create, long dim, VALUE *indices); diff --git a/version.c b/version.c index 10f8fe4..3490f17 100644 --- a/version.c +++ b/version.c @@ -19,9 +19,9 @@ * 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.18 $ - * @(#) $Id: version.c,v 30.18 2013/08/11 01:14:26 chongo Exp $ - * @(#) $Source: /usr/local/src/cmd/calc/RCS/version.c,v $ + * @(#) $Revision: 30.19 $ + * @(#) $Id: version.c,v 30.19 2013/08/11 08:41:38 chongo Exp $ + * @(#) $Source: /usr/local/src/bin/calc/RCS/version.c,v $ * * Under source code control: 1990/05/22 11:00:58 * File existed as early as: 1990 @@ -49,7 +49,7 @@ static char *program; #define MAJOR_VER 2 /* major library version */ #define MINOR_VER 12 /* minor library version */ #define MAJOR_PATCH 4 /* major software level under library version */ -#define MINOR_PATCH 9 /* minor software level or 0 if not patched */ +#define MINOR_PATCH 10 /* minor software level or 0 if not patched */ /* diff --git a/zfunc.c b/zfunc.c index 940d495..97178af 100644 --- a/zfunc.c +++ b/zfunc.c @@ -19,8 +19,8 @@ * 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: zfunc.c,v 30.2 2008/02/24 07:41:49 chongo Exp $ + * @(#) $Revision: 30.3 $ + * @(#) $Id: zfunc.c,v 30.3 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/zfunc.c,v $ * * Under source code control: 1990/02/15 01:48:27 @@ -430,7 +430,8 @@ zjacobi(ZVALUE z1, ZVALUE z2) zshift(p, -lowbit, &tmp); zfree(p); p = tmp; - if ((lowbit & 1) && (((*q.v & 0x7) == 3) || ((*q.v & 0x7) == 5))) + if ((lowbit & 1) && (((*q.v & 0x7) == 3) || + ((*q.v & 0x7) == 5))) val = -val; } if (zisunit(p)) { @@ -2069,11 +2070,12 @@ zroot(ZVALUE z1, ZVALUE z2, ZVALUE *dest) i = zrel(ztry, quo); if (i <= 0) { /* - * Current try is less than or equal to the root since it is - * less than the quotient. If the quotient is equal to the try, - * we are all done. Also, if the try is equal to the old value, - * we are done since no improvement occurred. - * If not, save the improved value and loop some more. + * Current try is less than or equal to the root since + * it is less than the quotient. If the quotient is + * equal to the try, we are all done. Also, if the + * try is equal to the old value, we are done since + * no improvement occurred. If not, save the improved + * value and loop some more. */ if ((i == 0) || (zcmp(old, ztry) == 0)) { zfree(quo); diff --git a/zio.c b/zio.c index f5ac1b7..ceb39f2 100644 --- a/zio.c +++ b/zio.c @@ -17,8 +17,8 @@ * 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: zio.c,v 30.1 2007/03/16 11:09:46 chongo Exp $ + * @(#) $Revision: 30.2 $ + * @(#) $Id: zio.c,v 30.2 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/zio.c,v $ * * Under source code control: 1993/07/30 19:42:48 @@ -327,7 +327,8 @@ math_setmode2(int newmode) { int oldmode; - if (newmode != MODE2_OFF && ((newmode <= MODE_DEFAULT) || (newmode > MODE_MAX))) { + if (newmode != MODE2_OFF && ((newmode <= MODE_DEFAULT) || + (newmode > MODE_MAX))) { math_error("Setting illegal secondary output mode"); /*NOTREACHED*/ } @@ -620,7 +621,8 @@ zprintval(ZVALUE z, long decimals, long width) */ _tenpowers_[0] = _ten_; depth = 0; - while ((_tenpowers_[depth].len < z.len) || (zrel(_tenpowers_[depth], z) <= 0)) { + while ((_tenpowers_[depth].len < z.len) || + (zrel(_tenpowers_[depth], z) <= 0)) { depth++; if (_tenpowers_[depth].len == 0) { if (depth <= TEN_MAX) { diff --git a/zmath.h b/zmath.h index cf639c7..b12a40c 100644 --- a/zmath.h +++ b/zmath.h @@ -17,8 +17,8 @@ * 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: zmath.h,v 30.2 2007/07/05 13:30:38 chongo Exp $ + * @(#) $Revision: 30.3 $ + * @(#) $Id: zmath.h,v 30.3 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/zmath.h,v $ * * Under source code control: 1993/07/30 19:42:48 @@ -376,8 +376,10 @@ E_FUNC FULL zpprime(ZVALUE z); E_FUNC void zpfact(ZVALUE z, ZVALUE *dest); E_FUNC BOOL zprimetest(ZVALUE z, long count, ZVALUE skip); E_FUNC BOOL zredcprimetest(ZVALUE z, long count, ZVALUE skip); -E_FUNC BOOL znextcand(ZVALUE z1, long count, ZVALUE skip, ZVALUE res, ZVALUE mod, ZVALUE *cand); -E_FUNC BOOL zprevcand(ZVALUE z1, long count, ZVALUE skip, ZVALUE res, ZVALUE mod, ZVALUE *cand); +E_FUNC BOOL znextcand(ZVALUE z1, long count, ZVALUE skip, ZVALUE res, + ZVALUE mod, ZVALUE *cand); +E_FUNC BOOL zprevcand(ZVALUE z1, long count, ZVALUE skip, ZVALUE res, + ZVALUE mod, ZVALUE *cand); E_FUNC FULL zlowfactor(ZVALUE z, long count); E_FUNC FLAG zfactor(ZVALUE z1, ZVALUE z2, ZVALUE *res); E_FUNC long zpix(ZVALUE z1); @@ -447,7 +449,8 @@ E_FUNC void zredcpower(REDC *rp, ZVALUE z1, ZVALUE z2, ZVALUE *res); /* * zgtmaxfull(z) TRUE if abs(z) > MAXFULL */ -#define zgtmaxfull(z) (((z).len > 2) || (((z).len == 2) && (((SHALF)(z).v[1]) < 0))) +#define zgtmaxfull(z) (((z).len > 2) || (((z).len == 2) && \ + (((SHALF)(z).v[1]) < 0))) /* * zgtmaxufull(z) TRUE if abs(z) will not fit into a FULL (> MAXUFULL) @@ -467,7 +470,8 @@ E_FUNC void zredcpower(REDC *rp, ZVALUE z1, ZVALUE z2, ZVALUE *res); * zgtmaxlong(z) TRUE if abs(z) > MAXLONG */ #if BASEB >= LONG_BITS -#define zgtmaxlong(z) (((z).len > 1) || (((z).len == 1) && (((SHALF)(z).v[0]) < 0))) +#define zgtmaxlong(z) (((z).len > 1) || (((z).len == 1) && \ + (((SHALF)(z).v[0]) < 0))) #else #define zgtmaxlong(z) zgtmaxfull(z) #endif @@ -510,8 +514,10 @@ E_FUNC void zredcpower(REDC *rp, ZVALUE z1, ZVALUE z2, ZVALUE *res); #else #define zge16b(z) (!zistiny(z)) -#define zge24b(z) (((z).len > 2) || (((z).len == 2) && ((z).v[1] >= (HALF)0x100))) -#define zge31b(z) (((z).len > 2) || (((z).len == 2) && (((SHALF)(z).v[1]) < 0))) +#define zge24b(z) (((z).len > 2) || (((z).len == 2) && \ + ((z).v[1] >= (HALF)0x100))) +#define zge31b(z) (((z).len > 2) || (((z).len == 2) && \ + (((SHALF)(z).v[1]) < 0))) #define zge32b(z) ((z).len > 2) #define zge64b(z) ((z).len > 4) #define zge128b(z) ((z).len > 8) diff --git a/zprime.c b/zprime.c index 2995f82..7a83531 100644 --- a/zprime.c +++ b/zprime.c @@ -17,8 +17,8 @@ * 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: zprime.c,v 30.1 2007/03/16 11:09:46 chongo Exp $ + * @(#) $Revision: 30.2 $ + * @(#) $Id: zprime.c,v 30.2 2013/08/11 08:41:38 chongo Exp $ * @(#) $Source: /usr/local/src/bin/calc/RCS/zprime.c,v $ * * Under source code control: 1994/05/29 04:34:36 @@ -1206,7 +1206,8 @@ zredcprimetest(ZVALUE z, long count, ZVALUE skip) * cand candidate found */ BOOL -znextcand(ZVALUE z, long count, ZVALUE skip, ZVALUE res, ZVALUE mod, ZVALUE *cand) +znextcand(ZVALUE z, long count, ZVALUE skip, ZVALUE res, ZVALUE mod, + ZVALUE *cand) { ZVALUE tmp1; ZVALUE tmp2; @@ -1285,7 +1286,8 @@ znextcand(ZVALUE z, long count, ZVALUE skip, ZVALUE res, ZVALUE mod, ZVALUE *can * cand candidate found */ BOOL -zprevcand(ZVALUE z, long count, ZVALUE skip, ZVALUE res, ZVALUE mod, ZVALUE *cand) +zprevcand(ZVALUE z, long count, ZVALUE skip, ZVALUE res, ZVALUE mod, + ZVALUE *cand) { ZVALUE tmp1; ZVALUE tmp2; diff --git a/zrandom.c b/zrandom.c index 24cd6a0..d0bc4dc 100644 --- a/zrandom.c +++ b/zrandom.c @@ -17,9 +17,9 @@ * 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: zrandom.c,v 30.3 2013/08/11 01:08:32 chongo Exp $ - * @(#) $Source: /usr/local/src/cmd/calc/RCS/zrandom.c,v $ + * @(#) $Revision: 30.4 $ + * @(#) $Id: zrandom.c,v 30.4 2013/08/11 08:41:38 chongo Exp $ + * @(#) $Source: /usr/local/src/bin/calc/RCS/zrandom.c,v $ * * Under source code control: 1997/02/15 04:01:56 * File existed as early as: 1997 @@ -2063,15 +2063,16 @@ STATIC CONST HALF h_rvec19[] = { (HALF)0x8892, (HALF)0xc73d, (HALF)0xc3f4, (HALF)0xa635, (HALF)0x0cf9, (HALF)0x9b5d, (HALF)0x3fd9, (HALF)0x0ac7, (HALF)0xfefb, (HALF)0xe801, (HALF)0xffd2, (HALF)0xb31c, - (HALF)0xaa55, (HALF)0xf3ea, (HALF)0xfa23, (HALF)0x0e74, (HALF)0xb290, - (HALF)0x5414, (HALF)0x6101, (HALF)0x6d17, + (HALF)0xaa55, (HALF)0xf3ea, (HALF)0xfa23, (HALF)0x0e74, + (HALF)0xb290, (HALF)0x5414, (HALF)0x6101, (HALF)0x6d17, (HALF)0x93f8, (HALF)0x5229, (HALF)0x3dad, (HALF)0xf829, (HALF)0x1e82, (HALF)0x713b, (HALF)0xbef0, (HALF)0xb83b, (HALF)0xcc62, (HALF)0xd001, (HALF)0xda39, (HALF)0x7537, (HALF)0x158b, (HALF)0x7d80, (HALF)0xc8e2, (HALF)0x9332, (HALF)0xfa75, (HALF)0x6fa6, (HALF)0x6512, (HALF)0xe21f, (HALF)0x18b4, (HALF)0x9995, (HALF)0x605b, (HALF)0x2196, - (HALF)0x1798, (HALF)0xe4fc, (HALF)0xe245, (HALF)0x5f21, (HALF)0xf172, (HALF)0x0008 + (HALF)0x1798, (HALF)0xe4fc, (HALF)0xe245, (HALF)0x5f21, + (HALF)0xf172, (HALF)0x0008 }; STATIC CONST HALF h_nvec20[] = { (HALF)0xd081, (HALF)0xc3c1, (HALF)0x2fce, (HALF)0x4d26,