commit c641facb96181a80e7baa70f2599a7ca309201ce
parent 1fa418efea2a7a552b234b2a21a16ddf1478e12b
Author: Andres Navarro <canavarro82@gmail.com>
Date: Mon, 20 Aug 2012 01:08:20 -0300
Split klisp_State into thread and global state: klisp_State and global_State, just as in lua. Only thread specific info remained in klisp_State. Rewrote the whole state initialization routine, but there is still some work to be done there. Added the thread object type, but still no code for garbage collecting it. There is still now way to creating more than one thread, first I will have to recover all functionality. Inverted the include order of kobject.h and klisp.h (it now follows lua). THIS WILL NOT COMPILE/RUN! IT'S STILL A WORK IN PROGRESS.
Diffstat:
| M | src/kgc.c | | | 3 | +-- |
| M | src/kgc.h | | | 9 | ++++----- |
| M | src/klisp.h | | | 15 | ++++++--------- |
| M | src/kobject.h | | | 38 | ++++---------------------------------- |
| M | src/kstate.c | | | 405 | ++++++++++++++++++++++++++++++++++++++++++++++++++----------------------------- |
| M | src/kstate.h | | | 165 | +++++++++++++++++++++++++++++++++++++++++++++++++++---------------------------- |
6 files changed, 379 insertions(+), 256 deletions(-)
diff --git a/src/kgc.c b/src/kgc.c
@@ -599,8 +599,7 @@ void klispC_callGCTM (lua_State *L) {
arrays that aren't TValues */
void klispC_freeall (klisp_State *K) {
/* mask to collect all elements */
- K->currentwhite = WHITEBITS | bitmask(SFIXEDBIT); /* in klisp this may not be
- necessary */
+ K->currentwhite = WHITEBITS | bitmask(SFIXEDBIT);
sweepwholelist(K, &K->rootgc);
/* free all keyword/symbol/string/bytevectors lists */
for (int32_t i = 0; i < K->strt.size; i++)
diff --git a/src/kgc.h b/src/kgc.h
@@ -71,22 +71,21 @@
#define iswhite(x) test2bits((x)->gch.gct, WHITE0BIT, WHITE1BIT)
#define isblack(x) testbit((x)->gch.gct, BLACKBIT)
-
#define isgray(x) (!isblack(x) && !iswhite(x))
-#define otherwhite(K) (K->currentwhite ^ WHITEBITS)
-#define isdead(K,v) ((v)->gch.gct & otherwhite(K) & WHITEBITS)
+#define otherwhite(g) (g->currentwhite ^ WHITEBITS)
+#define isdead(g,v) ((v)->gch.gct & otherwhite(g) & WHITEBITS)
#define changewhite(x) ((x)->gch.gct ^= WHITEBITS)
#define gray2black(x) l_setbit((x)->gch.gct, BLACKBIT)
#define valiswhite(x) (iscollectable(x) && iswhite(gcvalue(x)))
-#define klispC_white(K) cast(uint16_t, (K)->currentwhite & WHITEBITS)
+#define klispC_white(g) cast(uint16_t, (g)->currentwhite & WHITEBITS)
#define klispC_checkGC(K) { \
- if (K->totalbytes >= K->GCthreshold) \
+ if (G(K)->totalbytes >= G(K)->GCthreshold) \
klispC_step(K); }
diff --git a/src/klisp.h b/src/klisp.h
@@ -9,9 +9,6 @@
#include <stdlib.h>
-/* NOTE: this inclusion is reversed in lua */
-#include "kobject.h"
-
/*
** SOURCE NOTE: This is mostly from Lua.
*/
@@ -31,17 +28,17 @@ typedef void * (*klisp_Alloc)
(void *ud, void *ptr, size_t osize, size_t nsize);
/*
-** prototype for callable c functions from the interpreter main loop:
-**
-** TEMP: for now it is defined in kobject.h
+** prototype for underlying c functions of continuations &
+** operatives
*/
-/* typedef void (*klisp_Ifunc) (TValue *ud, TValue val); */
+typedef void (*klisp_CFunction) (struct klisp_State *K);
/*
** state manipulation
*/
-klisp_State *klisp_newstate (klisp_Alloc f, void *ud);
-void klisp_close (klisp_State *K);
+klisp_State *klisp_newstate(klisp_Alloc f, void *ud);
+void klisp_close(klisp_State *K);
+klisp_State *klisp_newthread(klisp_State *K);
/******************************************************************************
* Copyright (C) 2011-2012 Andres Navarro, Oto Havle.
diff --git a/src/kobject.h b/src/kobject.h
@@ -35,6 +35,7 @@
#include "klimits.h"
#include "klispconf.h"
+#include "klisp.h"
/*
** Union of all collectible objects
@@ -42,13 +43,6 @@
typedef union GCObject GCObject;
/*
-** prototype for underlying c functions of continuations &
-** operatives
-*/
-struct klisp_State; /* later defined in kstate.h */
-typedef void (*klisp_CFunction) (struct klisp_State *K);
-
-/*
** Common Header for all collectible objects (in macro form, to be
** included in other objects)
*/
@@ -177,6 +171,7 @@ typedef struct __attribute__ ((__packed__)) GCheader {
#define K_TVECTOR 44
#define K_TKEYWORD 45
#define K_TLIBRARY 46
+#define K_TTHREAD 47
/* for tables */
#define K_TDEADKEY 60
@@ -234,6 +229,7 @@ typedef struct __attribute__ ((__packed__)) GCheader {
#define K_TAG_VECTOR K_MAKE_VTAG(K_TVECTOR)
#define K_TAG_KEYWORD K_MAKE_VTAG(K_TKEYWORD)
#define K_TAG_LIBRARY K_MAKE_VTAG(K_TLIBRARY)
+#define K_TAG_THREAD K_MAKE_VTAG(K_TTHREAD)
/*
** Macros to test types
@@ -336,6 +332,7 @@ typedef struct __attribute__ ((__packed__)) GCheader {
#define ttisvector(o) (tbasetype_(o) == K_TAG_VECTOR)
#define ttiskeyword(o) (tbasetype_(o) == K_TAG_KEYWORD)
#define ttislibrary(o) (tbasetype_(o) == K_TAG_LIBRARY)
+#define ttisthread(o) (tbasetype_(o) == K_TAG_THREAD)
/* macros to easily check boolean values */
#define kis_true(o_) (tv_equal((o_), KTRUE))
@@ -608,33 +605,6 @@ typedef struct __attribute__ ((__packed__)) {
} MGCheader;
/*
-** Union of all Kernel heap-allocated values
-*/
-/* LUA NOTE: In Lua the corresponding union is in lstate.h */
-union GCObject {
- GCheader gch;
- MGCheader mgch;
- Pair pair;
- Symbol sym;
- String str;
- Environment env;
- Continuation cont;
- Operative op;
- Applicative app;
- Encapsulation enc;
- Promise prom;
- Table table;
- Bytevector bytevector;
- Port port; /* common fields for all types of ports */
- FPort fport;
- MPort mport;
- Vector vector;
- Keyword keyw;
- Library lib;
-};
-
-
-/*
** Some constants
*/
#define KNIL_ {.tv = {.t = K_TAG_NIL, .v = { .i = 0 }}}
diff --git a/src/kstate.c b/src/kstate.c
@@ -44,29 +44,57 @@
#include "kgc.h" /* for memory freeing & gc init */
+/* in lua state size can have an extra space here to save
+ some user data, for now we don't have that in klisp */
+#define state_size(x) (sizeof(x) + 0)
+#define fromstate(k) (cast(uint8_t *, (k)) - 0)
+#define tostate(k) (cast(klisp_State *, cast(uint8_t *, k) + 0))
+
/*
-** State creation and destruction
+** Main thread combines a thread state and the global state
*/
-klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
- klisp_State *K;
- void *k = (*f)(ud, NULL, 0, state_size());
- if (k == NULL) return NULL;
- void *s = (*f)(ud, NULL, 0, KS_ISSIZE * sizeof(TValue));
+typedef struct KG {
+ klisp_State k;
+ global_State g;
+} KG;
+
+/*
+** open parts that may cause memory-allocation errors
+*/
+static void f_klispopen (klisp_State *K, void *ud) {
+ global_State *g = G(K);
+ UNUSED(ud);
+ klispS_resize(K, MINSTRTABSIZE); /* initial size of string table */
+
+ void *s = (*g->frealloc)(ud, NULL, 0, KS_ISSIZE * sizeof(TValue));
if (s == NULL) {
- (*f)(ud, k, state_size(), 0);
- return NULL;
+ return; /* XXX throw error somehow & free mem */
}
- void *b = (*f)(ud, NULL, 0, KS_ITBSIZE);
+ void *b = (*g->frealloc)(ud, NULL, 0, KS_ITBSIZE);
if (b == NULL) {
- (*f)(ud, k, state_size(), 0);
- (*f)(ud, s, KS_ISSIZE * sizeof(TValue), 0);
- return NULL;
+ return; /* XXX throw error somehow & free mem */
}
- K = (klisp_State *) k;
+ /* initialize temp stacks */
+ K->ssize = KS_ISSIZE;
+ K->stop = 0; /* stack is empty */
+ K->sbuf = (TValue *)s;
+
+ ks_tbsize(K) = KS_ITBSIZE;
+ ks_tbidx(K) = 0; /* buffer is empty */
+ ks_tbuf(K) = (char *)b;
- K->curr_cont = KNIL;
+/* This is here in lua, but in klisp we still need to alloc
+ a bunch of objects:
+ g->GCthreshold = 4*g->totalbytes;
+*/
+}
+
+static void preinit_state (klisp_State *K, global_State *g) {
+ G(K) = g;
+
+ K->curr_cont = KNIL;
K->next_obj = KINERT;
K->next_func = NULL;
K->next_value = KINERT;
@@ -74,123 +102,196 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
K->next_xparams = NULL;
K->next_si = KNIL;
- /* these will be properly initialized later */
- K->eval_op = KINERT;
- K->list_app = KINERT;
- K->ground_env = KINERT;
- K->module_params_sym = KINERT;
- K->root_cont = KINERT;
- K->error_cont = KINERT;
- K->system_error_cont = KINERT;
-
- K->frealloc = f;
- K->ud = ud;
-
/* current input and output */
K->curr_port = KINERT; /* set on each call to read/write */
+ /* init the stacks used to protect variables & values from gc,
+ this should be done before any new object is created because
+ they are used by them */
+ K->rooted_tvs_top = 0;
+ K->rooted_vars_top = 0;
+
+ /* initialize tokenizer */
+
+ /* WORKAROUND: for stdin line buffering & reading of EOF */
+ K->ktok_seen_eof = false;
+
+ /* TEMP: For now just hardcode it to 8 spaces tab-stop */
+ K->ktok_source_info.tab_width = 8;
+ /* all three are set on each call to read */
+ K->ktok_source_info.filename = KINERT;
+ K->ktok_source_info.line = 1;
+ K->ktok_source_info.col = 0;
+
+ K->ktok_nested_comments = 0;
+
+ /* initialize reader */
+ K->shared_dict = KNIL;
+ K->read_mconsp = false; /* set on each call to read */
+
+ /* initialize writer */
+ K->write_displayp = false; /* set on each call to write */
+}
+
+static void close_state(klisp_State *K)
+{
+ global_State *g = G(K);
+
+ /* collect all objects */
+ klispC_freeall(K);
+ klisp_assert(g->rootgc == obj2gco(K));
+ klisp_assert(g->strt.nuse == 0);
+
+ /* free helper buffers */
+ klispM_freemem(K, ks_sbuf(K), ks_ssize(K) * sizeof(TValue));
+ klispM_freemem(K, ks_tbuf(K), ks_tbsize(K));
+ /* free string/symbol table */
+ klispM_freearray(K, G(K)->strt.hash, G(K)->strt.size, GCObject *);
+
+ /* only remaining mem should be of the state struct */
+ klisp_assert(g->totalbytes == sizeof(KG));
+ /* NOTE: this needs to be done "by hand" */
+ (*g->frealloc)(g->ud, fromstate(K), state_size(KG), 0);
+}
+
+/*
+** State creation and destruction
+*/
+klisp_State *klisp_newstate(klisp_Alloc f, void *ud)
+{
+ klisp_State *K;
+ global_State *g;
+
+ void *k = (*f)(ud, NULL, 0, state_size(KG));
+ if (k == NULL) return NULL;
+ K = tostate(k);
+ g = &((KG *)K)->g;
+ /* Init klisp_State object header (for GC) */
+ K->next = NULL;
+ K->tt = K_TTHREAD;
+ K->kflags = 0;
+ K->si = NULL;
+ g->currentwhite = bit2mask(WHITE0BIT, FIXEDBIT);
+ K->gct = klispC_white(g);
+ set2bits(K->gct, FIXEDBIT, SFIXEDBIT);
+
+ preinit_state(K, g);
+
+ ktok_init(K); /* initialize tokenizer tables */
+ g->frealloc = f;
+ g->ud = ud;
+ g->mainthread = K;
+
+ g->GCthreshold = 0; /* mark it as unfinished state */
+
+ /* these will be properly initialized later */
+ g->strt.size = 0;
+ g->strt.nuse = 0;
+ g->strt.hash = NULL;
+ g->name_table = KINERT;
+ g->cont_name_table = KINERT;
+
+ g->empty_string = KINERT;
+ g->empty_bytevector = KINERT;
+ g->empty_vector = KINERT;
+
+ g->ktok_lparen = KINERT;
+ g->ktok_rparen = KINERT;
+ g->ktok_dot = KINERT;
+ g->ktok_sexp_comment = KINERT;
+
+ g->require_path = KINERT;
+ g->require_table = KINERT;
+ g->libraries_registry = KINERT;
+
+ g->eval_op = KINERT;
+ g->list_app = KINERT;
+ g->memoize_app = KINERT;
+ g->ground_env = KINERT;
+ g->module_params_sym = KINERT;
+ g->root_cont = KINERT;
+ g->error_cont = KINERT;
+ g->system_error_cont = KINERT;
+
/* input / output for dynamic keys */
/* these are init later */
- K->kd_in_port_key = KINERT;
- K->kd_out_port_key = KINERT;
- K->kd_error_port_key = KINERT;
+ g->kd_in_port_key = KINERT;
+ g->kd_out_port_key = KINERT;
+ g->kd_error_port_key = KINERT;
/* strict arithmetic dynamic key */
/* this is init later */
- K->kd_strict_arith_key = KINERT;
+ g->kd_strict_arith_key = KINERT;
+
+ g->gcstate = GCSpause;
+ g->rootgc = obj2gco(K); /* was NULL in unithread klisp... CHECK */
+ g->sweepstrgc = 0;
+ g->sweepgc = &g->rootgc;
+ g->gray = NULL;
+ g->grayagain = NULL;
+ g->weak = NULL;
+ g->tmudata = NULL;
+ g->totalbytes = sizeof(KG);
+ g->gcpause = KLISPI_GCPAUSE;
+ g->gcstepmul = KLISPI_GCMUL;
+ g->gcdept = 0;
/* GC */
- K->currentwhite = bit2mask(WHITE0BIT, FIXEDBIT);
- K->gcstate = GCSpause;
- K->sweepstrgc = 0;
- K->rootgc = NULL;
- K->sweepgc = &(K->rootgc);
- K->gray = NULL;
- K->grayagain = NULL;
- K->weak = NULL;
- K->tmudata = NULL;
- K->totalbytes = state_size() + KS_ISSIZE * sizeof(TValue) +
+ g->totalbytes = state_size(KG) + KS_ISSIZE * sizeof(TValue) +
KS_ITBSIZE;
- K->GCthreshold = UINT32_MAX; /* we still have a lot of allocation
+ g->GCthreshold = UINT32_MAX; /* we still have a lot of allocation
+ to do, put a very high value to
+ avoid collection */
+ g->estimate = 0; /* doesn't matter, it is set by gc later */
+ /* XXX Things start being ugly from here on...
+ I have to think about the whole init procedure, for now
+ I am mostly following lua, but the differences between it and
+ klisp show... We still have to allocate a lot of objects and
+ it isn't really clear what happens if we run out of space before
+ all objects are allocated. For now let's suppose that will not
+ happen... */
+ /* TODO handle errors, maybe with longjmp, also see lua
+ luaD_rawrunprotected */
+ f_klispopen(K, NULL); /* this touches GCthreshold */
+
+ g->GCthreshold = UINT32_MAX; /* we still have a lot of allocation
to do, put a very high value to
avoid collection */
- K->estimate = 0; /* doesn't matter, it is set by gc later */
- K->gcdept = 0;
- K->gcpause = KLISPI_GCPAUSE;
- K->gcstepmul = KLISPI_GCMUL;
/* TEMP: err */
+ /* THIS MAY CRASH THE INTERPRETER IF THERE IS AN ERROR IN THE INIT */
/* do nothing for now */
- /* init the stacks used to protect variables & values from gc,
- this should be done before any new object is created because
- they are used by them */
- K->rooted_tvs_top = 0;
- K->rooted_vars_top = 0;
-
/* initialize strings */
- /* initial size of string/symbol table */
- K->strt.size = 0;
- K->strt.nuse = 0;
- K->strt.hash = NULL;
- klispS_resize(K, MINSTRTABSIZE);
-
/* initialize name info table */
/* needs weak keys, otherwise every named object would
be fixed! */
- K->name_table = klispH_new(K, 0, MINNAMETABSIZE,
+ g->name_table = klispH_new(K, 0, MINNAMETABSIZE,
K_FLAG_WEAK_KEYS);
/* here the keys are uncollectable */
- K->cont_name_table = klispH_new(K, 0, MINCONTNAMETABSIZE,
+ g->cont_name_table = klispH_new(K, 0, MINCONTNAMETABSIZE,
K_FLAG_WEAK_NOTHING);
/* Empty string */
/* MAYBE: fix it so we can remove empty_string from roots */
- K->empty_string = kstring_new_b_imm(K, "");
+ g->empty_string = kstring_new_b_imm(K, "");
/* Empty bytevector */
/* MAYBE: fix it so we can remove empty_bytevector from roots */
/* XXX: find a better way to do this */
- K->empty_bytevector = KNIL; /* trick constructor to create empty bytevector */
- K->empty_bytevector = kbytevector_new_bs_imm(K, NULL, 0);
+ g->empty_bytevector = KNIL; /* trick constructor to create empty bytevector */
+ g->empty_bytevector = kbytevector_new_bs_imm(K, NULL, 0);
/* Empty vector */
/* MAYBE: see above */
- K->empty_vector = kvector_new_bs_g(K, false, NULL, 0);
-
- /* initialize tokenizer */
-
- /* WORKAROUND: for stdin line buffering & reading of EOF */
- K->ktok_seen_eof = false;
-
- ks_tbsize(K) = KS_ITBSIZE;
- ks_tbidx(K) = 0; /* buffer is empty */
- ks_tbuf(K) = (char *)b;
+ g->empty_vector = kvector_new_bs_g(K, false, NULL, 0);
/* Special Tokens */
- K->ktok_lparen = kcons(K, ch2tv('('), KNIL);
- K->ktok_rparen = kcons(K, ch2tv(')'), KNIL);
- K->ktok_dot = kcons(K, ch2tv('.'), KNIL);
- K->ktok_sexp_comment = kcons(K, ch2tv(';'), KNIL);
-
- /* TEMP: For now just hardcode it to 8 spaces tab-stop */
- K->ktok_source_info.tab_width = 8;
- /* all three are set on each call to read */
- K->ktok_source_info.filename = KINERT;
- K->ktok_source_info.line = 1;
- K->ktok_source_info.col = 0;
-
- K->ktok_nested_comments = 0;
-
- ktok_init(K);
-
- /* initialize reader */
- K->shared_dict = KNIL;
- K->read_mconsp = false; /* set on each call to read */
-
- /* initialize writer */
- K->write_displayp = false; /* set on each call to write */
+ g->ktok_lparen = kcons(K, ch2tv('('), KNIL);
+ g->ktok_rparen = kcons(K, ch2tv(')'), KNIL);
+ g->ktok_dot = kcons(K, ch2tv('.'), KNIL);
+ g->ktok_sexp_comment = kcons(K, ch2tv(';'), KNIL);
/* initialize require facilities */
{
@@ -198,22 +299,17 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
if (str == NULL)
str = KLISP_PATH_DEFAULT;
- K->require_path = kstring_new_b_imm(K, str);
+ g->require_path = kstring_new_b_imm(K, str);
/* replace dirsep with forward slashes,
windows will happily accept forward slashes */
- str = kstring_buf(K->require_path);
+ str = kstring_buf(g->require_path);
while ((str = strchr(str, *KLISP_DIRSEP)) != NULL)
*str++ = '/';
}
- K->require_table = klispH_new(K, 0, MINREQUIRETABSIZE, 0);
+ g->require_table = klispH_new(K, 0, MINREQUIRETABSIZE, 0);
/* initialize library facilities */
- K->libraries_registry = KNIL;
-
- /* initialize temp stack */
- K->ssize = KS_ISSIZE;
- K->stop = 0; /* stack is empty */
- K->sbuf = (TValue *)s;
+ g->libraries_registry = KNIL;
/* the dynamic ports and the keys for the dynamic ports */
TValue in_port = kmake_std_fport(K, kstring_new_b_imm(K, "*STDIN*"),
@@ -222,68 +318,68 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
true, false, stdout);
TValue error_port = kmake_std_fport(K, kstring_new_b_imm(K, "*STDERR*"),
true, false, stderr);
- K->kd_in_port_key = kcons(K, KTRUE, in_port);
- K->kd_out_port_key = kcons(K, KTRUE, out_port);
- K->kd_error_port_key = kcons(K, KTRUE, error_port);
+ g->kd_in_port_key = kcons(K, KTRUE, in_port);
+ g->kd_out_port_key = kcons(K, KTRUE, out_port);
+ g->kd_error_port_key = kcons(K, KTRUE, error_port);
/* strict arithmetic key, (starts as false) */
- K->kd_strict_arith_key = kcons(K, KTRUE, KFALSE);
+ g->kd_strict_arith_key = kcons(K, KTRUE, KFALSE);
/* create the ground environment and the eval operative */
int32_t line_number;
TValue si;
- K->eval_op = kmake_operative(K, keval_ofn, 0), line_number = __LINE__;
+ g->eval_op = kmake_operative(K, keval_ofn, 0), line_number = __LINE__;
#if KTRACK_SI
si = kcons(K, kstring_new_b_imm(K, __FILE__),
kcons(K, i2tv(line_number), i2tv(0)));
- kset_source_info(K, K->eval_op, si);
+ kset_source_info(K, g->eval_op, si);
#endif
/* TODO: si */
TValue eval_name = ksymbol_new_b(K, "eval", KNIL);
- ktry_set_name(K, K->eval_op, eval_name);
+ ktry_set_name(K, g->eval_op, eval_name);
- K->list_app = kmake_applicative(K, list, 0), line_number = __LINE__;
+ g->list_app = kmake_applicative(K, list, 0), line_number = __LINE__;
#if KTRACK_SI
si = kcons(K, kstring_new_b_imm(K, __FILE__),
kcons(K, i2tv(__LINE__), i2tv(0)));
- kset_source_info(K, K->list_app, si);
- kset_source_info(K, kunwrap(K->list_app), si);
+ kset_source_info(K, g->list_app, si);
+ kset_source_info(K, kunwrap(g->list_app), si);
#endif
- K->memoize_app = kmake_applicative(K, memoize, 0), line_number = __LINE__;
+ g->memoize_app = kmake_applicative(K, memoize, 0), line_number = __LINE__;
#if KTRACK_SI
si = kcons(K, kstring_new_b_imm(K, __FILE__),
kcons(K, i2tv(__LINE__), i2tv(0)));
- kset_source_info(K, K->memoize_app, si);
- kset_source_info(K, kunwrap(K->memoize_app), si);
+ kset_source_info(K, g->memoize_app, si);
+ kset_source_info(K, kunwrap(g->memoize_app), si);
#endif
/* ground environment has a hashtable for bindings */
- K->ground_env = kmake_table_environment(K, KNIL);
-// K->ground_env = kmake_empty_environment(K);
+ g->ground_env = kmake_table_environment(K, KNIL);
+// g->ground_env = kmake_empty_environment(K);
/* MAYBE: fix it so we can remove module_params_sym from roots */
/* TODO si */
- K->module_params_sym = ksymbol_new_b(K, "module-parameters", KNIL);
+ g->module_params_sym = ksymbol_new_b(K, "module-parameters", KNIL);
/* Create the root and error continuation (will be added to the
environment in kinit_ground_env) */
- K->root_cont = kmake_continuation(K, KNIL, do_root_exit, 0);
+ g->root_cont = kmake_continuation(K, KNIL, do_root_exit, 0);
#if KTRACK_SI
/* Add source info to the cont */
TValue str = kstring_new_b_imm(K, __FILE__);
TValue tail = kcons(K, i2tv(__LINE__), i2tv(0));
si = kcons(K, str, tail);
- kset_source_info(K, K->root_cont, si);
+ kset_source_info(K, g->root_cont, si);
#endif
- K->error_cont = kmake_continuation(K, K->root_cont, do_error_exit, 0);
+ g->error_cont = kmake_continuation(K, g->root_cont, do_error_exit, 0);
#if KTRACK_SI
str = kstring_new_b_imm(K, __FILE__);
tail = kcons(K, i2tv(__LINE__), i2tv(0));
si = kcons(K, str, tail);
- kset_source_info(K, K->error_cont, si);
+ kset_source_info(K, g->error_cont, si);
#endif
/* this must be done before calling kinit_ground_env */
@@ -291,15 +387,50 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
kinit_ground_env(K);
kinit_cont_names(K);
- /* create a std environment and leave it in K->next_env */
- K->next_env = kmake_table_environment(K, K->ground_env);
+ /* create a std environment and leave it in g->next_env */
+ K->next_env = kmake_table_environment(K, g->ground_env);
/* set the threshold for gc start now that we have allocated all mem */
- K->GCthreshold = 4*K->totalbytes;
+ g->GCthreshold = 4*g->totalbytes;
+
+ return K;
+}
+/* this is in api.c in lua */
+klisp_State *klisp_newthread(klisp_State *K)
+{
+ /* TODO */
return K;
}
+/* TODO */
+#if 0
+lua_State *luaE_newthread (lua_State *L) {
+void luaE_freethread (lua_State *L, lua_State *L1) {
+#endif
+
+void klisp_close (klisp_State *K)
+{
+ K = G(K)->mainthread; /* only the main thread can be closed */
+
+/* XXX lua does the following */
+#if 0
+ lua_lock(L);
+ luaF_close(L, L->stack); /* close all upvalues for this thread */
+ luaC_separateudata(L, 1); /* separate udata that have GC metamethods */
+ L->errfunc = 0; /* no error function during GC metamethods */ /* free all collectable objects */
+ do { /* repeat until no more errors */
+ L->ci = L->base_ci;
+ L->base = L->top = L->ci->base;
+ L->nCcalls = L->baseCcalls = 0;
+ } while (luaD_rawrunprotected(L, callallgcTM, NULL) != 0);
+ lua_assert(G(L)->tmudata == NULL);
+ luai_userstateclose(L);
+#endif
+
+ close_state(K);
+}
+
/*
** Root and Error continuations
*/
@@ -646,25 +777,3 @@ void klispS_run(klisp_State *K)
}
}
}
-
-void klisp_close (klisp_State *K)
-{
- /* free all collectable objects */
- klispC_freeall(K);
-
- /* free helper buffers */
- klispM_freemem(K, ks_sbuf(K), ks_ssize(K) * sizeof(TValue));
- klispM_freemem(K, ks_tbuf(K), ks_tbsize(K));
-
- /* there should be no pending strings */
- klisp_assert(K->strt.nuse == 0);
-
- /* free string/symbol table */
- klispM_freearray(K, K->strt.hash, K->strt.size, GCObject *);
-
- /* only remaining mem should be of the state struct */
- klisp_assert(K->totalbytes == state_size());
-
- /* NOTE: this needs to be done "by hand" */
- (*(K->frealloc))(K->ud, K, state_size(), 0);
-}
diff --git a/src/kstate.h b/src/kstate.h
@@ -5,8 +5,7 @@
*/
/*
-** SOURCE NOTE: The main structure is from Lua, but because (for now)
-** klisp is single threaded, only global state is provided.
+** SOURCE NOTE: The main structure is from Lua.
*/
#ifndef kstate_h
@@ -44,40 +43,20 @@ typedef struct stringtable {
/* NOTE: when adding TValues here, remember to add them to
markroot in kgc.c!! */
+
/* TODO split this struct in substructs (e.g. run_context, tokenizer,
gc, etc) */
-struct klisp_State {
+
+/*
+** `global state', shared by all threads of this state
+*/
+typedef struct global_State {
+ /* Global tables */
stringtable strt; /* hash table for immutable strings & symbols */
TValue name_table; /* hash tables for naming objects */
- TValue cont_name_table; /* hash tables for naming continuation functions*/
-
- TValue curr_cont;
- /*
- ** If next_env is NIL, then the next_func from a continuation
- ** and otherwise next_func is from an operative
- */
- TValue next_obj; /* this is the operative or continuation to call
- must be here to protect it from gc */
- klisp_CFunction next_func; /* the next function to call
- (operative or continuation) */
- TValue next_value; /* the value to be passed to the next function */
- TValue next_env; /* either NIL or an environment for next operative */
- TValue *next_xparams;
- /* TODO replace with GCObject *next_si */
- TValue next_si; /* the source code info for this call */
-
- TValue eval_op; /* the operative for evaluation */
- TValue list_app; /* the applicative for list evaluation */
- TValue memoize_app; /* the applicative for promise memoize */
- TValue ground_env; /* the environment with all the ground definitions */
- /* standard environments are environments with no bindings and ground_env
- as parent */
- TValue module_params_sym; /* this is the symbol "module-parameters" */
- /* it is used in get-module */
- TValue root_cont;
- TValue error_cont;
- TValue system_error_cont; /* initialized by kinit_error_hierarchy() */
+ TValue cont_name_table; /* hash tables for naming continuation functions */
+ /* Memory allocator */
klisp_Alloc frealloc; /* function to reallocate memory */
void *ud; /* auxiliary data to `frealloc' */
@@ -99,19 +78,10 @@ struct klisp_State {
int32_t gcpause; /* size of pause between successive GCs */
int32_t gcstepmul; /* GC `granularity' */
- /* TEMP: error handling */
- jmp_buf error_jb;
-
- /* input/output port in use (for read & write) */
- TValue curr_port; /* save the port to update source info on errors */
-
- /* for current-input-port, current-output-port, current-error-port */
- TValue kd_in_port_key;
- TValue kd_out_port_key;
- TValue kd_error_port_key;
-
- /* for strict-arithmetic */
- TValue kd_strict_arith_key;
+ /* Basic Continuation objects */
+ TValue root_cont;
+ TValue error_cont;
+ TValue system_error_cont; /* initialized by kinit_error_hierarchy() */
/* Strings */
TValue empty_string;
@@ -129,10 +99,70 @@ struct klisp_State {
TValue ktok_dot;
TValue ktok_sexp_comment;
+ /* require */
+ TValue require_path;
+ TValue require_table;
+
+ /* libraries */
+ TValue libraries_registry; /* this is a list, because library names
+ are list of symbols and numbers so
+ putting them in a table isn't easy */
+
+ /* XXX These should be changed to use thread specific storage */
+ /* for current-input-port, current-output-port, current-error-port */
+ TValue kd_in_port_key;
+ TValue kd_out_port_key;
+ TValue kd_error_port_key;
+
+ /* for strict-arithmetic */
+ TValue kd_strict_arith_key;
+
+ /* Misc objects that are convenient to have here for now */
+ TValue eval_op; /* the operative for evaluation */
+ TValue list_app; /* the applicative for list evaluation */
+ TValue memoize_app; /* the applicative for promise memoize */
+ TValue ground_env; /* the environment with all the ground definitions */
+ /* NOTE standard environments are environments with no bindings and
+ ground_env as parent */
+ TValue module_params_sym; /* this is the symbol "module-parameters" */
+ /* (it is used in get-module) */
+
+ /* The main thread */
+ klisp_State *mainthread;
+} global_State;
+
+struct klisp_State {
+ CommonHeader; /* This represents a thread object */
+ global_State *k_G;
+ /* Current state of execution */
+ TValue curr_cont; /* the current continuation of this thread */
+ /*
+ ** If next_env is NIL, then the next_func is from a continuation
+ ** and otherwise next_func is from an operative
+ */
+ TValue next_obj; /* this is the operative or continuation to call
+ must be here to protect it from gc */
+ klisp_CFunction next_func; /* the next function to call
+ (operative or continuation) */
+ TValue next_value; /* the value to be passed to the next function */
+ TValue next_env; /* either NIL or an environment for next operative */
+ TValue *next_xparams;
+ /* TODO replace with GCObject *next_si */
+ TValue next_si; /* the source code info for this call */
+
+ /* TEMP: error handling */
+ jmp_buf error_jb;
+
+ /* XXX all reader and writer info should be local to the current
+ continuation to allow user defined port types */
+ /* input/output port in use (for read & write) */
+ TValue curr_port; /* save the port to update source info on errors */
+
/* WORKAROUND for repl */
bool ktok_seen_eof; /* to keep track of eofs that later dissapear */
/* source info tracking */
ksource_info_t ktok_source_info;
+ /* TODO do this with a string or bytevector */
/* tokenizer buffer (XXX this could be done with a string) */
int32_t ktok_buffer_size;
int32_t ktok_buffer_idx;
@@ -148,15 +178,7 @@ struct klisp_State {
/* writer */
bool write_displayp;
- /* require */
- TValue require_path;
- TValue require_table;
-
- /* libraries */
- TValue libraries_registry; /* this is a list, because library names
- are list of symbols and numbers so
- putting them in a table isn't easy */
-
+ /* TODO do this with a vector */
/* auxiliary stack (XXX this could be a vector) */
int32_t ssize; /* total size of array */
int32_t stop; /* top of the stack (all elements are below this index) */
@@ -175,10 +197,37 @@ struct klisp_State {
TValue *rooted_vars_buf[GC_PROTECT_SIZE];
};
+#define G(K) (K->k_G)
+
+/*
+** Union of all Kernel heap-allocated values
+*/
+union GCObject {
+ GCheader gch;
+ MGCheader mgch;
+ Pair pair;
+ Symbol sym;
+ String str;
+ Environment env;
+ Continuation cont;
+ Operative op;
+ Applicative app;
+ Encapsulation enc;
+ Promise prom;
+ Table table;
+ Bytevector bytevector;
+ Port port; /* common fields for all types of ports */
+ FPort fport;
+ MPort mport;
+ Vector vector;
+ Keyword keyw;
+ Library lib;
+ klisp_State th; /* thread */
+};
+
/* some size related macros */
#define KS_ISSIZE (1024)
#define KS_ITBSIZE (1024)
-#define state_size() (sizeof(klisp_State))
/*
** TEMP: for now use inlined functions, later check output in
@@ -485,10 +534,10 @@ void do_error_exit(klisp_State *K);
/* XXX: this is ugly but we can't include kpair.h here so... */
/* MAYBE: move car & cdr to kobject.h */
/* TODO: use these where appropriate */
-#define kcurr_input_port(K) (tv2pair((K)->kd_in_port_key)->cdr)
-#define kcurr_output_port(K) (tv2pair((K)->kd_out_port_key)->cdr)
-#define kcurr_error_port(K) (tv2pair((K)->kd_error_port_key)->cdr)
-#define kcurr_strict_arithp(K) bvalue(tv2pair((K)->kd_strict_arith_key)->cdr)
+#define kcurr_input_port(K) (tv2pair(G(K)->kd_in_port_key)->cdr)
+#define kcurr_output_port(K) (tv2pair(G(K)->kd_out_port_key)->cdr)
+#define kcurr_error_port(K) (tv2pair(G(K)->kd_error_port_key)->cdr)
+#define kcurr_strict_arithp(K) bvalue(tv2pair(G(K)->kd_strict_arith_key)->cdr)
#endif
