drygdryg/calc
1
0
Fork 0
mirror of https://github.com/lcn2/calc.git synced 2025-08-16 01:03:29 +03:00
Code Issues Packages Projects Releases Wiki Activity

Release calc version 2.12.4.10

Browse Source
This commit is contained in:
Landon Curt Noll
2013-08-11 02:13:25 -07:00
parent 7f125396c1
commit 17e3535595
70 changed files with 6874 additions and 628 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
BUGS
View File

@@ -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

26
CHANGES
View File

@@ -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 <czurnieden at gmx dot de> for this report.
Added a number of calc resource functions by
Added a number of calc resource files by
Christoph Zurnieden <czurnieden at gmx dot de> 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
<somos at harary dot math dot georgetown dot edu>
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

94
Makefile
View File

@@ -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

94
Makefile.simple
View File

@@ -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

10
alloc.h
View File

@@ -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

10
assocfunc.c
View File

@@ -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;

19
blkcpy.c
View File

@@ -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 */

7
byteswap.c
View File

@@ -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*/
}

34
cal/Makefile
View File

@@ -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

26
cal/alg_config.cal
View File

@@ -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);
}
/*

59
cal/bernpoly.cal Normal file
View File

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

257
cal/brentsolve.cal Normal file
View File

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

104
cal/constants.cal Normal file
View File

@@ -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<upperlimit){
k += ln(factor);
factor++;
}
epsilon(eps);
temp1 = 0;
ret = 1;
for(k=3;k<=factor;k++){
temp2 = temp1;
temp1 = ret;
ret = (k-1) *(temp1 + temp2);
}
ret = inverse( ret * inverse(factorial(factor) ) ) ;
__CZ__euler_mascheroni = ret;
__CZ__euler_mascheroni_prec = prec;
return ret;
}
/* Lupas' series */
static __CZ__catalan = 0;
static __CZ__catalan_prec = 0;
define G(){
local eps a s t n;
eps = epsilon(epsilon()*1e-10);
if(__CZ__catalan != 0 && __CZ__catalan >= log(1/eps))
return __CZ__catalan;
a = 1;
s = 0;
t = 1;
n = 1;
while(abs(t)> eps){
a *= 32 * n^3 * (2*n-1);
a /=((3-16*n+16*n^2)^2);
t = a * (-1)^(n-1) * (40*n^2-24*n+3) / (n^3 * (2*n-1));
s += t;
n += 1;
}
s = s/64;
__CZ__catalan = s;
__CZ__catalan_prec = log(1/eps);
epsilon(eps);
return s;
}
config("resource_debug", resource_debug_level),;
if (config("resource_debug") & 3) {
print "e()";
print "G()";
}

204
cal/factorial.cal Normal file
View File

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

723
cal/factorial2.cal Normal file
View File

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

288
cal/lambertw.cal Normal file
View File

@@ -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;k<limit;k++){
for(l=2;l<k;l++){
__CZ__Ws_a[k] += __CZ__Ws_c[l]*__CZ__Ws_c[k+1-l];
}
__CZ__Ws_c[k] = (k-1) * ( __CZ__Ws_c[k-2]/2
+__CZ__Ws_a[k-2]/4)/
(k+1)-__CZ__Ws_a[k]/2-__CZ__Ws_c[k-1]/(k+1);
tmp = __CZ__Ws_c[k] * PP;
sum += tmp;
if(abs(tmp) <= eps){
epsilon(epslocal);
return sum;
}
PP *= P;
}
epsilon(epslocal);
return
newerror(strcat("lambertw_series: does not converge in ",
str(limit)," terms" ));
}
/* */
define lambertw(z,branch){
local eps epslarge ret branchpoint bparea w we ew w1e wn k places m1e;
local closeness;
eps = epsilon();
if(branch == 0){
if(!im(z)){
if(abs(z) <= eps) return 0;
if(abs(z-exp(1)) <= eps) return 1;
if(abs(z - (-ln(2)/2)) <= eps ) return -ln(2);
if(abs(z - (-pi()/2)) <= eps ) return 1i*pi()/2;
}
}
branchpoint = -exp(-1);
bparea = .2;
if(branch == 0){
if(!im(z) && abs(z-branchpoint) == 0) return -1;
ret = __CZ__lambertw_0(z,eps);
/* Yeah, C&P, I know, sorry */
##ret = ln(z) + 2*pi()*1i*branch - ln(ln(z)+2*pi()*1i*branch);
}
else if(branch == 1){
if(im(z)<0 && abs(z-branchpoint) <= bparea)
ret = __CZ__lambertw_app(z,eps);
/* Does calc have a goto? Oh, it does! */
ret =ln(z) + 2*pi()*1i*branch - ln(ln(z)+2*pi()*1i*branch);
}
else if(branch == -1){##print "-1";
if(!im(z) && abs(z-branchpoint) == 0) return -1;
if(!im(z) && z>branchpoint && z < 0){##print "0";
ret = __CZ__lambertw_m1(z,eps);}
if(im(z)>=0 && abs(z-branchpoint) <= bparea){##print "1";
ret = __CZ__lambertw_app(z,eps);}
ret =ln(z) + 2*pi()*1i*branch - ln(ln(z)+2*pi()*1i*branch);
}
else
ret = ln(z) + 2*pi()*1i*branch - ln(ln(z)+2*pi()*1i*branch);
/*
Such a high precision is only needed _very_ close to the branchpoint
and might even be insufficient if z has not been computed with
sufficient precision itself (M below was calculated by Mathematica and also
with the series above with epsilon(1e-200)):
; epsilon(1e-50)
0.00000000000000000001
; display(50)
20
; M=-0.9999999999999999999999997668356018402875796636464119050387
; lambertw(-exp(-1)+1e-50,0)-M
-0.00000000000000000000000002678416515423276355643684
; epsilon(1e-60)
0.0000000000000000000000000000000000000000000000000
; A=-exp(-1)+1e-50
; epsilon(1e-50)
0.00000000000000000000000000000000000000000000000000
; lambertw(A,0)-M
-0.00000000000000000000000000000000000231185460220585
; lambertw_series(A,epsilon(),0)-M
-0.00000000000000000000000000000000000132145133161626
; epsilon(1e-100)
0.00000000000000000000000000000000000000000000000001
; A=-exp(-1)+1e-50
; epsilon(1e-65)
0.00000000000000000000000000000000000000000000000000
; lambertw_series(A,epsilon(),0)-M
0.00000000000000000000000000000000000000000000000000
; lambertw_series(-exp(-1)+1e-50,epsilon(),0)-M
-0.00000000000000000000000000000000000000002959444084
; epsilon(1e-74)
0.00000000000000000000000000000000000000000000000000
; lambertw_series(-exp(-1)+1e-50,epsilon(),0)-M
-0.00000000000000000000000000000000000000000000000006
*/
closeness = abs(z-branchpoint);
if( closeness< 1){
if(closeness != 0)
eps = epsilon(epsilon()*( closeness));
else
eps = epsilon(epsilon()^2);
}
else
eps = epsilon(epsilon()*1e-2);
epslarge =epsilon();
places = highbit(1 + int(1/epslarge)) + 1;
w = ret;
for(k=0;k<100;k++){
ew = exp(w);
we = w*ew;
if(abs(we-z)<= 4*epslarge*abs(z))break;
w1e = (1+w)*ew;
wn = bround(w- ((we - z) / ( w1e - ( (w+2)*(we-z) )/(2*w+2) ) ),places++) ;
if( abs(wn - w) <= epslarge*abs(wn)) break;
else w = wn;
}
if(k==100){
epsilon(eps);
return newerror("lambertw: Halley iteration does not converge");
}
/* The Maxima coders added a check if the iteration converged to the correct
branch. This coder deems it superfluous. */
epsilon(eps);
return wn;
}
config("resource_debug", resource_debug_level),;
if (config("resource_debug") & 3) {
print "lambertw(z,branch)";
print "lambertw_series(z,eps,branch,terms)";
print "lambertw_series_print()";
}

112
cal/lnseries.cal Normal file
View File

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

7
cal/quat.cal
View File

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

23
cal/regress.cal
View File

@@ -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 */

7
cal/solve.cal
View File

@@ -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);

1394
cal/specialfunctions.cal Normal file
View File

File diff suppressed because it is too large Load Diff

502
cal/statistics.cal Normal file
View File

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

16
cal/test2600.cal
View File

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

7
cal/test2700.cal
View File

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

10
cal/test4000.cal
View File

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

8
cal/test8500.cal
View File

@@ -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)
{

1641
cal/test8900.cal Normal file
View File

File diff suppressed because it is too large Load Diff

362
cal/toomcook.cal Normal file
View File

@@ -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);
/*
Cut-off at about 4,000 dec. digits
TODO: check
*/
if(isdefined("test8900")){
if(m < 20) return a*b;
}
else{
if(m < 4096 ) return a*b;
}
a = abs(a);
b = abs(b);
a0 = a & mask;
a1 = (a>>m) & mask;
a2 = (a>>(2*m));
b0 = b & mask;
b1 = (b>>m) & mask;
b2 = (b>>(2*m));
/*
Zimmermann
*/
S0 = toomcook3(a0 , b0);
S1 = toomcook3((a2+a1+a0) , (b2+b1+b0));
S2 = toomcook3(((a2<<2)+(a1<<1)+a0) , ((b2<<2)+(b1<<1)+b0));
S3 = toomcook3((a2-a1+a0) , (b2-b1+b0));
S4 = toomcook3(a2,b2);
T1 = (S3<<1) + S2;
T1 /= 3;
T1 += S0;
T1 >>= 1;
T1 -= S4<<1;
T2 = (S1 + S3)>>1;
S1 -= T1;
S2 = T2 - S0 - S4;
S3 = T1 - T2;
ret = (S4<<(4*m)) + (S3<<(3*m)) + (S2<<(2*m)) + (S1<<(1*m)) + S0;
ret = sign *ret;
return ret;
}
define toomcook3square(a){
local alen a0 a1 a2 m tmp tmp2 ret sign S0 S1 S2 S3 S4 T1 mask;
if(!isint(a))return newerror("toomcook3square(a): a is not integer");
alen = digits(a,2);
sign = sgn(a) * sgn(a);
if(sign == 0) return 0;
m = alen//3;
mask = ~-(1<<m);
/*
Cut-off at about 5,000 dec. digits
TODO: check
*/
if(isdefined("test8900")){
if(m < 20) return a^2;
}
else{
if(m < 5000 ) return a^2;
}
a = abs(a);
a0 = a & mask;
a1 = (a>>m) & mask;
a2 = (a>>(2*m));
/*
Bodrato/Zanoni
*/
S0 = toomcook3square(a0);
S1 = toomcook3square(a2+a1+a0);
S2 = toomcook3square(a2-a1+a0);
S3 = toomcook3(a1<<1,a2);
S4 = toomcook3square(a2);
T1 = (S1 + S2)>>1;
S1 = S1 - T1 - S3;
S2 = T1 - S4 -S0;
S1 = S1<<(1*m);
S2 = S2<<(2*m);
S3 = S3<<(3*m);
S4 = S4<<(4*m);
ret = S0 + S1 + S2 + S3 + S4;
ret = sign *ret;
return ret;
}
define toomcook4(a,b)
{
local a0 a1 a2 a3 b0 b1 b2 b3 b4 ret tmp tmp2 tmp3 sign;
local m alen blen mask;
local w1, w2, w3, w4, w5, w6, w7;
if(!isint(a) || !isint(b))
return newerror("toomcook4(a,b): a and/or b is not integer");
alen = digits(a,2);
blen = digits(b,2);
sign = sgn(a) * sgn(b);
if(sign == 0) return 0;
m = min(alen//4,blen//4);
mask = ~-(1<<m);
if(isdefined("test8900")){
if(m < 100) return toomcook3(a,b);
}
else{
if(m < 256*3072) return toomcook3(a,b);
}
a = abs(a);
b = abs(b);
a0 = a & mask;
a1 = (a>>m) & mask;
a2 = (a>>(2*m)) & mask;
a3 = (a>>(3*m));
b0 = b & mask;
b1 = (b>>m) & mask;
b2 = (b>>(2*m)) & mask;
b3 = (b>>(3*m));
/*
Bodrato / Zanoni
*/
w3 = a3 + (a1 + (a2 + a0));
w7 = b3 + (b1 + (b2 + b0));
w4 = -a3 + (-a1 + (a2 + a0));
w5 = -b3 + (-b1 + (b2 + b0));
w3 = toomcook4(w3, w7);
w4 = toomcook4(w4, w5);
w5 = a3 + ((a1<<2) + ((a2<<1) + (a0<<3)));
w2 = b3 + ((b1<<2) + ((b2<<1) + (b0<<3)));
w6 = -a3 + (-(a1<<2) + ((a2<<1) + (a0<<3)));
w7 = -b3 + (-(b1<<2) + ((b2<<1) + (b0<<3)));
w5 = toomcook4(w5, w2);
w6 = toomcook4(w6, w7);
w2 = (a3<<3) + ((a1<<1) + ((a2<<2) + a0));
w7 = (b3<<3) + ((b1<<1) + ((b2<<2) + b0));
w2 = toomcook4(w2, w7);
w1 = toomcook4(a3, b3);
w7 = toomcook4(a0, b0);
w2 = w2 + w5;
w6 = w5 - w6;
w4 = w3 - w4;
w5 = w5 - w1;
w5 -= w7 << 6;
w4 = w4>>1;
w3 = w3 - w4;
w5 = w5<<1;
w5 = w5 - w6;
w2 -= w3 * 65;
w3 = w3 - w7;
w3 = w3 - w1;
w2 += w3 * 45;
w5 -= w3<<3;
w5 = w5//24;
w6 = w6 - w2;
w2 -= w4<<4;
w2 = w2//18;
w3 = w3 - w5;
w4 = w4 - w2;
w6 += w2 * 30;
w6 = w6//60;
w2 = w2 - w6;
ret = w7 + (w6<<m) + (w5<<(2*m)) + (w4<<(3*m))+ (w3<<(4*m))+
(w2<<(5*m))+ (w1<<(6*m));
ret = sign *ret;
return ret;
}
define toomcook4square(a){
local a0 a1 a2 a3 ret S0 S1 S2 S3 S4 S5 S6 S7 tmp tmp2 tmp3;
local sign m alen mask;
local T0 T1 T2 T3 T4 T5 T6 T7 T8;
if(!isint(a) )return newerror("toomcook3square(a): a is not integer");
alen = digits(a,2);
sign = sgn(a) * sgn(a);
/* sgn(x) returns 0 if x = 0 */
if(sign == 0) return 0;
m = (alen)//4;
mask = ~-( 1 << m );
/*
cut-off at about 2 mio. dec. digits
TODO: check!
*/
if(isdefined("test8900")){
if(m < 100) return toomcook3square(a);
}
else{
if(m < 512*3072) return toomcook3square(a);
}
a = abs(a);
a0 = a & mask;
a1 = (a>>m) & mask;
a2 = (a>>(2*m)) & mask;
a3 = (a>>(3*m)) ;
/*
Bodrato / Zanoni
*/
S1 = toomcook4square(a0);
S2 = toomcook4(a0<<1,a1);
S3 = toomcook4((a0 + a1 - a2 - a3 ) , (a0 - a1 - a2 + a3 ));
S4 = toomcook4square(a0 + a1 + a2 + a3 );
S5 = toomcook4( (a0 - a2 )<<1 , (a1 - a3 ));
S6 = toomcook4(a3<<1 , a2);
S7 = toomcook4square(a3);
T1 = S3 + S4;
T2 = (T1 + S5 )>>1;
T3 = S2 + S6;
T4 = T2 - T3;
T5 = T3 - S5;
T6 = T4 - S3;
T7 = T4 - S1;
T8 = T6 - S7;
ret = (S7<<(6*m)) + (S6<<(5*m)) + (T7<<(4*m))
+ (T5<<(3*m)) + (T8<<(2*m)) + (S2<<(1*m)) + S1;
ret = sign *ret;
return ret;
}
/*
TODO: Implement the asymmetric variations
*/
/*
produce_long_random_number(n) returns large pseudorandom numbers. Really large
numbers, e.g.:
produce_long_random_number(16)
is ca 4,128,561 bits (ca 1,242,821 dec. digits) large. Exact length is not
predeterminable because of the chaotic output of the function random().
*/
define __CZ__produce_long_random_number(n)
{
local ret k;
ret = 1;
if(!isint(n) || n<1)
return newerror("__CZ__produce_long_random_number(n): "
"n is not an integer >=1");
for(k=0;k<n;k++){
ret += random();
ret = toomcook4square(ret);
}
return ret;
}
/*
* restore internal function from resource debugging
* report important interface functions
*/
config("resource_debug", resource_debug_level),;
if (config("resource_debug") & 3) {
print "toomcook3(a,b)";
print "toomcook3square(a)";
print "toomcook4(a,b)";
print "toomcook4square(a)";
}

114
cal/zeta2.cal Normal file
View File

@@ -0,0 +1,114 @@
/*
* zeta2 - Hurwitz Zeta function
* Copyright (C) 2013 Christoph Zurnieden
* Version: 0.0.1
* Licence: GPL
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* This program 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 General Public License for more details.
*
* @(#) $Revision: 30.3 $
* @(#) $Id: zeta2.cal,v 30.3 2013/08/11 08:41:38 chongo Exp $
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/zeta2.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 hurwitzzeta(s,a){
local realpart_a imagpart_s tmp tmp1 tmp2 tmp3;
local sum1 sum2 sum3 i k n precision result limit;
local limit_function offset offset_squared rest_sum eps;
/*
According to Linas Vepstas' "An efficient algorithm for accelerating
the convergence of oscillatory series, useful for computing the
polylogarithm and Hurwitz zeta functions" the Euler-Maclaurin series
is the fastest in most cases.
With a lot of help of the PARI/GP implementation by Prof. Henri Cohen,
hence the different license.
*/
eps=epsilon( epsilon() * 1e-3);
realpart_a=re(a);
if(realpart_a>1.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)";
}

10
calc.h
View File

@@ -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);

12
calc.man
View File

@@ -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

45
calc.spec.in
View File

@@ -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

39
codegen.c
View File

@@ -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)

13
config.c
View File

@@ -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);

11
cscript/Makefile
View File

@@ -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

12
custom/Makefile
View File

@@ -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

6
custom/Makefile.head
View File

@@ -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

12
custom/Makefile.simple
View File

@@ -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

6
custom/Makefile.tail
View File

@@ -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

265
custom/c_sysinfo.c
View File

@@ -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}

10
custom/pmodm127.cal
View File

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

7
decl.h
View File

@@ -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

13
file.c
View File

@@ -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 */

7
file.h
View File

@@ -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__ */

58
func.c
View File

@@ -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;

7
hash.c
View File

@@ -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++) {

7
have_posscl.c
View File

@@ -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;

16
have_stdvs.c
View File

@@ -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 <stdarg.h> */");
puts("#define SIMULATE_STDARG "
"/* use std_arg.h to simulate <stdarg.h> */");
#else
puts("#define STDARG /* use <stdarg.h> */");
puts("#include <stdarg.h>");

7
have_varvs.c
View File

@@ -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

2
help/errorcodes.sed
View File

@@ -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

11
help/fpathopen
View File

@@ -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

15
help/obj.file
View 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

18
input.c
View File

@@ -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)

13
longbits.c
View File

@@ -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

142
obj.c
View File

@@ -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;

403
opcodes.c
View File

@@ -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 */
};

10
qmath.c
View File

@@ -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))

7
qmath.h
View File

@@ -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);

10
rpm.mk
View File

@@ -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

13
str.c
View File

@@ -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;

7
symbol.c
View File

@@ -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)
/*

22
token.h
View File

@@ -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 */

9
value.c
View File

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

16
value.h
View File

@@ -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);

8
version.c
View File

@@ -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 */
/*

18
zfunc.c
View File

@@ -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);

10
zio.c
View File

@@ -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) {

22
zmath.h
View File

@@ -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)

10
zprime.c
View File

@@ -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;

13
zrandom.c
View File

@@ -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,