kstate.h (17908B)
1 /* 2 ** kstate.h 3 ** klisp vm state 4 ** See Copyright Notice in klisp.h 5 */ 6 7 /* 8 ** SOURCE NOTE: The main structure is from Lua. 9 */ 10 11 #ifndef kstate_h 12 #define kstate_h 13 14 #include <stdio.h> 15 #include <setjmp.h> 16 #include <pthread.h> 17 18 #include "klimits.h" 19 #include "kobject.h" 20 #include "klisp.h" 21 #include "ktoken.h" 22 #include "kmem.h" 23 24 /* XXX: for now, lines and column names are fixints */ 25 /* MAYBE: this should be in tokenizer */ 26 typedef struct { 27 TValue filename; 28 int32_t tab_width; 29 int32_t line; 30 int32_t col; 31 32 int32_t saved_line; 33 int32_t saved_col; 34 } ksource_info_t; 35 36 /* in klisp this has both the immutable strings & the symbols */ 37 typedef struct stringtable { 38 GCObject **hash; 39 uint32_t nuse; /* number of elements */ 40 int32_t size; 41 } stringtable; 42 43 #define GC_PROTECT_SIZE 32 44 45 /* NOTE: when adding TValues here, remember to add them to 46 markroot in kgc.c!! */ 47 48 /* TODO split this struct in substructs (e.g. run_context, tokenizer, 49 gc, etc) */ 50 51 /* 52 ** `global state', shared by all threads of this state 53 */ 54 typedef struct global_State { 55 /* Global tables */ 56 stringtable strt; /* hash table for immutable strings & symbols */ 57 TValue name_table; /* hash tables for naming objects */ 58 TValue cont_name_table; /* hash tables for naming continuation functions */ 59 TValue thread_table; /* hash table for all live (non done/error) threads */ 60 61 /* Memory allocator */ 62 klisp_Alloc frealloc; /* function to reallocate memory */ 63 void *ud; /* auxiliary data to `frealloc' */ 64 65 /* GC */ 66 uint16_t currentwhite; /* the one of the two whites that is in use in 67 this collection cycle */ 68 uint8_t gcstate; /* state of garbage collector */ 69 int32_t sweepstrgc; /* position of sweep in `strt' */ 70 GCObject *rootgc; /* list of all collectable objects */ 71 GCObject **sweepgc; /* position of sweep in `rootgc' */ 72 GCObject *gray; /* list of gray objects */ 73 GCObject *grayagain; /* list of objects to be traversed atomically */ 74 GCObject *weak; /* list of weak tables (to be cleared) */ 75 GCObject *tmudata; /* last element of list of userdata to be GC */ 76 uint32_t GCthreshold; 77 uint32_t totalbytes; /* number of bytes currently allocated */ 78 uint32_t estimate; /* an estimate of number of bytes actually in use */ 79 uint32_t gcdept; /* how much GC is `behind schedule' */ 80 int32_t gcpause; /* size of pause between successive GCs */ 81 int32_t gcstepmul; /* GC `granularity' */ 82 83 /* Basic Continuation objects */ 84 TValue root_cont; 85 TValue error_cont; 86 TValue system_error_cont; /* initialized by kinit_error_hierarchy() */ 87 88 /* Strings */ 89 TValue empty_string; 90 91 /* Bytevectors */ 92 TValue empty_bytevector; 93 94 /* Vectors */ 95 TValue empty_vector; 96 97 /* tokenizer */ 98 /* special tokens, see ktoken.c for rationale */ 99 TValue ktok_lparen; 100 TValue ktok_rparen; 101 TValue ktok_dot; 102 TValue ktok_sexp_comment; 103 104 /* require */ 105 TValue require_path; 106 TValue require_table; 107 108 /* libraries */ 109 TValue libraries_registry; /* this is a list, because library names 110 are list of symbols and numbers so 111 putting them in a table isn't easy */ 112 113 /* XXX These should be changed to use thread specific storage */ 114 /* for current-input-port, current-output-port, current-error-port */ 115 TValue kd_in_port_key; 116 TValue kd_out_port_key; 117 TValue kd_error_port_key; 118 119 /* for strict-arithmetic */ 120 TValue kd_strict_arith_key; 121 122 /* Misc objects that are convenient to have here for now */ 123 TValue eval_op; /* the operative for evaluation */ 124 TValue list_app; /* the applicative for list evaluation */ 125 TValue memoize_app; /* the applicative for promise memoize */ 126 TValue ground_env; /* the environment with all the ground definitions */ 127 /* NOTE standard environments are environments with no bindings and 128 ground_env as parent */ 129 TValue module_params_sym; /* this is the symbol "module-parameters" */ 130 /* (it is used in get-module) */ 131 132 /* The main thread */ 133 klisp_State *mainthread; 134 /* The GIL (Global Interpreter Lock) */ 135 /* This is a regular mutex, but we use it to emulate a recursive one. 136 The number of times the lock was acquired is maintained in the 137 locking thread in gil_count */ 138 pthread_mutex_t gil; 139 } global_State; 140 141 /* 142 ** Possible states of a thread/klisp_State, 143 ** currently threads are started as soon as they are created, but 144 ** that may change in the future. If the state is done, or error, 145 ** the returned/thrown object is kept in next_value 146 */ 147 #define KLISP_THREAD_CREATED (0) 148 #define KLISP_THREAD_STARTING (1) 149 #define KLISP_THREAD_RUNNING (2) 150 #define KLISP_THREAD_DONE (3) 151 #define KLISP_THREAD_ERROR (4) 152 153 struct klisp_State { 154 CommonHeader; /* This represents a thread object */ 155 global_State *k_G; 156 pthread_t thread; 157 int32_t status; /* the execution status of this thread */ 158 /* The main thread doesn't have a condition variable here because 159 you can't join it. This may be changed in the future */ 160 pthread_cond_t joincond; /* the condition variable for joining */ 161 /* Current state of execution */ 162 int32_t gil_count; /* the number of times the GIL was acquired */ 163 TValue curr_cont; /* the current continuation of this thread */ 164 /* 165 ** If next_env is NIL, then the next_func is from a continuation 166 ** and otherwise next_func is from an operative 167 */ 168 TValue next_obj; /* this is the operative or continuation to call 169 must be here to protect it from gc */ 170 klisp_CFunction next_func; /* the next function to call 171 (operative or continuation) */ 172 TValue next_value; /* the value to be passed to the next function */ 173 TValue next_env; /* either NIL or an environment for next operative */ 174 TValue *next_xparams; 175 /* TODO replace with GCObject *next_si */ 176 TValue next_si; /* the source code info for this call */ 177 178 /* TEMP: error handling */ 179 jmp_buf error_jb; 180 181 /* XXX all reader and writer info should be local to the current 182 continuation to allow user defined port types */ 183 /* input/output port in use (for read & write) */ 184 TValue curr_port; /* save the port to update source info on errors */ 185 186 /* WORKAROUND for repl */ 187 bool ktok_seen_eof; /* to keep track of eofs that later dissapear */ 188 /* source info tracking */ 189 ksource_info_t ktok_source_info; 190 /* TODO do this with a string or bytevector */ 191 /* tokenizer buffer (XXX this could be done with a string) */ 192 int32_t ktok_buffer_size; 193 int32_t ktok_buffer_idx; 194 char *ktok_buffer; 195 196 int32_t ktok_nested_comments; 197 198 /* reader */ 199 /* TODO: replace the list with a hashtable */ 200 TValue shared_dict; 201 bool read_mconsp; 202 203 /* writer */ 204 bool write_displayp; 205 206 /* TODO do this with a vector */ 207 /* auxiliary stack (XXX this could be a vector) */ 208 int32_t ssize; /* total size of array */ 209 int32_t stop; /* top of the stack (all elements are below this index) */ 210 TValue *sbuf; 211 212 /* These could be eliminated if a stack was adopted for the c interface */ 213 /* (like in lua) */ 214 /* TValue stack to protect values from gc, must not grow, otherwise 215 it may call the gc */ 216 int32_t rooted_tvs_top; 217 TValue rooted_tvs_buf[GC_PROTECT_SIZE]; 218 219 /* TValue * stack to protect c variables from gc. This is used when the 220 object pointed to by a variable may change */ 221 int32_t rooted_vars_top; 222 TValue *rooted_vars_buf[GC_PROTECT_SIZE]; 223 }; 224 225 #define G(K) (K->k_G) 226 227 /* 228 ** Union of all Kernel heap-allocated values 229 */ 230 union GCObject { 231 GCheader gch; 232 MGCheader mgch; 233 Pair pair; 234 Symbol sym; 235 String str; 236 Environment env; 237 Continuation cont; 238 Operative op; 239 Applicative app; 240 Encapsulation enc; 241 Promise prom; 242 Table table; 243 Bytevector bytevector; 244 Port port; /* common fields for all types of ports */ 245 FPort fport; 246 MPort mport; 247 Vector vector; 248 Keyword keyw; 249 Library lib; 250 klisp_State th; /* thread */ 251 }; 252 253 /* some size related macros */ 254 #define KS_ISSIZE (1024) 255 #define KS_ITBSIZE (1024) 256 257 klisp_State *klispT_newthread(klisp_State *K); 258 void klispT_freethread(klisp_State *K, klisp_State *K1); 259 260 /* 261 ** TEMP: for now use inlined functions, later check output in 262 ** different compilers and/or profile to see if it's worthy to 263 ** eliminate it, change it to compiler specific or replace it 264 ** with defines 265 */ 266 267 /* 268 ** Stack functions 269 */ 270 271 void ks_sshrink(klisp_State *K, int32_t new_top); 272 void ks_sgrow(klisp_State *K, int32_t new_top); 273 274 static inline void ks_spush(klisp_State *K, TValue obj); 275 static inline TValue ks_spop(klisp_State *K); 276 /* this is for DISCARDING stack pop (value isn't used, avoid warning) */ 277 #define ks_sdpop(st_) (UNUSED(ks_spop(st_))) 278 static inline void ks_sdiscardn(klisp_State *K, int32_t n); 279 static inline TValue ks_sget(klisp_State *K); 280 static inline void ks_sclear(klisp_State *K); 281 static inline bool ks_sisempty(klisp_State *K); 282 283 /* some stack manipulation macros */ 284 #define ks_ssize(st_) ((st_)->ssize) 285 #define ks_stop(st_) ((st_)->stop) 286 #define ks_sbuf(st_) ((st_)->sbuf) 287 #define ks_selem(st_, i_) ((ks_sbuf(st_))[i_]) 288 289 /* LOCK: All these functions should be called with the GIL already acquired */ 290 /* XXX/REFACTOR: the problem with these is that if the lock is acquired here 291 there's no way to protect the value just popped, it's no longer in the 292 stack, but the calling function has no way to protect it. One alternative 293 would be to take a ks_vars-protected TValue pointer and put the value there. 294 The other would be using a stack like lua for this... */ 295 static inline void ks_spush(klisp_State *K, TValue obj) 296 { 297 ks_selem(K, ks_stop(K)) = obj; 298 ++ks_stop(K); 299 /* put check after so that there is always space for one obj, and if 300 realloc is needed, obj is already rooted */ 301 if (ks_stop(K) == ks_ssize(K)) { 302 ks_sgrow(K, ks_stop(K)+1); 303 } 304 } 305 306 307 static inline TValue ks_spop(klisp_State *K) 308 { 309 if (ks_ssize(K) != KS_ISSIZE && ks_stop(K)-1 < (ks_ssize(K) / 4)) 310 ks_sshrink(K, ks_stop(K)-1); 311 TValue obj = ks_selem(K, ks_stop(K) - 1); 312 --ks_stop(K); 313 return obj; 314 } 315 316 static inline TValue ks_sget(klisp_State *K) 317 { 318 return ks_selem(K, ks_stop(K) - 1); 319 } 320 321 static inline void ks_sdiscardn(klisp_State *K, int32_t n) 322 { 323 int32_t new_top = ks_stop(K) - n; 324 ks_stop(K) = new_top; 325 if (ks_ssize(K) != KS_ISSIZE && new_top < (ks_ssize(K) / 4)) 326 ks_sshrink(K, new_top); 327 return; 328 } 329 330 static inline void ks_sclear(klisp_State *K) 331 { 332 if (ks_ssize(K) != KS_ISSIZE) 333 ks_sshrink(K, 0); 334 ks_stop(K) = 0; 335 } 336 337 static inline bool ks_sisempty(klisp_State *K) 338 { 339 return ks_stop(K) == 0; 340 } 341 342 /* 343 ** Tokenizer char buffer functions 344 */ 345 void ks_tbshrink(klisp_State *K, int32_t new_top); 346 void ks_tbgrow(klisp_State *K, int32_t new_top); 347 348 static inline void ks_tbadd(klisp_State *K, char ch); 349 #define ks_tbpush(K_, ch_) (ks_tbadd((K_), (ch_))) 350 static inline char ks_tbget(klisp_State *K); 351 static inline char ks_tbpop(klisp_State *K); 352 /* this is for DISCARDING stack pop (value isn't used, avoid warning) */ 353 #define ks_tbdpop(st_) (UNUSED(ks_tbpop(st_))) 354 355 static inline char *ks_tbget_buffer(klisp_State *K); 356 static inline void ks_tbclear(klisp_State *K); 357 static inline bool ks_tbisempty(klisp_State *K); 358 359 /* some buf manipulation macros */ 360 #define ks_tbsize(st_) ((st_)->ktok_buffer_size) 361 #define ks_tbidx(st_) ((st_)->ktok_buffer_idx) 362 #define ks_tbuf(st_) ((st_)->ktok_buffer) 363 #define ks_tbelem(st_, i_) ((ks_tbuf(st_))[i_]) 364 365 /* LOCK: All these functions should be called with the GIL already acquired */ 366 static inline void ks_tbadd(klisp_State *K, char ch) 367 { 368 if (ks_tbidx(K) == ks_tbsize(K)) 369 ks_tbgrow(K, ks_tbidx(K)+1); 370 ks_tbelem(K, ks_tbidx(K)) = ch; 371 ++ks_tbidx(K); 372 } 373 374 static inline char ks_tbget(klisp_State *K) 375 { 376 return ks_tbelem(K, ks_tbidx(K) - 1); 377 } 378 379 static inline char ks_tbpop(klisp_State *K) 380 { 381 if (ks_tbsize(K) != KS_ITBSIZE && ks_tbidx(K)-1 < (ks_tbsize(K) / 4)) 382 ks_tbshrink(K, ks_tbidx(K)-1); 383 char ch = ks_tbelem(K, ks_tbidx(K) - 1); 384 --ks_tbidx(K); 385 return ch; 386 } 387 388 static inline char *ks_tbget_buffer(klisp_State *K) 389 { 390 klisp_assert(ks_tbelem(K, ks_tbidx(K) - 1) == '\0'); 391 return ks_tbuf(K); 392 } 393 394 static inline void ks_tbclear(klisp_State *K) 395 { 396 if (ks_tbsize(K) != KS_ITBSIZE) 397 ks_tbshrink(K, 0); 398 ks_tbidx(K) = 0; 399 } 400 401 static inline bool ks_tbisempty(klisp_State *K) 402 { 403 return ks_tbidx(K) == 0; 404 } 405 406 /* 407 ** Functions to protect values from GC 408 ** TODO: add write barriers 409 */ 410 static inline void krooted_tvs_push(klisp_State *K, TValue tv) 411 { 412 klisp_assert(K->rooted_tvs_top < GC_PROTECT_SIZE); 413 K->rooted_tvs_buf[K->rooted_tvs_top++] = tv; 414 } 415 416 static inline void krooted_tvs_pop(klisp_State *K) 417 { 418 klisp_assert(K->rooted_tvs_top > 0); 419 --(K->rooted_tvs_top); 420 } 421 422 static inline void krooted_tvs_clear(klisp_State *K) { K->rooted_tvs_top = 0; } 423 424 static inline void krooted_vars_push(klisp_State *K, TValue *v) 425 { 426 klisp_assert(K->rooted_vars_top < GC_PROTECT_SIZE); 427 K->rooted_vars_buf[K->rooted_vars_top++] = v; 428 } 429 430 static inline void krooted_vars_pop(klisp_State *K) 431 { 432 klisp_assert(K->rooted_vars_top > 0); 433 --(K->rooted_vars_top); 434 } 435 436 static inline void krooted_vars_clear(klisp_State *K) { K->rooted_vars_top = 0; } 437 438 /* 439 ** Source code tracking 440 ** MAYBE: add source code tracking to symbols 441 */ 442 /* LOCK: All these functions should be called with the GIL already acquired */ 443 #if KTRACK_SI 444 static inline TValue kget_source_info(klisp_State *K, TValue obj) 445 { 446 UNUSED(K); 447 klisp_assert(khas_si(obj)); 448 GCObject *si = gcvalue(obj)->gch.si; 449 klisp_assert(si != NULL); 450 return gc2pair(si); 451 } 452 453 static inline void kset_source_info(klisp_State *K, TValue obj, TValue si) 454 { 455 UNUSED(K); 456 klisp_assert(kcan_have_si(obj)); 457 klisp_assert(ttisnil(si) || ttispair(si)); 458 if (ttisnil(si)) { 459 gcvalue(obj)->gch.si = NULL; 460 gcvalue(obj)->gch.kflags &= ~(K_FLAG_HAS_SI); 461 } else { 462 gcvalue(obj)->gch.si = gcvalue(si); 463 gcvalue(obj)->gch.kflags |= K_FLAG_HAS_SI; 464 } 465 } 466 467 static inline TValue ktry_get_si(klisp_State *K, TValue obj) 468 { 469 UNUSED(K); 470 return (khas_si(obj))? gc2pair(gcvalue(obj)->gch.si) : KNIL; 471 } 472 473 static inline TValue kget_csi(klisp_State *K) 474 { 475 return K->next_si; 476 } 477 #endif 478 479 /* 480 ** Functions to manipulate the current continuation and calling 481 ** operatives 482 */ 483 static inline void klispT_apply_cc(klisp_State *K, TValue val) 484 { 485 /* TODO write barriers */ 486 487 /* various assert to check the freeing of gc protection methods */ 488 /* TODO add marks assertions */ 489 klisp_assert(K->rooted_tvs_top == 0); 490 klisp_assert(K->rooted_vars_top == 0); 491 492 K->next_obj = K->curr_cont; /* save it from GC */ 493 Continuation *cont = tv2cont(K->curr_cont); 494 K->next_func = cont->fn; 495 K->next_value = val; 496 /* NOTE: this is needed to differentiate a return from a tail call */ 497 K->next_env = KNIL; 498 K->next_xparams = cont->extra; 499 K->curr_cont = cont->parent; 500 K->next_si = ktry_get_si(K, K->next_obj); 501 } 502 503 #define kapply_cc(K_, val_) klispT_apply_cc((K_), (val_)); return 504 505 static inline TValue klispT_get_cc(klisp_State *K) 506 { 507 return K->curr_cont; 508 } 509 510 #define kget_cc(K_) (klispT_get_cc(K_)) 511 512 static inline void klispT_set_cc(klisp_State *K, TValue new_cont) 513 { 514 K->curr_cont = new_cont; 515 } 516 517 #define kset_cc(K_, c_) (klispT_set_cc(K_, c_)) 518 519 static inline void klispT_tail_call_si(klisp_State *K, TValue top, TValue ptree, 520 TValue env, TValue si) 521 { 522 /* TODO write barriers */ 523 /* various assert to check the freeing of gc protection methods */ 524 klisp_assert(K->rooted_tvs_top == 0); 525 klisp_assert(K->rooted_vars_top == 0); 526 527 K->next_obj = top; 528 Operative *op = tv2op(top); 529 K->next_func = op->fn; 530 K->next_value = ptree; 531 /* NOTE: this is what differentiates a tail call from a return */ 532 klisp_assert(ttisenvironment(env)); 533 K->next_env = env; 534 K->next_xparams = op->extra; 535 K->next_si = si; 536 } 537 538 #define ktail_call_si(K_, op_, p_, e_, si_) \ 539 { klispT_tail_call_si((K_), (op_), (p_), (e_), (si_)); return; } 540 541 /* if no source info is needed */ 542 #define ktail_call(K_, op_, p_, e_) \ 543 { klisp_State *K__ = (K_); \ 544 TValue op__ = (op_); \ 545 TValue si__ = ktry_get_si(K__, op__); \ 546 (ktail_call_si(K__, op__, p_, e_, si__)); } \ 547 548 #define ktail_eval(K_, p_, e_) \ 549 { klisp_State *K__ = (K_); \ 550 TValue p__ = (p_); \ 551 TValue si__ = ktry_get_si(K__, p__); \ 552 klispT_tail_call_si(K__, G(K__)->eval_op, p__, (e_), si__); \ 553 return; } 554 555 void do_interception(klisp_State *K); 556 void kcall_cont(klisp_State *K, TValue dst_cont, TValue obj); 557 void klispT_init_repl(klisp_State *K); 558 void klispT_run(klisp_State *K); 559 void klisp_close (klisp_State *K); 560 561 /* simple accessors for dynamic keys */ 562 563 /* XXX: this is ugly but we can't include kpair.h here so... */ 564 /* MAYBE: move car & cdr to kobject.h */ 565 /* TODO: use these where appropriate */ 566 /* TODO LOCK, thread local */ 567 #define kcurr_input_port(K) (tv2pair(G(K)->kd_in_port_key)->cdr) 568 #define kcurr_output_port(K) (tv2pair(G(K)->kd_out_port_key)->cdr) 569 #define kcurr_error_port(K) (tv2pair(G(K)->kd_error_port_key)->cdr) 570 #define kcurr_strict_arithp(K) bvalue(tv2pair(G(K)->kd_strict_arith_key)->cdr) 571 572 #endif 573