commit 72d5129b0105a16cc9370a358fdf8a601307c144
parent e3539cf770682df26b98bc7ae9b84e4774dc9dcd
Author: Andres Navarro <canavarro82@gmail.com>
Date: Tue, 6 Dec 2011 19:59:00 -0300
Added Keyword constructor and simple methods. possible GC bugfix in symbol constructor, where the symbols itself was resucitated if needed, but the underlying string was not.
Diffstat:
6 files changed, 174 insertions(+), 47 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -36,11 +36,12 @@ CORE_O= kobject.o ktoken.o kpair.o kstring.o ksymbol.o kread.o \
kcontinuation.o koperative.o kapplicative.o keval.o krepl.o \
kencapsulation.o kpromise.o kport.o kinteger.o krational.o ksystem.o \
kreal.o ktable.o kgc.o imath.o imrat.o kbytevector.o kvector.o \
- kchar.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 kgbytevectors.o kgvectors.o kgsystem.o kgerrors.o \
+ kchar.o ksymbol.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 kgbytevectors.o kgvectors.o \
+ kgsystem.o kgerrors.o \
$(if $(USE_LIBFFI),kgffi.o)
# TEMP: in klisp there is no distinction between core & lib
@@ -281,6 +282,8 @@ 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 \
kstate.h kmem.h kstring.h kgc.h
+kkeyword.o: kkeyword.c kkeyword.h kobject.h klimits.h klisp.h klispconf.h \
+ kstate.h kmem.h kstring.h kgc.h
ksystem.o: ksystem.c kobject.h klimits.h klisp.h klispconf.h kstate.h \
ktoken.h kmem.h kerror.h kpair.h kgc.h ksystem.h
ksystem.posix.o: ksystem.posix.c kobject.h klimits.h klisp.h klispconf.h \
diff --git a/src/kbytevector.c b/src/kbytevector.c
@@ -32,7 +32,6 @@ TValue kbytevector_new_bs_g(klisp_State *K, bool m, const uint8_t *buf,
TValue kbytevector_new_bs_imm(klisp_State *K, const uint8_t *buf, uint32_t size)
{
/* first check to see if it's in the stringtable */
- GCObject *o;
uint32_t h = size; /* seed */
size_t step = (size>>5)+1; /* if bytevector is too long, don't hash all
its bytes */
@@ -40,17 +39,14 @@ TValue kbytevector_new_bs_imm(klisp_State *K, const uint8_t *buf, uint32_t size)
for (size1 = size; size1 >= step; size1 -= step) /* compute hash */
h = h ^ ((h<<5)+(h>>2)+ buf[size1-1]);
- for (o = K->strt.hash[lmod(h, K->strt.size)];
- o != NULL; o = o->gch.next) {
- Bytevector *tb = NULL;
- if (o->gch.tt == K_TBYTEVECTOR) {
- tb = (Bytevector *) o;
- } else if (o->gch.tt == K_TSYMBOL || o->gch.tt == K_TSTRING) {
- continue;
- } else {
- /* only symbols, immutable bytevectors and immutable strings */
- klisp_assert(0);
- }
+ for (GCObject *o = K->strt.hash[lmod(h, K->strt.size)];
+ o != NULL; o = o->gch.next) {
+ klisp_assert(o->gch.tt == K_TKEYWORD || o->gch.tt == K_TSYMBOL ||
+ o->gch.tt == K_TSTRING || o->gch.tt == K_TBYTEVECTOR);
+
+ if (o->gch.tt != K_TBYTEVECTOR) continue;
+
+ Bytevector *tb = (Bytevector *) o;
if (tb->size == size && (memcmp(buf, tb->b, size) == 0)) {
/* bytevector may be dead */
if (isdead(K, o)) changewhite(o);
diff --git a/src/kkeyword.c b/src/kkeyword.c
@@ -0,0 +1,98 @@
+/*
+** kkeywrod.c
+** Kernel Keywords
+** See Copyright Notice in klisp.h
+*/
+
+#include <string.h>
+
+#include "kkeyword.h"
+#include "kobject.h"
+#include "kstate.h"
+#include "kmem.h"
+#include "kgc.h"
+/* for immutable table */
+#include "kstring.h"
+
+/* No case folding is performed by these constructors */
+TValue kkeyword_new_bs(klisp_State *K, const char *buf, int32_t size)
+{
+ /* First calculate the hash */
+ uint32_t h = size; /* seed */
+ size_t step = (size>>5)+1; /* if string is too long, don't hash all
+ its chars */
+ size_t size1;
+ for (size1 = size; size1 >= step; size1 -= step) /* compute hash */
+ h = h ^ ((h<<5)+(h>>2)+ ((unsigned char) buf[size1-1]));
+
+ h ^= (uint32_t) 0x55555555;
+ /* keyword hash should be different from string & symbol hash
+ otherwise keywords and their respective immutable string
+ would always fall in the same bucket */
+ /* look for it in the table */
+ for (GCObject *o = K->strt.hash[lmod(h, K->strt.size)]; o != NULL;
+ o = o->gch.next) {
+ klisp_assert(o->gch.tt == K_TKEYWORD || o->gch.tt == K_TSYMBOL ||
+ o->gch.tt == K_TSTRING || o->gch.tt == K_TBYTEVECTOR);
+
+ if (o->gch.tt != K_TKEYWORD) continue;
+
+ String *ts = tv2str(((Keyword *) o)->str);
+ if (ts->size == size && (memcmp(buf, ts->b, size) == 0)) {
+ /* keyword and/or string may be dead */
+ if (isdead(K, o)) changewhite(o);
+ if (isdead(K, (Object *) ts)) changewhite((Object *) ts);
+ return gc2keyw(o);
+ }
+ }
+ /* REFACTOR: move this to a new function */
+ /* Didn't find it, alloc new immutable string and save in keyword table,
+ note that the hash value remained in h */
+ TValue new_str = kstring_new_bs_imm(K, buf, size);
+ krooted_tvs_push(K, new_str);
+ Keyword *new_keyw = klispM_new(K, Keyword);
+ TValue ret_tv = gc2keyw(new_keyw);
+ krooted_tvs_pop(K);
+
+ /* header + gc_fields */
+ /* can't use klispC_link, because strings use the next pointer
+ differently */
+ new_keyw->gct = klispC_white(K);
+ new_keyw->tt = K_TKEYWORD;
+ new_keyw->kflags = 0;
+ new_keyw->si = NULL;
+
+ /* keyword specific fields */
+ new_keyw->str = new_str;
+ new_keyw->hash = h;
+
+ /* add to the string/keyword table (and link it) */
+ stringtable *tb;
+ tb = &K->strt;
+ h = lmod(h, tb->size);
+ new_keyw->next = tb->hash[h]; /* chain new entry */
+ tb->hash[h] = (GCObject *)(new_keyw);
+ tb->nuse++;
+ if (tb->nuse > ((uint32_t) tb->size) && tb->size <= INT32_MAX / 2) {
+ krooted_tvs_push(K, ret_tv); /* save in case of gc */
+ klispS_resize(K, tb->size*2); /* too crowded */
+ krooted_tvs_pop(K);
+ }
+ return ret_tv;
+}
+
+/* for c strings with unknown size */
+TValue kkeyword_new_b(klisp_State *K, const char *buf)
+{
+ int32_t size = (int32_t) strlen(buf);
+ return kkeyword_new_bs(K, buf, size);
+}
+
+/* for string->keyword & symbol->keyword */
+/* GC: assumes str is rooted */
+TValue kkeyword_new_str(klisp_State *K, TValue str)
+{
+ return kkeyword_new_bs(K, kstring_buf(str), kstring_size(str));
+}
+
+bool kkeywordp(TValue obj) { return ttiskeyword(obj); }
diff --git a/src/kkeyword.h b/src/kkeyword.h
@@ -0,0 +1,31 @@
+/*
+** kkeywrod.h
+** Kernel Keywords
+** See Copyright Notice in klisp.h
+*/
+
+#ifndef kkeyword_h
+#define kkeyword_h
+
+#include "kobject.h"
+#include "kstate.h"
+#include "kstring.h"
+#include "kmem.h"
+
+/* All keywords are interned */
+/* No case folding is performed by these constructors */
+
+/* buffer + size, may contain nulls */
+TValue kkeyword_new_bs(klisp_State *K, const char *buf, int32_t size);
+/* null terminated buffer */
+TValue kkeyword_new_b(klisp_State *K, const char *buf);
+/* copies str if not immutable */
+TValue kkeyword_new_str(klisp_State *K, TValue str);
+
+#define kkeyword_str(tv_) (tv2keyw(tv_)->str)
+#define kkeyword_buf(tv_) (kstring_buf(tv2keyw(tv_)->str))
+#define kkeyword_size(tv_) (kstring_size(tv2keyw(tv_)->str))
+
+bool kkeywordp(TValue obj);
+
+#endif
diff --git a/src/kstring.c b/src/kstring.c
@@ -33,17 +33,23 @@ void klispS_resize (klisp_State *K, int32_t newsize)
/* imm string, imm bytevectors & symbols aren't chained with
all other objs, but with each other in strt */
GCObject *next = p->gch.next; /* save next */
-
uint32_t h = 0;
+ klisp_assert(p->gch.tt == K_TKEYWORD || p->gch.tt == K_TSYMBOL ||
+ p->gch.tt == K_TSTRING || p->gch.tt == K_TBYTEVECTOR);
- if (p->gch.tt == K_TSYMBOL) {
+ switch(p->gch.tt) {
+ case K_TSYMBOL:
h = ((Symbol *) p)->hash;
- } else if (p->gch.tt == K_TSTRING) {
+ break;
+ case K_TSTRING:
h = ((String *) p)->hash;
- } else if (p->gch.tt == K_TBYTEVECTOR) {
+ break;
+ case K_TBYTEVECTOR:
h = ((Bytevector *) p)->hash;
- } else {
- klisp_assert(0);
+ break;
+ case K_TKEYWORD:
+ h = ((Keyword *) p)->hash;
+ break;
}
int32_t h1 = lmod(h, newsize); /* new position */
@@ -74,7 +80,6 @@ TValue kstring_new_bs_g(klisp_State *K, bool m, const char *buf,
TValue kstring_new_bs_imm(klisp_State *K, const char *buf, uint32_t size)
{
/* first check to see if it's in the stringtable */
- GCObject *o;
uint32_t h = size; /* seed */
size_t step = (size>>5)+1; /* if string is too long, don't hash all
its chars */
@@ -82,17 +87,14 @@ TValue kstring_new_bs_imm(klisp_State *K, const char *buf, uint32_t size)
for (size1 = size; size1 >= step; size1 -= step) /* compute hash */
h = h ^ ((h<<5)+(h>>2)+ ((unsigned char) buf[size1-1]));
- for (o = K->strt.hash[lmod(h, K->strt.size)];
- o != NULL; o = o->gch.next) {
- String *ts = NULL;
- if (o->gch.tt == K_TSTRING) {
- ts = (String *) o;
- } else if (o->gch.tt == K_TSYMBOL || o->gch.tt == K_TBYTEVECTOR) {
- continue;
- } else {
- /* only symbols, immutable bytevectors and immutable strings */
- klisp_assert(0);
- }
+ for (GCObject *o = K->strt.hash[lmod(h, K->strt.size)];
+ o != NULL; o = o->gch.next) {
+ klisp_assert(o->gch.tt == K_TKEYWORD || o->gch.tt == K_TSYMBOL ||
+ o->gch.tt == K_TSTRING || o->gch.tt == K_TBYTEVECTOR);
+
+ if (o->gch.tt != K_TSTRING) continue;
+
+ String *ts = (String *) o;
if (ts->size == size && (memcmp(buf, ts->b, size) == 0)) {
/* string may be dead */
if (isdead(K, o)) changewhite(o);
diff --git a/src/ksymbol.c b/src/ksymbol.c
@@ -38,21 +38,18 @@ TValue ksymbol_new_bs(klisp_State *K, const char *buf, int32_t size, TValue si)
would always fall in the same bucket */
/* look for it in the table only if it doesn't have source info */
if (ttisnil(si)) {
- GCObject *o;
- for (o = K->strt.hash[lmod(h, K->strt.size)];
+ for (GCObject *o = K->strt.hash[lmod(h, K->strt.size)];
o != NULL; o = o->gch.next) {
- String *ts = NULL;
- if (o->gch.tt == K_TSTRING || o->gch.tt == K_TBYTEVECTOR) {
- continue;
- } else if (o->gch.tt == K_TSYMBOL) {
- ts = tv2str(((Symbol *) o)->str);
- } else {
- /* only symbols, immutable bytevectors and immutable strings */
- klisp_assert(0);
- }
+ klisp_assert(o->gch.tt == K_TKEYWORD || o->gch.tt == K_TSYMBOL ||
+ o->gch.tt == K_TSTRING || o->gch.tt == K_TBYTEVECTOR);
+
+ if (o->gch.tt != K_TSYMBOL) continue;
+
+ String *ts = tv2str(((Symbol *) o)->str);
if (ts->size == size && (memcmp(buf, ts->b, size) == 0)) {
- /* symbol may be dead */
+ /* symbol and/or string may be dead */
if (isdead(K, o)) changewhite(o);
+ if (isdead(K, (GCObject *) ts)) changewhite((GCObject *) ts);
return gc2sym(o);
}
}
