klisp

commit c3e06d98bde932ba603d499c63fb1b593ac91320
parent 0b42ae61dc42512bddaadd57bd67d4539090aabc
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Sat,  9 Apr 2011 14:52:33 -0300

Added object definitions for bigints.

Diffstat:
M
src/kobject.h
 | 
50
++++++++++++++++++++++++++++++++++++++++++++++++--

1 file changed, 48 insertions(+), 2 deletions(-)
diff --git a/src/kobject.h b/src/kobject.h
@@ -141,9 +141,10 @@ typedef struct __attribute__ ((__packed__)) GCheader {
 **
 ** - decide if inexact infinities and reals with no
 **    primary values are included in K_TDOUBLE
-** - For now we will only use fixints and exact infinities 
+** - For now we will only use fixints, bigints and exact infinities 
 */
 #define K_TAG_FIXINT	K_MAKE_VTAG(K_TFIXINT)
+#define K_TAG_BIGINT	K_MAKE_VTAG(K_TBIGINT)
 #define K_TAG_EINF	K_MAKE_VTAG(K_TEINF)
 #define K_TAG_IINF	K_MAKE_VTAG(K_TIINF)
 
@@ -181,11 +182,15 @@ typedef struct __attribute__ ((__packed__)) GCheader {
 /* This is intended for internal use below. DON'T USE OUTSIDE THIS FILE */
 #define ttag(o) ((o).tv.t)
 #define ttype_(o) (K_TAG_TYPE(ttag(o)))
+/* NOTE: not used for now */
 #define tflag_(o) (K_TAG_FLAG(ttag(o)))
 #define tbasetype_(o) (K_TAG_BASE_TYPE(ttag(o)))
 
 /* Simple types (value in TValue struct) */
 #define ttisfixint(o)	(tbasetype_(o) == K_TAG_FIXINT)
+#define ttisbigint(o)	(tbasetype_(o) == K_TAG_FIXINT)
+#define ttisinteger(o_) ({ int32_t t_ = tbasetype_(o_); \
+	    t_ == K_TAG_FIXINT || t_ == K_TAG_BIGINT;})
 #define ttiseinf(o)	(tbasetype_(o) == K_TAG_EINF)
 #define ttisiinf(o)	(tbasetype_(o) == K_TAG_IINF)
 #define ttisnil(o)	(tbasetype_(o) == K_TAG_NIL)
@@ -194,7 +199,7 @@ typedef struct __attribute__ ((__packed__)) GCheader {
 #define ttiseof(o)	(tbasetype_(o) == K_TAG_EOF)
 #define ttisboolean(o)	(tbasetype_(o) == K_TAG_BOOLEAN)
 #define ttischar(o)	(tbasetype_(o) == K_TAG_CHAR)
-#define ttisdouble(o)	((ttag(o) & K_TAG_BASE_MASK) != K_TAG_TAGGED) 
+#define ttisdouble(o)	((ttag(o) & K_TAG_BASE_MASK) != K_TAG_TAGGED)
 
 /* Complex types (value in heap) */
 #define ttisstring(o)	(tbasetype_(o) == K_TAG_STRING)
@@ -248,6 +253,41 @@ typedef __attribute__((aligned (8))) union {
 /*
 ** Individual heap-allocated values
 */
+
+/*
+** Node Structure for the list of 'digits' in bignums.
+** The node list is a xor encoded doubly linked list of big endian 'digits'
+** in base 2^32.
+** It is a linked list instead of say, an array because it is immutable and 
+** there is no need to index the list.
+** It is doubly linked because some operations (like + and *) work from least
+** significant to most significant and some others (like <? and >?) work the
+** other way around.
+** It is xor encoded because, well... I never had a chance to actually use
+** this and this is a perfect example of where it is actually useful: Lists
+** are to be traversed in both directions, the node is small so the space
+** gain is real (2/3 the space in 32 bits, 3/5 in 64 bits) and all the code
+** using the pointers is encapsulated in a (relatively) small module.
+*/
+
+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)))
+
+typedef struct __attribute__ ((__packed__)) {
+    CommonHeader; /* here there is a flag for the sign */
+    BigintNode *first;
+    BigintNode *last;
+} Bigint;
+
 typedef struct __attribute__ ((__packed__)) {
     CommonHeader;
     TValue mark; /* for cycle/sharing aware algorithms */
@@ -500,6 +540,12 @@ int32_t kmark_count;
 #define gch_get_flags(o_) (obj2gch(o_)->flags)
 #define tv_get_flags(o_) (gch_get_flags(tv2gch(o_)))
 
+/* Flags for bigints */
+/* is negative */
+#define K_FLAG_NEG 0x01
+#define kbigint_is_pos(s_) ((tv_get_flags(s_) & K_FLAG_NEG) == 0)
+#define kbigint_is_neg(s_) ((tv_get_flags(s_) & K_FLAG_NEG) != 0)
+
 /* Flags for symbols */
 /* has external representation (identifiers) */
 #define K_FLAG_EXT_REP 0x01