klisp

commit 8d26769f520c984931a98436ff8f1fc81e0cb3cb
parent dd43f846d8f3f0be00d3c53764d69f06b69d03d4
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Wed,  9 Mar 2011 18:04:15 -0300

Bugfix (endianness): Changed object representation so that flags and type are distinct fields.

Diffstat:
M
src/kapplicative.c
 | 
1
+
M
src/kcontinuation.c
 | 
1
+
M
src/kenvironment.c
 | 
1
+
M
src/kobject.h
 | 
15
++++++++++-----
M
src/koperative.c
 | 
1
+
M
src/kpair.c
 | 
3
++-
M
src/kstate.c
 | 
5
+++--
M
src/kstring.c
 | 
2
++
M
src/ksymbol.c
 | 
1
+

9 files changed, 22 insertions(+), 8 deletions(-)
diff --git a/src/kapplicative.c b/src/kapplicative.c
@@ -24,6 +24,7 @@ TValue kmake_applicative(klisp_State *K, TValue name, TValue si,
     K->root_gc = (GCObject *)new_app;
     new_app->gct = 0;
     new_app->tt = K_TAPPLICATIVE;
+    new_app->flags = 0;
 
     /* applicative specific fields */
     new_app->name = name;
diff --git a/src/kcontinuation.c b/src/kcontinuation.c
@@ -23,6 +23,7 @@ TValue kmake_continuation(klisp_State *K, TValue parent, TValue name,
     K->root_gc = (GCObject *)new_cont;
     new_cont->gct = 0;
     new_cont->tt = K_TCONTINUATION;
+    new_cont->flags = 0;
 
     /* continuation specific fields */
     new_cont->mark = KFALSE;    
diff --git a/src/kenvironment.c b/src/kenvironment.c
@@ -25,6 +25,7 @@ TValue kmake_environment(klisp_State *K, TValue parent)
     K->root_gc = (GCObject *) new_env;
     new_env->gct = 0;
     new_env->tt = K_TENVIRONMENT;
+    new_env->flags = 0;
 
     /* environment specific fields */
     new_env->mark = KFALSE;    
diff --git a/src/kobject.h b/src/kobject.h
@@ -40,7 +40,7 @@ typedef union GCObject GCObject;
 ** Common Header for all collectible objects (in macro form, to be
 ** included in other objects)
 */
-#define CommonHeader GCObject *next; uint16_t tt; uint16_t gct; 
+#define CommonHeader GCObject *next; uint8_t tt; uint8_t flags; uint16_t gct; 
 
 
 /*
@@ -380,11 +380,14 @@ const TValue keminf;
 #define tv2op(v_) ((Operative *) gcvalue(v_))
 #define tv2app(v_) ((Applicative *) gcvalue(v_))
 
+#define tv2gch(v_) ((GCheader *) gcvalue(v_))
 #define tv2mgch(v_) ((MGCheader *) gcvalue(v_))
 
 /* Macro to convert any Kernel object into a GCObject */
 #define obj2gco(v_) ((GCObject *) (v_))
 
+#define obj2gch(v_) ((GCheader *) (v_))
+
 /* Macros to access innertv values */
 /* TODO: add assertions */
 #define ivalue(o_) ((o_).tv.v.i)
@@ -408,11 +411,13 @@ extern char *ktv_names[];
 #define kis_marked(p_) (!kis_unmarked(p_))
 #define kis_unmarked(p_) (tv_equal(kget_mark(p_), KFALSE))
 
-/* Macros to access mutability flag */
-#define K_FLAG_IMMUTABLE 0x0100
-#define kget_flags(o_) (tv2mgch(o_)->tt)
+/* Macros to access flags & type in GCHeader */
+#define gch_get_type(o_) (obj2gch(o_)->tt)
+#define gch_get_flags(o_) (obj2gch(o_)->flags)
+#define tv_get_flags(o_) (gch_get_flags(tv2gch(o_)))
 
-#define kis_mutable(o_) ((kget_flags(o_) & K_FLAG_IMMUTABLE) == 0)
+#define K_FLAG_IMMUTABLE 0x01
+#define kis_mutable(o_) ((tv_get_flags(o_) & K_FLAG_IMMUTABLE) == 0)
 #define kis_immutable(o_) (!kis_mutable(o_))
 
 /* Macro to test the most basic equality on TValues */
diff --git a/src/koperative.c b/src/koperative.c
@@ -23,6 +23,7 @@ TValue kmake_operative(klisp_State *K, TValue name, TValue si,
     K->root_gc = (GCObject *)new_op;
     new_op->gct = 0;
     new_op->tt = K_TOPERATIVE;
+    new_op->flags = 0;
 
     /* operative specific fields */
     new_op->name = name;
diff --git a/src/kpair.c b/src/kpair.c
@@ -17,7 +17,8 @@ TValue kcons_g(klisp_State *K, bool m, TValue car, TValue cdr)
     new_pair->next = K->root_gc;
     K->root_gc = (GCObject *)new_pair;
     new_pair->gct = 0;
-    new_pair->tt = K_TPAIR | (m? 0 : K_FLAG_IMMUTABLE);
+    new_pair->tt = K_TPAIR;
+    new_pair->flags = (m? 0 : K_FLAG_IMMUTABLE);
 
     /* pair specific fields */
     new_pair->si = KNIL;
diff --git a/src/kstate.c b/src/kstate.c
@@ -166,8 +166,9 @@ void klisp_close (klisp_State *K)
     while(next) {
 	GCObject *obj = next;
 	next = obj->gch.next;
+	int type = gch_get_type(obj);
 
-	switch(obj->gch.tt) {
+	switch(type) {
 	case K_TPAIR:
 	    klispM_free(K, (Pair *)obj);
 	    break;
@@ -193,7 +194,7 @@ void klisp_close (klisp_State *K)
 	    break;
 	default:
 	    /* shouldn't happen */
-	    fprintf(stderr, "Unknown GCObject type: %d\n", obj->gch.tt);
+	    fprintf(stderr, "Unknown GCObject type: %d\n", type);
 	    abort();
 	}
     }
diff --git a/src/kstring.c b/src/kstring.c
@@ -23,6 +23,7 @@ TValue kstring_new_empty(klisp_State *K)
     K->root_gc = (GCObject *)new_str;
     new_str->gct = 0;
     new_str->tt = K_TSTRING;
+    new_str->flags = 0;
 
     /* string specific fields */
     new_str->mark = KFALSE;
@@ -48,6 +49,7 @@ TValue kstring_new(klisp_State *K, const char *buf, uint32_t size)
     K->root_gc = (GCObject *)new_str;
     new_str->gct = 0;
     new_str->tt = K_TSTRING;
+    new_str->flags = 0;
 
     /* string specific fields */
     new_str->mark = KFALSE;
diff --git a/src/ksymbol.c b/src/ksymbol.c
@@ -37,6 +37,7 @@ TValue ksymbol_new(klisp_State *K, const char *buf)
     K->root_gc = (GCObject *)new_sym;
     new_sym->gct = 0;
     new_sym->tt = K_TSYMBOL;
+    new_sym->flags = 0;
 
     /* symbol specific fields */
     new_sym->mark = KFALSE;