summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-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;
}
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-16 10:34:31 +0000