commit e7b96a3fb856e0d07d8704b675a08cf406495326
parent eb14a8efc89a104c32fc7feb4ca70c0dd8b67b4d
Author: Andres Navarro <canavarro82@gmail.com>
Date: Sat, 9 Apr 2011 17:20:19 -0300
Added some more support for bigints.
Diffstat:
| M | src/Makefile | | | 3 | ++- |
| A | src/kinteger.c | | | 82 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| A | src/kinteger.h | | | 40 | ++++++++++++++++++++++++++++++++++++++++ |
| M | src/kobject.h | | | 81 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++---------- |
4 files changed, 195 insertions(+), 11 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -10,7 +10,7 @@ MYLIBS=
CORE_O= kobject.o ktoken.o kpair.o kstring.o ksymbol.o kread.o \
kwrite.o kstate.o kmem.o kerror.o kauxlib.o kenvironment.o \
kcontinuation.o koperative.o kapplicative.o keval.o krepl.o \
- kencapsulation.o kpromise.o kport.o \
+ kencapsulation.o kpromise.o kport.o kinteger.o \
kground.o kghelpers.o kgbooleans.o kgeqp.o kgequalp.o \
kgsymbols.o kgcontrol.o kgpairs_lists.o kgpair_mut.o kgenvironments.o \
kgenv_mut.o kgcombiners.o kgcontinuations.o kgencapsulations.o \
@@ -45,6 +45,7 @@ klisp.o: klisp.c klisp.h kobject.h kread.h kwrite.h klimits.h kstate.h kmem.h \
kobject.o: kobject.c kobject.h klisp.h
ktoken.o: ktoken.c ktoken.h kobject.h kstate.h kpair.h kstring.h ksymbol.h \
kerror.h klisp.h
+kinteger.o: kinteger.c kinteger.h kobject.h kstate.h kmem.h klisp.h
kpair.o: kpair.c kpair.h kobject.h kstate.h kmem.h klisp.h
kstring.o: kstring.c kstring.h kobject.h kstate.h kmem.h klisp.h
# XXX: kpair.h because of use of list as symbol table
diff --git a/src/kinteger.c b/src/kinteger.c
@@ -0,0 +1,82 @@
+/*
+** kinteger.c
+** Kernel Integers (fixints and bigints)
+** See Copyright Notice in klisp.h
+*/
+
+#include <stdbool.h>
+#include <stdint.h>
+#include <inttypes.h>
+
+#include "kinteger.h"
+#include "kobject.h"
+#include "kstate.h"
+#include "kmem.h"
+
+#define bind_iter kbind_bigint_iter
+#define iter_has_next kbigint_iter_has_more
+#define iter_next kbigint_iter_next
+#define iter_update_last kbigint_iter_update_last
+
+Bigint_Node *make_new_node(klisp_State *K, uint32_t digit)
+{
+ Bigint_Node *node = klispM_new(K, Bigint_Node);
+ node->digit = digit;
+ node->next_xor_prev = (uintptr_t) 0; /* NULL ^ NULL: 0 */
+ return node;
+}
+
+TValue kbigint_new(klisp_State *K, int32_t fixint)
+{
+ Bigint *new_bigint = klispM_new(K, Bigint);
+
+ /* header + gc_fields */
+ new_bigint->next = K->root_gc;
+ K->root_gc = (GCObject *)new_bigint;
+ new_bigint->gct = 0;
+ new_bigint->tt = K_TBIGINT;
+ new_bigint->flags = 0;
+
+ /* bigint specific fields */
+
+ /* GC: root bigint */
+ /* put dummy value to work if garbage collections happens while allocating
+ node */
+ new_bigint->sign_size = 0;
+ new_bigint->first = new_bigint->last = NULL;
+
+ Bigint_Node *node = make_new_node(K, fixint);
+ new_bigint->first = new_bigint->last = node;
+ new_bigint->sign_size = fixint < 0? -1 : 1;
+
+ return gc2bigint(new_bigint);
+}
+
+/* This algorithm is like a fused multiply add on bignums,
+ unlike any other function here it modifies bigint. It is used in read
+ and it assumes that bigint is positive */
+void kbigint_add_digit(klisp_State *K, TValue tv_bigint, int32_t base,
+ int32_t digit)
+{
+ /* GC: root tv_bigint */
+ Bigint *bigint = tv2bigint(tv_bigint);
+ /* iterate in little endian mode */
+ bind_iter(iter, bigint, false);
+
+ uint64_t carry = digit;
+
+ while(iter_has_next(iter)) {
+ uint32_t cur = iter_next(iter);
+ /* I hope the compiler understand that this should be a
+ 32bits x 32bits = 64bits multiplication instruction */
+ uint64_t res_carry = (uint64_t) cur * base + carry;
+ carry = res_carry >> 32;
+ uint32_t new_cur = (uint32_t) res_carry;
+ iter_update_last(iter, new_cur);
+ }
+
+ if (carry != 0) {
+ /* must add one node to the bigint */
+ kbigint_add_node(bigint, make_new_node(K, carry));
+ }
+}
diff --git a/src/kinteger.h b/src/kinteger.h
@@ -0,0 +1,40 @@
+/*
+** kinteger.h
+** Kernel Integers (fixints and bigints)
+** See Copyright Notice in klisp.h
+*/
+
+#ifndef kinteger_h
+#define kinteger_h
+
+#include <stdbool.h>
+#include <stdint.h>
+#include <inttypes.h>
+
+#include "kobject.h"
+#include "kstate.h"
+
+/* for now used only for reading */
+TValue kbigint_new(klisp_State *K, int32_t fixint);
+
+
+/* Create a stack allocated bigints from a fixint,
+ useful for mixed operations, relatively light weight compared
+ to creating it in the heap and burdening the gc */
+#define kbind_bigint(name, fixint) \
+ int32_t (KUNIQUE_NAME(i)) = fixint; \
+ BigintNode KUNIQUE_NAME(node); \
+ node.val = { int64_t temp = (KUNIQUE_NAME(i)); \
+ (uint32_t) (temp < 0)? -temp : temp; }; \
+ node.next_xor_prev = (uintptr_t) 0; /* NULL ^ NULL: 0 */ \
+ Bigint KUNIQUE_NAME(bigint); \
+ (KUNIQUE_NAME(bigint)).first = &(KUNIQUE_NAME(node)); \
+ (KUNIQUE_NAME(bigint)).last = &(KUNIQUE_NAME(node)); \
+ (KUNIQUE_NAME(bigint)).sign_size = (KUNIQUE_NAME(i)) < 0? -1 : 1; \
+ Bigint *name = &(KUNIQUE_NAME(bigint));
+
+/* This is used by the reader to destructively add digits to a number */
+void kbigint_add_digit(klisp_State *K, TValue tv_bigint, int32_t base,
+ int32_t digit);
+
+#endif
diff --git a/src/kobject.h b/src/kobject.h
@@ -31,6 +31,7 @@
#include <stdbool.h>
#include <stdint.h>
#include <stdio.h>
+#include <assert.h>
/* This should be in a configuration .h */
/*
@@ -273,19 +274,12 @@ typedef __attribute__((aligned (8))) union {
typedef struct __attribute__ ((__packed__)) {
uint32_t digit;
uintptr_t next_xor_prev;
-} BigintNode;
-
-/* some useful macros to traverse the list */
-#define kxor_next(cur, prev) \
- ((BigintNode *) ((cur)->next_xor_prev ^ (uintptr_t) (prev)))
-
-#define kxor_prev(cur, next) \
- ((BigintNode *) ((cur)->next_xor_prev ^ (uintptr_t) (next)))
+} Bigint_Node;
typedef struct __attribute__ ((__packed__)) {
CommonHeader;
- BigintNode *first;
- BigintNode *last;
+ Bigint_Node *first;
+ Bigint_Node *last;
int32_t sign_size;
} Bigint;
@@ -296,6 +290,70 @@ typedef struct __attribute__ ((__packed__)) {
#define kbigint_size(b_) ({ int32_t ss = (b_)->sign_size; \
ss < 0? -ss : ss;})
+/* Java Style Iterator for the xor list */
+typedef struct {
+ Bigint_Node *cur;
+ Bigint_Node *next;
+} Bigint_Iter;
+
+#define kxor_next(cur, prev) \
+ ((Bigint_Node *) ((cur)->next_xor_prev ^ (uintptr_t) (prev)))
+
+/* REFACTOR: move these macros somewhere else */
+#define KCONCAT(a, b) a ## b
+#define KUNIQUE_NAME(prefix) KCONCAT(prefix, __LINE__)
+
+#define kbind_bigint_iter(name, bigint, be) \
+ Bigint_Iter KUNIQUE_NAME(iter); \
+ Bigint_Iter *(name) = &(KUNIQUE_NAME(iter)); \
+ kbigint_iter_init((name), (bigint), (be));
+
+inline void kbigint_iter_init(Bigint_Iter *i, Bigint *bigint, bool big_endian)
+{
+ i->cur = (Bigint_Node *) NULL;
+ i->next = big_endian? bigint->first : bigint->last;
+}
+
+inline bool kbigint_iter_has_more(Bigint_Iter *i)
+{
+ return i->next != NULL;
+}
+
+inline uint32_t kbigint_iter_next(Bigint_Iter *i)
+{
+ assert(kbigint_iter_has_more(i));
+
+ Bigint_Node *next_next = kxor_next(i->next, i->cur);
+ i->cur = i->next;
+ i->next = next_next;
+ return i->cur->digit;
+}
+
+/* this is needed for add_digit */
+inline void kbigint_iter_update_last(Bigint_Iter *i, uint32_t digit)
+{
+ assert(i->cur != NULL);
+ i->cur->digit = digit;
+}
+
+/* Helper for adding nodes to the head of the list.
+ Neither can be NULL.
+ The second argument should have NULL as previous for this to work */
+inline void kbigint_node_cons(Bigint_Node *head, Bigint_Node *tail)
+{
+ head->next_xor_prev = (uintptr_t) tail ^ (uintptr_t) NULL;
+ tail->next_xor_prev = (tail->next_xor_prev ^ (uintptr_t) NULL) ^
+ (uintptr_t) head;
+}
+
+/* used in add_digit, bigint has at least one node */
+inline void kbigint_add_node(Bigint *bigint, Bigint_Node *node)
+{
+ kbigint_node_cons(node, bigint->first);
+ bigint->first = node;
+ bigint->sign_size += bigint->sign_size < 0? -1 : 1;
+}
+
typedef struct __attribute__ ((__packed__)) {
CommonHeader;
TValue mark; /* for cycle/sharing aware algorithms */
@@ -467,9 +525,11 @@ const TValue keminf;
/* Macros to convert a GCObject * into a tagged value */
/* TODO: add assertions */
+/* REFACTOR: change names to bigint2tv, pair2tv, etc */
/* LUA NOTE: the corresponding defines are in lstate.h */
#define gc2tv(t_, o_) ((TValue) {.tv = {.t = (t_), \
.v = { .gc = obj2gco(o_)}}})
+#define gc2bigint(o_) (gc2tv(K_TAG_BIGINT, o_))
#define gc2pair(o_) (gc2tv(K_TAG_PAIR, o_))
#define gc2str(o_) (gc2tv(K_TAG_STRING, o_))
#define gc2sym(o_) (gc2tv(K_TAG_SYMBOL, o_))
@@ -482,6 +542,7 @@ const TValue keminf;
#define gc2port(o_) (gc2tv(K_TAG_PORT, o_))
/* Macro to convert a TValue into a specific heap allocated object */
+#define tv2bigint(v_) ((Bigint *) gcvalue(v_))
#define tv2pair(v_) ((Pair *) gcvalue(v_))
#define tv2str(v_) ((String *) gcvalue(v_))
#define tv2sym(v_) ((Symbol *) gcvalue(v_))
