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 "state.h"
27 #include "fiber.h"
28 #include "gc.h"
29 #include "symcache.h"
30 #include "util.h"
31 #endif
32
33 #include <math.h>
34
35 /* Virtual registers
36 *
37 * One instruction word
38 * CC | BB | AA | OP
39 * DD | DD | DD | OP
40 * EE | EE | AA | OP
41 */
42 #define A ((*pc >> 8) & 0xFF)
43 #define B ((*pc >> 16) & 0xFF)
44 #define C (*pc >> 24)
45 #define D (*pc >> 8)
46 #define E (*pc >> 16)
47
48 /* Signed interpretations of registers */
49 #define CS (*((int32_t *)pc) >> 24)
50 #define DS (*((int32_t *)pc) >> 8)
51 #define ES (*((int32_t *)pc) >> 16)
52
53 /* How we dispatch instructions. By default, we use
54 * a switch inside an infinite loop. For GCC/clang, we use
55 * computed gotos. */
56 #if defined(__GNUC__) && !defined(__EMSCRIPTEN__)
57 #define JANET_USE_COMPUTED_GOTOS
58 #endif
59
60 #ifdef JANET_USE_COMPUTED_GOTOS
61 #define VM_START() { goto *op_lookup[first_opcode];
62 #define VM_END() }
63 #define VM_OP(op) label_##op :
64 #define VM_DEFAULT() label_unknown_op:
65 #define vm_next() goto *op_lookup[*pc & 0xFF]
66 #define opcode (*pc & 0xFF)
67 #else
68 #define VM_START() uint8_t opcode = first_opcode; for (;;) {switch(opcode) {
69 #define VM_END() }}
70 #define VM_OP(op) case op :
71 #define VM_DEFAULT() default:
72 #define vm_next() opcode = *pc & 0xFF; continue
73 #endif
74
75 /* Commit and restore VM state before possible longjmp */
76 #define vm_commit() do { janet_stack_frame(stack)->pc = pc; } while (0)
77 #define vm_restore() do { \
78 stack = fiber->data + fiber->frame; \
79 pc = janet_stack_frame(stack)->pc; \
80 func = janet_stack_frame(stack)->func; \
81 } while (0)
82 #define vm_return(sig, val) do { \
83 janet_vm.return_reg[0] = (val); \
84 vm_commit(); \
85 return (sig); \
86 } while (0)
87 #define vm_return_no_restore(sig, val) do { \
88 janet_vm.return_reg[0] = (val); \
89 return (sig); \
90 } while (0)
91
92 /* Next instruction variations */
93 #define maybe_collect() do {\
94 if (janet_vm.next_collection >= janet_vm.gc_interval) janet_collect(); } while (0)
95 #define vm_checkgc_next() maybe_collect(); vm_next()
96 #define vm_pcnext() pc++; vm_next()
97 #define vm_checkgc_pcnext() maybe_collect(); vm_pcnext()
98
99 /* Handle certain errors in main vm loop */
100 #define vm_throw(e) do { vm_commit(); janet_panic(e); } while (0)
101 #define vm_assert(cond, e) do {if (!(cond)) vm_throw((e)); } while (0)
102 #define vm_assert_type(X, T) do { \
103 if (!(janet_checktype((X), (T)))) { \
104 vm_commit(); \
105 janet_panicf("expected %T, got %v", (1 << (T)), (X)); \
106 } \
107 } while (0)
108 #define vm_assert_types(X, TS) do { \
109 if (!(janet_checktypes((X), (TS)))) { \
110 vm_commit(); \
111 janet_panicf("expected %T, got %v", (TS), (X)); \
112 } \
113 } while (0)
114 #ifdef JANET_NO_INTERPRETER_INTERRUPT
115 #define vm_maybe_auto_suspend(COND)
116 #else
117 #define vm_maybe_auto_suspend(COND) do { \
118 if ((COND) && janet_vm.auto_suspend) { \
119 janet_vm.auto_suspend = 0; \
120 fiber->flags |= (JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP); \
121 vm_return(JANET_SIGNAL_INTERRUPT, janet_wrap_nil()); \
122 } \
123 } while (0)
124 #endif
125
126 /* Templates for certain patterns in opcodes */
127 #define vm_binop_immediate(op)\
128 {\
129 Janet op1 = stack[B];\
130 if (!janet_checktype(op1, JANET_NUMBER)) {\
131 vm_commit();\
132 Janet _argv[2] = { op1, janet_wrap_number(CS) };\
133 stack[A] = janet_mcall(#op, 2, _argv);\
134 vm_checkgc_pcnext();\
135 } else {\
136 double x1 = janet_unwrap_number(op1);\
137 stack[A] = janet_wrap_number(x1 op CS);\
138 vm_pcnext();\
139 }\
140 }
141 #define _vm_bitop_immediate(op, type1)\
142 {\
143 Janet op1 = stack[B];\
144 if (!janet_checktype(op1, JANET_NUMBER)) {\
145 vm_commit();\
146 Janet _argv[2] = { op1, janet_wrap_number(CS) };\
147 stack[A] = janet_mcall(#op, 2, _argv);\
148 vm_checkgc_pcnext();\
149 } else {\
150 type1 x1 = (type1) janet_unwrap_integer(op1);\
151 stack[A] = janet_wrap_integer(x1 op CS);\
152 vm_pcnext();\
153 }\
154 }
155 #define vm_bitop_immediate(op) _vm_bitop_immediate(op, int32_t);
156 #define vm_bitopu_immediate(op) _vm_bitop_immediate(op, uint32_t);
157 #define _vm_binop(op, wrap)\
158 {\
159 Janet op1 = stack[B];\
160 Janet op2 = stack[C];\
161 if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\
162 double x1 = janet_unwrap_number(op1);\
163 double x2 = janet_unwrap_number(op2);\
164 stack[A] = wrap(x1 op x2);\
165 vm_pcnext();\
166 } else {\
167 vm_commit();\
168 stack[A] = janet_binop_call(#op, "r" #op, op1, op2);\
169 vm_checkgc_pcnext();\
170 }\
171 }
172 #define vm_binop(op) _vm_binop(op, janet_wrap_number)
173 #define _vm_bitop(op, type1)\
174 {\
175 Janet op1 = stack[B];\
176 Janet op2 = stack[C];\
177 if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\
178 type1 x1 = (type1) janet_unwrap_integer(op1);\
179 int32_t x2 = janet_unwrap_integer(op2);\
180 stack[A] = janet_wrap_integer(x1 op x2);\
181 vm_pcnext();\
182 } else {\
183 vm_commit();\
184 stack[A] = janet_binop_call(#op, "r" #op, op1, op2);\
185 vm_checkgc_pcnext();\
186 }\
187 }
188 #define vm_bitop(op) _vm_bitop(op, int32_t)
189 #define vm_bitopu(op) _vm_bitop(op, uint32_t)
190 #define vm_compop(op) \
191 {\
192 Janet op1 = stack[B];\
193 Janet op2 = stack[C];\
194 if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\
195 double x1 = janet_unwrap_number(op1);\
196 double x2 = janet_unwrap_number(op2);\
197 stack[A] = janet_wrap_boolean(x1 op x2);\
198 vm_pcnext();\
199 } else {\
200 vm_commit();\
201 stack[A] = janet_wrap_boolean(janet_compare(op1, op2) op 0);\
202 vm_checkgc_pcnext();\
203 }\
204 }
205 #define vm_compop_imm(op) \
206 {\
207 Janet op1 = stack[B];\
208 if (janet_checktype(op1, JANET_NUMBER)) {\
209 double x1 = janet_unwrap_number(op1);\
210 double x2 = (double) CS; \
211 stack[A] = janet_wrap_boolean(x1 op x2);\
212 vm_pcnext();\
213 } else {\
214 vm_commit();\
215 stack[A] = janet_wrap_boolean(janet_compare(op1, janet_wrap_integer(CS)) op 0);\
216 vm_checkgc_pcnext();\
217 }\
218 }
219
220 /* Trace a function call */
vm_do_trace(JanetFunction * func,int32_t argc,const Janet * argv)221 static void vm_do_trace(JanetFunction *func, int32_t argc, const Janet *argv) {
222 if (func->def->name) {
223 janet_printf("trace (%S", func->def->name);
224 } else {
225 janet_printf("trace (%p", janet_wrap_function(func));
226 }
227 for (int32_t i = 0; i < argc; i++) {
228 janet_printf(" %p", argv[i]);
229 }
230 janet_printf(")\n");
231 }
232
233 /* Invoke a method once we have looked it up */
janet_method_invoke(Janet method,int32_t argc,Janet * argv)234 static Janet janet_method_invoke(Janet method, int32_t argc, Janet *argv) {
235 switch (janet_type(method)) {
236 case JANET_CFUNCTION:
237 return (janet_unwrap_cfunction(method))(argc, argv);
238 case JANET_FUNCTION: {
239 JanetFunction *fun = janet_unwrap_function(method);
240 return janet_call(fun, argc, argv);
241 }
242 case JANET_ABSTRACT: {
243 JanetAbstract abst = janet_unwrap_abstract(method);
244 const JanetAbstractType *at = janet_abstract_type(abst);
245 if (NULL != at->call) {
246 return at->call(abst, argc, argv);
247 }
248 }
249 /* fallthrough */
250 case JANET_STRING:
251 case JANET_BUFFER:
252 case JANET_TABLE:
253 case JANET_STRUCT:
254 case JANET_ARRAY:
255 case JANET_TUPLE: {
256 if (argc != 1) {
257 janet_panicf("%v called with %d arguments, possibly expected 1", method, argc);
258 }
259 return janet_in(method, argv[0]);
260 }
261 default: {
262 if (argc != 1) {
263 janet_panicf("%v called with %d arguments, possibly expected 1", method, argc);
264 }
265 return janet_in(argv[0], method);
266 }
267 }
268 }
269
270 /* Call a non function type from a JOP_CALL or JOP_TAILCALL instruction.
271 * Assumes that the arguments are on the fiber stack. */
call_nonfn(JanetFiber * fiber,Janet callee)272 static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
273 int32_t argc = fiber->stacktop - fiber->stackstart;
274 fiber->stacktop = fiber->stackstart;
275 return janet_method_invoke(callee, argc, fiber->data + fiber->stacktop);
276 }
277
278 /* Method lookup could potentially handle tables specially... */
method_to_fun(Janet method,Janet obj)279 static Janet method_to_fun(Janet method, Janet obj) {
280 return janet_get(obj, method);
281 }
282
283 /* Get a callable from a keyword method name and ensure that it is valid. */
resolve_method(Janet name,JanetFiber * fiber)284 static Janet resolve_method(Janet name, JanetFiber *fiber) {
285 int32_t argc = fiber->stacktop - fiber->stackstart;
286 if (argc < 1) janet_panicf("method call (%v) takes at least 1 argument, got 0", name);
287 Janet callee = method_to_fun(name, fiber->data[fiber->stackstart]);
288 if (janet_checktype(callee, JANET_NIL))
289 janet_panicf("unknown method %v invoked on %v", name, fiber->data[fiber->stackstart]);
290 return callee;
291 }
292
293 /* Lookup method on value x */
janet_method_lookup(Janet x,const char * name)294 static Janet janet_method_lookup(Janet x, const char *name) {
295 return method_to_fun(janet_ckeywordv(name), x);
296 }
297
298 /* Call a method first on the righthand side, and then on the left hand side with a prefix */
janet_binop_call(const char * lmethod,const char * rmethod,Janet lhs,Janet rhs)299 static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lhs, Janet rhs) {
300 Janet lm = janet_method_lookup(lhs, lmethod);
301 if (janet_checktype(lm, JANET_NIL)) {
302 /* Invert order for rmethod */
303 Janet lr = janet_method_lookup(rhs, rmethod);
304 Janet argv[2] = { rhs, lhs };
305 if (janet_checktype(lr, JANET_NIL)) {
306 janet_panicf("could not find method :%s for %v, or :%s for %v",
307 lmethod, lhs,
308 rmethod, rhs);
309 }
310 return janet_method_invoke(lr, 2, argv);
311 } else {
312 Janet argv[2] = { lhs, rhs };
313 return janet_method_invoke(lm, 2, argv);
314 }
315 }
316
317 /* Forward declaration */
318 static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out);
319 static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out);
320
321 /* Interpreter main loop */
run_vm(JanetFiber * fiber,Janet in)322 static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
323
324 /* opcode -> label lookup if using clang/GCC */
325 #ifdef JANET_USE_COMPUTED_GOTOS
326 static void *op_lookup[255] = {
327 &&label_JOP_NOOP,
328 &&label_JOP_ERROR,
329 &&label_JOP_TYPECHECK,
330 &&label_JOP_RETURN,
331 &&label_JOP_RETURN_NIL,
332 &&label_JOP_ADD_IMMEDIATE,
333 &&label_JOP_ADD,
334 &&label_JOP_SUBTRACT,
335 &&label_JOP_MULTIPLY_IMMEDIATE,
336 &&label_JOP_MULTIPLY,
337 &&label_JOP_DIVIDE_IMMEDIATE,
338 &&label_JOP_DIVIDE,
339 &&label_JOP_MODULO,
340 &&label_JOP_REMAINDER,
341 &&label_JOP_BAND,
342 &&label_JOP_BOR,
343 &&label_JOP_BXOR,
344 &&label_JOP_BNOT,
345 &&label_JOP_SHIFT_LEFT,
346 &&label_JOP_SHIFT_LEFT_IMMEDIATE,
347 &&label_JOP_SHIFT_RIGHT,
348 &&label_JOP_SHIFT_RIGHT_IMMEDIATE,
349 &&label_JOP_SHIFT_RIGHT_UNSIGNED,
350 &&label_JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE,
351 &&label_JOP_MOVE_FAR,
352 &&label_JOP_MOVE_NEAR,
353 &&label_JOP_JUMP,
354 &&label_JOP_JUMP_IF,
355 &&label_JOP_JUMP_IF_NOT,
356 &&label_JOP_JUMP_IF_NIL,
357 &&label_JOP_JUMP_IF_NOT_NIL,
358 &&label_JOP_GREATER_THAN,
359 &&label_JOP_GREATER_THAN_IMMEDIATE,
360 &&label_JOP_LESS_THAN,
361 &&label_JOP_LESS_THAN_IMMEDIATE,
362 &&label_JOP_EQUALS,
363 &&label_JOP_EQUALS_IMMEDIATE,
364 &&label_JOP_COMPARE,
365 &&label_JOP_LOAD_NIL,
366 &&label_JOP_LOAD_TRUE,
367 &&label_JOP_LOAD_FALSE,
368 &&label_JOP_LOAD_INTEGER,
369 &&label_JOP_LOAD_CONSTANT,
370 &&label_JOP_LOAD_UPVALUE,
371 &&label_JOP_LOAD_SELF,
372 &&label_JOP_SET_UPVALUE,
373 &&label_JOP_CLOSURE,
374 &&label_JOP_PUSH,
375 &&label_JOP_PUSH_2,
376 &&label_JOP_PUSH_3,
377 &&label_JOP_PUSH_ARRAY,
378 &&label_JOP_CALL,
379 &&label_JOP_TAILCALL,
380 &&label_JOP_RESUME,
381 &&label_JOP_SIGNAL,
382 &&label_JOP_PROPAGATE,
383 &&label_JOP_IN,
384 &&label_JOP_GET,
385 &&label_JOP_PUT,
386 &&label_JOP_GET_INDEX,
387 &&label_JOP_PUT_INDEX,
388 &&label_JOP_LENGTH,
389 &&label_JOP_MAKE_ARRAY,
390 &&label_JOP_MAKE_BUFFER,
391 &&label_JOP_MAKE_STRING,
392 &&label_JOP_MAKE_STRUCT,
393 &&label_JOP_MAKE_TABLE,
394 &&label_JOP_MAKE_TUPLE,
395 &&label_JOP_MAKE_BRACKET_TUPLE,
396 &&label_JOP_GREATER_THAN_EQUAL,
397 &&label_JOP_LESS_THAN_EQUAL,
398 &&label_JOP_NEXT,
399 &&label_JOP_NOT_EQUALS,
400 &&label_JOP_NOT_EQUALS_IMMEDIATE,
401 &&label_JOP_CANCEL,
402 &&label_unknown_op,
403 &&label_unknown_op,
404 &&label_unknown_op,
405 &&label_unknown_op,
406 &&label_unknown_op,
407 &&label_unknown_op,
408 &&label_unknown_op,
409 &&label_unknown_op,
410 &&label_unknown_op,
411 &&label_unknown_op,
412 &&label_unknown_op,
413 &&label_unknown_op,
414 &&label_unknown_op,
415 &&label_unknown_op,
416 &&label_unknown_op,
417 &&label_unknown_op,
418 &&label_unknown_op,
419 &&label_unknown_op,
420 &&label_unknown_op,
421 &&label_unknown_op,
422 &&label_unknown_op,
423 &&label_unknown_op,
424 &&label_unknown_op,
425 &&label_unknown_op,
426 &&label_unknown_op,
427 &&label_unknown_op,
428 &&label_unknown_op,
429 &&label_unknown_op,
430 &&label_unknown_op,
431 &&label_unknown_op,
432 &&label_unknown_op,
433 &&label_unknown_op,
434 &&label_unknown_op,
435 &&label_unknown_op,
436 &&label_unknown_op,
437 &&label_unknown_op,
438 &&label_unknown_op,
439 &&label_unknown_op,
440 &&label_unknown_op,
441 &&label_unknown_op,
442 &&label_unknown_op,
443 &&label_unknown_op,
444 &&label_unknown_op,
445 &&label_unknown_op,
446 &&label_unknown_op,
447 &&label_unknown_op,
448 &&label_unknown_op,
449 &&label_unknown_op,
450 &&label_unknown_op,
451 &&label_unknown_op,
452 &&label_unknown_op,
453 &&label_unknown_op,
454 &&label_unknown_op,
455 &&label_unknown_op,
456 &&label_unknown_op,
457 &&label_unknown_op,
458 &&label_unknown_op,
459 &&label_unknown_op,
460 &&label_unknown_op,
461 &&label_unknown_op,
462 &&label_unknown_op,
463 &&label_unknown_op,
464 &&label_unknown_op,
465 &&label_unknown_op,
466 &&label_unknown_op,
467 &&label_unknown_op,
468 &&label_unknown_op,
469 &&label_unknown_op,
470 &&label_unknown_op,
471 &&label_unknown_op,
472 &&label_unknown_op,
473 &&label_unknown_op,
474 &&label_unknown_op,
475 &&label_unknown_op,
476 &&label_unknown_op,
477 &&label_unknown_op,
478 &&label_unknown_op,
479 &&label_unknown_op,
480 &&label_unknown_op,
481 &&label_unknown_op,
482 &&label_unknown_op,
483 &&label_unknown_op,
484 &&label_unknown_op,
485 &&label_unknown_op,
486 &&label_unknown_op,
487 &&label_unknown_op,
488 &&label_unknown_op,
489 &&label_unknown_op,
490 &&label_unknown_op,
491 &&label_unknown_op,
492 &&label_unknown_op,
493 &&label_unknown_op,
494 &&label_unknown_op,
495 &&label_unknown_op,
496 &&label_unknown_op,
497 &&label_unknown_op,
498 &&label_unknown_op,
499 &&label_unknown_op,
500 &&label_unknown_op,
501 &&label_unknown_op,
502 &&label_unknown_op,
503 &&label_unknown_op,
504 &&label_unknown_op,
505 &&label_unknown_op,
506 &&label_unknown_op,
507 &&label_unknown_op,
508 &&label_unknown_op,
509 &&label_unknown_op,
510 &&label_unknown_op,
511 &&label_unknown_op,
512 &&label_unknown_op,
513 &&label_unknown_op,
514 &&label_unknown_op,
515 &&label_unknown_op,
516 &&label_unknown_op,
517 &&label_unknown_op,
518 &&label_unknown_op,
519 &&label_unknown_op,
520 &&label_unknown_op,
521 &&label_unknown_op,
522 &&label_unknown_op,
523 &&label_unknown_op,
524 &&label_unknown_op,
525 &&label_unknown_op,
526 &&label_unknown_op,
527 &&label_unknown_op,
528 &&label_unknown_op,
529 &&label_unknown_op,
530 &&label_unknown_op,
531 &&label_unknown_op,
532 &&label_unknown_op,
533 &&label_unknown_op,
534 &&label_unknown_op,
535 &&label_unknown_op,
536 &&label_unknown_op,
537 &&label_unknown_op,
538 &&label_unknown_op,
539 &&label_unknown_op,
540 &&label_unknown_op,
541 &&label_unknown_op,
542 &&label_unknown_op,
543 &&label_unknown_op,
544 &&label_unknown_op,
545 &&label_unknown_op,
546 &&label_unknown_op,
547 &&label_unknown_op,
548 &&label_unknown_op,
549 &&label_unknown_op,
550 &&label_unknown_op,
551 &&label_unknown_op,
552 &&label_unknown_op,
553 &&label_unknown_op,
554 &&label_unknown_op,
555 &&label_unknown_op,
556 &&label_unknown_op,
557 &&label_unknown_op,
558 &&label_unknown_op,
559 &&label_unknown_op,
560 &&label_unknown_op,
561 &&label_unknown_op,
562 &&label_unknown_op,
563 &&label_unknown_op,
564 &&label_unknown_op,
565 &&label_unknown_op,
566 &&label_unknown_op,
567 &&label_unknown_op,
568 &&label_unknown_op,
569 &&label_unknown_op,
570 &&label_unknown_op,
571 &&label_unknown_op,
572 &&label_unknown_op,
573 &&label_unknown_op,
574 &&label_unknown_op,
575 &&label_unknown_op,
576 &&label_unknown_op,
577 &&label_unknown_op,
578 &&label_unknown_op,
579 &&label_unknown_op,
580 &&label_unknown_op,
581 &&label_unknown_op
582 };
583 #endif
584
585 /* Interpreter state */
586 register Janet *stack;
587 register uint32_t *pc;
588 register JanetFunction *func;
589
590 if (fiber->flags & JANET_FIBER_RESUME_SIGNAL) {
591 JanetSignal sig = (fiber->gc.flags & JANET_FIBER_STATUS_MASK) >> JANET_FIBER_STATUS_OFFSET;
592 fiber->gc.flags &= ~JANET_FIBER_STATUS_MASK;
593 fiber->flags &= ~(JANET_FIBER_RESUME_SIGNAL | JANET_FIBER_FLAG_MASK);
594 janet_vm.return_reg[0] = in;
595 return sig;
596 }
597
598 vm_restore();
599
600 if (fiber->flags & JANET_FIBER_DID_LONGJUMP) {
601 if (janet_fiber_frame(fiber)->func == NULL) {
602 /* Inside a c function */
603 janet_fiber_popframe(fiber);
604 vm_restore();
605 }
606 /* Check if we were at a tail call instruction. If so, do implicit return */
607 if ((*pc & 0xFF) == JOP_TAILCALL) {
608 /* Tail call resume */
609 int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE;
610 janet_fiber_popframe(fiber);
611 if (entrance_frame) {
612 fiber->flags &= ~JANET_FIBER_FLAG_MASK;
613 vm_return(JANET_SIGNAL_OK, in);
614 }
615 vm_restore();
616 }
617 }
618
619 if (!(fiber->flags & JANET_FIBER_RESUME_NO_USEVAL)) stack[A] = in;
620 if (!(fiber->flags & JANET_FIBER_RESUME_NO_SKIP)) pc++;
621
622 uint8_t first_opcode = *pc & ((fiber->flags & JANET_FIBER_BREAKPOINT) ? 0x7F : 0xFF);
623
624 fiber->flags &= ~JANET_FIBER_FLAG_MASK;
625
626 /* Main interpreter loop. Semantically is a switch on
627 * (*pc & 0xFF) inside of an infinite loop. */
628 VM_START();
629
630 VM_DEFAULT();
631 fiber->flags |= JANET_FIBER_BREAKPOINT | JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
632 vm_return(JANET_SIGNAL_DEBUG, janet_wrap_nil());
633
634 VM_OP(JOP_NOOP)
635 vm_pcnext();
636
637 VM_OP(JOP_ERROR)
638 vm_return(JANET_SIGNAL_ERROR, stack[A]);
639
640 VM_OP(JOP_TYPECHECK)
641 vm_assert_types(stack[A], E);
642 vm_pcnext();
643
644 VM_OP(JOP_RETURN) {
645 Janet retval = stack[D];
646 int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE;
647 janet_fiber_popframe(fiber);
648 if (entrance_frame) vm_return_no_restore(JANET_SIGNAL_OK, retval);
649 vm_restore();
650 stack[A] = retval;
651 vm_checkgc_pcnext();
652 }
653
654 VM_OP(JOP_RETURN_NIL) {
655 Janet retval = janet_wrap_nil();
656 int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE;
657 janet_fiber_popframe(fiber);
658 if (entrance_frame) vm_return_no_restore(JANET_SIGNAL_OK, retval);
659 vm_restore();
660 stack[A] = retval;
661 vm_checkgc_pcnext();
662 }
663
664 VM_OP(JOP_ADD_IMMEDIATE)
665 vm_binop_immediate(+);
666
667 VM_OP(JOP_ADD)
668 vm_binop(+);
669
670 VM_OP(JOP_SUBTRACT)
671 vm_binop(-);
672
673 VM_OP(JOP_MULTIPLY_IMMEDIATE)
674 vm_binop_immediate(*);
675
676 VM_OP(JOP_MULTIPLY)
677 vm_binop(*);
678
679 VM_OP(JOP_DIVIDE_IMMEDIATE)
680 vm_binop_immediate( /);
681
682 VM_OP(JOP_DIVIDE)
683 vm_binop( /);
684
685 VM_OP(JOP_MODULO) {
686 Janet op1 = stack[B];
687 Janet op2 = stack[C];
688 if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
689 double x1 = janet_unwrap_number(op1);
690 double x2 = janet_unwrap_number(op2);
691 double intres = x2 * floor(x1 / x2);
692 stack[A] = janet_wrap_number(x1 - intres);
693 vm_pcnext();
694 } else {
695 vm_commit();
696 stack[A] = janet_binop_call("mod", "rmod", op1, op2);
697 vm_checkgc_pcnext();
698 }
699 }
700
701 VM_OP(JOP_REMAINDER) {
702 Janet op1 = stack[B];
703 Janet op2 = stack[C];
704 if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
705 double x1 = janet_unwrap_number(op1);
706 double x2 = janet_unwrap_number(op2);
707 stack[A] = janet_wrap_number(fmod(x1, x2));
708 vm_pcnext();
709 } else {
710 vm_commit();
711 stack[A] = janet_binop_call("%", "r%", op1, op2);
712 vm_checkgc_pcnext();
713 }
714 }
715
716 VM_OP(JOP_BAND)
717 vm_bitop(&);
718
719 VM_OP(JOP_BOR)
720 vm_bitop( |);
721
722 VM_OP(JOP_BXOR)
723 vm_bitop(^);
724
725 VM_OP(JOP_BNOT) {
726 Janet op = stack[E];
727 vm_assert_type(op, JANET_NUMBER);
728 stack[A] = janet_wrap_integer(~janet_unwrap_integer(op));
729 vm_pcnext();
730 }
731
732 VM_OP(JOP_SHIFT_RIGHT_UNSIGNED)
733 vm_bitopu( >>);
734
735 VM_OP(JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE)
736 vm_bitopu_immediate( >>);
737
738 VM_OP(JOP_SHIFT_RIGHT)
739 vm_bitop( >>);
740
741 VM_OP(JOP_SHIFT_RIGHT_IMMEDIATE)
742 vm_bitop_immediate( >>);
743
744 VM_OP(JOP_SHIFT_LEFT)
745 vm_bitop( <<);
746
747 VM_OP(JOP_SHIFT_LEFT_IMMEDIATE)
748 vm_bitop_immediate( <<);
749
750 VM_OP(JOP_MOVE_NEAR)
751 stack[A] = stack[E];
752 vm_pcnext();
753
754 VM_OP(JOP_MOVE_FAR)
755 stack[E] = stack[A];
756 vm_pcnext();
757
758 VM_OP(JOP_JUMP)
759 pc += DS;
760 vm_maybe_auto_suspend(DS < 0);
761 vm_next();
762
763 VM_OP(JOP_JUMP_IF)
764 if (janet_truthy(stack[A])) {
765 pc += ES;
766 vm_maybe_auto_suspend(ES < 0);
767 } else {
768 pc++;
769 }
770 vm_next();
771
772 VM_OP(JOP_JUMP_IF_NOT)
773 if (janet_truthy(stack[A])) {
774 pc++;
775 } else {
776 pc += ES;
777 vm_maybe_auto_suspend(ES < 0);
778 }
779 vm_next();
780
781 VM_OP(JOP_JUMP_IF_NIL)
782 if (janet_checktype(stack[A], JANET_NIL)) {
783 pc += ES;
784 vm_maybe_auto_suspend(ES < 0);
785 } else {
786 pc++;
787 }
788 vm_next();
789
790 VM_OP(JOP_JUMP_IF_NOT_NIL)
791 if (janet_checktype(stack[A], JANET_NIL)) {
792 pc++;
793 } else {
794 pc += ES;
795 vm_maybe_auto_suspend(ES < 0);
796 }
797 vm_next();
798
799 VM_OP(JOP_LESS_THAN)
800 vm_compop( <);
801
802 VM_OP(JOP_LESS_THAN_EQUAL)
803 vm_compop( <=);
804
805 VM_OP(JOP_LESS_THAN_IMMEDIATE)
806 vm_compop_imm( <);
807
808 VM_OP(JOP_GREATER_THAN)
809 vm_compop( >);
810
811 VM_OP(JOP_GREATER_THAN_EQUAL)
812 vm_compop( >=);
813
814 VM_OP(JOP_GREATER_THAN_IMMEDIATE)
815 vm_compop_imm( >);
816
817 VM_OP(JOP_EQUALS)
818 stack[A] = janet_wrap_boolean(janet_equals(stack[B], stack[C]));
819 vm_pcnext();
820
821 VM_OP(JOP_EQUALS_IMMEDIATE)
822 stack[A] = janet_wrap_boolean(janet_unwrap_number(stack[B]) == (double) CS);
823 vm_pcnext();
824
825 VM_OP(JOP_NOT_EQUALS)
826 stack[A] = janet_wrap_boolean(!janet_equals(stack[B], stack[C]));
827 vm_pcnext();
828
829 VM_OP(JOP_NOT_EQUALS_IMMEDIATE)
830 stack[A] = janet_wrap_boolean(janet_unwrap_number(stack[B]) != (double) CS);
831 vm_pcnext();
832
833 VM_OP(JOP_COMPARE)
834 stack[A] = janet_wrap_integer(janet_compare(stack[B], stack[C]));
835 vm_pcnext();
836
837 VM_OP(JOP_NEXT)
838 vm_commit();
839 {
840 Janet temp = janet_next_impl(stack[B], stack[C], 1);
841 vm_restore();
842 stack[A] = temp;
843 }
844 vm_pcnext();
845
846 VM_OP(JOP_LOAD_NIL)
847 stack[D] = janet_wrap_nil();
848 vm_pcnext();
849
850 VM_OP(JOP_LOAD_TRUE)
851 stack[D] = janet_wrap_true();
852 vm_pcnext();
853
854 VM_OP(JOP_LOAD_FALSE)
855 stack[D] = janet_wrap_false();
856 vm_pcnext();
857
858 VM_OP(JOP_LOAD_INTEGER)
859 stack[A] = janet_wrap_integer(ES);
860 vm_pcnext();
861
862 VM_OP(JOP_LOAD_CONSTANT) {
863 int32_t cindex = (int32_t)E;
864 vm_assert(cindex < func->def->constants_length, "invalid constant");
865 stack[A] = func->def->constants[cindex];
866 vm_pcnext();
867 }
868
869 VM_OP(JOP_LOAD_SELF)
870 stack[D] = janet_wrap_function(func);
871 vm_pcnext();
872
873 VM_OP(JOP_LOAD_UPVALUE) {
874 int32_t eindex = B;
875 int32_t vindex = C;
876 JanetFuncEnv *env;
877 vm_assert(func->def->environments_length > eindex, "invalid upvalue environment");
878 env = func->envs[eindex];
879 vm_assert(env->length > vindex, "invalid upvalue index");
880 vm_assert(janet_env_valid(env), "invalid upvalue environment");
881 if (env->offset > 0) {
882 /* On stack */
883 stack[A] = env->as.fiber->data[env->offset + vindex];
884 } else {
885 /* Off stack */
886 stack[A] = env->as.values[vindex];
887 }
888 vm_pcnext();
889 }
890
891 VM_OP(JOP_SET_UPVALUE) {
892 int32_t eindex = B;
893 int32_t vindex = C;
894 JanetFuncEnv *env;
895 vm_assert(func->def->environments_length > eindex, "invalid upvalue environment");
896 env = func->envs[eindex];
897 vm_assert(env->length > vindex, "invalid upvalue index");
898 vm_assert(janet_env_valid(env), "invalid upvalue environment");
899 if (env->offset > 0) {
900 env->as.fiber->data[env->offset + vindex] = stack[A];
901 } else {
902 env->as.values[vindex] = stack[A];
903 }
904 vm_pcnext();
905 }
906
907 VM_OP(JOP_CLOSURE) {
908 JanetFuncDef *fd;
909 JanetFunction *fn;
910 int32_t elen;
911 int32_t defindex = (int32_t)E;
912 vm_assert(defindex < func->def->defs_length, "invalid funcdef");
913 fd = func->def->defs[defindex];
914 elen = fd->environments_length;
915 fn = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) + ((size_t) elen * sizeof(JanetFuncEnv *)));
916 fn->def = fd;
917 {
918 int32_t i;
919 for (i = 0; i < elen; ++i) {
920 int32_t inherit = fd->environments[i];
921 if (inherit == -1) {
922 JanetStackFrame *frame = janet_stack_frame(stack);
923 if (!frame->env) {
924 /* Lazy capture of current stack frame */
925 JanetFuncEnv *env = janet_gcalloc(JANET_MEMORY_FUNCENV, sizeof(JanetFuncEnv));
926 env->offset = fiber->frame;
927 env->as.fiber = fiber;
928 env->length = func->def->slotcount;
929 frame->env = env;
930 }
931 fn->envs[i] = frame->env;
932 } else {
933 fn->envs[i] = func->envs[inherit];
934 }
935 }
936 }
937 stack[A] = janet_wrap_function(fn);
938 vm_checkgc_pcnext();
939 }
940
941 VM_OP(JOP_PUSH)
942 janet_fiber_push(fiber, stack[D]);
943 stack = fiber->data + fiber->frame;
944 vm_checkgc_pcnext();
945
946 VM_OP(JOP_PUSH_2)
947 janet_fiber_push2(fiber, stack[A], stack[E]);
948 stack = fiber->data + fiber->frame;
949 vm_checkgc_pcnext();
950
951 VM_OP(JOP_PUSH_3)
952 janet_fiber_push3(fiber, stack[A], stack[B], stack[C]);
953 stack = fiber->data + fiber->frame;
954 vm_checkgc_pcnext();
955
956 VM_OP(JOP_PUSH_ARRAY) {
957 const Janet *vals;
958 int32_t len;
959 if (janet_indexed_view(stack[D], &vals, &len)) {
960 janet_fiber_pushn(fiber, vals, len);
961 } else {
962 janet_panicf("expected %T, got %v", JANET_TFLAG_INDEXED, stack[D]);
963 }
964 }
965 stack = fiber->data + fiber->frame;
966 vm_checkgc_pcnext();
967
968 VM_OP(JOP_CALL) {
969 vm_maybe_auto_suspend(1);
970 Janet callee = stack[E];
971 if (fiber->stacktop > fiber->maxstack) {
972 vm_throw("stack overflow");
973 }
974 if (janet_checktype(callee, JANET_KEYWORD)) {
975 vm_commit();
976 callee = resolve_method(callee, fiber);
977 }
978 if (janet_checktype(callee, JANET_FUNCTION)) {
979 func = janet_unwrap_function(callee);
980 if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
981 vm_do_trace(func, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart);
982 }
983 janet_stack_frame(stack)->pc = pc;
984 if (janet_fiber_funcframe(fiber, func)) {
985 int32_t n = fiber->stacktop - fiber->stackstart;
986 janet_panicf("%v called with %d argument%s, expected %d",
987 callee, n, n == 1 ? "" : "s", func->def->arity);
988 }
989 stack = fiber->data + fiber->frame;
990 pc = func->def->bytecode;
991 vm_checkgc_next();
992 } else if (janet_checktype(callee, JANET_CFUNCTION)) {
993 vm_commit();
994 int32_t argc = fiber->stacktop - fiber->stackstart;
995 janet_fiber_cframe(fiber, janet_unwrap_cfunction(callee));
996 Janet ret = janet_unwrap_cfunction(callee)(argc, fiber->data + fiber->frame);
997 janet_fiber_popframe(fiber);
998 stack = fiber->data + fiber->frame;
999 stack[A] = ret;
1000 vm_checkgc_pcnext();
1001 } else {
1002 vm_commit();
1003 stack[A] = call_nonfn(fiber, callee);
1004 vm_pcnext();
1005 }
1006 }
1007
1008 VM_OP(JOP_TAILCALL) {
1009 vm_maybe_auto_suspend(1);
1010 Janet callee = stack[D];
1011 if (fiber->stacktop > fiber->maxstack) {
1012 vm_throw("stack overflow");
1013 }
1014 if (janet_checktype(callee, JANET_KEYWORD)) {
1015 vm_commit();
1016 callee = resolve_method(callee, fiber);
1017 }
1018 if (janet_checktype(callee, JANET_FUNCTION)) {
1019 func = janet_unwrap_function(callee);
1020 if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
1021 vm_do_trace(func, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart);
1022 }
1023 if (janet_fiber_funcframe_tail(fiber, func)) {
1024 janet_stack_frame(fiber->data + fiber->frame)->pc = pc;
1025 int32_t n = fiber->stacktop - fiber->stackstart;
1026 janet_panicf("%v called with %d argument%s, expected %d",
1027 callee, n, n == 1 ? "" : "s", func->def->arity);
1028 }
1029 stack = fiber->data + fiber->frame;
1030 pc = func->def->bytecode;
1031 vm_checkgc_next();
1032 } else {
1033 Janet retreg;
1034 int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE;
1035 vm_commit();
1036 if (janet_checktype(callee, JANET_CFUNCTION)) {
1037 int32_t argc = fiber->stacktop - fiber->stackstart;
1038 janet_fiber_cframe(fiber, janet_unwrap_cfunction(callee));
1039 retreg = janet_unwrap_cfunction(callee)(argc, fiber->data + fiber->frame);
1040 janet_fiber_popframe(fiber);
1041 } else {
1042 retreg = call_nonfn(fiber, callee);
1043 }
1044 janet_fiber_popframe(fiber);
1045 if (entrance_frame) {
1046 vm_return_no_restore(JANET_SIGNAL_OK, retreg);
1047 }
1048 vm_restore();
1049 stack[A] = retreg;
1050 vm_checkgc_pcnext();
1051 }
1052 }
1053
1054 VM_OP(JOP_RESUME) {
1055 Janet retreg;
1056 vm_maybe_auto_suspend(1);
1057 vm_assert_type(stack[B], JANET_FIBER);
1058 JanetFiber *child = janet_unwrap_fiber(stack[B]);
1059 if (janet_check_can_resume(child, &retreg)) {
1060 vm_commit();
1061 janet_panicv(retreg);
1062 }
1063 fiber->child = child;
1064 JanetSignal sig = janet_continue_no_check(child, stack[C], &retreg);
1065 if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
1066 vm_return(sig, retreg);
1067 }
1068 fiber->child = NULL;
1069 stack = fiber->data + fiber->frame;
1070 stack[A] = retreg;
1071 vm_checkgc_pcnext();
1072 }
1073
1074 VM_OP(JOP_SIGNAL) {
1075 int32_t s = C;
1076 if (s > JANET_SIGNAL_USER9) s = JANET_SIGNAL_USER9;
1077 if (s < 0) s = 0;
1078 vm_return(s, stack[B]);
1079 }
1080
1081 VM_OP(JOP_PROPAGATE) {
1082 Janet fv = stack[C];
1083 vm_assert_type(fv, JANET_FIBER);
1084 JanetFiber *f = janet_unwrap_fiber(fv);
1085 JanetFiberStatus sub_status = janet_fiber_status(f);
1086 if (sub_status > JANET_STATUS_USER9) {
1087 vm_commit();
1088 janet_panicf("cannot propagate from fiber with status :%s",
1089 janet_status_names[sub_status]);
1090 }
1091 fiber->child = f;
1092 vm_return((int) sub_status, stack[B]);
1093 }
1094
1095 VM_OP(JOP_CANCEL) {
1096 Janet retreg;
1097 vm_assert_type(stack[B], JANET_FIBER);
1098 JanetFiber *child = janet_unwrap_fiber(stack[B]);
1099 if (janet_check_can_resume(child, &retreg)) {
1100 vm_commit();
1101 janet_panicv(retreg);
1102 }
1103 fiber->child = child;
1104 JanetSignal sig = janet_continue_signal(child, stack[C], &retreg, JANET_SIGNAL_ERROR);
1105 if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
1106 vm_return(sig, retreg);
1107 }
1108 fiber->child = NULL;
1109 stack = fiber->data + fiber->frame;
1110 stack[A] = retreg;
1111 vm_checkgc_pcnext();
1112 }
1113
1114 VM_OP(JOP_PUT)
1115 vm_commit();
1116 fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL;
1117 janet_put(stack[A], stack[B], stack[C]);
1118 fiber->flags &= ~JANET_FIBER_RESUME_NO_USEVAL;
1119 vm_checkgc_pcnext();
1120
1121 VM_OP(JOP_PUT_INDEX)
1122 vm_commit();
1123 fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL;
1124 janet_putindex(stack[A], C, stack[B]);
1125 fiber->flags &= ~JANET_FIBER_RESUME_NO_USEVAL;
1126 vm_checkgc_pcnext();
1127
1128 VM_OP(JOP_IN)
1129 vm_commit();
1130 stack[A] = janet_in(stack[B], stack[C]);
1131 vm_pcnext();
1132
1133 VM_OP(JOP_GET)
1134 vm_commit();
1135 stack[A] = janet_get(stack[B], stack[C]);
1136 vm_pcnext();
1137
1138 VM_OP(JOP_GET_INDEX)
1139 vm_commit();
1140 stack[A] = janet_getindex(stack[B], C);
1141 vm_pcnext();
1142
1143 VM_OP(JOP_LENGTH)
1144 vm_commit();
1145 stack[A] = janet_lengthv(stack[E]);
1146 vm_pcnext();
1147
1148 VM_OP(JOP_MAKE_ARRAY) {
1149 int32_t count = fiber->stacktop - fiber->stackstart;
1150 Janet *mem = fiber->data + fiber->stackstart;
1151 stack[D] = janet_wrap_array(janet_array_n(mem, count));
1152 fiber->stacktop = fiber->stackstart;
1153 vm_checkgc_pcnext();
1154 }
1155
1156 VM_OP(JOP_MAKE_TUPLE)
1157 /* fallthrough */
1158 VM_OP(JOP_MAKE_BRACKET_TUPLE) {
1159 int32_t count = fiber->stacktop - fiber->stackstart;
1160 Janet *mem = fiber->data + fiber->stackstart;
1161 const Janet *tup = janet_tuple_n(mem, count);
1162 if (opcode == JOP_MAKE_BRACKET_TUPLE)
1163 janet_tuple_flag(tup) |= JANET_TUPLE_FLAG_BRACKETCTOR;
1164 stack[D] = janet_wrap_tuple(tup);
1165 fiber->stacktop = fiber->stackstart;
1166 vm_checkgc_pcnext();
1167 }
1168
1169 VM_OP(JOP_MAKE_TABLE) {
1170 int32_t count = fiber->stacktop - fiber->stackstart;
1171 Janet *mem = fiber->data + fiber->stackstart;
1172 if (count & 1) {
1173 vm_commit();
1174 janet_panicf("expected even number of arguments to table constructor, got %d", count);
1175 }
1176 JanetTable *table = janet_table(count / 2);
1177 for (int32_t i = 0; i < count; i += 2)
1178 janet_table_put(table, mem[i], mem[i + 1]);
1179 stack[D] = janet_wrap_table(table);
1180 fiber->stacktop = fiber->stackstart;
1181 vm_checkgc_pcnext();
1182 }
1183
1184 VM_OP(JOP_MAKE_STRUCT) {
1185 int32_t count = fiber->stacktop - fiber->stackstart;
1186 Janet *mem = fiber->data + fiber->stackstart;
1187 if (count & 1) {
1188 vm_commit();
1189 janet_panicf("expected even number of arguments to struct constructor, got %d", count);
1190 }
1191 JanetKV *st = janet_struct_begin(count / 2);
1192 for (int32_t i = 0; i < count; i += 2)
1193 janet_struct_put(st, mem[i], mem[i + 1]);
1194 stack[D] = janet_wrap_struct(janet_struct_end(st));
1195 fiber->stacktop = fiber->stackstart;
1196 vm_checkgc_pcnext();
1197 }
1198
1199 VM_OP(JOP_MAKE_STRING) {
1200 int32_t count = fiber->stacktop - fiber->stackstart;
1201 Janet *mem = fiber->data + fiber->stackstart;
1202 JanetBuffer buffer;
1203 janet_buffer_init(&buffer, 10 * count);
1204 for (int32_t i = 0; i < count; i++)
1205 janet_to_string_b(&buffer, mem[i]);
1206 stack[D] = janet_stringv(buffer.data, buffer.count);
1207 janet_buffer_deinit(&buffer);
1208 fiber->stacktop = fiber->stackstart;
1209 vm_checkgc_pcnext();
1210 }
1211
1212 VM_OP(JOP_MAKE_BUFFER) {
1213 int32_t count = fiber->stacktop - fiber->stackstart;
1214 Janet *mem = fiber->data + fiber->stackstart;
1215 JanetBuffer *buffer = janet_buffer(10 * count);
1216 for (int32_t i = 0; i < count; i++)
1217 janet_to_string_b(buffer, mem[i]);
1218 stack[D] = janet_wrap_buffer(buffer);
1219 fiber->stacktop = fiber->stackstart;
1220 vm_checkgc_pcnext();
1221 }
1222
1223 VM_END()
1224 }
1225
1226 /*
1227 * Execute a single instruction in the fiber. Does this by inspecting
1228 * the fiber, setting a breakpoint at the next instruction, executing, and
1229 * reseting breakpoints to how they were prior. Yes, it's a bit hacky.
1230 */
janet_step(JanetFiber * fiber,Janet in,Janet * out)1231 JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out) {
1232 /* No finished or currently alive fibers. */
1233 JanetFiberStatus status = janet_fiber_status(fiber);
1234 if (status == JANET_STATUS_ALIVE ||
1235 status == JANET_STATUS_DEAD ||
1236 status == JANET_STATUS_ERROR) {
1237 janet_panicf("cannot step fiber with status :%s", janet_status_names[status]);
1238 }
1239
1240 /* Get PC for setting breakpoints */
1241 uint32_t *pc = janet_stack_frame(fiber->data + fiber->frame)->pc;
1242
1243 /* Check current opcode (sans debug flag). This tells us where the next or next two candidate
1244 * instructions will be. Usually it's the next instruction in memory,
1245 * but for branching instructions it is also the target of the branch. */
1246 uint32_t *nexta = NULL, *nextb = NULL, olda = 0, oldb = 0;
1247
1248 /* Set temporary breakpoints */
1249 switch (*pc & 0x7F) {
1250 default:
1251 nexta = pc + 1;
1252 break;
1253 /* These we just ignore for now. Supporting them means
1254 * we could step into and out of functions (including JOP_CALL). */
1255 case JOP_RETURN_NIL:
1256 case JOP_RETURN:
1257 case JOP_ERROR:
1258 case JOP_TAILCALL:
1259 break;
1260 case JOP_JUMP:
1261 nexta = pc + DS;
1262 break;
1263 case JOP_JUMP_IF:
1264 case JOP_JUMP_IF_NOT:
1265 nexta = pc + 1;
1266 nextb = pc + ES;
1267 break;
1268 }
1269 if (nexta) {
1270 olda = *nexta;
1271 *nexta |= 0x80;
1272 }
1273 if (nextb) {
1274 oldb = *nextb;
1275 *nextb |= 0x80;
1276 }
1277
1278 /* Go */
1279 JanetSignal signal = janet_continue(fiber, in, out);
1280
1281 /* Restore */
1282 if (nexta) *nexta = olda;
1283 if (nextb) *nextb = oldb;
1284
1285 return signal;
1286 }
1287
janet_call(JanetFunction * fun,int32_t argc,const Janet * argv)1288 Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
1289 /* Check entry conditions */
1290 if (!janet_vm.fiber)
1291 janet_panic("janet_call failed because there is no current fiber");
1292 if (janet_vm.stackn >= JANET_RECURSION_GUARD)
1293 janet_panic("C stack recursed too deeply");
1294
1295 /* Tracing */
1296 if (fun->gc.flags & JANET_FUNCFLAG_TRACE) {
1297 vm_do_trace(fun, argc, argv);
1298 }
1299
1300 /* Push frame */
1301 janet_fiber_pushn(janet_vm.fiber, argv, argc);
1302 if (janet_fiber_funcframe(janet_vm.fiber, fun)) {
1303 int32_t min = fun->def->min_arity;
1304 int32_t max = fun->def->max_arity;
1305 Janet funv = janet_wrap_function(fun);
1306 if (min == max && min != argc)
1307 janet_panicf("arity mismatch in %v, expected %d, got %d", funv, min, argc);
1308 if (min >= 0 && argc < min)
1309 janet_panicf("arity mismatch in %v, expected at least %d, got %d", funv, min, argc);
1310 janet_panicf("arity mismatch in %v, expected at most %d, got %d", funv, max, argc);
1311 }
1312 janet_fiber_frame(janet_vm.fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
1313
1314 /* Set up */
1315 int32_t oldn = janet_vm.stackn++;
1316 int handle = janet_gclock();
1317
1318 /* Run vm */
1319 janet_vm.fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
1320 JanetSignal signal = run_vm(janet_vm.fiber, janet_wrap_nil());
1321
1322 /* Teardown */
1323 janet_vm.stackn = oldn;
1324 janet_gcunlock(handle);
1325
1326 if (signal != JANET_SIGNAL_OK) {
1327 janet_panicv(*janet_vm.return_reg);
1328 }
1329
1330 return *janet_vm.return_reg;
1331 }
1332
janet_check_can_resume(JanetFiber * fiber,Janet * out)1333 static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out) {
1334 /* Check conditions */
1335 JanetFiberStatus old_status = janet_fiber_status(fiber);
1336 if (janet_vm.stackn >= JANET_RECURSION_GUARD) {
1337 janet_fiber_set_status(fiber, JANET_STATUS_ERROR);
1338 *out = janet_cstringv("C stack recursed too deeply");
1339 return JANET_SIGNAL_ERROR;
1340 }
1341 if (old_status == JANET_STATUS_ALIVE ||
1342 old_status == JANET_STATUS_DEAD ||
1343 (old_status >= JANET_STATUS_USER0 && old_status <= JANET_STATUS_USER4) ||
1344 old_status == JANET_STATUS_ERROR) {
1345 const uint8_t *str = janet_formatc("cannot resume fiber with status :%s",
1346 janet_status_names[old_status]);
1347 *out = janet_wrap_string(str);
1348 return JANET_SIGNAL_ERROR;
1349 }
1350 return JANET_SIGNAL_OK;
1351 }
1352
janet_try_init(JanetTryState * state)1353 void janet_try_init(JanetTryState *state) {
1354 state->stackn = janet_vm.stackn++;
1355 state->gc_handle = janet_vm.gc_suspend;
1356 state->vm_fiber = janet_vm.fiber;
1357 state->vm_jmp_buf = janet_vm.signal_buf;
1358 state->vm_return_reg = janet_vm.return_reg;
1359 janet_vm.return_reg = &(state->payload);
1360 janet_vm.signal_buf = &(state->buf);
1361 }
1362
janet_restore(JanetTryState * state)1363 void janet_restore(JanetTryState *state) {
1364 janet_vm.stackn = state->stackn;
1365 janet_vm.gc_suspend = state->gc_handle;
1366 janet_vm.fiber = state->vm_fiber;
1367 janet_vm.signal_buf = state->vm_jmp_buf;
1368 janet_vm.return_reg = state->vm_return_reg;
1369 }
1370
janet_continue_no_check(JanetFiber * fiber,Janet in,Janet * out)1371 static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out) {
1372
1373 JanetFiberStatus old_status = janet_fiber_status(fiber);
1374
1375 #ifdef JANET_EV
1376 janet_fiber_did_resume(fiber);
1377 #endif
1378
1379 /* Clear last value */
1380 fiber->last_value = janet_wrap_nil();
1381
1382 /* Continue child fiber if it exists */
1383 if (fiber->child) {
1384 if (janet_vm.root_fiber == NULL) janet_vm.root_fiber = fiber;
1385 JanetFiber *child = fiber->child;
1386 uint32_t instr = (janet_stack_frame(fiber->data + fiber->frame)->pc)[0];
1387 janet_vm.stackn++;
1388 JanetSignal sig = janet_continue(child, in, &in);
1389 janet_vm.stackn--;
1390 if (janet_vm.root_fiber == fiber) janet_vm.root_fiber = NULL;
1391 if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
1392 *out = in;
1393 janet_fiber_set_status(fiber, sig);
1394 return sig;
1395 }
1396 /* Check if we need any special handling for certain opcodes */
1397 switch (instr & 0x7F) {
1398 default:
1399 break;
1400 case JOP_NEXT: {
1401 if (sig == JANET_SIGNAL_OK ||
1402 sig == JANET_SIGNAL_ERROR ||
1403 sig == JANET_SIGNAL_USER0 ||
1404 sig == JANET_SIGNAL_USER1 ||
1405 sig == JANET_SIGNAL_USER2 ||
1406 sig == JANET_SIGNAL_USER3 ||
1407 sig == JANET_SIGNAL_USER4) {
1408 in = janet_wrap_nil();
1409 } else {
1410 in = janet_wrap_integer(0);
1411 }
1412 break;
1413 }
1414 }
1415 fiber->child = NULL;
1416 }
1417
1418 /* Handle new fibers being resumed with a non-nil value */
1419 if (old_status == JANET_STATUS_NEW && !janet_checktype(in, JANET_NIL)) {
1420 Janet *stack = fiber->data + fiber->frame;
1421 JanetFunction *func = janet_stack_frame(stack)->func;
1422 if (func) {
1423 if (func->def->arity > 0) {
1424 stack[0] = in;
1425 } else if (func->def->flags & JANET_FUNCDEF_FLAG_VARARG) {
1426 stack[0] = janet_wrap_tuple(janet_tuple_n(&in, 1));
1427 }
1428 }
1429 }
1430
1431 /* Save global state */
1432 JanetTryState tstate;
1433 JanetSignal sig = janet_try(&tstate);
1434 if (!sig) {
1435 /* Normal setup */
1436 if (janet_vm.root_fiber == NULL) janet_vm.root_fiber = fiber;
1437 janet_vm.fiber = fiber;
1438 janet_fiber_set_status(fiber, JANET_STATUS_ALIVE);
1439 sig = run_vm(fiber, in);
1440 }
1441
1442 /* Restore */
1443 if (janet_vm.root_fiber == fiber) janet_vm.root_fiber = NULL;
1444 janet_fiber_set_status(fiber, sig);
1445 janet_restore(&tstate);
1446 fiber->last_value = tstate.payload;
1447 *out = tstate.payload;
1448
1449 return sig;
1450 }
1451
1452 /* Enter the main vm loop */
janet_continue(JanetFiber * fiber,Janet in,Janet * out)1453 JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
1454 /* Check conditions */
1455 JanetSignal tmp_signal = janet_check_can_resume(fiber, out);
1456 if (tmp_signal) return tmp_signal;
1457 return janet_continue_no_check(fiber, in, out);
1458 }
1459
1460 /* Enter the main vm loop but immediately raise a signal */
janet_continue_signal(JanetFiber * fiber,Janet in,Janet * out,JanetSignal sig)1461 JanetSignal janet_continue_signal(JanetFiber *fiber, Janet in, Janet *out, JanetSignal sig) {
1462 JanetSignal tmp_signal = janet_check_can_resume(fiber, out);
1463 if (tmp_signal) return tmp_signal;
1464 if (sig != JANET_SIGNAL_OK) {
1465 JanetFiber *child = fiber;
1466 while (child->child) child = child->child;
1467 child->gc.flags &= ~JANET_FIBER_STATUS_MASK;
1468 child->gc.flags |= sig << JANET_FIBER_STATUS_OFFSET;
1469 child->flags |= JANET_FIBER_RESUME_SIGNAL;
1470 }
1471 return janet_continue_no_check(fiber, in, out);
1472 }
1473
janet_pcall(JanetFunction * fun,int32_t argc,const Janet * argv,Janet * out,JanetFiber ** f)1474 JanetSignal janet_pcall(
1475 JanetFunction *fun,
1476 int32_t argc,
1477 const Janet *argv,
1478 Janet *out,
1479 JanetFiber **f) {
1480 JanetFiber *fiber;
1481 if (f && *f) {
1482 fiber = janet_fiber_reset(*f, fun, argc, argv);
1483 } else {
1484 fiber = janet_fiber(fun, 64, argc, argv);
1485 }
1486 if (f) *f = fiber;
1487 if (!fiber) {
1488 *out = janet_cstringv("arity mismatch");
1489 return JANET_SIGNAL_ERROR;
1490 }
1491 return janet_continue(fiber, janet_wrap_nil(), out);
1492 }
1493
janet_mcall(const char * name,int32_t argc,Janet * argv)1494 Janet janet_mcall(const char *name, int32_t argc, Janet *argv) {
1495 /* At least 1 argument */
1496 if (argc < 1) {
1497 janet_panicf("method :%s expected at least 1 argument", name);
1498 }
1499 /* Find method */
1500 Janet method = janet_method_lookup(argv[0], name);
1501 if (janet_checktype(method, JANET_NIL)) {
1502 janet_panicf("could not find method :%s for %v", name, argv[0]);
1503 }
1504 /* Invoke method */
1505 return janet_method_invoke(method, argc, argv);
1506 }
1507
1508 /* Setup VM */
janet_init(void)1509 int janet_init(void) {
1510
1511 /* Garbage collection */
1512 janet_vm.blocks = NULL;
1513 janet_vm.next_collection = 0;
1514 janet_vm.gc_interval = 0x400000;
1515 janet_vm.block_count = 0;
1516
1517 janet_symcache_init();
1518
1519 /* Initialize gc roots */
1520 janet_vm.roots = NULL;
1521 janet_vm.root_count = 0;
1522 janet_vm.root_capacity = 0;
1523
1524 /* Scratch memory */
1525 janet_vm.user = NULL;
1526 janet_vm.scratch_mem = NULL;
1527 janet_vm.scratch_len = 0;
1528 janet_vm.scratch_cap = 0;
1529
1530 /* Initialize registry */
1531 janet_vm.registry = NULL;
1532 janet_vm.registry_cap = 0;
1533 janet_vm.registry_count = 0;
1534 janet_vm.registry_dirty = 0;
1535
1536 /* Intialize abstract registry */
1537 janet_vm.abstract_registry = janet_table(0);
1538 janet_gcroot(janet_wrap_table(janet_vm.abstract_registry));
1539
1540 /* Traversal */
1541 janet_vm.traversal = NULL;
1542 janet_vm.traversal_base = NULL;
1543 janet_vm.traversal_top = NULL;
1544
1545 /* Core env */
1546 janet_vm.core_env = NULL;
1547
1548 /* Auto suspension */
1549 janet_vm.auto_suspend = 0;
1550
1551 /* Dynamic bindings */
1552 janet_vm.top_dyns = NULL;
1553
1554 /* Seed RNG */
1555 janet_rng_seed(janet_default_rng(), 0);
1556
1557 /* Fibers */
1558 janet_vm.fiber = NULL;
1559 janet_vm.root_fiber = NULL;
1560 janet_vm.stackn = 0;
1561
1562 #ifdef JANET_EV
1563 janet_ev_init();
1564 #endif
1565 #ifdef JANET_NET
1566 janet_net_init();
1567 #endif
1568 return 0;
1569 }
1570
1571 /* Clear all memory associated with the VM */
janet_deinit(void)1572 void janet_deinit(void) {
1573 janet_clear_memory();
1574 janet_symcache_deinit();
1575 janet_free(janet_vm.roots);
1576 janet_vm.roots = NULL;
1577 janet_vm.root_count = 0;
1578 janet_vm.root_capacity = 0;
1579 janet_vm.abstract_registry = NULL;
1580 janet_vm.core_env = NULL;
1581 janet_vm.top_dyns = NULL;
1582 janet_vm.user = NULL;
1583 janet_free(janet_vm.traversal_base);
1584 janet_vm.fiber = NULL;
1585 janet_vm.root_fiber = NULL;
1586 janet_free(janet_vm.registry);
1587 janet_vm.registry = NULL;
1588 #ifdef JANET_EV
1589 janet_ev_deinit();
1590 #endif
1591 #ifdef JANET_NET
1592 janet_net_deinit();
1593 #endif
1594 }
1595