commit 5445c97c9f8043a31c064598a7b1231db361cef2
parent 8675a8253a3cda82922d9481f321b4df98fb3dae
Author: Andres Navarro <canavarro82@gmail.com>
Date: Wed, 20 Apr 2011 22:10:06 -0300
Added can_have_name & has_name & has_si flag. Added hashtable with weak keys for storing names.
Diffstat:
11 files changed, 46 insertions(+), 13 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -59,7 +59,7 @@ kwrite.o: kwrite.c kwrite.h kobject.h kpair.h kstring.h kstate.h kerror.h \
kstate.o: kstate.c kstate.h klisp.h kobject.h kmem.h kstring.h klisp.h \
kenvironment.h kpair.h keval.h koperative.h kground.h \
krepl.h kcontinuation.h kapplicative.h kport.h ksymbol.h kport.h \
- kstring.h kinteger.h kgc.h klimits.h
+ kstring.h kinteger.h kgc.h klimits.h ktable.h
kmem.o: kmem.c kmem.h klisp.h kerror.h klisp.h kstate.h kgc.h klispconf.h
kerror.o: kerror.c kerror.h klisp.h kstate.h klisp.h kmem.h kstring.h kpair.h
kauxlib.o: kauxlib.c kauxlib.h klisp.h kstate.h klisp.h
diff --git a/src/kapplicative.c b/src/kapplicative.c
@@ -16,7 +16,8 @@ TValue kwrap(klisp_State *K, TValue underlying)
Applicative *new_app = klispM_new(K, Applicative);
/* header + gc_fields */
- klispC_link(K, (GCObject *) new_app, K_TAPPLICATIVE, 0);
+ klispC_link(K, (GCObject *) new_app, K_TAPPLICATIVE,
+ K_FLAG_CAN_HAVE_NAME);
/* applicative specific fields */
new_app->underlying = underlying;
diff --git a/src/kcontinuation.c b/src/kcontinuation.c
@@ -21,7 +21,9 @@ TValue kmake_continuation(klisp_State *K, TValue parent, klisp_Cfunc fn,
klispM_malloc(K, sizeof(Continuation) + sizeof(TValue) * xcount);
/* header + gc_fields */
- klispC_link(K, (GCObject *) new_cont, K_TCONTINUATION, 0);
+ klispC_link(K, (GCObject *) new_cont, K_TCONTINUATION,
+ K_FLAG_CAN_HAVE_NAME);
+
/* continuation specific fields */
new_cont->mark = KFALSE;
diff --git a/src/kenvironment.c b/src/kenvironment.c
@@ -31,7 +31,8 @@ TValue kmake_environment(klisp_State *K, TValue parents)
Environment *new_env = klispM_new(K, Environment);
/* header + gc_fields */
- klispC_link(K, (GCObject *) new_env, K_TENVIRONMENT, 0);
+ klispC_link(K, (GCObject *) new_env, K_TENVIRONMENT,
+ K_FLAG_CAN_HAVE_NAME);
/* environment specific fields */
new_env->mark = KFALSE;
diff --git a/src/kgc.c b/src/kgc.c
@@ -530,6 +530,7 @@ static void markroot (klisp_State *K) {
/* TEMP: this is quite awfull, think of other way to do this */
/* MAYBE: some of these could be FIXED */
+ markvalue(K, K->name_table);
markvalue(K, K->curr_cont);
markvalue(K, K->next_obj);
markvalue(K, K->next_value);
diff --git a/src/klimits.h b/src/klimits.h
@@ -54,6 +54,11 @@
#define MINSTRTABSIZE 32
#endif
+/* minimum size for the name table (must be power of 2) */
+#ifndef MINNAMETABSIZE
+#define MINNAMETABSIZE 32
+#endif
+
/* starting size for ground environment hashtable */
/* at last count, there were about 200 bindings in ground env */
#define ENVTABSIZE 512
diff --git a/src/kobject.h b/src/kobject.h
@@ -630,6 +630,26 @@ int32_t kmark_count;
#define gch_get_kflags(o_) (obj2gch(o_)->kflags)
#define tv_get_kflags(o_) (gch_get_kflags(tv2gch(o_)))
+/* General KFlags */
+/* TODO use bittricks from kgc.h */
+/* MAYBE make flags 16 bits, make gc flags 8 bits */
+/* for now only used in pairs and strings */
+
+#define K_FLAG_CAN_HAVE_NAME 0x80
+#define K_FLAG_HAS_NAME 0x40
+
+#define kcan_have_name(o_) ((tv_get_kflags(o_)) & K_FLAG_CAN_HAVE_NAME)
+#define khas_name(o_) ((tv_get_kflags(o_)) & K_FLAG_HAS_NAME)
+
+#define K_FLAG_HAS_SI 0x20
+
+#define khas_si(o_) ((tv_get_kflags(o_)) & K_FLAG_HAS_SI)
+
+#define K_FLAG_IMMUTABLE 0x10
+
+#define kis_mutable(o_) ((tv_get_kflags(o_) & K_FLAG_IMMUTABLE) == 0)
+#define kis_immutable(o_) (!kis_mutable(o_))
+
/* KFlags for symbols */
/* has external representation (identifiers) */
#define K_FLAG_EXT_REP 0x01
@@ -652,11 +672,6 @@ int32_t kmark_count;
#define kis_dyn_cont(c_) ((tv_get_kflags(c_) & K_FLAG_DYNAMIC) != 0)
#define kis_bool_check_cont(c_) ((tv_get_kflags(c_) & K_FLAG_BOOL_CHECK) != 0)
-/* for now only used in pairs and strings */
-#define K_FLAG_IMMUTABLE 0x01
-#define kis_mutable(o_) ((tv_get_kflags(o_) & K_FLAG_IMMUTABLE) == 0)
-#define kis_immutable(o_) (!kis_mutable(o_))
-
#define K_FLAG_OUTPUT_PORT 0x01
#define K_FLAG_INPUT_PORT 0x02
#define K_FLAG_CLOSED_PORT 0x04
@@ -678,8 +693,6 @@ int32_t kmark_count;
#define ktable_has_weak_values(o_) \
((tv_get_kflags(o_) & K_FLAG_WEAK_VALUES) != 0)
-
-
/* can't be inline because we also use pointers to them,
(at least gcc doesn't bother to create them and the linker fails) */
bool kis_input_port(TValue o);
diff --git a/src/koperative.c b/src/koperative.c
@@ -21,7 +21,8 @@ TValue kmake_operative(klisp_State *K, klisp_Ofunc fn, int32_t xcount, ...)
klispM_malloc(K, sizeof(Operative) + sizeof(TValue) * xcount);
/* header + gc_fields */
- klispC_link(K, (GCObject *) new_op, K_TOPERATIVE, 0);
+ klispC_link(K, (GCObject *) new_op, K_TOPERATIVE,
+ K_FLAG_CAN_HAVE_NAME);
/* operative specific fields */
new_op->fn = fn;
diff --git a/src/kport.c b/src/kport.c
@@ -45,7 +45,8 @@ TValue kmake_std_port(klisp_State *K, TValue filename, bool writep,
/* header + gc_fields */
klispC_link(K, (GCObject *) new_port, K_TPORT,
- writep? K_FLAG_OUTPUT_PORT : K_FLAG_INPUT_PORT);
+ K_FLAG_CAN_HAVE_NAME |
+ (writep? K_FLAG_OUTPUT_PORT : K_FLAG_INPUT_PORT));
/* port specific fields */
new_port->filename = filename;
diff --git a/src/kstate.c b/src/kstate.c
@@ -33,6 +33,7 @@
#include "ksymbol.h"
#include "kstring.h"
#include "kport.h"
+#include "ktable.h"
#include "kgpairs_lists.h" /* for creating list_app */
@@ -131,6 +132,12 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
K->strt.hash = NULL;
klispS_resize(K, MINSTRTABSIZE);
+ /* initialize name table */
+ /* has to have weak keys, otherwise every named object would
+ be fixed! */
+ K->name_table = klispH_new(K, 0, MINNAMETABSIZE,
+ K_FLAG_WEAK_KEYS);
+
/* Empty string */
/* MAYBE: fix it so we can remove empty_string from roots */
K->empty_string = kstring_new_b_imm(K, "");
diff --git a/src/kstate.h b/src/kstate.h
@@ -47,6 +47,7 @@ typedef struct stringtable {
markroot in kgc.c!! */
struct klisp_State {
stringtable strt; /* hash table for immutable strings & symbols */
+ TValue name_table; /* hash tables for naming objects */
TValue curr_cont;
/*
