klisp

commit d65b05eb1552ca832e519b5d1f4bc9f93526bbca
parent fd4110cc2e2cf4870bef7da472e37d294f77f2fa
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Fri,  8 Jul 2011 17:35:49 -0300

Added some more on blob definitions and constructors.

Diffstat:
M
src/Makefile
 | 
9
++++++---
A
src/kblob.c
 | 
66
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
M
src/kblob.h
 | 
7
++++---
M
src/kgc.c
 | 
2
++
M
src/kobject.h
 | 
1
+
M
src/kstate.c
 | 
7
+++++++
M
src/kstate.h
 | 
3
+++

7 files changed, 89 insertions(+), 6 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -29,7 +29,7 @@ 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 kinteger.o krational.o \
-	kreal.o ktable.o kgc.o imath.o imrat.o \
+	kreal.o ktable.o kgc.o imath.o imrat.o kblob.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 \
@@ -117,7 +117,8 @@ kgbooleans.o: kgbooleans.c kobject.h klimits.h klisp.h klispconf.h \
  kcontinuation.h kerror.h kghelpers.h kapplicative.h koperative.h \
  kenvironment.h
 kgc.o: kgc.c kgc.h kobject.h klimits.h klisp.h klispconf.h kstate.h \
- ktoken.h kmem.h kport.h imath.h imrat.h ktable.h kstring.h kerror.h
+ ktoken.h kmem.h kport.h imath.h imrat.h ktable.h kstring.h kerror.h \
+ kblob.h
 kgchars.o: kgchars.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
  ktoken.h kmem.h kapplicative.h koperative.h kcontinuation.h kerror.h \
  kghelpers.h kpair.h kgc.h kenvironment.h ksymbol.h kstring.h kgchars.h
@@ -229,7 +230,7 @@ krepl.o: krepl.c klisp.h kobject.h klimits.h klispconf.h kstate.h \
 kstate.o: kstate.c klisp.h kobject.h klimits.h klispconf.h kstate.h \
  ktoken.h kmem.h kstring.h kpair.h kgc.h keval.h koperative.h \
  kapplicative.h kcontinuation.h kenvironment.h kground.h krepl.h \
- ksymbol.h kport.h ktable.h kgpairs_lists.h kghelpers.h kerror.h
+ ksymbol.h kport.h ktable.h kgpairs_lists.h kghelpers.h kerror.h kblob.h
 kstring.o: kstring.c kstring.h kobject.h klimits.h klisp.h klispconf.h \
  kstate.h ktoken.h kmem.h kgc.h
 ksymbol.o: ksymbol.c ksymbol.h kobject.h klimits.h klisp.h klispconf.h \
@@ -249,3 +250,5 @@ imath.o: imath.c imath.h kobject.h klimits.h klisp.h klispconf.h kstate.h \
  ktoken.h kmem.h kerror.h
 imrat.o: imrat.c imrat.h imath.h kobject.h klimits.h klisp.h klispconf.h \
  kstate.h ktoken.h kmem.h kerror.h
+kblob.o: kblob.c kblob.h kobject.h klimits.h klisp.h klispconf.h \
+ kstate.h ktoken.h kmem.h kgc.h
diff --git a/src/kblob.c b/src/kblob.c
@@ -0,0 +1,66 @@
+/*
+** kblob.c
+** Kernel Blobs (byte vectors)
+** See Copyright Notice in klisp.h
+*/
+
+#include <string.h>
+
+#include "kblob.h"
+#include "kobject.h"
+#include "kstate.h"
+#include "kmem.h"
+#include "kgc.h"
+
+/* Constructors */
+TValue kblob_new_g(klisp_State *K, bool m, uint32_t size)
+{
+    Blob *new_blob;
+
+    /* XXX: find a better way to do this! */
+    if (size == 0 && ttisblob(K->empty_blob)) {
+	return K->empty_blob;
+    }
+
+    new_blob = klispM_malloc(K, sizeof(Blob) + size);
+
+    /* header + gc_fields */
+    klispC_link(K, (GCObject *) new_blob, K_TBLOB, m? 0 : K_FLAG_IMMUTABLE);
+
+    /* blob specific fields */
+    new_blob->mark = KFALSE;
+    new_blob->size = size;
+
+    /* clear the buffer */
+    memset(new_blob->b, 0, size);
+
+    return gc2blob(new_blob);
+}
+
+TValue kblob_new(klisp_State *K, uint32_t size)
+{
+    return kblob_new_g(K, true, size);
+}
+
+TValue kblob_new_imm(klisp_State *K, uint32_t size)
+{
+    return kblob_new_g(K, false, size);
+}
+
+/* both obj1 and obj2 should be blobs */
+bool kblob_equalp(TValue obj1, TValue obj2)
+{
+    klisp_assert(ttisblob(obj1) && ttisblob(obj2));
+
+    Blob *blob1 = tv2blob(obj1);
+    Blob *blob2 = tv2blob(obj2);
+
+    if (blob1->size == blob2->size) {
+	return (blob1->size == 0) ||
+	    (memcmp(blob1->b, blob2->b, blob1->size) == 0);
+    } else {
+	return false;
+    }
+}
+
+bool kblobp(TValue obj) { return ttisblob(obj); }
diff --git a/src/kblob.h b/src/kblob.h
@@ -10,10 +10,10 @@
 #include "kobject.h"
 #include "kstate.h"
 
-/* General constructor for blobs */
+/* Constructors for blobs */
 TValue kblob_new_g(klisp_State *K, bool m, uint32_t size);
-TValue kblob_new_imm(klisp_State *K, bool m, uint32_t size);
-TValue kblob_new(klisp_State *K, bool m, uint32_t size);
+TValue kblob_new_imm(klisp_State *K, uint32_t size);
+TValue kblob_new(klisp_State *K, uint32_t size);
 
 /* both obj1 and obj2 should be blobs, this compares byte by byte
   and doesn't differentiate immutable from mutable blobs */
@@ -24,6 +24,7 @@ bool kblob(TValue obj);
 #define kblob_buf(tv_) (tv2blob(tv_)->b)
 #define kblob_size(tv_) (tv2blob(tv_)->size)
 
+#define kblob_emptyp(tv_) (kblob_size(tv_) == 0)
 #define kblob_mutablep(tv_) (kis_mutable(tv_))
 #define kblob_immutablep(tv_) (kis_immutable(tv_))
 
diff --git a/src/kgc.c b/src/kgc.c
@@ -20,6 +20,7 @@
 #include "imrat.h"
 #include "ktable.h"
 #include "kstring.h"
+#include "kblob.h"
 #include "kerror.h"
 
 #define GCSTEPSIZE	1024u
@@ -574,6 +575,7 @@ static void markroot (klisp_State *K) {
     markvalue(K, K->kd_in_port_key);
     markvalue(K, K->kd_out_port_key);
     markvalue(K, K->empty_string);
+    markvalue(K, K->empty_blob);
 
     markvalue(K, K->ktok_lparen);
     markvalue(K, K->ktok_rparen);
diff --git a/src/kobject.h b/src/kobject.h
@@ -484,6 +484,7 @@ typedef struct __attribute__ ((__packed__)) {
 /* Blobs (binary vectors) */
 typedef struct __attribute__ ((__packed__)) {
     CommonHeader;
+    TValue mark; /* for cycle/sharing aware algorithms */
     uint32_t size;
     int32_t __dummy; /* for alignment to 64 bits */
     char b[]; /* buffer */
diff --git a/src/kstate.c b/src/kstate.c
@@ -34,6 +34,7 @@
 #include "kstring.h"
 #include "kport.h"
 #include "ktable.h"
+#include "kblob.h"
 
 #include "kgpairs_lists.h" /* for creating list_app */
 
@@ -149,6 +150,12 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
     /* MAYBE: fix it so we can remove empty_string from roots */
     K->empty_string = kstring_new_b_imm(K, "");
 
+    /* Empty blob */
+    /* MAYBE: fix it so we can remove empty_blob from roots */
+    /* XXX: find a better way to do this */
+    K->empty_blob = KNIL; /* trick constructor to create empty blob */
+    K->empty_blob = kblob_new_imm(K, 0);
+
     /* initialize tokenizer */
 
     /* WORKAROUND: for stdin line buffering & reading of EOF */
diff --git a/src/kstate.h b/src/kstate.h
@@ -112,6 +112,9 @@ struct klisp_State {
 
     /* Strings */
     TValue empty_string;
+
+    /* Blobs */
+    TValue empty_blob;
     
     /* tokenizer */
     /* special tokens, see ktoken.c for rationale */