klisp

an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

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:
Msrc/Makefile | 3++-
Asrc/kinteger.c | 82+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Asrc/kinteger.h | 40++++++++++++++++++++++++++++++++++++++++
Msrc/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_))