klisp

an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

kstate.c (19953B)


      1 /*
      2 ** kstate.c
      3 ** klisp vm state
      4 ** See Copyright Notice in klisp.h
      5 */
      6 
      7 /*
      8 ** SOURCE NOTE: this is mostly from Lua.
      9 ** The algorithm for testing if a continuation is within the dynamic extent
     10 ** of another continuation using marks is by John Shutt. The implementation
     11 ** he uses (see SINK) is in scheme and is under the GPL but I think this is 
     12 ** different enough (and the algorithm simple/small enough) to avoid any 
     13 ** problem. ASK John.
     14 */
     15 
     16 #include <stdlib.h>
     17 #include <stddef.h>
     18 #include <setjmp.h>
     19 #include <string.h>
     20 #include <pthread.h>
     21 
     22 #include "klisp.h"
     23 #include "klimits.h"
     24 #include "kstate.h"
     25 #include "kobject.h"
     26 #include "kpair.h"
     27 #include "kmem.h"
     28 #include "keval.h"
     29 #include "koperative.h"
     30 #include "kapplicative.h"
     31 #include "kcontinuation.h"
     32 #include "kenvironment.h"
     33 #include "kground.h"
     34 #include "krepl.h"
     35 #include "ksymbol.h"
     36 #include "kstring.h"
     37 #include "kport.h"
     38 #include "ktable.h"
     39 #include "kbytevector.h"
     40 #include "kvector.h"
     41 
     42 #include "kghelpers.h" /* for creating list_app & memoize_app */
     43 #include "kgerrors.h" /* for creating error hierarchy */
     44 
     45 #include "kgc.h" /* for memory freeing & gc init */
     46 
     47 
     48 /* in lua state size can have an extra space here to save
     49    some user data, for now we don't have that in klisp */
     50 #define state_size(x) (sizeof(x) + 0)
     51 #define fromstate(k)	(cast(uint8_t *, (k)) - 0)
     52 #define tostate(k)   (cast(klisp_State *, cast(uint8_t *, k) + 0))
     53 
     54 /*
     55 ** Main thread combines a thread state and the global state
     56 */
     57 typedef struct KG {
     58   klisp_State k;
     59   global_State g;
     60 } KG;
     61 
     62 /*
     63 ** open parts that may cause memory-allocation errors
     64 */
     65 /* TODO move other stuff that cause allocs here */
     66 static void f_klispopen (klisp_State *K, void *ud) {
     67     global_State *g = G(K);
     68     UNUSED(ud);
     69     klispS_resize(K, MINSTRTABSIZE);  /* initial size of string table */
     70 
     71     void *s = (*g->frealloc)(ud, NULL, 0, KS_ISSIZE * sizeof(TValue));
     72     if (s == NULL) { 
     73         return; /* XXX throw error somehow & free mem */
     74     }
     75     void *b = (*g->frealloc)(ud, NULL, 0, KS_ITBSIZE);
     76     if (b == NULL) {
     77         return; /* XXX throw error somehow & free mem */
     78     }
     79 
     80     /* initialize temp stacks */
     81     ks_ssize(K) = KS_ISSIZE;
     82     ks_stop(K) = 0; /* stack is empty */
     83     ks_sbuf(K) = (TValue *)s;
     84 
     85     ks_tbsize(K) = KS_ITBSIZE;
     86     ks_tbidx(K) = 0; /* buffer is empty */
     87     ks_tbuf(K) = (char *)b;
     88     
     89     /* (at least for now) we'll use a non recursive mutex for the GIL */
     90     /* XXX/TODO check return code */
     91     pthread_mutex_init(&g->gil, NULL);
     92 
     93 /* This is here in lua, but in klisp we still need to alloc
     94    a bunch of objects:
     95    g->GCthreshold = 4*g->totalbytes; 
     96 */
     97 }
     98 
     99 
    100 static void preinit_state (klisp_State *K, global_State *g) {
    101     G(K) = g;
    102 
    103     K->status = KLISP_THREAD_CREATED;
    104     K->gil_count = 0;
    105     K->curr_cont = KNIL;
    106     K->next_obj = KINERT;
    107     K->next_func = NULL;
    108     K->next_value = KINERT;
    109     K->next_env = KNIL;
    110     K->next_xparams = NULL;
    111     K->next_si = KNIL;
    112 
    113     /* current input and output */
    114     K->curr_port = KINERT; /* set on each call to read/write */
    115 
    116     /* init the stacks used to protect variables & values from gc,
    117        this should be done before any new object is created because
    118        they are used by them */
    119     K->rooted_tvs_top = 0;
    120     K->rooted_vars_top = 0;
    121 
    122     /* initialize tokenizer */
    123 
    124     /* WORKAROUND: for stdin line buffering & reading of EOF */
    125     K->ktok_seen_eof = false;
    126 
    127     /* TEMP: For now just hardcode it to 8 spaces tab-stop */
    128     K->ktok_source_info.tab_width = 8;
    129     /* all three are set on each call to read */
    130     K->ktok_source_info.filename = KINERT; 
    131     K->ktok_source_info.line = 1; 
    132     K->ktok_source_info.col = 0;
    133 
    134     K->ktok_nested_comments = 0;
    135 
    136     /* initialize reader */
    137     K->shared_dict = KNIL;
    138     K->read_mconsp = false; /* set on each call to read */
    139 
    140     /* initialize writer */
    141     K->write_displayp = false; /* set on each call to write */
    142 
    143     /* put zeroes first, in case alloc fails */
    144     ks_stop(K) = 0;
    145     ks_ssize(K) = 0; 
    146     ks_sbuf(K) = NULL;
    147 
    148     ks_tbidx(K) = 0;
    149     ks_tbsize(K) = 0;
    150     ks_tbuf(K) = NULL;
    151 }
    152 
    153 /* LOCK: GIL should be acquired */
    154 static void close_state(klisp_State *K)
    155 {
    156     global_State *g = G(K);
    157 
    158     /* collect all objects */
    159     klispC_freeall(K);
    160     klisp_assert(g->rootgc == obj2gco(K));
    161     klisp_assert(g->strt.nuse == 0);
    162 
    163     /* free helper buffers */
    164     klispM_freemem(K, ks_sbuf(K), ks_ssize(K) * sizeof(TValue));
    165     klispM_freemem(K, ks_tbuf(K), ks_tbsize(K));
    166     /* free string/symbol table */
    167     klispM_freearray(K, g->strt.hash, g->strt.size, GCObject *);
    168 
    169     /* destroy the GIL */
    170     pthread_mutex_destroy(&g->gil);
    171 
    172     /* only remaining mem should be of the state struct */
    173     klisp_assert(g->totalbytes == sizeof(KG));
    174     /* NOTE: this needs to be done "by hand" */
    175     (*g->frealloc)(g->ud, fromstate(K), state_size(KG), 0);
    176 }
    177 
    178 /*
    179 ** State creation and destruction
    180 */
    181 klisp_State *klisp_newstate(klisp_Alloc f, void *ud)
    182 {
    183     klisp_State *K;
    184     global_State *g;
    185     
    186     void *k = (*f)(ud, NULL, 0, state_size(KG));
    187     if (k == NULL) return NULL;
    188     K = tostate(k);
    189     g = &((KG *)K)->g;
    190     /* Init klisp_State object header (for GC) */
    191     K->next = NULL;
    192     K->tt = K_TTHREAD;
    193     K->kflags = 0;
    194     K->si = NULL;
    195     g->currentwhite = bit2mask(WHITE0BIT, FIXEDBIT);
    196     K->gct = klispC_white(g);
    197     set2bits(K->gct, FIXEDBIT, SFIXEDBIT);
    198 
    199     preinit_state(K, g);
    200 
    201     ktok_init(K); /* initialize tokenizer tables */
    202     g->frealloc = f;
    203     g->ud = ud;
    204     g->mainthread = K;
    205 
    206     g->GCthreshold = 0;  /* mark it as unfinished state */
    207 
    208     /* these will be properly initialized later */
    209     g->strt.size = 0;
    210     g->strt.nuse = 0;
    211     g->strt.hash = NULL;
    212     g->name_table = KINERT;
    213     g->cont_name_table = KINERT;
    214     g->thread_table = KINERT;
    215 
    216     g->empty_string = KINERT;
    217     g->empty_bytevector = KINERT;
    218     g->empty_vector = KINERT;
    219 
    220     g->ktok_lparen = KINERT;
    221     g->ktok_rparen = KINERT;
    222     g->ktok_dot = KINERT;
    223     g->ktok_sexp_comment = KINERT;
    224 
    225     g->require_path = KINERT;
    226     g->require_table = KINERT;
    227     g->libraries_registry = KINERT;
    228 
    229     g->eval_op = KINERT;
    230     g->list_app = KINERT;
    231     g->memoize_app = KINERT;
    232     g->ground_env = KINERT;
    233     g->module_params_sym = KINERT;
    234     g->root_cont = KINERT;
    235     g->error_cont = KINERT;
    236     g->system_error_cont = KINERT;
    237 
    238     /* input / output for dynamic keys */
    239     /* these are init later */
    240     g->kd_in_port_key = KINERT;
    241     g->kd_out_port_key = KINERT;
    242     g->kd_error_port_key = KINERT;
    243 
    244     /* strict arithmetic dynamic key */
    245     /* this is init later */
    246     g->kd_strict_arith_key = KINERT;
    247 
    248     g->gcstate = GCSpause;
    249     g->rootgc = obj2gco(K); /* was NULL in unithread klisp... CHECK */
    250     g->sweepstrgc = 0;
    251     g->sweepgc = &g->rootgc;
    252     g->gray = NULL;
    253     g->grayagain = NULL;
    254     g->weak = NULL;
    255     g->tmudata = NULL;
    256     g->totalbytes = sizeof(KG);
    257     g->gcpause = KLISPI_GCPAUSE;
    258     g->gcstepmul = KLISPI_GCMUL;
    259     g->gcdept = 0;
    260 
    261     /* GC */
    262     g->totalbytes = state_size(KG) + KS_ISSIZE * sizeof(TValue) +
    263         KS_ITBSIZE;
    264     g->GCthreshold = UINT32_MAX; /* we still have a lot of allocation
    265                                     to do, put a very high value to 
    266                                     avoid collection */
    267     g->estimate = 0; /* doesn't matter, it is set by gc later */
    268     /* XXX Things start being ugly from here on...
    269        I have to think about the whole init procedure, for now
    270        I am mostly following lua, but the differences between it and 
    271        klisp show... We still have to allocate a lot of objects and 
    272        it isn't really clear what happens if we run out of space before
    273        all objects are allocated.  For now let's suppose that will not
    274        happen... */
    275     /* TODO handle errors, maybe with longjmp, also see lua
    276      luaD_rawrunprotected */
    277     f_klispopen(K, NULL); /* this touches GCthreshold */
    278 
    279     g->GCthreshold = UINT32_MAX; /* we still have a lot of allocation
    280                                     to do, put a very high value to 
    281                                     avoid collection */
    282 
    283     /* TEMP: err */
    284     /* THIS MAY CRASH THE INTERPRETER IF THERE IS AN ERROR IN THE INIT */
    285     /* do nothing for now */
    286 
    287     /* initialize strings */
    288 
    289     /* initialize name info table */
    290     /* needs weak keys, otherwise every named object would
    291        be fixed! */
    292     g->name_table = klispH_new(K, 0, MINNAMETABSIZE, 
    293                                K_FLAG_WEAK_KEYS);
    294     /* here the keys are uncollectable */
    295     g->cont_name_table = klispH_new(K, 0, MINCONTNAMETABSIZE, 
    296                                     K_FLAG_WEAK_NOTHING);
    297     /* here the keys are uncollectable */
    298     g->thread_table = klispH_new(K, 0, MINTHREADTABSIZE,
    299                                  K_FLAG_WEAK_NOTHING);
    300 
    301     /* Empty string */
    302     /* MAYBE: fix it so we can remove empty_string from roots */
    303     g->empty_string = kstring_new_b_imm(K, "");
    304 
    305     /* Empty bytevector */
    306     /* MAYBE: fix it so we can remove empty_bytevector from roots */
    307     /* XXX: find a better way to do this */
    308     g->empty_bytevector = KNIL; /* trick constructor to create empty bytevector */
    309     g->empty_bytevector = kbytevector_new_bs_imm(K, NULL, 0);
    310 
    311     /* Empty vector */
    312     /* MAYBE: see above */
    313     g->empty_vector = kvector_new_bs_g(K, false, NULL, 0);
    314 
    315     /* Special Tokens */
    316     g->ktok_lparen = kcons(K, ch2tv('('), KNIL);
    317     g->ktok_rparen = kcons(K, ch2tv(')'), KNIL);
    318     g->ktok_dot = kcons(K, ch2tv('.'), KNIL);
    319     g->ktok_sexp_comment = kcons(K, ch2tv(';'), KNIL);
    320 
    321     /* initialize require facilities */ 
    322     {
    323         char *str = getenv(KLISP_PATH);
    324         if (str == NULL)
    325             str = KLISP_PATH_DEFAULT;
    326 	
    327         g->require_path = kstring_new_b_imm(K, str);
    328         /* replace dirsep with forward slashes,
    329            windows will happily accept forward slashes */
    330         str = kstring_buf(g->require_path);
    331         while ((str = strchr(str, *KLISP_DIRSEP)) != NULL)
    332             *str++ = '/';
    333     }
    334     g->require_table = klispH_new(K, 0, MINREQUIRETABSIZE, 0);
    335 
    336     /* initialize library facilities */
    337     g->libraries_registry = KNIL;
    338 
    339     /* the dynamic ports and the keys for the dynamic ports */
    340     TValue in_port = kmake_std_fport(K, kstring_new_b_imm(K, "*STDIN*"),
    341                                      false, false,  stdin);
    342     TValue out_port = kmake_std_fport(K, kstring_new_b_imm(K, "*STDOUT*"),
    343                                       true, false, stdout);
    344     TValue error_port = kmake_std_fport(K, kstring_new_b_imm(K, "*STDERR*"),
    345                                         true, false, stderr);
    346     g->kd_in_port_key = kcons(K, KTRUE, in_port);
    347     g->kd_out_port_key = kcons(K, KTRUE, out_port);
    348     g->kd_error_port_key = kcons(K, KTRUE, error_port);
    349 
    350     /* strict arithmetic key, (starts as false) */
    351     g->kd_strict_arith_key = kcons(K, KTRUE, KFALSE);
    352 
    353     /* create the ground environment and the eval operative */
    354     int32_t line_number; 
    355     TValue si;
    356     g->eval_op = kmake_operative(K, keval_ofn, 0), line_number = __LINE__;
    357 #if KTRACK_SI
    358     si = kcons(K, kstring_new_b_imm(K, __FILE__), 
    359                kcons(K, i2tv(line_number), i2tv(0)));
    360     kset_source_info(K, g->eval_op, si);
    361 #endif
    362     /* TODO: si */
    363     TValue eval_name = ksymbol_new_b(K, "eval", KNIL);
    364     ktry_set_name(K, g->eval_op, eval_name);
    365     
    366     g->list_app = kmake_applicative(K, list, 0), line_number = __LINE__;
    367 #if KTRACK_SI
    368     si = kcons(K, kstring_new_b_imm(K, __FILE__), 
    369                kcons(K, i2tv(__LINE__), i2tv(0)));
    370     kset_source_info(K, g->list_app, si);
    371     kset_source_info(K, kunwrap(g->list_app), si);
    372 #endif
    373 
    374     g->memoize_app = kmake_applicative(K, memoize, 0), line_number = __LINE__;
    375 #if KTRACK_SI
    376     si = kcons(K, kstring_new_b_imm(K, __FILE__), 
    377                kcons(K, i2tv(__LINE__), i2tv(0)));
    378     kset_source_info(K, g->memoize_app, si);
    379     kset_source_info(K, kunwrap(g->memoize_app), si);
    380 #endif
    381     /* ground environment has a hashtable for bindings */
    382     g->ground_env = kmake_table_environment(K, KNIL);
    383 //    g->ground_env = kmake_empty_environment(K);
    384 
    385     /* MAYBE: fix it so we can remove module_params_sym from roots */
    386     /* TODO si */
    387     g->module_params_sym = ksymbol_new_b(K, "module-parameters", KNIL);
    388 
    389     kinit_ground_env(K);
    390     kinit_cont_names(K);
    391 
    392     /* put the main thread in the thread table */
    393     TValue *node = klispH_set(K, tv2table(g->thread_table), gc2th(K));
    394     *node = KTRUE;
    395 
    396     /* create a std environment and leave it in g->next_env */
    397     K->next_env = kmake_table_environment(K, g->ground_env);
    398 
    399     /* set the threshold for gc start now that we have allocated all mem */ 
    400     g->GCthreshold = 4*g->totalbytes;
    401 
    402     /* luai_userstateopen(L); */
    403     return K;
    404 }
    405 
    406 /* this is in api.c in lua */
    407 klisp_State *klisp_newthread(klisp_State *K)
    408 {
    409     /* TODO */
    410     return NULL;
    411 }
    412 
    413 klisp_State *klispT_newthread(klisp_State *K)
    414 {
    415     klisp_State *K1 = tostate(klispM_malloc(K, state_size(klisp_State)));
    416     klispC_link(K, (GCObject *) K1, K_TTHREAD, 0);
    417 
    418     preinit_state(K1, G(K));
    419 
    420     /* protect from gc */
    421     krooted_tvs_push(K, gc2th(K1));
    422 
    423     /* initialize temp stacks */
    424     ks_sbuf(K1) = (TValue *) klispM_malloc(K, KS_ISSIZE * sizeof(TValue));
    425     ks_ssize(K1) = KS_ISSIZE;
    426     ks_stop(K1) = 0; /* stack is empty */
    427 
    428     ks_tbuf(K1) = (char *) klispM_malloc(K, KS_ITBSIZE);
    429     ks_tbsize(K1) = KS_ITBSIZE;
    430     ks_tbidx(K1) = 0; /* buffer is empty */
    431 
    432     /* initialize condition variable for joining */
    433     int32_t ret = pthread_cond_init(&K1->joincond, NULL);
    434 
    435     if (ret != 0) {
    436         klispE_throw_simple_with_irritants(K, "Error creating joincond for "
    437                                            "new thread", 1, i2tv(ret));
    438         return NULL;
    439     }
    440 
    441     /* everything went well, put the thread in the thread table */
    442     TValue *node = klispH_set(K, tv2table(G(K)->thread_table), gc2th(K1));
    443     *node = KTRUE;
    444     krooted_tvs_pop(K);
    445 
    446     klisp_assert(iswhite((GCObject *) (K1)));
    447     return K1;
    448 }
    449 
    450 
    451 void klispT_freethread (klisp_State *K, klisp_State *K1)
    452 {
    453     /* main thread can't come here, so it's safe to remove the
    454        condvar here */
    455     int32_t ret = pthread_cond_destroy(&K1->joincond);
    456     klisp_assert(ret == 0); /* shouldn't happen */
    457 
    458     klispM_freemem(K, ks_sbuf(K1), ks_ssize(K1) * sizeof(TValue));
    459     klispM_freemem(K, ks_tbuf(K1), ks_tbsize(K1));
    460     /* userstatefree() */
    461     klispM_freemem(K, fromstate(K1), state_size(klisp_State));
    462 }
    463 
    464 void klisp_close (klisp_State *K)
    465 {
    466     K = G(K)->mainthread;  /* only the main thread can be closed */
    467 
    468     klisp_lock(K);
    469 /* XXX lua does the following */
    470 #if 0 
    471     lua_lock(L); 
    472     luaF_close(L, L->stack);  /* close all upvalues for this thread */
    473     luaC_separateudata(L, 1);  /* separate udata that have GC metamethods */
    474     L->errfunc = 0;  /* no error function during GC metamethods */    /* free all collectable objects */
    475   do {  /* repeat until no more errors */
    476     L->ci = L->base_ci;
    477     L->base = L->top = L->ci->base;
    478     L->nCcalls = L->baseCcalls = 0;
    479   } while (luaD_rawrunprotected(L, callallgcTM, NULL) != 0);
    480   lua_assert(G(L)->tmudata == NULL);
    481   luai_userstateclose(L);
    482 #endif
    483 
    484   /* luai_userstateclose(L); */
    485     close_state(K);
    486 }
    487 
    488 /*
    489 ** Stacks memory management
    490 */
    491 
    492 /* LOCK: All these functions should be called with the GIL already acquired */
    493 /* TODO test this */
    494 void ks_sgrow(klisp_State *K, int32_t new_top)
    495 {
    496     size_t old_size = ks_ssize(K);
    497     /* should be powers of two multiple of KS_ISIZE */
    498     /* TEMP: do it naively for now */
    499     size_t new_size = old_size * 2;
    500     while(new_top > new_size)
    501         new_size *= 2;
    502 
    503     ks_sbuf(K) = klispM_realloc_(K, ks_sbuf(K), old_size*sizeof(TValue),
    504                                  new_size*sizeof(TValue));
    505     ks_ssize(K) = new_size; 
    506 }
    507 
    508 void ks_sshrink(klisp_State *K, int32_t new_top)
    509 {
    510     /* NOTE: may shrink more than once, take it to a multiple of 
    511        KS_ISSIZE that is a power of 2 and no smaller than (size * 4) */
    512     size_t old_size = ks_ssize(K);
    513     /* TEMP: do it naively for now */
    514     size_t new_size = old_size;
    515     while(new_size > KS_ISSIZE && new_top * 4 < new_size)
    516         new_size /= 2;
    517 
    518     /* NOTE: shrink can't fail */
    519     ks_sbuf(K) = klispM_realloc_(K, ks_sbuf(K), old_size*sizeof(TValue),
    520                                  new_size*sizeof(TValue));
    521     ks_ssize(K) = new_size;
    522 }
    523 
    524 
    525 /* TODO test this */
    526 void ks_tbgrow(klisp_State *K, int32_t new_top)
    527 {
    528     size_t old_size = ks_tbsize(K);
    529     /* should be powers of two multiple of KS_ISIZE */
    530     /* TEMP: do it naively for now */
    531     size_t new_size = old_size * 2;
    532     while(new_top > new_size)
    533         new_size *= 2;
    534     
    535     ks_tbuf(K) = klispM_realloc_(K, ks_tbuf(K), old_size*sizeof(TValue),
    536                                  new_size*sizeof(TValue));
    537     ks_tbsize(K) = new_size; 
    538 }
    539 
    540 void ks_tbshrink(klisp_State *K, int32_t new_top)
    541 {
    542     /* NOTE: may shrink more than once, take it to a multiple of 
    543        KS_ISSIZE that is a power of 2 and no smaller than (size * 4) */
    544     size_t old_size = ks_tbsize(K);
    545     /* TEMP: do it naively for now */
    546     size_t new_size = old_size;
    547     while(new_size > KS_ISSIZE && new_top * 4 < new_size)
    548         new_size /= 2;
    549 
    550     /* NOTE: shrink can't fail */
    551     ks_tbuf(K) = klispM_realloc_(K, ks_tbuf(K), old_size*sizeof(TValue),
    552                                  new_size*sizeof(TValue));
    553     ks_tbsize(K) = new_size;
    554 }
    555 
    556 /* GC: Don't assume anything about obj & dst_cont, they may not be rooted.
    557    In the most common case of apply-continuation & continuation->applicative
    558    they are rooted, but in general there's no way to protect them, because
    559    this ends in a setjmp */
    560 void kcall_cont(klisp_State *K, TValue dst_cont, TValue obj)
    561 {
    562     krooted_tvs_push(K, dst_cont);
    563     krooted_tvs_push(K, obj);
    564     TValue src_cont = kget_cc(K);
    565     TValue int_ls = create_interception_list(K, src_cont, dst_cont);
    566     TValue new_cont;
    567     if (ttisnil(int_ls)) {
    568         new_cont = dst_cont; /* no interceptions */
    569     } else {
    570         krooted_tvs_push(K, int_ls);
    571         /* we have to contruct a continuation to do the interceptions
    572            in order and finally call dst_cont if no divert occurs */
    573         new_cont = kmake_continuation(K, kget_cc(K), do_interception, 
    574                                       2, int_ls, dst_cont);
    575         krooted_tvs_pop(K);
    576     }
    577     /* no more allocation from this point */
    578     krooted_tvs_pop(K);
    579     krooted_tvs_pop(K);
    580 
    581     /*
    582     ** This may come from an error detected by the interpreter, so we can't
    583     ** do just a return (like kapply_cc does), maybe we could somehow 
    584     ** differentiate to avoid the longjmp when return would suffice 
    585     ** TODO: do that
    586     */
    587     kset_cc(K, new_cont);
    588     klispT_apply_cc(K, obj);
    589     longjmp(K->error_jb, 1);
    590 }
    591 
    592 void klispT_init_repl(klisp_State *K)
    593 {
    594     /* this is in krepl.c */
    595     kinit_repl(K);
    596 }
    597 
    598 /* 
    599 ** TEMP/LOCK: put lock here, until all operatives and continuations do locking directly
    600 ** or a new interface (like lua api) does it for them.
    601 ** This has the problem that nothing can be done in parallel (but still has the advantage
    602 ** that (unlike coroutines) when one thread is blocked (e.g. waiting for IO) the others
    603 ** may continue (provided that the blocked thread unlocks the GIL before blocking...)
    604 */
    605 void klispT_run(klisp_State *K)
    606 {
    607     while(true) {
    608         if (setjmp(K->error_jb)) {
    609             /* continuation called */
    610             /* TEMP: do nothing, the loop will call the continuation */
    611 	    klisp_unlock_all(K);
    612         } else {
    613             klisp_lock(K);
    614             /* all ok, continue with next func */
    615             while (K->next_func) {
    616                 /* next_func is either operative or continuation
    617                    but in any case the call is the same */
    618                 (*(K->next_func))(K);
    619                 klispi_threadyield(K);
    620             }
    621             /* K->next_func is NULL, this means we should exit already */
    622             klisp_unlock(K);
    623             break;
    624         }
    625     }
    626 }