commit 378080ecf1439d64c9530388647d791cbda57c42
parent f300b3cc18d514dcf41edfdd01d0dd7534c74eb7
Author: Andres Navarro <canavarro82@gmail.com>
Date: Wed, 16 Nov 2011 18:16:57 -0300
Terminology change: renamed blobs to bytevectors following r6rs and the last draft of r7rs.
Diffstat:
19 files changed, 493 insertions(+), 468 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -35,12 +35,12 @@ 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 kscript.o \
kencapsulation.o kpromise.o kport.o kinteger.o krational.o \
- kreal.o ktable.o kgc.o imath.o imrat.o kblob.o \
+ kreal.o ktable.o kgc.o imath.o imrat.o kbytevector.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 \
kgpromises.o kgkd_vars.o kgks_vars.o kgports.o kgchars.o kgnumbers.o \
- kgstrings.o kgblobs.o kgsystem.o kgerror.o \
+ kgstrings.o kgbytevectors.o kgsystem.o kgerror.o \
$(if $(USE_LIBFFI),kgffi.o)
# TEMP: in klisp there is no distinction between core & lib
@@ -69,7 +69,7 @@ $(KRN_T): $(KRN_O) $(KRN_A)
$(CC) -o $@ $(MYLDFLAGS) $(KRN_O) $(KRN_A) $(LIBS)
clean:
- $(RM) $(ALL_T) $(ALL_O)
+ $(RM) $(ALL_T) $(ALL_O) kgffi.o
depend:
@$(CC) $(CFLAGS) -MM k*.c imath.c imrat.c
@@ -116,8 +116,8 @@ kapplicative.o: kapplicative.c kobject.h klimits.h klisp.h klispconf.h \
kstate.h ktoken.h kmem.h kapplicative.h koperative.h kgc.h
kauxlib.o: kauxlib.c klisp.h kobject.h klimits.h klispconf.h kstate.h \
ktoken.h kmem.h
-kblob.o: kblob.c kblob.h kobject.h klimits.h klisp.h klispconf.h kstate.h \
- ktoken.h kmem.h kgc.h
+kbytevector.o: kbytevector.c kbytevector.h kobject.h klimits.h klisp.h \
+klispconf.h kstate.h ktoken.h kmem.h kgc.h
kcontinuation.o: kcontinuation.c kcontinuation.h kobject.h klimits.h \
klisp.h klispconf.h kstate.h ktoken.h kmem.h kgc.h
kencapsulation.o: kencapsulation.c kobject.h klimits.h klisp.h \
@@ -129,16 +129,16 @@ kerror.o: kerror.c klisp.h kobject.h klimits.h klispconf.h kpair.h \
kstate.h ktoken.h kmem.h kgc.h kstring.h
keval.o: keval.c klisp.h kobject.h klimits.h klispconf.h kstate.h \
ktoken.h kmem.h kpair.h kgc.h kenvironment.h kcontinuation.h kerror.h
-kgblobs.o: kgblobs.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
- ktoken.h kmem.h kapplicative.h koperative.h kcontinuation.h kerror.h \
- kblob.h kghelpers.h kpair.h kgc.h kenvironment.h ksymbol.h kstring.h \
- kgblobs.h kgnumbers.h
+kgbytevectors.o: kgbytevectors.c kstate.h klimits.h klisp.h kobject.h \
+ klispconf.h ktoken.h kmem.h kapplicative.h koperative.h kcontinuation.h \
+ kerror.h kbytevector.h kghelpers.h kpair.h kgc.h kenvironment.h ksymbol.h \
+ kstring.h kgbytevectors.h kgnumbers.h
kgbooleans.o: kgbooleans.c kobject.h klimits.h klisp.h klispconf.h \
kstate.h ktoken.h kmem.h kpair.h kgc.h ksymbol.h kstring.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 kblob.h \
+ ktoken.h kmem.h kport.h imath.h imrat.h ktable.h kstring.h kbytevector.h \
kerror.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 \
@@ -172,9 +172,9 @@ kgeqp.o: kgeqp.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
kapplicative.h koperative.h kenvironment.h ksymbol.h kstring.h kgeqp.h \
kinteger.h imath.h krational.h imrat.h
kgequalp.o: kgequalp.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
- ktoken.h kmem.h kpair.h kgc.h kstring.h kblob.h kcontinuation.h kerror.h \
- kghelpers.h kapplicative.h koperative.h kenvironment.h ksymbol.h kgeqp.h \
- kinteger.h imath.h krational.h imrat.h kgequalp.h
+ ktoken.h kmem.h kpair.h kgc.h kstring.h kbytevector.h kcontinuation.h \
+ kerror.h kghelpers.h kapplicative.h koperative.h kenvironment.h ksymbol.h \
+ kgeqp.h kinteger.h imath.h krational.h imrat.h kgequalp.h
kgerror.o: kgerror.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
ktoken.h kmem.h kstring.h kpair.h kgc.h kerror.h kghelpers.h \
kapplicative.h koperative.h kcontinuation.h kenvironment.h ksymbol.h \
@@ -206,7 +206,8 @@ kgpairs_lists.o: kgpairs_lists.c kstate.h klimits.h klisp.h kobject.h \
kgports.o: kgports.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
ktoken.h kmem.h kport.h kenvironment.h kapplicative.h koperative.h \
kcontinuation.h kpair.h kgc.h kerror.h ksymbol.h kstring.h kread.h \
- kwrite.h kghelpers.h kgports.h kgcontinuations.h kgcontrol.h kgkd_vars.h kscript.h
+ kwrite.h kghelpers.h kgports.h kgcontinuations.h kgcontrol.h kgkd_vars.h \
+ kscript.h
kgpromises.o: kgpromises.c kstate.h klimits.h klisp.h kobject.h \
klispconf.h ktoken.h kmem.h kpromise.h kpair.h kgc.h kapplicative.h \
koperative.h kcontinuation.h kerror.h kghelpers.h kenvironment.h \
@@ -218,7 +219,7 @@ kground.o: kground.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
kgequalp.h kgsymbols.h kgcontrol.h kgpairs_lists.h kgpair_mut.h \
kgenvironments.h kgenv_mut.h kgcombiners.h kgcontinuations.h \
kgencapsulations.h kgpromises.h kgkd_vars.h kgks_vars.h kgnumbers.h \
- kgstrings.h kgchars.h kgports.h kgblobs.h ktable.h keval.h krepl.h \
+ kgstrings.h kgchars.h kgports.h kgbytevectors.h ktable.h keval.h krepl.h \
kscript.h kgsystem.h kgerror.h kgffi.h
kgstrings.o: kgstrings.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
ktoken.h kmem.h kapplicative.h koperative.h kcontinuation.h kerror.h \
@@ -235,7 +236,7 @@ kgsystem.o: kgsystem.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
kgffi.o: kgsystem.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
ktoken.h kmem.h kpair.h kgc.h kerror.h kghelpers.h kapplicative.h \
koperative.h kcontinuation.h kenvironment.h ksymbol.h kstring.h \
- kblob.h kencapsulation.h kgencapsulations.h kgffi.h
+ kbytevector.h kencapsulation.h kgencapsulations.h kgffi.h
kinteger.o: kinteger.c kinteger.h kobject.h klimits.h klisp.h klispconf.h \
kstate.h ktoken.h kmem.h imath.h kgc.h
klisp.o: klisp.c klimits.h klisp.h kobject.h klispconf.h kstate.h \
@@ -263,11 +264,12 @@ krepl.o: krepl.c klisp.h kobject.h klimits.h klispconf.h kstate.h \
kstring.h krepl.h ksymbol.h kport.h kpair.h kgc.h ktable.h
kscript.o: kscript.c klisp.h kobject.h klimits.h klispconf.h kstate.h \
ktoken.h kmem.h kcontinuation.h kenvironment.h kerror.h kread.h kwrite.h \
- kstring.h krepl.h kscript.h ksymbol.h kport.h kpair.h kgc.h ktable.h kgcontrol.h
+ kstring.h krepl.h kscript.h ksymbol.h kport.h kpair.h kgc.h ktable.h \
+ kgcontrol.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 kscript.h \
- ksymbol.h kport.h ktable.h kblob.h kgpairs_lists.h kghelpers.h kerror.h
+ ksymbol.h kport.h ktable.h kbytevector.h kgpairs_lists.h kghelpers.h kerror.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 \
@@ -282,7 +284,7 @@ ktoken.o: ktoken.c ktoken.h kobject.h klimits.h klisp.h klispconf.h \
kwrite.o: kwrite.c kwrite.h kobject.h klimits.h klisp.h klispconf.h \
kstate.h ktoken.h kmem.h kinteger.h imath.h krational.h imrat.h kreal.h \
kpair.h kgc.h kstring.h ksymbol.h kerror.h ktable.h kport.h \
- kenvironment.h kblob.h
+ kenvironment.h kbytevector.h
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 \
diff --git a/src/kblob.c b/src/kblob.c
@@ -1,66 +0,0 @@
-/*
-** 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
@@ -1,34 +0,0 @@
-/*
-** kblob.h
-** Kernel Blobs (byte vectors)
-** See Copyright Notice in klisp.h
-*/
-
-#ifndef kblob_h
-#define kblob_h
-
-#include "kobject.h"
-#include "kstate.h"
-
-/* TODO change blob constructors to string like constructors */
-/* TODO change names to lua-like (e.g. klispB_new, etc) */
-
-/* Constructors for blobs */
-TValue kblob_new_g(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 */
-bool kblob_equalp(TValue obj1, TValue obj2);
-bool kblob(TValue obj);
-
-/* some macros to access the parts of the blobs */
-#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_))
-
-#endif
diff --git a/src/kbytevector.c b/src/kbytevector.c
@@ -0,0 +1,66 @@
+/*
+** kbytevector.c
+** Kernel Byte Vectors
+** See Copyright Notice in klisp.h
+*/
+
+#include <string.h>
+
+#include "kbytevector.h"
+#include "kobject.h"
+#include "kstate.h"
+#include "kmem.h"
+#include "kgc.h"
+
+/* Constructors */
+TValue kbytevector_new_g(klisp_State *K, bool m, uint32_t size)
+{
+ Bytevector *new_bytevector;
+
+ /* XXX: find a better way to do this! */
+ if (size == 0 && ttisbytevector(K->empty_bytevector)) {
+ return K->empty_bytevector;
+ }
+
+ new_bytevector = klispM_malloc(K, sizeof(Bytevector) + size);
+
+ /* header + gc_fields */
+ klispC_link(K, (GCObject *) new_bytevector, K_TBYTEVECTOR, m? 0 : K_FLAG_IMMUTABLE);
+
+ /* bytevector specific fields */
+ new_bytevector->mark = KFALSE;
+ new_bytevector->size = size;
+
+ /* clear the buffer */
+ memset(new_bytevector->b, 0, size);
+
+ return gc2bytevector(new_bytevector);
+}
+
+TValue kbytevector_new(klisp_State *K, uint32_t size)
+{
+ return kbytevector_new_g(K, true, size);
+}
+
+TValue kbytevector_new_imm(klisp_State *K, uint32_t size)
+{
+ return kbytevector_new_g(K, false, size);
+}
+
+/* both obj1 and obj2 should be bytevectors */
+bool kbytevector_equalp(TValue obj1, TValue obj2)
+{
+ klisp_assert(ttisbytevector(obj1) && ttisbytevector(obj2));
+
+ Bytevector *bytevector1 = tv2bytevector(obj1);
+ Bytevector *bytevector2 = tv2bytevector(obj2);
+
+ if (bytevector1->size == bytevector2->size) {
+ return (bytevector1->size == 0) ||
+ (memcmp(bytevector1->b, bytevector2->b, bytevector1->size) == 0);
+ } else {
+ return false;
+ }
+}
+
+bool kbytevectorp(TValue obj) { return ttisbytevector(obj); }
diff --git a/src/kbytevector.h b/src/kbytevector.h
@@ -0,0 +1,34 @@
+/*
+** kbytevector.h
+** Kernel Byte Vectors
+** See Copyright Notice in klisp.h
+*/
+
+#ifndef kbytevector_h
+#define kbytevector_h
+
+#include "kobject.h"
+#include "kstate.h"
+
+/* TODO change bytevector constructors to string like constructors */
+/* TODO change names to lua-like (e.g. klispB_new, etc) */
+
+/* Constructors for bytevectors */
+TValue kbytevector_new_g(klisp_State *K, bool m, uint32_t size);
+TValue kbytevector_new_imm(klisp_State *K, uint32_t size);
+TValue kbytevector_new(klisp_State *K, uint32_t size);
+
+/* both obj1 and obj2 should be bytevectors, this compares byte by byte
+ and doesn't differentiate immutable from mutable bytevectors */
+bool kbytevector_equalp(TValue obj1, TValue obj2);
+bool kbytevector(TValue obj);
+
+/* some macros to access the parts of the bytevectors */
+#define kbytevector_buf(tv_) (tv2bytevector(tv_)->b)
+#define kbytevector_size(tv_) (tv2bytevector(tv_)->size)
+
+#define kbytevector_emptyp(tv_) (kbytevector_size(tv_) == 0)
+#define kbytevector_mutablep(tv_) (kis_mutable(tv_))
+#define kbytevector_immutablep(tv_) (kis_immutable(tv_))
+
+#endif
diff --git a/src/kgblobs.c b/src/kgblobs.c
@@ -1,247 +0,0 @@
-/*
-** kgblobs.c
-** Blobs features for the ground environment
-** See Copyright Notice in klisp.h
-*/
-
-#include <assert.h>
-#include <stdio.h>
-#include <string.h>
-#include <stdlib.h>
-#include <stdbool.h>
-#include <stdint.h>
-
-#include "kstate.h"
-#include "kobject.h"
-#include "kapplicative.h"
-#include "koperative.h"
-#include "kcontinuation.h"
-#include "kerror.h"
-#include "kblob.h"
-
-#include "kghelpers.h"
-#include "kgblobs.h"
-#include "kgnumbers.h" /* for keintegerp & knegativep */
-
-/* 13.1.1? blob? */
-/* uses typep */
-
-/* 13.1.2? make-blob */
-void make_blob(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
-{
- UNUSED(xparams);
- UNUSED(denv);
- bind_al1tp(K, ptree, "exact integer", keintegerp, tv_s,
- maybe_byte);
-
- uint8_t fill = 0;
- if (get_opt_tpar(K, "make-blob", K_TFIXINT, &maybe_byte)) {
- if (ivalue(maybe_byte) < 0 || ivalue(maybe_byte) > 255) {
- klispE_throw_simple(K, "bad fill byte");
- return;
- }
- fill = ivalue(maybe_byte);
- }
-
- if (knegativep(tv_s)) {
- klispE_throw_simple(K, "negative size");
- return;
- } else if (!ttisfixint(tv_s)) {
- klispE_throw_simple(K, "size is too big");
- return;
- }
-/* XXX/TODO */
-/* TValue new_blob = kblob_new_sf(K, ivalue(tv_s), fill); */
- TValue new_blob = kblob_new(K, ivalue(tv_s));
- if (fill != 0) {
- int32_t s = ivalue(tv_s);
- uint8_t *ptr = kblob_buf(new_blob);
- while(s--)
- *ptr++ = fill;
- }
-
- kapply_cc(K, new_blob);
-}
-
-/* 13.1.3? blob-length */
-void blob_length(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv)
-{
- UNUSED(xparams);
- UNUSED(denv);
- bind_1tp(K, ptree, "blob", ttisblob, blob);
-
- TValue res = i2tv(kblob_size(blob));
- kapply_cc(K, res);
-}
-
-/* 13.1.4? blob-u8-ref */
-void blob_u8_ref(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
-{
- UNUSED(xparams);
- UNUSED(denv);
- bind_2tp(K, ptree, "blob", ttisblob, blob,
- "exact integer", keintegerp, tv_i);
-
- if (!ttisfixint(tv_i)) {
- /* TODO show index */
- klispE_throw_simple(K, "index out of bounds");
- return;
- }
- int32_t i = ivalue(tv_i);
-
- if (i < 0 || i >= kblob_size(blob)) {
- /* TODO show index */
- klispE_throw_simple(K, "index out of bounds");
- return;
- }
-
- TValue res = i2tv(kblob_buf(blob)[i]);
- kapply_cc(K, res);
-}
-
-/* 13.1.5? blob-u8-set! */
-void blob_u8_setS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
-{
- UNUSED(xparams);
- UNUSED(denv);
- bind_3tp(K, ptree, "blob", ttisblob, blob,
- "exact integer", keintegerp, tv_i, "u8", ttisu8, tv_byte);
-
- if (!ttisfixint(tv_i)) {
- /* TODO show index */
- klispE_throw_simple(K, "index out of bounds");
- return;
- } else if (kblob_immutablep(blob)) {
- klispE_throw_simple(K, "immutable blob");
- return;
- }
-
- int32_t i = ivalue(tv_i);
-
- if (i < 0 || i >= kblob_size(blob)) {
- /* TODO show index */
- klispE_throw_simple(K, "index out of bounds");
- return;
- }
-
- kblob_buf(blob)[i] = (uint8_t) ivalue(tv_byte);
- kapply_cc(K, KINERT);
-}
-
-/* TODO change blob constructors to string like constructors */
-
-/* 13.2.8? blob-copy */
-/* TEMP: at least for now this always returns mutable blobs */
-void blob_copy(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
-{
- UNUSED(xparams);
- UNUSED(denv);
- bind_1tp(K, ptree, "blob", ttisblob, blob);
-
- TValue new_blob;
- /* the if isn't strictly necessary but it's clearer this way */
- if (tv_equal(blob, K->empty_blob)) {
- new_blob = blob;
- } else {
- new_blob = kblob_new(K, kblob_size(blob));
- memcpy(kblob_buf(new_blob), kblob_buf(blob), kblob_size(blob));
- }
- kapply_cc(K, new_blob);
-}
-
-/* 13.2.9? blob->immutable-blob */
-void blob_to_immutable_blob(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv)
-{
- UNUSED(xparams);
- UNUSED(denv);
- bind_1tp(K, ptree, "blob", ttisblob, blob);
-
- TValue res_blob;
- if (kblob_immutablep(blob)) {/* this includes the empty blob */
- res_blob = blob;
- } else {
- res_blob = kblob_new_imm(K, kblob_size(blob));
- memcpy(kblob_buf(res_blob), kblob_buf(blob), kblob_size(blob));
- }
- kapply_cc(K, res_blob);
-}
-
-/* init ground */
-void kinit_blobs_ground_env(klisp_State *K)
-{
- TValue ground_env = K->ground_env;
- TValue symbol, value;
-
- /*
- ** This section is not in the report. The bindings here are
- ** taken from the r7rs scheme draft and should not be considered standard.
- ** They are provided in the meantime to allow programs to use byte vectors.
- */
-
- /* ??.1.1? blob? */
- add_applicative(K, ground_env, "blob?", typep, 2, symbol,
- i2tv(K_TBLOB));
- /* ??.1.2? make-blob */
- add_applicative(K, ground_env, "make-blob", make_blob, 0);
- /* ??.1.3? blob-length */
- add_applicative(K, ground_env, "blob-length", blob_length, 0);
-
- /* ??.1.4? blob-u8-ref */
- add_applicative(K, ground_env, "blob-u8-ref", blob_u8_ref, 0);
- /* ??.1.5? blob-u8-set! */
- add_applicative(K, ground_env, "blob-u8-set!", blob_u8_setS, 0);
-
- /* ??.1.?? blob-copy */
- add_applicative(K, ground_env, "blob-copy", blob_copy, 0);
- /* ??.1.?? blob->immutable-blob */
- add_applicative(K, ground_env, "blob->immutable-blob", blob_to_immutable_blob, 0);
-
-/* TODO put the blob equivalents here */
-#if 0
- /* 13.2.1? string */
- add_applicative(K, ground_env, "string", string, 0);
- /* 13.2.2? string=?, string-ci=? */
- add_applicative(K, ground_env, "string=?", ftyped_bpredp, 3,
- symbol, p2tv(kstringp), p2tv(kstring_eqp));
- add_applicative(K, ground_env, "string-ci=?", ftyped_bpredp, 3,
- symbol, p2tv(kstringp), p2tv(kstring_ci_eqp));
- /* 13.2.3? string<?, string<=?, string>?, string>=? */
- add_applicative(K, ground_env, "string<?", ftyped_bpredp, 3,
- symbol, p2tv(kstringp), p2tv(kstring_ltp));
- add_applicative(K, ground_env, "string<=?", ftyped_bpredp, 3,
- symbol, p2tv(kstringp), p2tv(kstring_lep));
- add_applicative(K, ground_env, "string>?", ftyped_bpredp, 3,
- symbol, p2tv(kstringp), p2tv(kstring_gtp));
- add_applicative(K, ground_env, "string>=?", ftyped_bpredp, 3,
- symbol, p2tv(kstringp), p2tv(kstring_gep));
- /* 13.2.4? string-ci<?, string-ci<=?, string-ci>?, string-ci>=? */
- add_applicative(K, ground_env, "string-ci<?", ftyped_bpredp, 3,
- symbol, p2tv(kstringp), p2tv(kstring_ci_ltp));
- add_applicative(K, ground_env, "string-ci<=?", ftyped_bpredp, 3,
- symbol, p2tv(kstringp), p2tv(kstring_ci_lep));
- add_applicative(K, ground_env, "string-ci>?", ftyped_bpredp, 3,
- symbol, p2tv(kstringp), p2tv(kstring_ci_gtp));
- add_applicative(K, ground_env, "string-ci>=?", ftyped_bpredp, 3,
- symbol, p2tv(kstringp), p2tv(kstring_ci_gep));
- /* 13.2.5? substring */
- add_applicative(K, ground_env, "substring", substring, 0);
- /* 13.2.6? string-append */
- add_applicative(K, ground_env, "string-append", string_append, 0);
- /* 13.2.7? string->list, list->string */
- add_applicative(K, ground_env, "string->list", string_to_list, 0);
- add_applicative(K, ground_env, "list->string", list_to_string, 0);
- /* 13.2.8? string-copy */
- add_applicative(K, ground_env, "string-copy", string_copy, 0);
- /* 13.2.9? string->immutable-string */
- add_applicative(K, ground_env, "string->immutable-string",
- string_to_immutable_string, 0);
-
- /* TODO: add string-immutable? or general immutable? */
- /* TODO: add string-upcase and string-downcase like in r7rs-draft */
-
- /* 13.2.10? string-fill! */
- add_applicative(K, ground_env, "string-fill!", string_fillS, 0);
-#endif
-}
diff --git a/src/kgblobs.h b/src/kgblobs.h
@@ -1,48 +0,0 @@
-/*
-** kgblobs.h
-** Blobs features for the ground environment
-** See Copyright Notice in klisp.h
-*/
-
-#ifndef kgblobs_h
-#define kgblobs_h
-
-#include <assert.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <stdbool.h>
-#include <stdint.h>
-
-#include "kobject.h"
-#include "klisp.h"
-#include "kstate.h"
-#include "kghelpers.h"
-
-/* ??.1.1? blob? */
-/* uses typep */
-
-/* ??.1.2? make-blob */
-void make_blob(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
-
-/* ??.1.3? blob-length */
-void blob_length(klisp_State *K, TValue *xparams, TValue ptree,
- TValue denv);
-
-/* ??.1.4? blob-u8-ref */
-void blob_u8_ref(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
-
-/* ??.1.5? blob-u8-set! */
-void blob_u8_setS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
-
-/* ??.2.?? blob-copy */
-void blob_copy(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv);
-
-/* ??.2.?? blob->immutable-blob */
-void blob_to_immutable_blob(klisp_State *K, TValue *xparams,
- TValue ptree, TValue denv);
-
-/* init ground */
-void kinit_blobs_ground_env(klisp_State *K);
-
-#endif
diff --git a/src/kgbytevectors.c b/src/kgbytevectors.c
@@ -0,0 +1,258 @@
+/*
+** kgbytevectors.c
+** Bytevectors features for the ground environment
+** See Copyright Notice in klisp.h
+*/
+
+#include <assert.h>
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+#include <stdbool.h>
+#include <stdint.h>
+
+#include "kstate.h"
+#include "kobject.h"
+#include "kapplicative.h"
+#include "koperative.h"
+#include "kcontinuation.h"
+#include "kerror.h"
+#include "kbytevector.h"
+
+#include "kghelpers.h"
+#include "kgbytevectors.h"
+#include "kgnumbers.h" /* for keintegerp & knegativep */
+
+/* 13.1.1? bytevector? */
+/* uses typep */
+
+/* 13.1.2? make-bytevector */
+void make_bytevector(klisp_State *K, TValue *xparams, TValue ptree,
+ TValue denv)
+{
+ UNUSED(xparams);
+ UNUSED(denv);
+ bind_al1tp(K, ptree, "exact integer", keintegerp, tv_s,
+ maybe_byte);
+
+ uint8_t fill = 0;
+ if (get_opt_tpar(K, "make-bytevector", K_TFIXINT, &maybe_byte)) {
+ if (ivalue(maybe_byte) < 0 || ivalue(maybe_byte) > 255) {
+ klispE_throw_simple(K, "bad fill byte");
+ return;
+ }
+ fill = ivalue(maybe_byte);
+ }
+
+ if (knegativep(tv_s)) {
+ klispE_throw_simple(K, "negative size");
+ return;
+ } else if (!ttisfixint(tv_s)) {
+ klispE_throw_simple(K, "size is too big");
+ return;
+ }
+/* XXX/TODO */
+/* TValue new_bytevector = kbytevector_new_sf(K, ivalue(tv_s), fill); */
+ TValue new_bytevector = kbytevector_new(K, ivalue(tv_s));
+ if (fill != 0) {
+ int32_t s = ivalue(tv_s);
+ uint8_t *ptr = kbytevector_buf(new_bytevector);
+ while(s--)
+ *ptr++ = fill;
+ }
+
+ kapply_cc(K, new_bytevector);
+}
+
+/* 13.1.3? bytevector-length */
+void bytevector_length(klisp_State *K, TValue *xparams, TValue ptree,
+ TValue denv)
+{
+ UNUSED(xparams);
+ UNUSED(denv);
+ bind_1tp(K, ptree, "bytevector", ttisbytevector, bytevector);
+
+ TValue res = i2tv(kbytevector_size(bytevector));
+ kapply_cc(K, res);
+}
+
+/* 13.1.4? bytevector-u8-ref */
+void bytevector_u8_ref(klisp_State *K, TValue *xparams, TValue ptree,
+ TValue denv)
+{
+ UNUSED(xparams);
+ UNUSED(denv);
+ bind_2tp(K, ptree, "bytevector", ttisbytevector, bytevector,
+ "exact integer", keintegerp, tv_i);
+
+ if (!ttisfixint(tv_i)) {
+ /* TODO show index */
+ klispE_throw_simple(K, "index out of bounds");
+ return;
+ }
+ int32_t i = ivalue(tv_i);
+
+ if (i < 0 || i >= kbytevector_size(bytevector)) {
+ /* TODO show index */
+ klispE_throw_simple(K, "index out of bounds");
+ return;
+ }
+
+ TValue res = i2tv(kbytevector_buf(bytevector)[i]);
+ kapply_cc(K, res);
+}
+
+/* 13.1.5? bytevector-u8-set! */
+void bytevector_u8_setS(klisp_State *K, TValue *xparams, TValue ptree,
+ TValue denv)
+{
+ UNUSED(xparams);
+ UNUSED(denv);
+ bind_3tp(K, ptree, "bytevector", ttisbytevector, bytevector,
+ "exact integer", keintegerp, tv_i, "u8", ttisu8, tv_byte);
+
+ if (!ttisfixint(tv_i)) {
+ /* TODO show index */
+ klispE_throw_simple(K, "index out of bounds");
+ return;
+ } else if (kbytevector_immutablep(bytevector)) {
+ klispE_throw_simple(K, "immutable bytevector");
+ return;
+ }
+
+ int32_t i = ivalue(tv_i);
+
+ if (i < 0 || i >= kbytevector_size(bytevector)) {
+ /* TODO show index */
+ klispE_throw_simple(K, "index out of bounds");
+ return;
+ }
+
+ kbytevector_buf(bytevector)[i] = (uint8_t) ivalue(tv_byte);
+ kapply_cc(K, KINERT);
+}
+
+/* TODO change bytevector constructors to string like constructors */
+
+/* 13.2.8? bytevector-copy */
+/* TEMP: at least for now this always returns mutable bytevectors */
+void bytevector_copy(klisp_State *K, TValue *xparams, TValue ptree,
+ TValue denv)
+{
+ UNUSED(xparams);
+ UNUSED(denv);
+ bind_1tp(K, ptree, "bytevector", ttisbytevector, bytevector);
+
+ TValue new_bytevector;
+ /* the if isn't strictly necessary but it's clearer this way */
+ if (tv_equal(bytevector, K->empty_bytevector)) {
+ new_bytevector = bytevector;
+ } else {
+ new_bytevector = kbytevector_new(K, kbytevector_size(bytevector));
+ memcpy(kbytevector_buf(new_bytevector),
+ kbytevector_buf(bytevector),
+ kbytevector_size(bytevector));
+ }
+ kapply_cc(K, new_bytevector);
+}
+
+/* 13.2.9? bytevector->immutable-bytevector */
+void bytevector_to_immutable_bytevector(klisp_State *K, TValue *xparams,
+ TValue ptree, TValue denv)
+{
+ UNUSED(xparams);
+ UNUSED(denv);
+ bind_1tp(K, ptree, "bytevector", ttisbytevector, bytevector);
+
+ TValue res_bytevector;
+ if (kbytevector_immutablep(bytevector)) {
+/* this includes the empty bytevector */
+ res_bytevector = bytevector;
+ } else {
+ res_bytevector = kbytevector_new_imm(K, kbytevector_size(bytevector));
+ memcpy(kbytevector_buf(res_bytevector),
+ kbytevector_buf(bytevector),
+ kbytevector_size(bytevector));
+ }
+ kapply_cc(K, res_bytevector);
+}
+
+/* init ground */
+void kinit_bytevectors_ground_env(klisp_State *K)
+{
+ TValue ground_env = K->ground_env;
+ TValue symbol, value;
+
+ /*
+ ** This section is not in the report. The bindings here are
+ ** taken from the r7rs scheme draft and should not be considered standard.
+ ** They are provided in the meantime to allow programs to use byte vectors.
+ */
+
+ /* ??.1.1? bytevector? */
+ add_applicative(K, ground_env, "bytevector?", typep, 2, symbol,
+ i2tv(K_TBYTEVECTOR));
+ /* ??.1.2? make-bytevector */
+ add_applicative(K, ground_env, "make-bytevector", make_bytevector, 0);
+ /* ??.1.3? bytevector-length */
+ add_applicative(K, ground_env, "bytevector-length", bytevector_length, 0);
+
+ /* ??.1.4? bytevector-u8-ref */
+ add_applicative(K, ground_env, "bytevector-u8-ref", bytevector_u8_ref, 0);
+ /* ??.1.5? bytevector-u8-set! */
+ add_applicative(K, ground_env, "bytevector-u8-set!", bytevector_u8_setS,
+ 0);
+
+ /* ??.1.?? bytevector-copy */
+ add_applicative(K, ground_env, "bytevector-copy", bytevector_copy, 0);
+ /* ??.1.?? bytevector->immutable-bytevector */
+ add_applicative(K, ground_env, "bytevector->immutable-bytevector",
+ bytevector_to_immutable_bytevector, 0);
+
+/* TODO put the bytevector equivalents here */
+#if 0
+ /* 13.2.1? string */
+ add_applicative(K, ground_env, "string", string, 0);
+ /* 13.2.2? string=?, string-ci=? */
+ add_applicative(K, ground_env, "string=?", ftyped_bpredp, 3,
+ symbol, p2tv(kstringp), p2tv(kstring_eqp));
+ add_applicative(K, ground_env, "string-ci=?", ftyped_bpredp, 3,
+ symbol, p2tv(kstringp), p2tv(kstring_ci_eqp));
+ /* 13.2.3? string<?, string<=?, string>?, string>=? */
+ add_applicative(K, ground_env, "string<?", ftyped_bpredp, 3,
+ symbol, p2tv(kstringp), p2tv(kstring_ltp));
+ add_applicative(K, ground_env, "string<=?", ftyped_bpredp, 3,
+ symbol, p2tv(kstringp), p2tv(kstring_lep));
+ add_applicative(K, ground_env, "string>?", ftyped_bpredp, 3,
+ symbol, p2tv(kstringp), p2tv(kstring_gtp));
+ add_applicative(K, ground_env, "string>=?", ftyped_bpredp, 3,
+ symbol, p2tv(kstringp), p2tv(kstring_gep));
+ /* 13.2.4? string-ci<?, string-ci<=?, string-ci>?, string-ci>=? */
+ add_applicative(K, ground_env, "string-ci<?", ftyped_bpredp, 3,
+ symbol, p2tv(kstringp), p2tv(kstring_ci_ltp));
+ add_applicative(K, ground_env, "string-ci<=?", ftyped_bpredp, 3,
+ symbol, p2tv(kstringp), p2tv(kstring_ci_lep));
+ add_applicative(K, ground_env, "string-ci>?", ftyped_bpredp, 3,
+ symbol, p2tv(kstringp), p2tv(kstring_ci_gtp));
+ add_applicative(K, ground_env, "string-ci>=?", ftyped_bpredp, 3,
+ symbol, p2tv(kstringp), p2tv(kstring_ci_gep));
+ /* 13.2.5? substring */
+ add_applicative(K, ground_env, "substring", substring, 0);
+ /* 13.2.6? string-append */
+ add_applicative(K, ground_env, "string-append", string_append, 0);
+ /* 13.2.7? string->list, list->string */
+ add_applicative(K, ground_env, "string->list", string_to_list, 0);
+ add_applicative(K, ground_env, "list->string", list_to_string, 0);
+ /* 13.2.8? string-copy */
+ add_applicative(K, ground_env, "string-copy", string_copy, 0);
+ /* 13.2.9? string->immutable-string */
+ add_applicative(K, ground_env, "string->immutable-string",
+ string_to_immutable_string, 0);
+
+ /* TODO: add string-immutable? or general immutable? */
+ /* TODO: add string-upcase and string-downcase like in r7rs-draft */
+
+ /* 13.2.10? string-fill! */
+ add_applicative(K, ground_env, "string-fill!", string_fillS, 0);
+#endif
+}
diff --git a/src/kgbytevectors.h b/src/kgbytevectors.h
@@ -0,0 +1,51 @@
+/*
+** kgbytevectors.h
+** Bytevectors features for the ground environment
+** See Copyright Notice in klisp.h
+*/
+
+#ifndef kgbytevectors_h
+#define kgbytevectors_h
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdbool.h>
+#include <stdint.h>
+
+#include "kobject.h"
+#include "klisp.h"
+#include "kstate.h"
+#include "kghelpers.h"
+
+/* ??.1.1? bytevector? */
+/* uses typep */
+
+/* ??.1.2? make-bytevector */
+void make_bytevector(klisp_State *K, TValue *xparams, TValue ptree,
+ TValue denv);
+
+/* ??.1.3? bytevector-length */
+void bytevector_length(klisp_State *K, TValue *xparams, TValue ptree,
+ TValue denv);
+
+/* ??.1.4? bytevector-u8-ref */
+void bytevector_u8_ref(klisp_State *K, TValue *xparams, TValue ptree,
+ TValue denv);
+
+/* ??.1.5? bytevector-u8-set! */
+void bytevector_u8_setS(klisp_State *K, TValue *xparams, TValue ptree,
+ TValue denv);
+
+/* ??.2.?? bytevector-copy */
+void bytevector_copy(klisp_State *K, TValue *xparams, TValue ptree,
+ TValue denv);
+
+/* ??.2.?? bytevector->immutable-bytevector */
+void bytevector_to_immutable_bytevector(klisp_State *K, TValue *xparams,
+ TValue ptree, TValue denv);
+
+/* init ground */
+void kinit_bytevectors_ground_env(klisp_State *K);
+
+#endif
diff --git a/src/kgc.c b/src/kgc.c
@@ -20,7 +20,7 @@
#include "imrat.h"
#include "ktable.h"
#include "kstring.h"
-#include "kblob.h"
+#include "kbytevector.h"
#include "kerror.h"
#define GCSTEPSIZE 1024u
@@ -109,7 +109,7 @@ static void reallymarkobject (klisp_State *K, GCObject *o)
case K_TPORT:
case K_TTABLE:
case K_TERROR:
- case K_TBLOB:
+ case K_TBYTEVECTOR:
o->gch.gclist = K->gray;
K->gray = o;
break;
@@ -321,8 +321,8 @@ static int32_t propagatemark (klisp_State *K) {
markvalue(K, e->irritants);
return sizeof(Error);
}
- case K_TBLOB: {
- Blob *b = cast(Blob *, o);
+ case K_TBYTEVECTOR: {
+ Bytevector *b = cast(Bytevector *, o);
markvalue(K, b->mark);
return sizeof(String) + b->size * sizeof(uint8_t);
}
@@ -456,8 +456,8 @@ static void freeobj (klisp_State *K, GCObject *o) {
case K_TERROR:
klispE_free(K, (Error *)o);
break;
- case K_TBLOB:
- klispM_freemem(K, o, sizeof(Blob)+o->blob.size);
+ case K_TBYTEVECTOR:
+ klispM_freemem(K, o, sizeof(Bytevector)+o->bytevector.size);
break;
default:
/* shouldn't happen */
@@ -587,7 +587,7 @@ static void markroot (klisp_State *K) {
markvalue(K, K->kd_error_port_key);
markvalue(K, K->kd_strict_arith_key);
markvalue(K, K->empty_string);
- markvalue(K, K->empty_blob);
+ markvalue(K, K->empty_bytevector);
markvalue(K, K->ktok_lparen);
markvalue(K, K->ktok_rparen);
diff --git a/src/kgeqp.h b/src/kgeqp.h
@@ -28,7 +28,7 @@ void eqp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
/* Helper (also used in equal?) */
inline bool eq2p(klisp_State *K, TValue obj1, TValue obj2)
{
- /* TODO/FIXME: immutable blobs aren't interned and so will compare
+ /* TODO/FIXME: immutable bytevectors aren't interned and so will compare
as un-eq? even if the contents are the same */
bool res = (tv_equal(obj1, obj2));
if (!res && (ttype(obj1) == ttype(obj2))) {
diff --git a/src/kgequalp.c b/src/kgequalp.c
@@ -14,7 +14,7 @@
#include "kobject.h"
#include "kpair.h"
#include "kstring.h" /* for kstring_equalp */
-#include "kblob.h" /* for kblob_equalp */
+#include "kbytevector.h" /* for kbytevector_equalp */
#include "kcontinuation.h"
#include "kerror.h"
@@ -197,8 +197,8 @@ bool equal2p(klisp_State *K, TValue obj1, TValue obj2)
result = false;
break;
}
- } else if (ttisblob(obj1) && ttisblob(obj2)) {
- if (!kblob_equalp(obj1, obj2)) {
+ } else if (ttisbytevector(obj1) && ttisbytevector(obj2)) {
+ if (!kbytevector_equalp(obj1, obj2)) {
result = false;
break;
}
diff --git a/src/kgffi.c b/src/kgffi.c
@@ -36,7 +36,7 @@
#include "kinteger.h"
#include "kpair.h"
#include "kerror.h"
-#include "kblob.h"
+#include "kbytevector.h"
#include "kencapsulation.h"
#include "ktable.h"
@@ -123,8 +123,8 @@ static TValue ffi_decode_pointer(ffi_codec_t *self, klisp_State *K, const void *
static void ffi_encode_pointer(ffi_codec_t *self, klisp_State *K, TValue v, void *buf)
{
- if (ttisblob(v)) {
- *(void **)buf = tv2blob(v)->b;
+ if (ttisbytevector(v)) {
+ *(void **)buf = tv2bytevector(v)->b;
} else if (ttisstring(v)) {
*(void **)buf = kstring_buf(v);
} else if (ttisnil(v)) {
@@ -133,7 +133,7 @@ static void ffi_encode_pointer(ffi_codec_t *self, klisp_State *K, TValue v, void
/* TODO: do not use internal macro tbasetype_ */
*(void **)buf = pvalue(v);
} else {
- klispE_throw_simple_with_irritants(K, "neither blob, string, pointer or nil", 1, v);
+ klispE_throw_simple_with_irritants(K, "neither bytevector, string, pointer or nil", 1, v);
}
}
@@ -483,17 +483,17 @@ void ffi_make_call_interface(klisp_State *K, TValue *xparams,
krooted_tvs_push(K, argtypes_tv);
TValue key = xparams[0];
krooted_tvs_push(K, key);
- size_t blob_size = sizeof(ffi_call_interface_t) + (sizeof(ffi_codec_t *) + sizeof(ffi_type)) * nargs;
- TValue blob = kblob_new_imm(K, blob_size);
- krooted_tvs_push(K, blob);
- TValue enc = kmake_encapsulation(K, key, blob);
+ size_t bytevector_size = sizeof(ffi_call_interface_t) + (sizeof(ffi_codec_t *) + sizeof(ffi_type)) * nargs;
+ TValue bytevector = kbytevector_new_imm(K, bytevector_size);
+ krooted_tvs_push(K, bytevector);
+ TValue enc = kmake_encapsulation(K, key, bytevector);
krooted_tvs_pop(K);
krooted_tvs_pop(K);
krooted_tvs_pop(K);
krooted_tvs_pop(K);
krooted_tvs_pop(K);
- ffi_call_interface_t *p = (ffi_call_interface_t *) tv2blob(blob)->b;
+ ffi_call_interface_t *p = (ffi_call_interface_t *) tv2bytevector(bytevector)->b;
p->acodecs = (ffi_codec_t **) ((char *) p + sizeof(ffi_call_interface_t));
p->argtypes = (ffi_type **) ((char *) p + sizeof(ffi_call_interface_t) + nargs * sizeof(ffi_codec_t *));
@@ -541,11 +541,11 @@ void do_ffi_call(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
UNUSED(denv);
/*
** xparams[0]: function pointer
- ** xparams[1]: call interface (encapsulated blob)
+ ** xparams[1]: call interface (encapsulated bytevector)
*/
void *funptr = pvalue(xparams[0]);
- ffi_call_interface_t *p = (ffi_call_interface_t *) tv2blob(kget_enc_val(xparams[1]))->b;
+ ffi_call_interface_t *p = (ffi_call_interface_t *) tv2bytevector(kget_enc_val(xparams[1]))->b;
int64_t buffer[(p->buffer_size + sizeof(int64_t) - 1) / sizeof(int64_t)];
@@ -690,7 +690,7 @@ void do_ffi_callback_encode_result(klisp_State *K, TValue *xparams,
** xparams[0]: cif
** xparams[1]: p2tv(libffi return buffer)
*/
- ffi_call_interface_t *p = (ffi_call_interface_t *) kblob_buf(kget_enc_val(xparams[0]));
+ ffi_call_interface_t *p = (ffi_call_interface_t *) kbytevector_buf(kget_enc_val(xparams[0]));
void *ret = pvalue(xparams[1]);
p->rcodec->encode(p->rcodec, K, obj, ret);
kapply_cc(K, KINERT);
@@ -719,7 +719,7 @@ void do_ffi_callback_decode_arguments(klisp_State *K, TValue *xparams,
assert(ttisencapsulation(cif_tv));
krooted_tvs_push(K, app_tv);
krooted_tvs_push(K, cif_tv);
- ffi_call_interface_t *p = (ffi_call_interface_t *) kblob_buf(kget_enc_val(cif_tv));
+ ffi_call_interface_t *p = (ffi_call_interface_t *) kbytevector_buf(kget_enc_val(cif_tv));
/* Decode arguments. */
@@ -878,7 +878,7 @@ void ffi_make_callback(klisp_State *K, TValue *xparams,
klispE_throw_simple(K, "second argument shall be call interface");
return;
}
- ffi_call_interface_t *p = (ffi_call_interface_t *) kblob_buf(kget_enc_val(cif_tv));
+ ffi_call_interface_t *p = (ffi_call_interface_t *) kbytevector_buf(kget_enc_val(cif_tv));
TValue cb_tab = xparams[1];
/* Allocate memory for libffi closure. */
@@ -936,15 +936,15 @@ void ffi_make_callback(klisp_State *K, TValue *xparams,
static uint8_t * ffi_memory_location(klisp_State *K, bool allow_nesting,
TValue v, bool mutable, size_t size)
{
- if (ttisblob(v)) {
- if (mutable && kblob_immutablep(v)) {
- klispE_throw_simple_with_irritants(K, "blob not mutable", 1, v);
+ if (ttisbytevector(v)) {
+ if (mutable && kbytevector_immutablep(v)) {
+ klispE_throw_simple_with_irritants(K, "bytevector not mutable", 1, v);
return NULL;
- } else if (size > kblob_size(v)) {
- klispE_throw_simple_with_irritants(K, "blob too small", 1, v);
+ } else if (size > kbytevector_size(v)) {
+ klispE_throw_simple_with_irritants(K, "bytevector too small", 1, v);
return NULL;
} else {
- return kblob_buf(v);
+ return kbytevector_buf(v);
}
} else if (ttisstring(v)) {
if (mutable && kstring_immutablep(v)) {
diff --git a/src/kground.c b/src/kground.c
@@ -35,7 +35,7 @@
#include "kgstrings.h"
#include "kgchars.h"
#include "kgports.h"
-#include "kgblobs.h"
+#include "kgbytevectors.h"
#include "kgsystem.h"
#include "kgerror.h"
@@ -142,7 +142,7 @@ void kinit_ground_env(klisp_State *K)
kinit_strings_ground_env(K);
kinit_chars_ground_env(K);
kinit_ports_ground_env(K);
- kinit_blobs_ground_env(K);
+ kinit_bytevectors_ground_env(K);
kinit_system_ground_env(K);
kinit_error_ground_env(K);
#if KUSE_LIBFFI
diff --git a/src/kobject.c b/src/kobject.c
@@ -30,6 +30,7 @@ const TValue kfree = KFREE_;
/*
** The name strings for all TValue types
+** This should be updated if types are modified in kobject.h
*/
char *ktv_names[] = {
[K_TFIXINT] = "fixint",
@@ -39,11 +40,12 @@ char *ktv_names[] = {
[K_TEINF] = "einf",
[K_TDOUBLE] = "double",
[K_TBDOUBLE] = "bdouble",
+ [K_TIINF] = "einf",
[K_TIINF] = "iinf",
[K_TRWNPV] = "rwnpv",
- [K_TUNDEFINED] = "undefined",
[K_TCOMPLEX] = "complex",
+ [K_TUNDEFINED] = "undefined",
[K_TNIL] = "nil",
[K_TIGNORE] = "ignore",
@@ -51,7 +53,7 @@ char *ktv_names[] = {
[K_TEOF] = "eof",
[K_TBOOLEAN] = "boolean",
[K_TCHAR] = "char",
- [K_TCHAR] = "free entry",
+ [K_TFREE] = "free entry",
[K_TDEADKEY] = "dead key",
[K_TUSER] = "user pointer",
@@ -65,7 +67,10 @@ char *ktv_names[] = {
[K_TAPPLICATIVE] = "applicative",
[K_TENCAPSULATION] = "encapsulation",
[K_TPROMISE] = "promise",
- [K_TPORT] = "port"
+ [K_TPORT] = "port",
+ [K_TTABLE] = "table",
+ [K_TERROR] = "error",
+ [K_TBYTEVECTOR] = "bytevector"
};
bool kis_input_port(TValue o)
diff --git a/src/kobject.h b/src/kobject.h
@@ -127,6 +127,10 @@ typedef struct __attribute__ ((__packed__)) GCheader {
*/
/* LUA NOTE: In Lua the corresponding defines are in lua.h */
+/*
+** The name strings for all TValue types are in kobject.c
+** Thoseshould be updated if types here are modified
+*/
#define K_TFIXINT 0
#define K_TBIGINT 1
#define K_TFIXRAT 2
@@ -161,7 +165,7 @@ typedef struct __attribute__ ((__packed__)) GCheader {
#define K_TPORT 39
#define K_TTABLE 40
#define K_TERROR 41
-#define K_TBLOB 42
+#define K_TBYTEVECTOR 42
/* for tables */
#define K_TDEADKEY 60
@@ -214,7 +218,7 @@ typedef struct __attribute__ ((__packed__)) GCheader {
#define K_TAG_PORT K_MAKE_VTAG(K_TPORT)
#define K_TAG_TABLE K_MAKE_VTAG(K_TTABLE)
#define K_TAG_ERROR K_MAKE_VTAG(K_TERROR)
-#define K_TAG_BLOB K_MAKE_VTAG(K_TBLOB)
+#define K_TAG_BYTEVECTOR K_MAKE_VTAG(K_TBYTEVECTOR)
/*
@@ -299,7 +303,7 @@ typedef struct __attribute__ ((__packed__)) GCheader {
#define ttisport(o) (tbasetype_(o) == K_TAG_PORT)
#define ttistable(o) (tbasetype_(o) == K_TAG_TABLE)
#define ttiserror(o) (tbasetype_(o) == K_TAG_ERROR)
-#define ttisblob(o) (tbasetype_(o) == K_TAG_BLOB)
+#define ttisbytevector(o) (tbasetype_(o) == K_TAG_BYTEVECTOR)
/* macros to easily check boolean values */
#define kis_true(o_) (tv_equal((o_), KTRUE))
@@ -484,14 +488,14 @@ typedef struct __attribute__ ((__packed__)) {
TValue irritants; /* list of extra objs */
} Error;
-/* Blobs (binary vectors) */
+/* Bytevectors */
typedef struct __attribute__ ((__packed__)) {
CommonHeader;
TValue mark; /* for cycle/sharing aware algorithms */
uint32_t size;
int32_t __dummy; /* for alignment to 64 bits */
uint8_t b[]; /* buffer */
-} Blob;
+} Bytevector;
/*
** `module' operation for hashing (size is always a power of 2)
@@ -551,7 +555,7 @@ union GCObject {
Promise prom;
Port port;
Table table;
- Blob blob;
+ Bytevector bytevector;
};
@@ -653,7 +657,7 @@ const TValue kfree;
#define gc2port(o_) (gc2tv(K_TAG_PORT, o_))
#define gc2table(o_) (gc2tv(K_TAG_TABLE, o_))
#define gc2error(o_) (gc2tv(K_TAG_ERROR, o_))
-#define gc2blob(o_) (gc2tv(K_TAG_BLOB, o_))
+#define gc2bytevector(o_) (gc2tv(K_TAG_BYTEVECTOR, o_))
#define gc2deadkey(o_) (gc2tv(K_TAG_DEADKEY, o_))
/* Macro to convert a TValue into a specific heap allocated object */
@@ -671,7 +675,7 @@ const TValue kfree;
#define tv2port(v_) ((Port *) gcvalue(v_))
#define tv2table(v_) ((Table *) gcvalue(v_))
#define tv2error(v_) ((Error *) gcvalue(v_))
-#define tv2blob(v_) ((Blob *) gcvalue(v_))
+#define tv2bytevector(v_) ((Bytevector *) gcvalue(v_))
#define tv2gch(v_) ((GCheader *) gcvalue(v_))
#define tv2mgch(v_) ((MGCheader *) gcvalue(v_))
diff --git a/src/kstate.c b/src/kstate.c
@@ -35,7 +35,7 @@
#include "kstring.h"
#include "kport.h"
#include "ktable.h"
-#include "kblob.h"
+#include "kbytevector.h"
#include "kgpairs_lists.h" /* for creating list_app */
@@ -153,11 +153,11 @@ 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 */
+ /* Empty bytevector */
+ /* MAYBE: fix it so we can remove empty_bytevector 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);
+ K->empty_bytevector = KNIL; /* trick constructor to create empty bytevector */
+ K->empty_bytevector = kbytevector_new_imm(K, 0);
/* initialize tokenizer */
diff --git a/src/kstate.h b/src/kstate.h
@@ -115,8 +115,8 @@ struct klisp_State {
/* Strings */
TValue empty_string;
- /* Blobs */
- TValue empty_blob;
+ /* Bytevectors */
+ TValue empty_bytevector;
/* tokenizer */
/* special tokens, see ktoken.c for rationale */
diff --git a/src/kwrite.c b/src/kwrite.c
@@ -23,7 +23,7 @@
#include "ktable.h"
#include "kport.h"
#include "kenvironment.h"
-#include "kblob.h"
+#include "kbytevector.h"
/*
** Stack for the write FSM
@@ -445,8 +445,8 @@ void kwrite_simple(klisp_State *K, TValue obj)
kw_printf(K, "]");
break;
}
- case K_TBLOB:
- kw_printf(K, "#[blob");
+ case K_TBYTEVECTOR:
+ kw_printf(K, "#[bytevector");
#if KTRACK_NAMES
if (khas_name(obj)) {
kw_print_name(K, obj);
