1 /*
2 * Copyright (c) 2021 Calvin Rose
3 *
4 * Permission is hereby granted, free of charge, to any person obtaining a copy
5 * of this software and associated documentation files (the "Software"), to
6 * deal in the Software without restriction, including without limitation the
7 * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
8 * sell copies of the Software, and to permit persons to whom the Software is
9 * furnished to do so, subject to the following conditions:
10 *
11 * The above copyright notice and this permission notice shall be included in
12 * all copies or substantial portions of the Software.
13 *
14 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
17 * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
18 * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
19 * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
20 * IN THE SOFTWARE.
21 */
22 
23 #ifndef JANET_AMALG
24 #include "features.h"
25 #include <janet.h>
26 #include "fiber.h"
27 #include "state.h"
28 #include "gc.h"
29 #include "util.h"
30 #endif
31 
fiber_reset(JanetFiber * fiber)32 static void fiber_reset(JanetFiber *fiber) {
33     fiber->maxstack = JANET_STACK_MAX;
34     fiber->frame = 0;
35     fiber->stackstart = JANET_FRAME_SIZE;
36     fiber->stacktop = JANET_FRAME_SIZE;
37     fiber->child = NULL;
38     fiber->flags = JANET_FIBER_MASK_YIELD | JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
39     fiber->env = NULL;
40     fiber->last_value = janet_wrap_nil();
41 #ifdef JANET_EV
42     fiber->waiting = NULL;
43     fiber->sched_id = 0;
44     fiber->supervisor_channel = NULL;
45 #endif
46     janet_fiber_set_status(fiber, JANET_STATUS_NEW);
47 }
48 
fiber_alloc(int32_t capacity)49 static JanetFiber *fiber_alloc(int32_t capacity) {
50     Janet *data;
51     JanetFiber *fiber = janet_gcalloc(JANET_MEMORY_FIBER, sizeof(JanetFiber));
52     if (capacity < 32) {
53         capacity = 32;
54     }
55     fiber->capacity = capacity;
56     data = janet_malloc(sizeof(Janet) * (size_t) capacity);
57     if (NULL == data) {
58         JANET_OUT_OF_MEMORY;
59     }
60     janet_vm.next_collection += sizeof(Janet) * capacity;
61     fiber->data = data;
62     return fiber;
63 }
64 
65 /* Create a new fiber with argn values on the stack by reusing a fiber. */
janet_fiber_reset(JanetFiber * fiber,JanetFunction * callee,int32_t argc,const Janet * argv)66 JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t argc, const Janet *argv) {
67     int32_t newstacktop;
68     fiber_reset(fiber);
69     if (argc) {
70         newstacktop = fiber->stacktop + argc;
71         if (newstacktop >= fiber->capacity) {
72             janet_fiber_setcapacity(fiber, 2 * newstacktop);
73         }
74         if (argv) {
75             memcpy(fiber->data + fiber->stacktop, argv, argc * sizeof(Janet));
76         } else {
77             /* If argv not given, fill with nil */
78             for (int32_t i = 0; i < argc; i++) {
79                 fiber->data[fiber->stacktop + i] = janet_wrap_nil();
80             }
81         }
82         fiber->stacktop = newstacktop;
83     }
84     if (janet_fiber_funcframe(fiber, callee)) return NULL;
85     janet_fiber_frame(fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
86 #ifdef JANET_EV
87     fiber->waiting = NULL;
88     fiber->supervisor_channel = NULL;
89 #endif
90     return fiber;
91 }
92 
93 /* Create a new fiber with argn values on the stack. */
janet_fiber(JanetFunction * callee,int32_t capacity,int32_t argc,const Janet * argv)94 JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv) {
95     return janet_fiber_reset(fiber_alloc(capacity), callee, argc, argv);
96 }
97 
98 #ifdef JANET_DEBUG
99 /* Test for memory issues by reallocating fiber every time we push a stack frame */
janet_fiber_refresh_memory(JanetFiber * fiber)100 static void janet_fiber_refresh_memory(JanetFiber *fiber) {
101     int32_t n = fiber->capacity;
102     if (n) {
103         Janet *newData = janet_malloc(sizeof(Janet) * n);
104         if (NULL == newData) {
105             JANET_OUT_OF_MEMORY;
106         }
107         memcpy(newData, fiber->data, fiber->capacity * sizeof(Janet));
108         janet_free(fiber->data);
109         fiber->data = newData;
110     }
111 }
112 #endif
113 
114 /* Ensure that the fiber has enough extra capacity */
janet_fiber_setcapacity(JanetFiber * fiber,int32_t n)115 void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n) {
116     int32_t old_size = fiber->capacity;
117     int32_t diff = n - old_size;
118     Janet *newData = janet_realloc(fiber->data, sizeof(Janet) * n);
119     if (NULL == newData) {
120         JANET_OUT_OF_MEMORY;
121     }
122     fiber->data = newData;
123     fiber->capacity = n;
124     janet_vm.next_collection += sizeof(Janet) * diff;
125 }
126 
127 /* Grow fiber if needed */
janet_fiber_grow(JanetFiber * fiber,int32_t needed)128 static void janet_fiber_grow(JanetFiber *fiber, int32_t needed) {
129     int32_t cap = needed > (INT32_MAX / 2) ? INT32_MAX : 2 * needed;
130     janet_fiber_setcapacity(fiber, cap);
131 }
132 
133 /* Push a value on the next stack frame */
janet_fiber_push(JanetFiber * fiber,Janet x)134 void janet_fiber_push(JanetFiber *fiber, Janet x) {
135     if (fiber->stacktop == INT32_MAX) janet_panic("stack overflow");
136     if (fiber->stacktop >= fiber->capacity) {
137         janet_fiber_grow(fiber, fiber->stacktop);
138     }
139     fiber->data[fiber->stacktop++] = x;
140 }
141 
142 /* Push 2 values on the next stack frame */
janet_fiber_push2(JanetFiber * fiber,Janet x,Janet y)143 void janet_fiber_push2(JanetFiber *fiber, Janet x, Janet y) {
144     if (fiber->stacktop >= INT32_MAX - 1) janet_panic("stack overflow");
145     int32_t newtop = fiber->stacktop + 2;
146     if (newtop > fiber->capacity) {
147         janet_fiber_grow(fiber, newtop);
148     }
149     fiber->data[fiber->stacktop] = x;
150     fiber->data[fiber->stacktop + 1] = y;
151     fiber->stacktop = newtop;
152 }
153 
154 /* Push 3 values on the next stack frame */
janet_fiber_push3(JanetFiber * fiber,Janet x,Janet y,Janet z)155 void janet_fiber_push3(JanetFiber *fiber, Janet x, Janet y, Janet z) {
156     if (fiber->stacktop >= INT32_MAX - 2) janet_panic("stack overflow");
157     int32_t newtop = fiber->stacktop + 3;
158     if (newtop > fiber->capacity) {
159         janet_fiber_grow(fiber, newtop);
160     }
161     fiber->data[fiber->stacktop] = x;
162     fiber->data[fiber->stacktop + 1] = y;
163     fiber->data[fiber->stacktop + 2] = z;
164     fiber->stacktop = newtop;
165 }
166 
167 /* Push an array on the next stack frame */
janet_fiber_pushn(JanetFiber * fiber,const Janet * arr,int32_t n)168 void janet_fiber_pushn(JanetFiber *fiber, const Janet *arr, int32_t n) {
169     if (fiber->stacktop > INT32_MAX - n) janet_panic("stack overflow");
170     int32_t newtop = fiber->stacktop + n;
171     if (newtop > fiber->capacity) {
172         janet_fiber_grow(fiber, newtop);
173     }
174     safe_memcpy(fiber->data + fiber->stacktop, arr, n * sizeof(Janet));
175     fiber->stacktop = newtop;
176 }
177 
178 /* Create a struct with n values. If n is odd, the last value is ignored. */
make_struct_n(const Janet * args,int32_t n)179 static Janet make_struct_n(const Janet *args, int32_t n) {
180     int32_t i = 0;
181     JanetKV *st = janet_struct_begin(n & (~1));
182     for (; i < n; i += 2) {
183         janet_struct_put(st, args[i], args[i + 1]);
184     }
185     return janet_wrap_struct(janet_struct_end(st));
186 }
187 
188 /* Push a stack frame to a fiber */
janet_fiber_funcframe(JanetFiber * fiber,JanetFunction * func)189 int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
190     JanetStackFrame *newframe;
191 
192     int32_t i;
193     int32_t oldtop = fiber->stacktop;
194     int32_t oldframe = fiber->frame;
195     int32_t nextframe = fiber->stackstart;
196     int32_t nextstacktop = nextframe + func->def->slotcount + JANET_FRAME_SIZE;
197     int32_t next_arity = fiber->stacktop - fiber->stackstart;
198 
199     /* Check strict arity before messing with state */
200     if (next_arity < func->def->min_arity) return 1;
201     if (next_arity > func->def->max_arity) return 1;
202 
203     if (fiber->capacity < nextstacktop) {
204         janet_fiber_setcapacity(fiber, 2 * nextstacktop);
205 #ifdef JANET_DEBUG
206     } else {
207         janet_fiber_refresh_memory(fiber);
208 #endif
209     }
210 
211     /* Nil unset stack arguments (Needed for gc correctness) */
212     for (i = fiber->stacktop; i < nextstacktop; ++i) {
213         fiber->data[i] = janet_wrap_nil();
214     }
215 
216     /* Set up the next frame */
217     fiber->frame = nextframe;
218     fiber->stacktop = fiber->stackstart = nextstacktop;
219     newframe = janet_fiber_frame(fiber);
220     newframe->prevframe = oldframe;
221     newframe->pc = func->def->bytecode;
222     newframe->func = func;
223     newframe->env = NULL;
224     newframe->flags = 0;
225 
226     /* Check varargs */
227     if (func->def->flags & JANET_FUNCDEF_FLAG_VARARG) {
228         int32_t tuplehead = fiber->frame + func->def->arity;
229         int st = func->def->flags & JANET_FUNCDEF_FLAG_STRUCTARG;
230         if (tuplehead >= oldtop) {
231             fiber->data[tuplehead] = st
232                                      ? make_struct_n(NULL, 0)
233                                      : janet_wrap_tuple(janet_tuple_n(NULL, 0));
234         } else {
235             fiber->data[tuplehead] = st
236                                      ? make_struct_n(
237                                          fiber->data + tuplehead,
238                                          oldtop - tuplehead)
239                                      : janet_wrap_tuple(janet_tuple_n(
240                                                  fiber->data + tuplehead,
241                                                  oldtop - tuplehead));
242         }
243     }
244 
245     /* Good return */
246     return 0;
247 }
248 
249 /* If a frame has a closure environment, detach it from
250  * the stack and have it keep its own values */
janet_env_detach(JanetFuncEnv * env)251 static void janet_env_detach(JanetFuncEnv *env) {
252     /* Check for closure environment */
253     if (env) {
254         janet_env_valid(env);
255         int32_t len = env->length;
256         size_t s = sizeof(Janet) * (size_t) len;
257         Janet *vmem = janet_malloc(s);
258         janet_vm.next_collection += (uint32_t) s;
259         if (NULL == vmem) {
260             JANET_OUT_OF_MEMORY;
261         }
262         Janet *values = env->as.fiber->data + env->offset;
263         safe_memcpy(vmem, values, s);
264         uint32_t *bitset = janet_stack_frame(values)->func->def->closure_bitset;
265         if (bitset) {
266             /* Clear unneeded references in closure environment */
267             for (int32_t i = 0; i < len; i += 32) {
268                 uint32_t mask = ~(bitset[i >> 5]);
269                 int32_t maxj = i + 32 > len ? len : i + 32;
270                 for (int32_t j = i; j < maxj; j++) {
271                     if (mask & 1) vmem[j] = janet_wrap_nil();
272                     mask >>= 1;
273                 }
274             }
275         }
276         env->offset = 0;
277         env->as.values = vmem;
278     }
279 }
280 
281 /* Validate potentially untrusted func env (unmarshalled envs are difficult to verify) */
janet_env_valid(JanetFuncEnv * env)282 int janet_env_valid(JanetFuncEnv *env) {
283     if (env->offset < 0) {
284         int32_t real_offset = -(env->offset);
285         JanetFiber *fiber = env->as.fiber;
286         int32_t i = fiber->frame;
287         while (i > 0) {
288             JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
289             if (real_offset == i &&
290                     frame->env == env &&
291                     frame->func &&
292                     frame->func->def->slotcount == env->length) {
293                 env->offset = real_offset;
294                 return 1;
295             }
296             i = frame->prevframe;
297         }
298         /* Invalid, set to empty off-stack variant. */
299         env->offset = 0;
300         env->length = 0;
301         env->as.values = NULL;
302         return 0;
303     } else {
304         return 1;
305     }
306 }
307 
308 /* Detach a fiber from the env if the target fiber has stopped mutating */
janet_env_maybe_detach(JanetFuncEnv * env)309 void janet_env_maybe_detach(JanetFuncEnv *env) {
310     /* Check for detachable closure envs */
311     janet_env_valid(env);
312     if (env->offset > 0) {
313         JanetFiberStatus s = janet_fiber_status(env->as.fiber);
314         int isFinished = s == JANET_STATUS_DEAD ||
315                          s == JANET_STATUS_ERROR ||
316                          s == JANET_STATUS_USER0 ||
317                          s == JANET_STATUS_USER1 ||
318                          s == JANET_STATUS_USER2 ||
319                          s == JANET_STATUS_USER3 ||
320                          s == JANET_STATUS_USER4;
321         if (isFinished) {
322             janet_env_detach(env);
323         }
324     }
325 }
326 
327 /* Create a tail frame for a function */
janet_fiber_funcframe_tail(JanetFiber * fiber,JanetFunction * func)328 int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
329     int32_t i;
330     int32_t nextframetop = fiber->frame + func->def->slotcount;
331     int32_t nextstacktop = nextframetop + JANET_FRAME_SIZE;
332     int32_t next_arity = fiber->stacktop - fiber->stackstart;
333     int32_t stacksize;
334 
335     /* Check strict arity before messing with state */
336     if (next_arity < func->def->min_arity) return 1;
337     if (next_arity > func->def->max_arity) return 1;
338 
339     if (fiber->capacity < nextstacktop) {
340         janet_fiber_setcapacity(fiber, 2 * nextstacktop);
341 #ifdef JANET_DEBUG
342     } else {
343         janet_fiber_refresh_memory(fiber);
344 #endif
345     }
346 
347     Janet *stack = fiber->data + fiber->frame;
348     Janet *args = fiber->data + fiber->stackstart;
349 
350     /* Detach old function */
351     if (NULL != janet_fiber_frame(fiber)->func)
352         janet_env_detach(janet_fiber_frame(fiber)->env);
353     janet_fiber_frame(fiber)->env = NULL;
354 
355     /* Check varargs */
356     if (func->def->flags & JANET_FUNCDEF_FLAG_VARARG) {
357         int32_t tuplehead = fiber->stackstart + func->def->arity;
358         int st = func->def->flags & JANET_FUNCDEF_FLAG_STRUCTARG;
359         if (tuplehead >= fiber->stacktop) {
360             if (tuplehead >= fiber->capacity) janet_fiber_setcapacity(fiber, 2 * (tuplehead + 1));
361             for (i = fiber->stacktop; i < tuplehead; ++i) fiber->data[i] = janet_wrap_nil();
362             fiber->data[tuplehead] = st
363                                      ? make_struct_n(NULL, 0)
364                                      : janet_wrap_tuple(janet_tuple_n(NULL, 0));
365         } else {
366             fiber->data[tuplehead] = st
367                                      ? make_struct_n(
368                                          fiber->data + tuplehead,
369                                          fiber->stacktop - tuplehead)
370                                      : janet_wrap_tuple(janet_tuple_n(
371                                                  fiber->data + tuplehead,
372                                                  fiber->stacktop - tuplehead));
373         }
374         stacksize = tuplehead - fiber->stackstart + 1;
375     } else {
376         stacksize = fiber->stacktop - fiber->stackstart;
377     }
378 
379     if (stacksize) memmove(stack, args, stacksize * sizeof(Janet));
380 
381     /* Nil unset locals (Needed for functional correctness) */
382     for (i = fiber->frame + stacksize; i < nextframetop; ++i)
383         fiber->data[i] = janet_wrap_nil();
384 
385     /* Set stack stuff */
386     fiber->stacktop = fiber->stackstart = nextstacktop;
387 
388     /* Set frame stuff */
389     janet_fiber_frame(fiber)->func = func;
390     janet_fiber_frame(fiber)->pc = func->def->bytecode;
391     janet_fiber_frame(fiber)->flags |= JANET_STACKFRAME_TAILCALL;
392 
393     /* Good return */
394     return 0;
395 }
396 
397 /* Push a stack frame to a fiber for a c function */
janet_fiber_cframe(JanetFiber * fiber,JanetCFunction cfun)398 void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun) {
399     JanetStackFrame *newframe;
400 
401     int32_t oldframe = fiber->frame;
402     int32_t nextframe = fiber->stackstart;
403     int32_t nextstacktop = fiber->stacktop + JANET_FRAME_SIZE;
404 
405     if (fiber->capacity < nextstacktop) {
406         janet_fiber_setcapacity(fiber, 2 * nextstacktop);
407 #ifdef JANET_DEBUG
408     } else {
409         janet_fiber_refresh_memory(fiber);
410 #endif
411     }
412 
413     /* Set the next frame */
414     fiber->frame = nextframe;
415     fiber->stacktop = fiber->stackstart = nextstacktop;
416     newframe = janet_fiber_frame(fiber);
417 
418     /* Set up the new frame */
419     newframe->prevframe = oldframe;
420     newframe->pc = (uint32_t *) cfun;
421     newframe->func = NULL;
422     newframe->env = NULL;
423     newframe->flags = 0;
424 }
425 
426 /* Pop a stack frame from the fiber. */
janet_fiber_popframe(JanetFiber * fiber)427 void janet_fiber_popframe(JanetFiber *fiber) {
428     JanetStackFrame *frame = janet_fiber_frame(fiber);
429     if (fiber->frame == 0) return;
430 
431     /* Clean up the frame (detach environments) */
432     if (NULL != frame->func)
433         janet_env_detach(frame->env);
434 
435     /* Shrink stack */
436     fiber->stacktop = fiber->stackstart = fiber->frame;
437     fiber->frame = frame->prevframe;
438 }
439 
janet_fiber_status(JanetFiber * f)440 JanetFiberStatus janet_fiber_status(JanetFiber *f) {
441     return ((f)->flags & JANET_FIBER_STATUS_MASK) >> JANET_FIBER_STATUS_OFFSET;
442 }
443 
janet_current_fiber(void)444 JanetFiber *janet_current_fiber(void) {
445     return janet_vm.fiber;
446 }
447 
janet_root_fiber(void)448 JanetFiber *janet_root_fiber(void) {
449     return janet_vm.root_fiber;
450 }
451 
452 /* CFuns */
453 
454 JANET_CORE_FN(cfun_fiber_getenv,
455               "(fiber/getenv fiber)",
456               "Gets the environment for a fiber. Returns nil if no such table is "
457               "set yet.") {
458     janet_fixarity(argc, 1);
459     JanetFiber *fiber = janet_getfiber(argv, 0);
460     return fiber->env ?
461            janet_wrap_table(fiber->env) :
462            janet_wrap_nil();
463 }
464 
465 JANET_CORE_FN(cfun_fiber_setenv,
466               "(fiber/setenv fiber table)",
467               "Sets the environment table for a fiber. Set to nil to remove the current "
468               "environment.") {
469     janet_fixarity(argc, 2);
470     JanetFiber *fiber = janet_getfiber(argv, 0);
471     if (janet_checktype(argv[1], JANET_NIL)) {
472         fiber->env = NULL;
473     } else {
474         fiber->env = janet_gettable(argv, 1);
475     }
476     return argv[0];
477 }
478 
479 JANET_CORE_FN(cfun_fiber_new,
480               "(fiber/new func &opt sigmask)",
481               "Create a new fiber with function body func. Can optionally "
482               "take a set of signals to block from the current parent fiber "
483               "when called. The mask is specified as a keyword where each character "
484               "is used to indicate a signal to block. If the ev module is enabled, and "
485               "this fiber is used as an argument to `ev/go`, these \"blocked\" signals "
486               "will result in messages being sent to the supervisor channel. "
487               "The default sigmask is :y. "
488               "For example,\n\n"
489               "    (fiber/new myfun :e123)\n\n"
490               "blocks error signals and user signals 1, 2 and 3. The signals are "
491               "as follows:\n\n"
492               "* :a - block all signals\n"
493               "* :d - block debug signals\n"
494               "* :e - block error signals\n"
495               "* :t - block termination signals: error + user[0-4]\n"
496               "* :u - block user signals\n"
497               "* :y - block yield signals\n"
498               "* :0-9 - block a specific user signal\n\n"
499               "The sigmask argument also can take environment flags. If any mutually "
500               "exclusive flags are present, the last flag takes precedence.\n\n"
501               "* :i - inherit the environment from the current fiber\n"
502               "* :p - the environment table's prototype is the current environment table") {
503     janet_arity(argc, 1, 2);
504     JanetFunction *func = janet_getfunction(argv, 0);
505     JanetFiber *fiber;
506     if (func->def->min_arity > 1) {
507         janet_panicf("fiber function must accept 0 or 1 arguments");
508     }
509     fiber = janet_fiber(func, 64, func->def->min_arity, NULL);
510     if (argc == 2) {
511         int32_t i;
512         JanetByteView view = janet_getbytes(argv, 1);
513         fiber->flags = JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
514         janet_fiber_set_status(fiber, JANET_STATUS_NEW);
515         for (i = 0; i < view.len; i++) {
516             if (view.bytes[i] >= '0' && view.bytes[i] <= '9') {
517                 fiber->flags |= JANET_FIBER_MASK_USERN(view.bytes[i] - '0');
518             } else {
519                 switch (view.bytes[i]) {
520                     default:
521                         janet_panicf("invalid flag %c, expected a, t, d, e, u, y, i, or p", view.bytes[i]);
522                         break;
523                     case 'a':
524                         fiber->flags |=
525                             JANET_FIBER_MASK_DEBUG |
526                             JANET_FIBER_MASK_ERROR |
527                             JANET_FIBER_MASK_USER |
528                             JANET_FIBER_MASK_YIELD;
529                         break;
530                     case 't':
531                         fiber->flags |=
532                             JANET_FIBER_MASK_ERROR |
533                             JANET_FIBER_MASK_USER0 |
534                             JANET_FIBER_MASK_USER1 |
535                             JANET_FIBER_MASK_USER2 |
536                             JANET_FIBER_MASK_USER3 |
537                             JANET_FIBER_MASK_USER4;
538                         break;
539                     case 'd':
540                         fiber->flags |= JANET_FIBER_MASK_DEBUG;
541                         break;
542                     case 'e':
543                         fiber->flags |= JANET_FIBER_MASK_ERROR;
544                         break;
545                     case 'u':
546                         fiber->flags |= JANET_FIBER_MASK_USER;
547                         break;
548                     case 'y':
549                         fiber->flags |= JANET_FIBER_MASK_YIELD;
550                         break;
551                     case 'i':
552                         if (!janet_vm.fiber->env) {
553                             janet_vm.fiber->env = janet_table(0);
554                         }
555                         fiber->env = janet_vm.fiber->env;
556                         break;
557                     case 'p':
558                         if (!janet_vm.fiber->env) {
559                             janet_vm.fiber->env = janet_table(0);
560                         }
561                         fiber->env = janet_table(0);
562                         fiber->env->proto = janet_vm.fiber->env;
563                         break;
564                 }
565             }
566         }
567     }
568     return janet_wrap_fiber(fiber);
569 }
570 
571 JANET_CORE_FN(cfun_fiber_status,
572               "(fiber/status fib)",
573               "Get the status of a fiber. The status will be one of:\n\n"
574               "* :dead - the fiber has finished\n"
575               "* :error - the fiber has errored out\n"
576               "* :debug - the fiber is suspended in debug mode\n"
577               "* :pending - the fiber has been yielded\n"
578               "* :user(0-9) - the fiber is suspended by a user signal\n"
579               "* :alive - the fiber is currently running and cannot be resumed\n"
580               "* :new - the fiber has just been created and not yet run") {
581     janet_fixarity(argc, 1);
582     JanetFiber *fiber = janet_getfiber(argv, 0);
583     uint32_t s = janet_fiber_status(fiber);
584     return janet_ckeywordv(janet_status_names[s]);
585 }
586 
587 JANET_CORE_FN(cfun_fiber_current,
588               "(fiber/current)",
589               "Returns the currently running fiber.") {
590     (void) argv;
591     janet_fixarity(argc, 0);
592     return janet_wrap_fiber(janet_vm.fiber);
593 }
594 
595 JANET_CORE_FN(cfun_fiber_root,
596               "(fiber/root)",
597               "Returns the current root fiber. The root fiber is the oldest ancestor "
598               "that does not have a parent.") {
599     (void) argv;
600     janet_fixarity(argc, 0);
601     return janet_wrap_fiber(janet_vm.root_fiber);
602 }
603 
604 JANET_CORE_FN(cfun_fiber_maxstack,
605               "(fiber/maxstack fib)",
606               "Gets the maximum stack size in janet values allowed for a fiber. While memory for "
607               "the fiber's stack is not allocated up front, the fiber will not allocated more "
608               "than this amount and will throw a stack-overflow error if more memory is needed. ") {
609     janet_fixarity(argc, 1);
610     JanetFiber *fiber = janet_getfiber(argv, 0);
611     return janet_wrap_integer(fiber->maxstack);
612 }
613 
614 JANET_CORE_FN(cfun_fiber_setmaxstack,
615               "(fiber/setmaxstack fib maxstack)",
616               "Sets the maximum stack size in janet values for a fiber. By default, the "
617               "maximum stack size is usually 8192.") {
618     janet_fixarity(argc, 2);
619     JanetFiber *fiber = janet_getfiber(argv, 0);
620     int32_t maxs = janet_getinteger(argv, 1);
621     if (maxs < 0) {
622         janet_panic("expected positive integer");
623     }
624     fiber->maxstack = maxs;
625     return argv[0];
626 }
627 
628 JANET_CORE_FN(cfun_fiber_can_resume,
629               "(fiber/can-resume? fiber)",
630               "Check if a fiber is finished and cannot be resumed.") {
631     janet_fixarity(argc, 1);
632     JanetFiber *fiber = janet_getfiber(argv, 0);
633     JanetFiberStatus s = janet_fiber_status(fiber);
634     int isFinished = s == JANET_STATUS_DEAD ||
635                      s == JANET_STATUS_ERROR ||
636                      s == JANET_STATUS_USER0 ||
637                      s == JANET_STATUS_USER1 ||
638                      s == JANET_STATUS_USER2 ||
639                      s == JANET_STATUS_USER3 ||
640                      s == JANET_STATUS_USER4;
641     return janet_wrap_boolean(!isFinished);
642 }
643 
644 JANET_CORE_FN(cfun_fiber_last_value,
645               "(fiber/last-value)",
646               "Get the last value returned or signaled from the fiber.") {
647     janet_fixarity(argc, 1);
648     JanetFiber *fiber = janet_getfiber(argv, 0);
649     return fiber->last_value;
650 }
651 
652 /* Module entry point */
janet_lib_fiber(JanetTable * env)653 void janet_lib_fiber(JanetTable *env) {
654     JanetRegExt fiber_cfuns[] = {
655         JANET_CORE_REG("fiber/new", cfun_fiber_new),
656         JANET_CORE_REG("fiber/status", cfun_fiber_status),
657         JANET_CORE_REG("fiber/root", cfun_fiber_root),
658         JANET_CORE_REG("fiber/current", cfun_fiber_current),
659         JANET_CORE_REG("fiber/maxstack", cfun_fiber_maxstack),
660         JANET_CORE_REG("fiber/setmaxstack", cfun_fiber_setmaxstack),
661         JANET_CORE_REG("fiber/getenv", cfun_fiber_getenv),
662         JANET_CORE_REG("fiber/setenv", cfun_fiber_setenv),
663         JANET_CORE_REG("fiber/can-resume?", cfun_fiber_can_resume),
664         JANET_CORE_REG("fiber/last-value", cfun_fiber_last_value),
665         JANET_REG_END
666     };
667     janet_core_cfuns_ext(env, NULL, fiber_cfuns);
668 }
669