summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2011-12-09 22:25:51 -0800
committerKaz Kylheku <kaz@kylheku.com>2011-12-09 22:25:51 -0800
commit236a20e92316535bc75dde63d51431875e253bfb (patch)
tree6ec4fb84a27cb311027495db9d3c34b791fe207e
parentb1088a2502cba1a61b862f708489c8d4baa722fe (diff)
downloadtxr-236a20e92316535bc75dde63d51431875e253bfb.tar.gz
txr-236a20e92316535bc75dde63d51431875e253bfb.tar.bz2
txr-236a20e92316535bc75dde63d51431875e253bfb.zip
Bignum support, here we go!
Bignums, based on Michael Fromberger's MPI library, are integrated into the input syntax, stream output, equality testing, the garbage collector, and hashing. The plus operation handles transitions between fixnums and bignums. Other operations are still fixnum only. * Makefile (CFLAGS): Add mpi directory to include file search. (OBJS): Include new arith.o module and all of MPI_OBJS. (MPI_OBJS, MPI_OBJS_BASE): New variables. * configure (mpi_version, have_quilt, have_patch): New variables. Script detects whether patch and quilt are available. Unpacks mpi library, applies patches. Detects 128 bit integer type. Records more information in config.h about the sizes of types. * dep.mk: Updated. * depend.txr: Make work with paths that have directory components. * eval.c (eval_init): Rename of nump to fixnump. * gc.c (finalize, mark_obj): Handle BGNUM case. * hash.c: (hash_c_str): Changed to return unsigned long instead of long. (equal_hash): Handle BGNUM case. (eql_hash): Handle bignums with equal-hash, but other objects as eq. * lib.c (num_s): Variable renamed to fixnum_s. (bignum_s): New symbol variable. (code2type): Follow rename of num_s. Handle BGNUM case. (typeof): Follow rename of num_s. (eql): Handle bignums using equal, and other types using eq. (equal): Handle BGNUM case. (chk_calloc): New function. (c_num): Wording change in error message: is not a fixnum. (nump): Renamed to fixnump. (bignump): New function. (plus): Function removed, reimplemented in arith.c. (int_str): Handle integers which are too large for wcstol using bignum conversion. Base 0 is no longer passed to wcstol but converted to 10 because the special semantics for 0 would be inconsistent for bignums. (obj_init): Follow rename of num_s. Initialize bignum_s.
-rw-r--r--ChangeLog100
-rw-r--r--Makefile14
-rw-r--r--arith.c139
-rw-r--r--arith.h28
-rwxr-xr-xconfigure183
-rw-r--r--dep.mk31
-rw-r--r--depend.txr11
-rw-r--r--eval.c2
-rw-r--r--gc.c4
-rw-r--r--hash.c18
-rw-r--r--lib.c70
-rw-r--r--lib.h24
-rw-r--r--match.c54
-rw-r--r--mpi-1.8.6.tar.gzbin0 -> 154702 bytes
-rw-r--r--mpi-patches/add-mp-hash48
-rw-r--r--mpi-patches/add-mp-set-intptr77
-rw-r--r--mpi-patches/add-mpi-toradix-with-case54
-rw-r--r--mpi-patches/config-types120
-rw-r--r--mpi-patches/export-mp-eq34
-rw-r--r--mpi-patches/fix-mult-bug13
-rw-r--r--mpi-patches/fix-warnings61
-rw-r--r--mpi-patches/series8
-rw-r--r--mpi-patches/use-txr-allocator70
-rw-r--r--parser.l35
-rw-r--r--parser.y7
-rw-r--r--stream.c72
26 files changed, 1140 insertions, 137 deletions
diff --git a/ChangeLog b/ChangeLog
index 640a7530..3b4c03e3 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,103 @@
+2011-12-09 Kaz Kylheku <kaz@kylheku.com>
+
+ Bignum support, here we go!
+
+ Bignums, based on Michael Fromberger's MPI library, are integrated
+ into the input syntax, stream output, equality testing, the garbage
+ collector, and hashing.
+
+ The plus operation handles transitions between fixnums and bignums.
+ Other operations are still fixnum only.
+
+ * Makefile (CFLAGS): Add mpi directory to include file search.
+ (OBJS): Include new arith.o module and all of MPI_OBJS.
+ (MPI_OBJS, MPI_OBJS_BASE): New variables.
+
+ * configure (mpi_version, have_quilt, have_patch): New variables.
+ Script detects whether patch and quilt are available. Unpacks
+ mpi library, applies patches. Detects 128 bit integer type.
+ Records more information in config.h about the sizes of types.
+
+ * dep.mk: Updated.
+
+ * depend.txr: Make work with paths that have directory components.
+
+ * eval.c (eval_init): Rename of nump to fixnump.
+
+ * gc.c (finalize, mark_obj): Handle BGNUM case.
+
+ * hash.c: (hash_c_str): Changed to return unsigned long
+ instead of long.
+ (equal_hash): Handle BGNUM case.
+ (eql_hash): Handle bignums with equal-hash, but other
+ objects as eq.
+
+ * lib.c (num_s): Variable renamed to fixnum_s.
+ (bignum_s): New symbol variable.
+ (code2type): Follow rename of num_s. Handle BGNUM case.
+ (typeof): Follow rename of num_s.
+ (eql): Handle bignums using equal, and other types using eq.
+ (equal): Handle BGNUM case.
+ (chk_calloc): New function.
+ (c_num): Wording change in error message: is not a fixnum.
+ (nump): Renamed to fixnump.
+ (bignump): New function.
+ (plus): Function removed, reimplemented in arith.c.
+ (int_str): Handle integers which are too large for wcstol
+ using bignum conversion. Base 0 is no longer passed to
+ wcstol but converted to 10 because the special semantics
+ for 0 would be inconsistent for bignums.
+ (obj_init): Follow rename of num_s. Initialize bignum_s.
+ (obj_print, obj_pprint): Handle BGNUM.
+ (init): Call arith_init.
+
+ * lib.h: Includes "mpi.h", as an exception to the project rule against
+ headers including headers.
+ (enum type): New enumeration member, BGNUM.
+ (struct bignum): New struct type.
+ (union obj): New member bn.
+ (mp): New inline function.
+ (num_s): Redeclared as fixnum_s.
+ (bignum_s, chk_calloc, bignump): Declared.
+ (nump): Redeclared as fixnump.
+
+ * match.c (h_var, h_line, h_skip, h_coll, h_fun, format_field, v_skip,
+ v_freeform, v_collect, v_match_files): Follow nump to fixnump rename.
+
+ * parser.l (NUM): New token type. Split up the parsing of identifiers
+ and numbers once again. But since every number is also lexically also
+ lexically an identifier, we put the action first. The action for
+ making numbers handles bignums. It produces object numbers, not
+ C numbers (change in yystype union).
+
+ * parser.y (%union): num changes type from cnum to val.
+
+ * stream.c (vformat): Handle bignums in numeric conversions.
+
+ * arith.c: New file.
+
+ * arith.h: New file.
+
+ * mpi-1.8.6.tar.gz: New file.
+
+ * mpi-patches/add-mp-hash: New file.
+
+ * mpi-patches/add-mp-set-intptr: New file.
+
+ * mpi-patches/add-mpi-toradix-with-case: New file.
+
+ * mpi-patches/config-types: New file.
+
+ * mpi-patches/export-mp-eq: New file.
+
+ * mpi-patches/fix-mult-bug: New file.
+
+ * mpi-patches/fix-warnings: New file.
+
+ * mpi-patches/series: New file.
+
+ * mpi-patches/use-txr-allocator: New file.
+
2011-12-08 Kaz Kylheku <kaz@kylheku.com>
C++ maintenance.
diff --git a/Makefile b/Makefile
index 3f74ec64..3d850f40 100644
--- a/Makefile
+++ b/Makefile
@@ -30,14 +30,23 @@ include config.make
CFLAGS := -I. -I$(top_srcdir) $(LANG_FLAGS) $(DIAG_FLAGS) \
$(OPT_FLAGS) $(DBG_FLAGS) $(PLATFORM_FLAGS)
+CFLAGS += -I$(top_srcdir)/mpi-$(mpi_version)
CFLAGS := $(filter-out $(REMOVE_FLAGS),$(CFLAGS))
ifneq ($(subst g++,@,$(notdir $(CC))),$(notdir $(CC)))
CFLAGS := $(filter-out -Wmissing-prototypes -Wstrict-prototypes,$(CFLAGS))
endif
+# TXR objects
OBJS := txr.o lex.yy.o y.tab.o match.o lib.o regex.o gc.o unwind.o stream.o
-OBJS += hash.o utf8.o filter.o debug.o eval.o
+OBJS += arith.o hash.o utf8.o filter.o debug.o eval.o
+
+# MPI objects
+MPI_OBJ_BASE=mpi.o mplogic.o
+
+MPI_OBJS := $(addprefix mpi-$(mpi_version)/,$(MPI_OBJ_BASE))
+
+OBJS += $(MPI_OBJS)
PROG := ./txr
@@ -58,6 +67,9 @@ y.tab.c y.tab.h: parser.y
# Bison-generated parser also tests for this lint define.
y.tab.o: CFLAGS += -Dlint
+$(MPI_OBJS): CFLAGS += -DXMALLOC=chk_malloc -DXREALLOC=chk_realloc
+$(MPI_OBJS): CFLAGS += -DXCALLOC=chk_calloc -DXFREE=free
+
.PHONY: rebuild
rebuild: clean $(PROG)
diff --git a/arith.c b/arith.c
new file mode 100644
index 00000000..a1026b37
--- /dev/null
+++ b/arith.c
@@ -0,0 +1,139 @@
+/* Copyright 2011
+ * Kaz Kylheku <kaz@kylheku.com>
+ * Vancouver, Canada
+ * All rights reserved.
+ *
+ * BSD License:
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in
+ * the documentation and/or other materials provided with the
+ * distribution.
+ * 3. The name of the author may not be used to endorse or promote
+ * products derived from this software without specific prior
+ * written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
+ * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+ */
+
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <wctype.h>
+#include <assert.h>
+#include <limits.h>
+#include <stdarg.h>
+#include <dirent.h>
+#include <setjmp.h>
+#include <wchar.h>
+#include "config.h"
+#include "lib.h"
+#include "unwind.h"
+#include "gc.h"
+#include "arith.h"
+
+#define TAG_PAIR(A, B) ((A) << TAG_SHIFT | (B))
+
+static mp_int NUM_MAX_MP;
+
+val make_bignum(void)
+{
+ val n = make_obj();
+ n->bn.type = BGNUM;
+ mp_init(&n->bn.mp);
+ return n;
+}
+
+static val normalize(val bignum)
+{
+ switch (mp_cmp_mag(mp(bignum), &NUM_MAX_MP)) {
+ case MP_EQ:
+ case MP_GT:
+ return bignum;
+ default:
+ {
+ cnum fixnum;
+ mp_get_intptr(mp(bignum), &fixnum);
+ return num(fixnum);
+ }
+ }
+}
+
+val plus(val anum, val bnum)
+{
+ int tag_a = tag(anum);
+ int tag_b = tag(bnum);
+
+ switch (TAG_PAIR(tag_a, tag_b)) {
+ case TAG_PAIR(TAG_NUM, TAG_NUM):
+ {
+ cnum a = c_num(anum);
+ cnum b = c_num(bnum);
+ cnum sum = a + b;
+
+ if (sum < NUM_MIN || sum > NUM_MAX) {
+ val n = make_bignum();
+ mp_set_intptr(mp(n), sum);
+ return n;
+ }
+
+ return num(sum);
+ }
+ case TAG_PAIR(TAG_NUM, TAG_PTR):
+ {
+ val n;
+ type_check(bnum, BGNUM);
+ n = make_bignum();
+ if (sizeof (int_ptr_t) <= sizeof (mp_digit)) {
+ mp_add_d(mp(bnum), c_num(anum), mp(n));
+ } else {
+ mp_int tmp;
+ mp_init(&tmp);
+ mp_set_intptr(&tmp, c_num(anum));
+ mp_add(mp(bnum), &tmp, mp(n));
+ }
+ return normalize(n);
+ }
+ case TAG_PAIR(TAG_PTR, TAG_NUM):
+ {
+ val n;
+ type_check(anum, BGNUM);
+ n = make_bignum();
+ if (sizeof (int_ptr_t) <= sizeof (mp_digit)) {
+ mp_add_d(mp(anum), c_num(bnum), mp(n));
+ } else {
+ mp_int tmp;
+ mp_init(&tmp);
+ mp_set_intptr(&tmp, c_num(bnum));
+ mp_add(mp(anum), &tmp, mp(n));
+ }
+ return normalize(n);
+ }
+ case TAG_PAIR(TAG_PTR, TAG_PTR):
+ {
+ val n;
+ type_check(anum, BGNUM);
+ type_check(bnum, BGNUM);
+ n = make_bignum();
+ mp_add(mp(anum), mp(bnum), mp(n));
+ return normalize(n);
+ }
+ }
+ uw_throwf(error_s, lit("plus: invalid operands ~s ~s"), anum, bnum, nao);
+ abort();
+}
+
+void arith_init(void)
+{
+ mp_init(&NUM_MAX_MP);
+ mp_set_intptr(&NUM_MAX_MP, NUM_MAX);
+}
diff --git a/arith.h b/arith.h
new file mode 100644
index 00000000..ba8fd958
--- /dev/null
+++ b/arith.h
@@ -0,0 +1,28 @@
+/* Copyright 2011
+ * Kaz Kylheku <kaz@kylheku.com>
+ * Vancouver, Canada
+ * All rights reserved.
+ *
+ * BSD License:
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in
+ * the documentation and/or other materials provided with the
+ * distribution.
+ * 3. The name of the author may not be used to endorse or promote
+ * products derived from this software without specific prior
+ * written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
+ * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+ */
+
+val make_bignum(void);
+void arith_init(void);
diff --git a/configure b/configure
index 0c8a0e7e..d961b59f 100755
--- a/configure
+++ b/configure
@@ -136,6 +136,9 @@ txr_dbg_opts=${txr_dbg_opts---gc-debug}
valgrind=${valgrind-}
lit_align=${lit_align-}
extra_debugging=${extra_debugging-}
+mpi_version=1.8.6
+have_quilt=
+have_patch=
#
# If --help was given (or --help=<nonempty> or help=<nonempty>) then
@@ -476,10 +479,10 @@ case "$top_srcdir" in
esac
if [ "$source_dir" != "." ] ; then
- printf "symlinking Makefile -> $source_dir/Makefile\n"
+ printf "Symlinking Makefile -> $source_dir/Makefile\n"
ln -sf "$source_dir/Makefile" .
else
- printf "warning: its recommended to build in a separate directory\n"
+ printf "Warning: its recommended to build in a separate directory\n"
fi
gen_config_make()
@@ -527,6 +530,9 @@ compiler_prefix := $compiler_prefix
# prefix for non-compiler toolchain commands
tool_prefix := $tool_prefix
+# MPI version
+mpi_version := $mpi_version
+
CC := $cc
LEX := $lex
LEXLIB := $lexlib
@@ -548,7 +554,7 @@ TXR_DBG_OPTS := $txr_dbg_opts
# Before doing some other tests, we need a config.make
#
-printf "generating config.make ... "
+printf "Generating config.make ... "
gen_config_make
printf "\n"
@@ -616,17 +622,83 @@ else
printf "none\n"
fi
+printf "Checking what C type we have for unsigned integers wider than \"long\" ... "
+
+for try_type in uint64 __uint64 "unsigned long long" ; do
+ cat > conftest.c <<!
+$try_type value;
+!
+ rm -f conftest.o
+ if make conftest.o > conftest.err 2>&1 ; then
+ ulonglong=$try_type
+ break
+ fi
+done
+
+if [ -n "$ulonglong" ] ; then
+ printf '"%s"\n' "$ulonglong"
+ printf "#define HAVE_ULONGLONG_T 1\n" >> config.h
+ printf "typedef $ulonglong ulonglong_t;\n" >> config.h
+else
+ printf "none\n"
+fi
+
+printf "Checking what C type we have for integers wider than \"long long\" ... "
+
+for try_type in int128 int128_t __int128 __int128_t ; do
+ cat > conftest.c <<!
+$try_type value;
+!
+ rm -f conftest.o
+ if make conftest.o > conftest.err 2>&1 ; then
+ superlong=$try_type
+ break
+ fi
+done
+
+if [ -n "$superlong" ] ; then
+ printf '"%s"\n' "$superlong"
+ printf "#define HAVE_SUPERLONG_T 1\n" >> config.h
+ printf "typedef $superlong superlong_t;\n" >> config.h
+else
+ printf "none\n"
+fi
+
+printf "Checking what C type we have for u. integers wider than \"long long\" ... "
+
+for try_type in uint128 uint128_t __uint128 __uint128_t ; do
+ cat > conftest.c <<!
+$try_type value;
+!
+ rm -f conftest.o
+ if make conftest.o > conftest.err 2>&1 ; then
+ usuperlong=$try_type
+ break
+ fi
+done
+
+if [ -n "$usuperlong" ] ; then
+ printf '"%s"\n' "$usuperlong"
+ printf "#define HAVE_USUPERLONG_T 1\n" >> config.h
+ printf "typedef $usuperlong usuperlong_t;\n" >> config.h
+else
+ printf "none\n"
+fi
+
printf "Checking what C integer type can hold a pointer ... "
if [ -z "$intptr" ] ; then
cat > conftest.c <<!
#include "config.h"
-char sizeof_ptr[sizeof (char *)];
-char sizeof_short[sizeof (short)];
-char sizeof_int[sizeof (int)];
-char sizeof_long[sizeof (long)];
+char SIZEOF_PTR[sizeof (char *)];
+char SIZEOF_SHORT[sizeof (short)];
+char SIZEOF_INT[sizeof (int)];
+char SIZEOF_LONG[sizeof (long)];
#ifdef HAVE_LONGLONG_T
-char sizeof_longlong_t[sizeof (longlong_t)];
+char SIZEOF_LONGLONG_T[sizeof (longlong_t)];
+#endif
+#ifdef HAVE_SUPERLONG_T
+char SIZEOF_SUPERLONG_T[sizeof (superlong_t)];
#endif
!
rm -f conftest.o conftest.syms
@@ -639,11 +711,12 @@ char sizeof_longlong_t[sizeof (longlong_t)];
exit 1
fi
- sizeof_ptr=0
- sizeof_short=0
- sizeof_int=0
- sizeof_long=0
- sizeof_longlong_t=0
+ SIZEOF_PTR=0
+ SIZEOF_SHORT=0
+ SIZEOF_INT=0
+ SIZEOF_LONG=0
+ SIZEOF_LONGLONG_T=0
+ SIZEOF_SUPERLONG_T=0
while read symbol type offset size ; do
size=$(( 0$size + 0 ))
@@ -652,26 +725,28 @@ char sizeof_longlong_t[sizeof (longlong_t)];
size=$(( 0$offset + 0 ))
fi
case "$symbol" in
- sizeof* )
+ SIZEOF* )
eval $(printf "%s=%d\n" "$symbol" "$size")
;;
esac
+ # retain all useful information!
+ printf "#define %s %s\n" "$symbol" "$size" >> config.h
done < conftest.syms
rm -f conftest.syms conftest.o
- if [ $sizeof_ptr -eq 0 ] ; then
+ if [ $SIZEOF_PTR -eq 0 ] ; then
printf "failed\n"
exit 1
fi
- if [ $sizeof_ptr -eq $sizeof_short ] ; then
+ if [ $SIZEOF_PTR -eq $SIZEOF_SHORT ] ; then
intptr="short"
- elif [ $sizeof_ptr -eq $sizeof_int ] ; then
+ elif [ $SIZEOF_PTR -eq $SIZEOF_INT ] ; then
intptr="int"
- elif [ $sizeof_ptr -eq $sizeof_long ] ; then
+ elif [ $SIZEOF_PTR -eq $SIZEOF_LONG ] ; then
intptr="long"
- elif [ $sizeof_ptr -eq $sizeof_long_long_t ] ; then
+ elif [ $SIZEOF_PTR -eq $SIZEOF_LONG_LONG_T ] ; then
intptr="longlong_t"
fi
@@ -683,7 +758,7 @@ fi
printf '"%s"\n' "$intptr"
printf "typedef $intptr int_ptr_t;\n" >> config.h
-intptr_max_expr="((((($intptr) 1 << $((sizeof_ptr * 8 - 2))) - 1) << 1) + 1)"
+intptr_max_expr="((((($intptr) 1 << $((SIZEOF_PTR * 8 - 2))) - 1) << 1) + 1)"
printf "#define INT_PTR_MAX %s\n" "$intptr_max_expr" >> config.h
printf "#define INT_PTR_MIN (-INT_PTR_MAX)\n" >> config.h
@@ -944,10 +1019,76 @@ rm -f conftest conftest.[co] conftest.{err,syms}
rm -f conftest2 conftest[12].[oc]
#
+# What do we have for patch management.
+#
+
+printf "Checking for quilt ... "
+
+if ! quilt --version > /dev/null 2>&1 ; then
+ printf "not found\n"
+else
+ printf "found\n"
+ have_quilt=y
+fi
+
+printf "Checking for patch ... "
+
+if ! patch --version > /dev/null 2>&1 ; then
+ printf "not found\n"
+ printf "\npatch tool required!\n\n"
+ exit 1
+else
+ printf "found\n"
+ have_patch=y
+fi
+
+#
+# Function to apply patches.
+#
+apply_patches()
+{
+ if ! [ -e patches/series ] ; then
+ echo "no patches"
+ return 0
+ fi
+
+ while read patch patchlevel ; do
+ case patch in
+ '#' ) continue ;;
+ * ) patch ${patchlevel:--p0} < $patch ;;
+ esac
+ done < patches/series
+}
+
+#
+# Try to extract MPI if not already.
+#
+
+printf "Extracting MPI ... "
+
+if [ -e $top_srcdir/mpi-${mpi_version} ] ; then
+ printf "already extracted\n"
+else
+ tar -C $top_srcdir -xzf $top_srcdir/mpi-${mpi_version}.tar.gz
+ printf "\n"
+ printf "Symlinking MPI patches ...\n"
+ ln -sf ../mpi-patches \
+ $top_srcdir/mpi-${mpi_version}/patches
+ printf "Applying MPI patches ...\n"
+ if [ -n "$have_quilt" ] ; then
+ ( cd $top_srcdir/mpi-${mpi_version}/patches ;
+ if [ -e series ] ; then quilt push -a ; else echo "no patches" ; fi )
+ else
+ ( cd $top_srcdir/mpi-${mpi_version} ;
+ apply_patches )
+ fi
+fi
+
+#
# Regenerate config.make
#
-printf "regenerating config.make ... "
+printf "Regenerating config.make ... "
gen_config_make
printf "\n"
diff --git a/dep.mk b/dep.mk
index 3b5cc922..53952e53 100644
--- a/dep.mk
+++ b/dep.mk
@@ -1,14 +1,17 @@
-txr.o: config.h $(top_srcdir)/lib.h $(top_srcdir)/stream.h $(top_srcdir)/gc.h $(top_srcdir)/unwind.h $(top_srcdir)/parser.h $(top_srcdir)/match.h $(top_srcdir)/utf8.h $(top_srcdir)/debug.h $(top_srcdir)/txr.h
-lex.yy.o: config.h $(top_srcdir)/lib.h y.tab.h $(top_srcdir)/gc.h $(top_srcdir)/stream.h $(top_srcdir)/utf8.h $(top_srcdir)/unwind.h $(top_srcdir)/hash.h $(top_srcdir)/parser.h
-y.tab.o: config.h $(top_srcdir)/lib.h $(top_srcdir)/regex.h $(top_srcdir)/utf8.h $(top_srcdir)/match.h $(top_srcdir)/hash.h $(top_srcdir)/parser.h
-match.o: config.h $(top_srcdir)/lib.h $(top_srcdir)/gc.h $(top_srcdir)/unwind.h $(top_srcdir)/regex.h $(top_srcdir)/stream.h $(top_srcdir)/parser.h $(top_srcdir)/txr.h $(top_srcdir)/utf8.h $(top_srcdir)/filter.h $(top_srcdir)/hash.h $(top_srcdir)/debug.h $(top_srcdir)/match.h
-lib.o: config.h $(top_srcdir)/lib.h $(top_srcdir)/gc.h $(top_srcdir)/hash.h $(top_srcdir)/unwind.h $(top_srcdir)/stream.h $(top_srcdir)/utf8.h $(top_srcdir)/filter.h
-regex.o: config.h $(top_srcdir)/lib.h $(top_srcdir)/unwind.h $(top_srcdir)/regex.h $(top_srcdir)/txr.h
-gc.o: config.h $(top_srcdir)/lib.h $(top_srcdir)/stream.h $(top_srcdir)/hash.h $(top_srcdir)/txr.h $(top_srcdir)/gc.h
-unwind.o: config.h $(top_srcdir)/lib.h $(top_srcdir)/gc.h $(top_srcdir)/stream.h $(top_srcdir)/txr.h $(top_srcdir)/unwind.h
-stream.o: config.h $(top_srcdir)/lib.h $(top_srcdir)/gc.h $(top_srcdir)/unwind.h $(top_srcdir)/stream.h $(top_srcdir)/utf8.h
-hash.o: config.h $(top_srcdir)/lib.h $(top_srcdir)/gc.h $(top_srcdir)/unwind.h $(top_srcdir)/hash.h
-utf8.o: config.h $(top_srcdir)/lib.h $(top_srcdir)/unwind.h $(top_srcdir)/utf8.h
-filter.o: config.h $(top_srcdir)/lib.h $(top_srcdir)/hash.h $(top_srcdir)/unwind.h $(top_srcdir)/match.h $(top_srcdir)/filter.h $(top_srcdir)/gc.h
-debug.o: config.h $(top_srcdir)/lib.h $(top_srcdir)/debug.h $(top_srcdir)/gc.h $(top_srcdir)/unwind.h $(top_srcdir)/stream.h $(top_srcdir)/parser.h
-eval.o: $(top_srcdir)/lib.h config.h $(top_srcdir)/lib.h $(top_srcdir)/gc.h $(top_srcdir)/unwind.h
+./txr.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./stream.h $(top_srcdir)/./gc.h $(top_srcdir)/./unwind.h $(top_srcdir)/./parser.h $(top_srcdir)/./match.h $(top_srcdir)/./utf8.h $(top_srcdir)/./debug.h $(top_srcdir)/./txr.h
+./lex.yy.o: config.h $(top_srcdir)/./lib.h y.tab.h $(top_srcdir)/./gc.h $(top_srcdir)/./stream.h $(top_srcdir)/./utf8.h $(top_srcdir)/./unwind.h $(top_srcdir)/./hash.h $(top_srcdir)/./parser.h
+./y.tab.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./regex.h $(top_srcdir)/./utf8.h $(top_srcdir)/./match.h $(top_srcdir)/./hash.h $(top_srcdir)/./eval.h $(top_srcdir)/./parser.h
+./match.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./gc.h $(top_srcdir)/./unwind.h $(top_srcdir)/./regex.h $(top_srcdir)/./stream.h $(top_srcdir)/./parser.h $(top_srcdir)/./txr.h $(top_srcdir)/./utf8.h $(top_srcdir)/./filter.h $(top_srcdir)/./hash.h $(top_srcdir)/./debug.h $(top_srcdir)/./eval.h $(top_srcdir)/./match.h
+./lib.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./gc.h $(top_srcdir)/./hash.h $(top_srcdir)/./unwind.h $(top_srcdir)/./stream.h $(top_srcdir)/./utf8.h $(top_srcdir)/./filter.h $(top_srcdir)/./eval.h
+./regex.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./unwind.h $(top_srcdir)/./regex.h $(top_srcdir)/./txr.h
+./gc.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./stream.h $(top_srcdir)/./hash.h $(top_srcdir)/./txr.h $(top_srcdir)/./eval.h $(top_srcdir)/./gc.h
+./unwind.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./gc.h $(top_srcdir)/./stream.h $(top_srcdir)/./txr.h $(top_srcdir)/./unwind.h
+./stream.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./gc.h $(top_srcdir)/./unwind.h $(top_srcdir)/./stream.h $(top_srcdir)/./utf8.h
+./arith.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./gc.h
+./hash.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./gc.h $(top_srcdir)/./unwind.h $(top_srcdir)/./hash.h
+./utf8.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./unwind.h $(top_srcdir)/./utf8.h
+./filter.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./hash.h $(top_srcdir)/./unwind.h $(top_srcdir)/./match.h $(top_srcdir)/./filter.h $(top_srcdir)/./gc.h
+./debug.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./debug.h $(top_srcdir)/./gc.h $(top_srcdir)/./unwind.h $(top_srcdir)/./stream.h $(top_srcdir)/./parser.h
+./eval.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./gc.h $(top_srcdir)/./unwind.h $(top_srcdir)/./regex.h $(top_srcdir)/./stream.h $(top_srcdir)/./parser.h $(top_srcdir)/./hash.h $(top_srcdir)/./debug.h $(top_srcdir)/./match.h $(top_srcdir)/./eval.h
+mpi-1.8.6/mpi.o: $(top_srcdir)/mpi-1.8.6/../config.h $(top_srcdir)/mpi-1.8.6/mpi.h $(top_srcdir)/mpi-1.8.6/logtab.h
+mpi-1.8.6/mplogic.o: $(top_srcdir)/mpi-1.8.6/../config.h $(top_srcdir)/mpi-1.8.6/mplogic.h
diff --git a/depend.txr b/depend.txr
index 61dfcec3..fc67696d 100644
--- a/depend.txr
+++ b/depend.txr
@@ -1,17 +1,22 @@
@(next :args)
@(collect)
+@(cases)
+@dir/@file.o
+@(or)
@file.o
-@(next `@file.c`)
+@(bind dir ".")
+@(end)
+@(next `@dir/@file.c`)
@(collect)
#include "@hdr"
@(cases)
@(bind hdr ("y.tab.h" "config.h"))
@(bind header hdr)
@(or)
-@(bind header `$(top_srcdir)/@hdr`)
+@(bind header `$(top_srcdir)/@dir/@hdr`)
@(end)
@(end)
@(output)
-@file.o:@(rep) @header@(end)
+@dir/@file.o:@(rep) @header@(end)
@(end)
@(end)
diff --git a/eval.c b/eval.c
index 7834c074..43a98305 100644
--- a/eval.c
+++ b/eval.c
@@ -1156,7 +1156,7 @@ void eval_init(void)
reg_fun(intern(lit("*"), user_package), func_n0v(mulv));
reg_fun(intern(lit("trunc"), user_package), func_n2(trunc));
reg_fun(intern(lit("mod"), user_package), func_n2(mod));
- reg_fun(intern(lit("numberp"), user_package), func_n1(nump));
+ reg_fun(intern(lit("fixnump"), user_package), func_n1(fixnump));
reg_fun(intern(lit(">"), user_package), func_n1v(gtv));
reg_fun(intern(lit("<"), user_package), func_n1v(ltv));
diff --git a/gc.c b/gc.c
index 72b1af05..a01ce794 100644
--- a/gc.c
+++ b/gc.c
@@ -209,6 +209,9 @@ static void finalize(val obj)
return;
case ENV:
return;
+ case BGNUM:
+ mp_clear(mp(obj));
+ return;
}
assert (0 && "corrupt type field");
@@ -262,6 +265,7 @@ tail_call:
case CHR:
case NUM:
case LIT:
+ case BGNUM:
return;
case SYM:
mark_obj(obj->s.name);
diff --git a/hash.c b/hash.c
index 495cc0e3..214d4e8f 100644
--- a/hash.c
+++ b/hash.c
@@ -75,7 +75,7 @@ static struct hash *reachable_weak_hashes;
* We don't reduce the final result modulo a small prime, but leave it
* as it is; let the hashing routines do their own reduction.
*/
-static long hash_c_str(const wchar_t *str)
+static unsigned long hash_c_str(const wchar_t *str)
{
unsigned long h = 0;
while (*str) {
@@ -131,6 +131,8 @@ static cnum equal_hash(val obj)
case LSTR:
lazy_str_force(obj);
return equal_hash(obj->ls.prefix);
+ case BGNUM:
+ return mp_hash(mp(obj));
case COBJ:
return obj->co.ops->hash(obj);
}
@@ -140,12 +142,14 @@ static cnum equal_hash(val obj)
static cnum eql_hash(val obj)
{
- switch (sizeof (mem_t *)) {
- case 4:
- return (((cnum) obj) & NUM_MAX) >> 4;
- case 8: default:
- return (((cnum) obj) & NUM_MAX) >> 5;
- }
+ if (bignump(obj))
+ return mp_hash(mp(obj));
+ switch (sizeof (mem_t *)) {
+ case 4:
+ return (((cnum) obj) & NUM_MAX) >> 4;
+ case 8: default:
+ return (((cnum) obj) & NUM_MAX) >> 5;
+ }
}
cnum cobj_hash_op(val obj)
diff --git a/lib.c b/lib.c
index 96b0e3c6..d99d16e2 100644
--- a/lib.c
+++ b/lib.c
@@ -33,6 +33,7 @@
#include <stdarg.h>
#include <dirent.h>
#include <setjmp.h>
+#include <errno.h>
#include <wchar.h>
#include "config.h"
#ifdef HAVE_GETENVIRONMENTSTRINGS
@@ -41,6 +42,7 @@
#endif
#include "lib.h"
#include "gc.h"
+#include "arith.h"
#include "hash.h"
#include "unwind.h"
#include "stream.h"
@@ -55,9 +57,9 @@ val packages;
val system_package, keyword_package, user_package;
-val null, t, cons_s, str_s, chr_s, num_s, sym_s, pkg_s, fun_s, vec_s;
+val null, t, cons_s, str_s, chr_s, fixnum_s, sym_s, pkg_s, fun_s, vec_s;
val stream_s, hash_s, hash_iter_s, lcons_s, lstr_s, cobj_s, cptr_s;
-val env_s;
+val env_s, bignum_s;
val var_s, expr_s, regex_s, chset_s, set_s, cset_s, wild_s, oneplus_s;
val nongreedy_s, compiled_regex_s;
val quote_s, qquote_s, unquote_s, splice_s;
@@ -99,7 +101,7 @@ static val code2type(int code)
case STR: return str_s;
case LIT: return str_s;
case CHR: return chr_s;
- case NUM: return num_s;
+ case NUM: return fixnum_s;
case SYM: return sym_s;
case PKG: return pkg_s;
case FUN: return fun_s;
@@ -108,6 +110,7 @@ static val code2type(int code)
case LSTR: return lstr_s;
case COBJ: return cobj_s;
case ENV: return env_s;
+ case BGNUM: return bignum_s;
}
return nil;
}
@@ -116,7 +119,7 @@ val typeof(val obj)
{
switch (tag(obj)) {
case TAG_NUM:
- return num_s;
+ return fixnum_s;
case TAG_CHR:
return chr_s;
case TAG_LIT:
@@ -494,6 +497,8 @@ val eql(val left, val right)
/* eql is same as eq for now, but when we get bignums,
eql will compare different bignum objects which are
the same number as equal. */
+ if (is_ptr(left) && type(left) == BGNUM)
+ return equal(left, right);
return eq(left, right);
}
@@ -597,6 +602,10 @@ val equal(val left, val right)
break;
}
return nil;
+ case BGNUM:
+ if (type(right) == BGNUM && mp_cmp(mp(left), mp(right)) == MP_EQ)
+ return t;
+ return nil;
case COBJ:
if (type(right) == COBJ)
return left->co.ops->equal(left, right);
@@ -619,6 +628,16 @@ mem_t *chk_malloc(size_t size)
return ptr;
}
+mem_t *chk_calloc(size_t n, size_t size)
+{
+ mem_t *ptr = (mem_t *) calloc(n, size);
+ if (size && ptr == 0) {
+ ptr = (mem_t *) oom_realloc(0, size);
+ memset(ptr, 0, n * size);
+ }
+ return ptr;
+}
+
mem_t *chk_realloc(mem_t *old, size_t size)
{
mem_t *newptr = (mem_t *) realloc(old, size);
@@ -799,24 +818,18 @@ cnum c_num(val num)
case TAG_CHR: case TAG_NUM:
return ((cnum) num) >> TAG_SHIFT;
default:
- type_mismatch(lit("~s is not a number"), num, nao);
+ type_mismatch(lit("~s is not a fixnum"), num, nao);
}
}
-val nump(val num)
+val fixnump(val num)
{
return (is_num(num)) ? t : nil;
}
-val plus(val anum, val bnum)
+val bignump(val num)
{
- cnum a = c_num(anum);
- cnum b = c_num(bnum);
-
- numeric_assert (a <= 0 || b <= 0 || NUM_MAX - b >= a);
- numeric_assert (a >= 0 || b >= 0 || NUM_MIN - b <= a);
-
- return num(a + b);
+ return (is_ptr(num) && type(num) == BGNUM) ? t : nil;
}
val plusv(val nlist)
@@ -1449,12 +1462,27 @@ val int_str(val str, val base)
const wchar_t *wcs = c_str(str);
wchar_t *ptr;
cnum b = c_num(base);
+
/* TODO: detect if we have wcstoll */
- long val = wcstol(wcs, &ptr, b);
- if (val == 0 && ptr == wcs)
+ long value = wcstol(wcs, &ptr, b ? b : 10);
+ if (value == 0 && ptr == wcs)
return nil;
- numeric_assert (val >= NUM_MIN && val <= NUM_MAX);
- return num(val);
+ if (((value == LONG_MAX || value == LONG_MIN) && errno == ERANGE) ||
+ (value < NUM_MIN || value > NUM_MAX))
+ {
+ val bignum = make_bignum();
+ unsigned char *ucs = utf8_dup_to_uc(wcs);
+ mp_err err = mp_read_radix(mp(bignum), ucs, b);
+
+ free(ucs); /* TODO: make wchar_t version of mp_read_radix. */
+
+ if (err != MP_OKAY)
+ return nil;
+
+ return bignum;
+ }
+
+ return num(value);
}
val chrp(val chr)
@@ -3057,7 +3085,7 @@ static void obj_init(void)
cons_s = intern(lit("cons"), user_package);
str_s = intern(lit("str"), user_package);
chr_s = intern(lit("chr"), user_package);
- num_s = intern(lit("num"), user_package);
+ fixnum_s = intern(lit("fixnum"), user_package);
sym_s = intern(lit("sym"), user_package);
pkg_s = intern(lit("pkg"), user_package);
fun_s = intern(lit("fun"), user_package);
@@ -3070,6 +3098,7 @@ static void obj_init(void)
cobj_s = intern(lit("cobj"), user_package);
cptr_s = intern(lit("cptr"), user_package);
env_s = intern(lit("env"), user_package);
+ bignum_s = intern(lit("bignum"), user_package);
var_s = intern(lit("var"), system_package);
expr_s = intern(lit("expr"), system_package);
regex_s = intern(lit("regex"), system_package);
@@ -3241,6 +3270,7 @@ val obj_print(val obj, val out)
}
return obj;
case NUM:
+ case BGNUM:
format(out, lit("~s"), obj, nao);
return obj;
case SYM:
@@ -3335,6 +3365,7 @@ val obj_pprint(val obj, val out)
put_char(out, obj);
return obj;
case NUM:
+ case BGNUM:
format(out, lit("~s"), obj, nao);
return obj;
case SYM:
@@ -3384,6 +3415,7 @@ void init(const wchar_t *pn, mem_t *(*oom)(mem_t *, size_t),
oom_realloc = oom;
gc_init(stack_bottom);
obj_init();
+ arith_init();
uw_init();
stream_init();
eval_init();
diff --git a/lib.h b/lib.h
index 019ffb73..9c4fe339 100644
--- a/lib.h
+++ b/lib.h
@@ -24,6 +24,8 @@
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
+#include "mpi.h"
+
typedef int_ptr_t cnum;
#define TAG_SHIFT 2
@@ -37,7 +39,8 @@ typedef int_ptr_t cnum;
typedef enum type {
NUM = TAG_NUM, CHR = TAG_CHR, LIT = TAG_LIT, CONS,
- STR, SYM, PKG, FUN, VEC, LCONS, LSTR, COBJ, ENV
+ STR, SYM, PKG, FUN, VEC, LCONS, LSTR, COBJ, ENV,
+ BGNUM
} type_t;
typedef enum functype
@@ -183,6 +186,11 @@ struct env {
val up_env;
};
+struct bignum {
+ type_t type;
+ mp_int mp;
+};
+
union obj {
struct any t;
struct cons c;
@@ -195,6 +203,7 @@ union obj {
struct lazy_string ls;
struct cobj co;
struct env e;
+ struct bignum bn;
};
INLINE cnum tag(val obj) { return ((cnum) obj) & TAG_MASK; }
@@ -245,6 +254,11 @@ INLINE val num_fast(cnum n)
return (val) ((n << TAG_SHIFT) | TAG_NUM);
}
+INLINE mp_int *mp(val bign)
+{
+ return &bign->bn.mp;
+}
+
INLINE val chr(wchar_t ch)
{
return (val) (((cnum) ch << TAG_SHIFT) | TAG_CHR);
@@ -259,9 +273,9 @@ INLINE val chr(wchar_t ch)
#define lit(strlit) lit_noex(strlit)
extern val keyword_package, system_package, user_package;
-extern val null, t, cons_s, str_s, chr_s, num_s, sym_s, pkg_s, fun_s, vec_s;
+extern val null, t, cons_s, str_s, chr_s, fixnum_s, sym_s, pkg_s, fun_s, vec_s;
extern val stream_s, hash_s, hash_iter_s, lcons_s, lstr_s, cobj_s, cptr_s;
-extern val env_s;
+extern val env_s, bignum_s;
extern val var_s, expr_s, regex_s, chset_s, set_s, cset_s, wild_s, oneplus_s;
extern val nongreedy_s, compiled_regex_s;
extern val quote_s, qquote_s, unquote_s, splice_s;
@@ -328,6 +342,7 @@ val none_satisfy(val list, val pred, val key);
val eql(val left, val right);
val equal(val left, val right);
mem_t *chk_malloc(size_t size);
+mem_t *chk_calloc(size_t n, size_t size);
mem_t *chk_realloc(mem_t *, size_t size);
wchar_t *chk_strdup(const wchar_t *str);
val cons(val car, val cdr);
@@ -346,7 +361,8 @@ val proper_plist_to_alist(val list);
val improper_plist_to_alist(val list, val boolean_keys);
val num(cnum val);
cnum c_num(val num);
-val nump(val num);
+val fixnump(val num);
+val bignump(val num);
val plus(val anum, val bnum);
val plusv(val nlist);
val minus(val anum, val bnum);
diff --git a/match.c b/match.c
index b39bb514..fdd7666a 100644
--- a/match.c
+++ b/match.c
@@ -462,7 +462,7 @@ static val h_var(match_line_ctx c, match_line_ctx *cout)
val loc = source_loc(c.specline);
c.specline = cons(cdr(pair), cons(pat, rest(c.specline)));
rl(car(c.specline), loc);
- } else if (nump(modifier)) {
+ } else if (fixnump(modifier)) {
val past = plus(c.pos, modifier);
if (length_str_lt(c.dataline, past) || lt(past, c.pos))
@@ -506,7 +506,7 @@ static val h_var(match_line_ctx c, match_line_ctx *cout)
rl(car(c.specline), loc);
goto repeat;
}
- } else if (nump(modifier)) { /* fixed field */
+ } else if (fixnump(modifier)) { /* fixed field */
val past = plus(c.pos, modifier);
if (length_str_lt(c.dataline, past) || lt(past, c.pos))
{
@@ -625,8 +625,8 @@ static val h_skip(match_line_ctx c, match_line_ctx *cout)
val elem = first(c.specline);
val max = txeval(elem, second(elem), c.bindings);
val min = txeval(elem, third(elem), c.bindings);
- cnum cmax = nump(max) ? c_num(max) : 0;
- cnum cmin = nump(min) ? c_num(min) : 0;
+ cnum cmax = fixnump(max) ? c_num(max) : 0;
+ cnum cmin = fixnump(min) ? c_num(min) : 0;
val greedy = eq(max, greedy_k);
val last_good_result = nil, last_good_pos = nil;
@@ -703,14 +703,14 @@ static val h_coll(match_line_ctx c, match_line_ctx *cout)
val chars = txeval(elem, getplist(args, chars_k), c.bindings);
val have_vars;
val vars = getplist_f(args, vars_k, &have_vars);
- cnum cmax = nump(gap) ? c_num(gap) : (nump(max) ? c_num(max) : 0);
- cnum cmin = nump(gap) ? c_num(gap) : (nump(min) ? c_num(min) : 0);
+ cnum cmax = fixnump(gap) ? c_num(gap) : (fixnump(max) ? c_num(max) : 0);
+ cnum cmin = fixnump(gap) ? c_num(gap) : (fixnump(min) ? c_num(min) : 0);
cnum mincounter = cmin, maxcounter = 0;
- cnum ctimax = nump(times) ? c_num(times)
- : (nump(maxtimes) ? c_num(maxtimes) : 0);
- cnum ctimin = nump(times) ? c_num(times)
- : (nump(mintimes) ? c_num(mintimes) : 0);
- cnum cchars = nump(chars) ? c_num(chars) : 0;
+ cnum ctimax = fixnump(times) ? c_num(times)
+ : (fixnump(maxtimes) ? c_num(maxtimes) : 0);
+ cnum ctimin = fixnump(times) ? c_num(times)
+ : (fixnump(mintimes) ? c_num(mintimes) : 0);
+ cnum cchars = fixnump(chars) ? c_num(chars) : 0;
cnum timescounter = 0, charscounter = 0;
val iter;
@@ -1056,7 +1056,7 @@ static val h_fun(match_line_ctx c, match_line_ctx *cout)
}
}
- if (nump(success))
+ if (fixnump(success))
c.pos = success;
}
}
@@ -1213,7 +1213,7 @@ static val format_field(val string_or_list, val modifier, val filter)
for (; modifier; pop(&modifier)) {
val item = first(modifier);
- if (nump(item))
+ if (fixnump(item))
n = item;
if (regexp(item))
uw_throw(query_error_s, lit("format_field: regex modifier in output"));
@@ -1717,8 +1717,8 @@ static val v_skip(match_files_ctx *c)
val args = rest(first_spec);
val max = txeval(skipspec, first(args), c->bindings);
val min = txeval(skipspec, second(args), c->bindings);
- cnum cmax = nump(max) ? c_num(max) : 0;
- cnum cmin = nump(min) ? c_num(min) : 0;
+ cnum cmax = fixnump(max) ? c_num(max) : 0;
+ cnum cmin = fixnump(min) ? c_num(min) : 0;
val greedy = eq(max, greedy_k);
val last_good_result = nil;
val last_good_line = num(0);
@@ -1820,8 +1820,8 @@ static val v_freeform(match_files_ctx *c)
return nil;
} else {
uses_or2;
- val limit = or2(if2(nump(first(vals)), first(vals)),
- if2(nump(second(vals)), second(vals)));
+ val limit = or2(if2(fixnump(first(vals)), first(vals)),
+ if2(fixnump(second(vals)), second(vals)));
val term = or2(if2(stringp(first(vals)), first(vals)),
if2(stringp(second(vals)), second(vals)));
val ff_specline = first(c->spec);
@@ -1836,7 +1836,7 @@ static val v_freeform(match_files_ctx *c)
return nil;
}
- if (nump(success)) {
+ if (fixnump(success)) {
c->data = lazy_str_get_trailing_list(ff_dataline, success);
c->data_lineno = plus(c->data_lineno, num(1));
}
@@ -2284,16 +2284,16 @@ static val v_collect(match_files_ctx *c)
val lines = txeval(specline, getplist(args, lines_k), c->bindings);
val have_vars;
val vars = getplist_f(args, vars_k, &have_vars);
- cnum cmax = nump(gap) ? c_num(gap) : (nump(max) ? c_num(max) : 0);
- cnum cmin = nump(gap) ? c_num(gap) : (nump(min) ? c_num(min) : 0);
+ cnum cmax = fixnump(gap) ? c_num(gap) : (fixnump(max) ? c_num(max) : 0);
+ cnum cmin = fixnump(gap) ? c_num(gap) : (fixnump(min) ? c_num(min) : 0);
cnum mincounter = cmin, maxcounter = 0;
- cnum ctimax = nump(times) ? c_num(times)
- : (nump(maxtimes) ? c_num(maxtimes) : 0);
- cnum ctimin = nump(times) ? c_num(times)
- : (nump(mintimes) ? c_num(mintimes) : 0);
+ cnum ctimax = fixnump(times) ? c_num(times)
+ : (fixnump(maxtimes) ? c_num(maxtimes) : 0);
+ cnum ctimin = fixnump(times) ? c_num(times)
+ : (fixnump(mintimes) ? c_num(mintimes) : 0);
cnum timescounter = 0, linescounter = 0;
- cnum ctimes = nump(times) ? c_num(times) : 0;
- cnum clines = nump(lines) ? c_num(lines) : 0;
+ cnum ctimes = fixnump(times) ? c_num(times) : 0;
+ cnum clines = fixnump(lines) ? c_num(lines) : 0;
val iter;
if (gap && (max || min))
@@ -3215,7 +3215,7 @@ repeat_spec_same_data:
match_line(ml_all(c.bindings, specline, dataline, zero,
c.data_lineno, first(c.files))));
- if (nump(success) && c_num(success) < c_num(length_str(dataline))) {
+ if (fixnump(success) && c_num(success) < c_num(length_str(dataline))) {
debuglf(specline, lit("spec only matches line to position ~a: ~a"),
success, dataline, nao);
return nil;
diff --git a/mpi-1.8.6.tar.gz b/mpi-1.8.6.tar.gz
new file mode 100644
index 00000000..43791a77
--- /dev/null
+++ b/mpi-1.8.6.tar.gz
Binary files differ
diff --git a/mpi-patches/add-mp-hash b/mpi-patches/add-mp-hash
new file mode 100644
index 00000000..8a2cd585
--- /dev/null
+++ b/mpi-patches/add-mp-hash
@@ -0,0 +1,48 @@
+Index: mpi-1.8.6/mpi.c
+===================================================================
+--- mpi-1.8.6.orig/mpi.c 2011-12-09 14:10:41.000000000 -0800
++++ mpi-1.8.6/mpi.c 2011-12-09 14:26:02.000000000 -0800
+@@ -1960,6 +1960,30 @@
+
+ /* }}} */
+
++unsigned long mp_hash(mp_int *a)
++{
++ unsigned long hash = 0;
++ int ix;
++ for (ix = 0; ix < USED(a); ix++) {
++ mp_digit d = DIGIT(a, ix);
++#if SIZEOF_LONG < MP_DIGIT_SIZE
++ int j;
++ for (j = 0; j < MP_DIGIT_SIZE / SIZEOF_LONG; j++) {
++ hash ^= d;
++ d >> (SIZEOF_LONG * CHAR_BIT);
++ }
++#elif SIZEOF_LONG == MP_DIGIT_SIZE
++ hash ^= d;
++#else
++ hash <<= MP_DIGIT_BITS;
++ hash ^= d;
++#endif
++ }
++ if (SIGN(a) == MP_NEG)
++ hash = (hash << 16 | hash >> (SIZEOF_LONG * CHAR_BIT - 16));
++ return hash;
++}
++
+ /*------------------------------------------------------------------------*/
+ /* {{{ Number theoretic functions */
+
+Index: mpi-1.8.6/mpi.h
+===================================================================
+--- mpi-1.8.6.orig/mpi.h 2011-12-09 14:10:41.000000000 -0800
++++ mpi-1.8.6/mpi.h 2011-12-09 14:10:41.000000000 -0800
+@@ -165,6 +165,8 @@
+ int mp_isodd(mp_int *a);
+ int mp_iseven(mp_int *a);
+
++unsigned long mp_hash(mp_int *a);
++
+ /*------------------------------------------------------------------------*/
+ /* Number theoretic */
+
diff --git a/mpi-patches/add-mp-set-intptr b/mpi-patches/add-mp-set-intptr
new file mode 100644
index 00000000..a5d50a33
--- /dev/null
+++ b/mpi-patches/add-mp-set-intptr
@@ -0,0 +1,77 @@
+Index: mpi-1.8.6/mpi.c
+===================================================================
+--- mpi-1.8.6.orig/mpi.c 2011-12-09 13:52:26.000000000 -0800
++++ mpi-1.8.6/mpi.c 2011-12-09 13:56:19.000000000 -0800
+@@ -528,6 +528,59 @@
+
+ /* }}} */
+
++mp_err mp_set_intptr(mp_int *mp, int_ptr_t z)
++{
++ if (sizeof z > sizeof (mp_digit)) {
++ int ix, shift;
++ unsigned long v = z > 0 ? z : -z;
++ const int nd = (sizeof v + sizeof (mp_digit) - 1) / sizeof (mp_digit);
++
++ ARGCHK(mp != NULL, MP_BADARG);
++
++ mp_zero(mp);
++
++ if(z == 0)
++ return MP_OKAY; /* shortcut for zero */
++
++ s_mp_grow(mp, nd);
++
++ USED(mp) = nd;
++
++ for (ix = 0, shift = 0; ix < nd; ix++, shift += MP_DIGIT_BIT)
++ {
++ DIGIT(mp, ix) = (v >> shift) & MP_DIGIT_MAX;
++ }
++
++ if(z < 0)
++ SIGN(mp) = MP_NEG;
++
++ return MP_OKAY;
++ }
++
++ mp_set(mp, z);
++ return MP_OKAY;
++}
++
++/*
++ * No checks here: assumes that the mp is in range!
++ */
++mp_err mp_get_intptr(mp_int *mp, int_ptr_t *z)
++{
++ int_ptr_t out = 0;
++
++#if MP_DIGIT_SIZE < SIZEOF_PTR
++ int ix;
++ int nd = USED(mp);
++ for (ix = 0; ix < nd; ix++, out <<= MP_DIGIT_BIT)
++ out = DIGIT(mp, ix);
++#else
++ out = DIGIT(mp, 0);
++#endif
++
++ *z = (SIGN(mp) == MP_NEG) ? -out : out;
++ return MP_OKAY;
++}
++
+ /*------------------------------------------------------------------------*/
+ /* {{{ Digit arithmetic */
+
+Index: mpi-1.8.6/mpi.h
+===================================================================
+--- mpi-1.8.6.orig/mpi.h 2011-12-09 13:49:20.000000000 -0800
++++ mpi-1.8.6/mpi.h 2011-12-09 13:56:19.000000000 -0800
+@@ -94,6 +94,8 @@
+ void mp_zero(mp_int *mp);
+ void mp_set(mp_int *mp, mp_digit d);
+ mp_err mp_set_int(mp_int *mp, long z);
++mp_err mp_set_intptr(mp_int *mp, int_ptr_t z);
++mp_err mp_get_intptr(mp_int *mp, int_ptr_t *z);
+
+ /*------------------------------------------------------------------------*/
+ /* Single digit arithmetic */
diff --git a/mpi-patches/add-mpi-toradix-with-case b/mpi-patches/add-mpi-toradix-with-case
new file mode 100644
index 00000000..6fe9c191
--- /dev/null
+++ b/mpi-patches/add-mpi-toradix-with-case
@@ -0,0 +1,54 @@
+Index: mpi-1.8.6/mpi.c
+===================================================================
+--- mpi-1.8.6.orig/mpi.c 2011-12-09 19:16:58.000000000 -0800
++++ mpi-1.8.6/mpi.c 2011-12-09 19:19:23.000000000 -0800
+@@ -2624,9 +2624,9 @@
+
+ /* }}} */
+
+-/* {{{ mp_toradix(mp, str, radix) */
++/* {{{ mp_toradix_case(mp, str, radix, low) */
+
+-mp_err mp_toradix(mp_int *mp, unsigned char *str, int radix)
++mp_err mp_toradix_case(mp_int *mp, unsigned char *str, int radix, int low)
+ {
+ int ix, pos = 0;
+
+@@ -2657,7 +2657,7 @@
+ }
+
+ /* Generate digits, use capital letters */
+- ch = s_mp_todigit(rem, radix, 0);
++ ch = s_mp_todigit(rem, radix, low);
+
+ str[pos++] = ch;
+ }
+@@ -2685,10 +2685,15 @@
+
+ return MP_OKAY;
+
+-} /* end mp_toradix() */
++} /* end mp_toradix_case() */
+
+ /* }}} */
+
++mp_err mp_toradix(mp_int *mp, unsigned char *str, int radix)
++{
++ return mp_toradix_case(mp, str, radix, 0);
++}
++
+ /* {{{ mp_char2value(ch, r) */
+
+ int mp_char2value(char ch, int r)
+Index: mpi-1.8.6/mpi.h
+===================================================================
+--- mpi-1.8.6.orig/mpi.h 2011-12-09 19:16:58.000000000 -0800
++++ mpi-1.8.6/mpi.h 2011-12-09 19:28:38.000000000 -0800
+@@ -213,6 +213,7 @@
+ int mp_radix_size(mp_int *mp, int radix);
+ int mp_value_radix_size(int num, int qty, int radix);
+ mp_err mp_toradix(mp_int *mp, unsigned char *str, int radix);
++mp_err mp_toradix_case(mp_int *mp, unsigned char *str, int radix, int low);
+
+ int mp_char2value(char ch, int r);
+
diff --git a/mpi-patches/config-types b/mpi-patches/config-types
new file mode 100644
index 00000000..78b672b8
--- /dev/null
+++ b/mpi-patches/config-types
@@ -0,0 +1,120 @@
+Index: mpi-1.8.6/mpi-types.h
+===================================================================
+--- mpi-1.8.6.orig/mpi-types.h 2011-12-09 09:00:59.000000000 -0800
++++ mpi-1.8.6/mpi-types.h 2011-12-09 14:09:59.000000000 -0800
+@@ -1,17 +1,54 @@
+-/* Type definitions generated by 'types.pl' */
++/*
++ * Universal. We can further tweak these by making them
++ * bitfields inside the mp_int struct.
++ */
++typedef int mp_sign;
++typedef int mp_size;
+
+-typedef char mp_sign;
+-typedef unsigned short mp_digit; /* 2 byte type */
+-typedef unsigned int mp_word; /* 4 byte type */
+-typedef unsigned int mp_size;
+-typedef int mp_err;
++/*
++ * Universal. Does not need platform configuration.
++ */
++typedef int mp_err;
+
+-#define MP_DIGIT_BIT (CHAR_BIT*sizeof(mp_digit))
+-#define MP_DIGIT_MAX USHRT_MAX
+-#define MP_WORD_BIT (CHAR_BIT*sizeof(mp_word))
+-#define MP_WORD_MAX UINT_MAX
++#if HAVE_USUPERLONG_T && HAVE_ULONGLONG_T && \
++ SIZEOF_SUPERLONG_T / 2 == SIZEOF_LONGLONG_T && \
++ SIZEOF_PTR >= SIZEOF_LONGLONG_T
++ typedef ulonglong_t mp_digit;
++ typedef usuperlong_t mp_word;
++ #define MP_DIGIT_SIZE SIZEOF_LONGLONG_T
++ #define DIGIT_FMT "%" #SIZEOF_SUPERLONG_T "llx"
++#elif HAVE_ULONGLONG_T && SIZEOF_LONGLONG_T / 2 == SIZEOF_LONG && \
++ SIZEOF_PTR >= SIZEOF_LONG
++ typedef unsigned long mp_digit;
++ typedef ulonglong_t mp_word;
++ #define MP_DIGIT_SIZE SIZEOF_LONG_T
++ #define DIGIT_FMT "%" #SIZEOF_LONGLONG_T "lx"
++#elif HAVE_ULONGLONG_T && SIZEOF_LONGLONG_T / 2 == SIZEOF_INT && \
++ SIZEOF_PTR >= SIZEOF_INT
++ typedef unsigned int mp_digit;
++ typedef ulonglong_t mp_word;
++ #define MP_DIGIT_SIZE SIZEOF_INT
++ #define DIGIT_FMT "%" #SIZEOF_LONGLONG_T "lx"
++#elif SIZEOF_LONG / 2 == SIZEOF_INT && SIZEOF_PTR >= SIZEOF_INT
++ typedef unsigned int mp_digit;
++ typedef unsigned long mp_word;
++ #define MP_DIGIT_SIZE SIZEOF_INT
++ #define DIGIT_FMT "%" #SIZEOF_LONG "x"
++#elif SIZEOF_INT / 2 == SIZEOF_SHORT
++ typedef unsigned short mp_digit;
++ typedef unsigned int mp_word;
++ #define DIGIT_FMT "%" #SIZEOF_INT "x"
++#elif SIZEOF_SHORT == 2
++ typedef unsigned char mp_digit;
++ typedef unsigned short mp_word;
++ #define DIGIT_FMT "%" #SIZEOF_SHORT "x"
++#else
++ #error Failure to configure MPI types on this target platform
++#endif
+
+-#define RADIX (MP_DIGIT_MAX+1)
++#define MP_DIGIT_BIT ((int) (CHAR_BIT*sizeof(mp_digit)))
++#define MP_DIGIT_MAX ((mp_digit) -1)
++#define MP_WORD_BIT ((int) (CHAR_BIT*sizeof(mp_word)))
++#define MP_WORD_MAX ((mp_word) -1)
+
+-#define MP_DIGIT_SIZE 2
+-#define DIGIT_FMT "%04X"
++#define RADIX (((mp_word) MP_DIGIT_MAX) + 1)
+Index: mpi-1.8.6/mpi.c
+===================================================================
+--- mpi-1.8.6.orig/mpi.c 2011-12-09 09:00:59.000000000 -0800
++++ mpi-1.8.6/mpi.c 2011-12-09 14:10:29.000000000 -0800
+@@ -9,6 +9,7 @@
+ $Id: mpi.c,v 1.1 2004/02/08 04:29:29 sting Exp $
+ */
+
++#include "../config.h"
+ #include "mpi.h"
+ #include <stdlib.h>
+ #include <string.h>
+Index: mpi-1.8.6/mplogic.c
+===================================================================
+--- mpi-1.8.6.orig/mplogic.c 2011-12-09 09:00:59.000000000 -0800
++++ mpi-1.8.6/mplogic.c 2011-12-09 14:10:29.000000000 -0800
+@@ -9,6 +9,7 @@
+ $Id: mplogic.c,v 1.1 2004/02/08 04:29:29 sting Exp $
+ */
+
++#include "../config.h"
+ #include "mplogic.h"
+ #include <stdlib.h>
+
+Index: mpi-1.8.6/mpprime.c
+===================================================================
+--- mpi-1.8.6.orig/mpprime.c 2011-12-09 09:00:59.000000000 -0800
++++ mpi-1.8.6/mpprime.c 2011-12-09 09:01:01.000000000 -0800
+@@ -10,6 +10,7 @@
+ $Id: mpprime.c,v 1.1 2004/02/08 04:29:29 sting Exp $
+ */
+
++#include "../config.h"
+ #include "mpprime.h"
+ #include <stdlib.h>
+
+Index: mpi-1.8.6/mprsa.c
+===================================================================
+--- mpi-1.8.6.orig/mprsa.c 2011-12-09 09:00:59.000000000 -0800
++++ mpi-1.8.6/mprsa.c 2011-12-09 09:01:01.000000000 -0800
+@@ -11,6 +11,7 @@
+ $Id: mprsa.c,v 1.1 2004/02/08 04:29:29 sting Exp $
+ */
+
++#include "../config.h"
+ #include "mprsa.h"
+ #include <stdlib.h>
+ #include <string.h>
diff --git a/mpi-patches/export-mp-eq b/mpi-patches/export-mp-eq
new file mode 100644
index 00000000..e9ea7a49
--- /dev/null
+++ b/mpi-patches/export-mp-eq
@@ -0,0 +1,34 @@
+Index: mpi-1.8.6/mpi.c
+===================================================================
+--- mpi-1.8.6.orig/mpi.c 2011-12-09 13:56:19.000000000 -0800
++++ mpi-1.8.6/mpi.c 2011-12-09 13:56:23.000000000 -0800
+@@ -86,14 +86,6 @@
+
+ /* }}} */
+
+-/* {{{ Comparison constants */
+-
+-#define MP_LT -1
+-#define MP_EQ 0
+-#define MP_GT 1
+-
+-/* }}} */
+-
+ /* {{{ Constant strings */
+
+ /* Constant strings returned by mp_strerror() */
+Index: mpi-1.8.6/mpi.h
+===================================================================
+--- mpi-1.8.6.orig/mpi.h 2011-12-09 13:56:19.000000000 -0800
++++ mpi-1.8.6/mpi.h 2011-12-09 13:56:23.000000000 -0800
+@@ -42,6 +42,10 @@
+ #define MP_UNDEF -5 /* answer is undefined */
+ #define MP_LAST_CODE MP_UNDEF
+
++#define MP_LT -1
++#define MP_EQ 0
++#define MP_GT 1
++
+ #include "mpi-types.h"
+
+ /* Included for compatibility... */
diff --git a/mpi-patches/fix-mult-bug b/mpi-patches/fix-mult-bug
new file mode 100644
index 00000000..691f3334
--- /dev/null
+++ b/mpi-patches/fix-mult-bug
@@ -0,0 +1,13 @@
+Index: mpi-1.8.6/mpi.c
+===================================================================
+--- mpi-1.8.6.orig/mpi.c 2011-12-09 21:11:31.000000000 -0800
++++ mpi-1.8.6/mpi.c 2011-12-09 21:12:09.000000000 -0800
+@@ -3272,7 +3272,7 @@
+ }
+
+ for(ix = 0; ix < max; ix++) {
+- w = (dp[ix] * d) + k;
++ w = (dp[ix] * (mp_word) d) + k;
+ dp[ix] = ACCUM(w);
+ k = CARRYOUT(w);
+ }
diff --git a/mpi-patches/fix-warnings b/mpi-patches/fix-warnings
new file mode 100644
index 00000000..c35e4ead
--- /dev/null
+++ b/mpi-patches/fix-warnings
@@ -0,0 +1,61 @@
+Index: mpi-1.8.6/mpi.c
+===================================================================
+--- mpi-1.8.6.orig/mpi.c 2011-12-08 21:03:20.000000000 -0800
++++ mpi-1.8.6/mpi.c 2011-12-08 21:05:04.000000000 -0800
+@@ -2401,7 +2401,7 @@
+ int ix;
+
+ d = *dp;
+- for(ix = 0; ix < sizeof(mp_digit); ++ix) {
++ for(ix = 0; ix < (int) sizeof(mp_digit); ++ix) {
+ *spos = d & UCHAR_MAX;
+ d >>= CHAR_BIT;
+ ++spos;
+@@ -2598,10 +2598,10 @@
+ /* Reverse the digits and sign indicator */
+ ix = 0;
+ while(ix < pos) {
+- char tmp = str[ix];
++ char tmp2 = str[ix];
+
+ str[ix] = str[pos];
+- str[pos] = tmp;
++ str[pos] = tmp2;
+ ++ix;
+ --pos;
+ }
+@@ -2952,10 +2952,10 @@
+ void s_mp_mod_2d(mp_int *mp, mp_digit d)
+ {
+ unsigned int ndig = (d / DIGIT_BIT), nbit = (d % DIGIT_BIT);
+- unsigned int ix;
++ int ix;
+ mp_digit dmask, *dp = DIGITS(mp);
+
+- if(ndig >= USED(mp))
++ if((int) ndig >= USED(mp))
+ return;
+
+ /* Flush all the bits above 2^d in its digit */
+Index: mpi-1.8.6/mplogic.c
+===================================================================
+--- mpi-1.8.6.orig/mplogic.c 2011-12-08 21:03:20.000000000 -0800
++++ mpi-1.8.6/mplogic.c 2011-12-08 21:05:16.000000000 -0800
+@@ -290,7 +290,7 @@
+ for(ix = 0; ix < USED(a); ix++) {
+ cur = DIGIT(a, ix);
+
+- for(db = 0; db < sizeof(mp_digit); db++) {
++ for(db = 0; db < (int) sizeof(mp_digit); db++) {
+ reg = (cur >> (CHAR_BIT * db)) & UCHAR_MAX;
+
+ nset += bitc[reg];
+@@ -319,7 +319,7 @@
+ for(ix = 0; ix < USED(a); ix++) {
+ cur = DIGIT(a, ix);
+
+- for(db = 0; db < sizeof(mp_digit); db++) {
++ for(db = 0; db < (int) sizeof(mp_digit); db++) {
+ reg = (cur >> (CHAR_BIT * db)) & UCHAR_MAX;
+
+ nset += bitc[UCHAR_MAX - reg];
diff --git a/mpi-patches/series b/mpi-patches/series
new file mode 100644
index 00000000..71aa73ba
--- /dev/null
+++ b/mpi-patches/series
@@ -0,0 +1,8 @@
+config-types
+fix-warnings
+use-txr-allocator
+add-mp-set-intptr
+export-mp-eq
+add-mp-hash
+add-mpi-toradix-with-case
+fix-mult-bug
diff --git a/mpi-patches/use-txr-allocator b/mpi-patches/use-txr-allocator
new file mode 100644
index 00000000..2f85a574
--- /dev/null
+++ b/mpi-patches/use-txr-allocator
@@ -0,0 +1,70 @@
+Index: mpi-1.8.6/mpi.c
+===================================================================
+--- mpi-1.8.6.orig/mpi.c 2011-12-08 22:17:15.000000000 -0800
++++ mpi-1.8.6/mpi.c 2011-12-08 22:27:07.000000000 -0800
+@@ -15,6 +15,11 @@
+ #include <string.h>
+ #include <ctype.h>
+
++typedef unsigned char mem_t;
++extern mem_t *chk_malloc(size_t size);
++extern mem_t *chk_calloc(size_t n, size_t size);
++extern mem_t *chk_realloc(mem_t *, size_t size);
++
+ #if MP_DEBUG
+ #include <stdio.h>
+
+@@ -154,7 +159,7 @@
+ #define s_mp_copy(sp, dp, count) memcpy(dp, sp, (count) * sizeof(mp_digit))
+ #endif /* MP_MEMCPY */
+
+- #define s_mp_alloc(nb, ni) calloc(nb, ni)
++ #define s_mp_alloc(nb, ni) chk_calloc(nb, ni)
+ #define s_mp_free(ptr) {if(ptr) free(ptr);}
+ #endif /* MP_MACRO */
+
+@@ -282,7 +287,7 @@
+ {
+ ARGCHK(mp != NULL && prec > 0, MP_BADARG);
+
+- if((DIGITS(mp) = s_mp_alloc(prec, sizeof(mp_digit))) == NULL)
++ if((DIGITS(mp) = (mp_digit *) s_mp_alloc(prec, sizeof(mp_digit))) == NULL)
+ return MP_MEM;
+
+ SIGN(mp) = MP_ZPOS;
+@@ -312,7 +317,7 @@
+ if(mp == from)
+ return MP_OKAY;
+
+- if((DIGITS(mp) = s_mp_alloc(USED(from), sizeof(mp_digit))) == NULL)
++ if((DIGITS(mp) = (mp_digit *) s_mp_alloc(USED(from), sizeof(mp_digit))) == NULL)
+ return MP_MEM;
+
+ s_mp_copy(DIGITS(from), DIGITS(mp), USED(from));
+@@ -358,7 +363,7 @@
+ s_mp_copy(DIGITS(from), DIGITS(to), USED(from));
+
+ } else {
+- if((tmp = s_mp_alloc(USED(from), sizeof(mp_digit))) == NULL)
++ if((tmp = (mp_digit *) s_mp_alloc(USED(from), sizeof(mp_digit))) == NULL)
+ return MP_MEM;
+
+ s_mp_copy(DIGITS(from), tmp, USED(from));
+@@ -2670,7 +2675,7 @@
+ /* Set min to next nearest default precision block size */
+ min = ((min + (s_mp_defprec - 1)) / s_mp_defprec) * s_mp_defprec;
+
+- if((tmp = s_mp_alloc(min, sizeof(mp_digit))) == NULL)
++ if((tmp = (mp_digit *) s_mp_alloc(min, sizeof(mp_digit))) == NULL)
+ return MP_MEM;
+
+ s_mp_copy(DIGITS(mp), tmp, USED(mp));
+@@ -2757,7 +2762,7 @@
+ /* Allocate ni records of nb bytes each, and return a pointer to that */
+ void *s_mp_alloc(size_t nb, size_t ni)
+ {
+- return calloc(nb, ni);
++ return chk_calloc(nb, ni);
+
+ } /* end s_mp_alloc() */
+ #endif
diff --git a/parser.l b/parser.l
index 53644a03..e7881a30 100644
--- a/parser.l
+++ b/parser.l
@@ -146,6 +146,7 @@ static wchar_t num_esc(char *num)
%option noinput
SYM [a-zA-Z0-9_]+
+NUM [+\-]?[0-9]+
NSCHR [a-zA-Z0-9!$%&*+\-<=>?\\^_~]
NSYM {NSCHR}({NSCHR}|#)*
TOK :?{SYM}
@@ -170,12 +171,19 @@ UONLY {U2}{U}|{U3}{U}{U}|{U4}{U}{U}{U}
%%
-<SPECIAL>{TOK} |
-<NESTED>{NTOK} {
- cnum val;
- char *errp;
+<SPECIAL,NESTED>{NUM} {
+ val str = string_own(utf8_dup_from(yytext));
+ if (yy_top_state() == INITIAL
+ || yy_top_state() == QSILIT)
+ yy_pop_state();
+ yylval.num = int_str(str, num(10));
+ return NUMBER;
+ }
+
+<SPECIAL>{TOK} |
+<NESTED>{NTOK} {
if (yy_top_state() == INITIAL
|| yy_top_state() == QSILIT)
yy_pop_state();
@@ -188,28 +196,9 @@ UONLY {U2}{U}|{U3}{U}{U}|{U4}{U}{U}{U}
yylval.lexeme = utf8_dup_from(yytext + 1);
return METAVAR;
default:
- break;
- }
-
- errno = 0;
-
- val = strtol(yytext, &errp, 10);
-
- if (*errp != 0) {
- /* not a number */
yylval.lexeme = utf8_dup_from(yytext);
return IDENT;
}
-
- if ((val == LONG_MAX || val == LONG_MIN)
- && errno == ERANGE)
- yyerror("numeric overflow in token");
-
- if (val < NUM_MIN || val > NUM_MAX)
- yyerror("numeric overflow in token");
-
- yylval.num = val;
- return NUMBER;
}
<SPECIAL>\({WS}all{WS}\) {
diff --git a/parser.y b/parser.y
index 5b0e857d..cc6a6dbd 100644
--- a/parser.y
+++ b/parser.y
@@ -60,7 +60,8 @@ static val parsed_spec;
wchar_t *lexeme;
union obj *val;
wchar_t chr;
- cnum num, lineno;
+ union obj *num;
+ cnum lineno;
}
%token <lexeme> SPACE TEXT IDENT KEYWORD METAVAR
@@ -71,7 +72,7 @@ static val parsed_spec;
%token <lineno> ERRTOK /* deliberately not used in grammar */
%token <lineno> HASH_BACKSLASH
-%token <num> NUMBER
+%token <val> NUMBER
%token <chr> REGCHAR LITCHAR
%token <chr> METAPAR SPLICE
@@ -646,7 +647,7 @@ expr : IDENT { $$ = rl(intern(string_own($1), nil),
| METAVAR { $$ = list(var_s,
intern(string_own($1), nil), nao);
rl($$, num(lineno)); }
- | NUMBER { $$ = num($1); }
+ | NUMBER { $$ = $1; }
| list { $$ = $1; }
| vector { $$ = $1; }
| meta_expr { $$ = $1; }
diff --git a/stream.c b/stream.c
index a7ddbb66..9f0b282f 100644
--- a/stream.c
+++ b/stream.c
@@ -837,11 +837,11 @@ val vformat(val stream, val fmtstr, va_list vl)
int left = 0, zeropad = 0;
cnum value;
void *ptr;
- char num_buf[64];
for (;;) {
val obj;
wchar_t ch = *fmt++;
+ char num_buf[64], *pnum = num_buf;
switch (state) {
case vf_init:
@@ -951,24 +951,45 @@ val vformat(val stream, val fmtstr, va_list vl)
switch (ch) {
case 'x':
obj = va_arg(vl, val);
- value = c_num(obj);
- sprintf(num_buf, num_fmt->hex, value);
+ if (bignump(obj)) {
+ int nchars = mp_radix_size(mp(obj), 16);
+ if (nchars >= (int) sizeof (num_buf))
+ pnum = (char *) chk_malloc(nchars + 1);
+ mp_toradix_case(mp(obj), (unsigned char *) pnum, 16, 1);
+ } else {
+ value = c_num(obj);
+ sprintf(num_buf, num_fmt->hex, value);
+ }
goto output_num;
case 'X':
obj = va_arg(vl, val);
- value = c_num(obj);
- sprintf(num_buf, num_fmt->HEX, value);
+ if (bignump(obj)) {
+ int nchars = mp_radix_size(mp(obj), 16);
+ if (nchars >= (int) sizeof (num_buf))
+ pnum = (char *) chk_malloc(nchars + 1);
+ mp_toradix_case(mp(obj), (unsigned char *) pnum, 16, 0);
+ } else {
+ value = c_num(obj);
+ sprintf(num_buf, num_fmt->HEX, value);
+ }
goto output_num;
case 'o':
obj = va_arg(vl, val);
- value = c_num(obj);
- sprintf(num_buf, num_fmt->oct, value);
+ if (bignump(obj)) {
+ int nchars = mp_radix_size(mp(obj), 8);
+ if (nchars >= (int) sizeof (num_buf))
+ pnum = (char *) chk_malloc(nchars + 1);
+ mp_toradix(mp(obj), (unsigned char *) pnum, 8);
+ } else {
+ value = c_num(obj);
+ sprintf(num_buf, num_fmt->oct, value);
+ }
goto output_num;
case 'a':
obj = va_arg(vl, val);
if (obj == nao)
goto premature;
- if (nump(obj)) {
+ if (fixnump(obj)) {
value = c_num(obj);
sprintf(num_buf, num_fmt->dec, value);
goto output_num;
@@ -976,6 +997,12 @@ val vformat(val stream, val fmtstr, va_list vl)
if (!vformat_str(stream, obj, width, left, precision))
return nil;
continue;
+ } else if (bignump(obj)) {
+ int nchars = mp_radix_size(mp(obj), 10);
+ if (nchars >= (int) sizeof (num_buf))
+ pnum = (char *) chk_malloc(nchars + 1);
+ mp_toradix(mp(obj), (unsigned char *) pnum, 10);
+ goto output_num;
}
obj_pprint(obj, stream);
continue;
@@ -983,12 +1010,24 @@ val vformat(val stream, val fmtstr, va_list vl)
obj = va_arg(vl, val);
if (obj == nao)
goto premature;
- if (nump(obj)) {
+ if (fixnump(obj)) {
value = c_num(obj);
sprintf(num_buf, num_fmt->dec, value);
if (!vformat_num(stream, num_buf, 0, 0, 0, 0))
return nil;
continue;
+ } else if (bignump(obj)) {
+ int nchars = mp_radix_size(mp(obj), 10);
+ val res;
+ if (nchars >= (int) sizeof (num_buf))
+ pnum = (char *) chk_malloc(nchars + 1);
+ mp_toradix(mp(obj), (unsigned char *) pnum, 10);
+ res = vformat_num(stream, pnum, 0, 0, 0, 0);
+ if (pnum != num_buf)
+ free(pnum);
+ if (!res)
+ return nil;
+ continue;
}
obj_print(obj, stream);
continue;
@@ -1001,11 +1040,16 @@ val vformat(val stream, val fmtstr, va_list vl)
default:
abort();
output_num:
- if (!vformat_num(stream, num_buf, width, left,
- precision ? 0 : zeropad,
- precision ? precision : 1))
- return nil;
- continue;
+ {
+ val res = vformat_num(stream, pnum, width, left,
+ precision ? 0 : zeropad,
+ precision ? precision : 1);
+ if (pnum != num_buf)
+ free(pnum);
+ if (!res)
+ return nil;
+ continue;
+ }
}
continue;
}