You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815
  1. #include "vm/vm.h"
  2. #include <string.h>
  3. #include <stdio.h>
  4. #include <stdarg.h>
  5. #include "vm/builtins.h"
  6. static int stdio_inited = 0;
  7. static struct l2_io_file_writer std_output;
  8. static struct l2_io_file_writer std_error;
  9. static l2_word alloc_val(struct l2_vm *vm) {
  10. size_t id = l2_bitset_set_next(&vm->valueset);
  11. if (id + 16 >= vm->valuessize) {
  12. if (id >= vm->valuessize) {
  13. if (vm->valuessize == 0) {
  14. vm->valuessize = 64;
  15. }
  16. while (id >= vm->valuessize) {
  17. vm->valuessize *= 2;
  18. }
  19. vm->values = realloc(vm->values, sizeof(*vm->values) * vm->valuessize);
  20. } else {
  21. vm->gc_scheduled = 1;
  22. }
  23. }
  24. return (l2_word)id;
  25. }
  26. static void gc_mark_array(struct l2_vm *vm, struct l2_vm_value *val);
  27. static void gc_mark_namespace(struct l2_vm *vm, struct l2_vm_value *val);
  28. static void gc_mark(struct l2_vm *vm, l2_word id) {
  29. struct l2_vm_value *val = &vm->values[id];
  30. if (val->flags & L2_VAL_MARKED) {
  31. return;
  32. }
  33. val->flags |= L2_VAL_MARKED;
  34. int typ = l2_value_get_type(val);
  35. if (typ == L2_VAL_TYPE_ARRAY) {
  36. gc_mark_array(vm, val);
  37. } else if (typ == L2_VAL_TYPE_NAMESPACE) {
  38. gc_mark_namespace(vm, val);
  39. } else if (typ == L2_VAL_TYPE_FUNCTION) {
  40. gc_mark(vm, val->func.ns);
  41. } else if (typ == L2_VAL_TYPE_CONTINUATION && val->cont != NULL) {
  42. if (val->cont->marker != NULL) {
  43. val->cont->marker(vm, val->cont, gc_mark);
  44. }
  45. if (val->cont->args != 0) {
  46. gc_mark(vm, val->cont->args);
  47. }
  48. }
  49. }
  50. static void gc_mark_array(struct l2_vm *vm, struct l2_vm_value *val) {
  51. l2_word *data;
  52. if (val->flags & L2_VAL_SBO) {
  53. data = val->shortarray;
  54. } else {
  55. data = val->array->data;
  56. }
  57. for (size_t i = 0; i < val->extra.arr_length; ++i) {
  58. gc_mark(vm, data[i]);
  59. }
  60. }
  61. static void gc_mark_namespace(struct l2_vm *vm, struct l2_vm_value *val) {
  62. if (val->extra.ns_parent != 0) {
  63. gc_mark(vm, val->extra.ns_parent);
  64. }
  65. if (val->ns == NULL) {
  66. return;
  67. }
  68. for (size_t i = 0; i < val->ns->size; ++i) {
  69. l2_word key = val->ns->data[i];
  70. if (key == 0 || key == ~(l2_word)0) {
  71. continue;
  72. }
  73. gc_mark(vm, val->ns->data[val->ns->size + i]);
  74. }
  75. }
  76. static void gc_free(struct l2_vm *vm, l2_word id) {
  77. struct l2_vm_value *val = &vm->values[id];
  78. l2_bitset_unset(&vm->valueset, id);
  79. // Don't need to do anything more; the next round of GC will free
  80. // whichever values were only referenced by the array
  81. int typ = l2_value_get_type(val);
  82. if (typ == L2_VAL_TYPE_ARRAY && !(val->flags & L2_VAL_SBO)) {
  83. free(val->array);
  84. } else if (typ == L2_VAL_TYPE_BUFFER) {
  85. free(val->buffer);
  86. } else if (typ == L2_VAL_TYPE_NAMESPACE) {
  87. free(val->ns);
  88. } else if (typ == L2_VAL_TYPE_ERROR) {
  89. free(val->error);
  90. } else if (typ == L2_VAL_TYPE_CONTINUATION && val->cont) {
  91. free(val->cont);
  92. }
  93. }
  94. static size_t gc_sweep(struct l2_vm *vm) {
  95. size_t freed = 0;
  96. for (size_t i = vm->gc_start; i < vm->valuessize; ++i) {
  97. if (!l2_bitset_get(&vm->valueset, i)) {
  98. continue;
  99. }
  100. struct l2_vm_value *val = &vm->values[i];
  101. if (!(val->flags & L2_VAL_MARKED)) {
  102. l2_bitset_unset(&vm->valueset, i);
  103. gc_free(vm, i);
  104. freed += 1;
  105. } else {
  106. val->flags &= ~L2_VAL_MARKED;
  107. }
  108. }
  109. // Normal variables are unmarked by the above loop,
  110. // but builtins don't go through that loop
  111. for (size_t i = 0; i < vm->gc_start; ++i) {
  112. vm->values[i].flags &= ~L2_VAL_MARKED;
  113. }
  114. return freed;
  115. }
  116. const char *l2_value_type_name(enum l2_value_type typ) {
  117. switch (typ) {
  118. case L2_VAL_TYPE_NONE: return "NONE";
  119. case L2_VAL_TYPE_ATOM: return "ATOM";
  120. case L2_VAL_TYPE_REAL: return "REAL";
  121. case L2_VAL_TYPE_BUFFER: return "BUFFER";
  122. case L2_VAL_TYPE_ARRAY: return "ARRAY";
  123. case L2_VAL_TYPE_NAMESPACE: return "NAMESPACE";
  124. case L2_VAL_TYPE_FUNCTION: return "FUNCTION";
  125. case L2_VAL_TYPE_CFUNCTION: return "CFUNCTION";
  126. case L2_VAL_TYPE_ERROR: return "ERROR";
  127. case L2_VAL_TYPE_CONTINUATION: return "CONTINUATION";
  128. }
  129. return "(unknown)";
  130. }
  131. l2_word l2_value_arr_get(struct l2_vm *vm, struct l2_vm_value *val, l2_word k) {
  132. if (k >= val->extra.arr_length) {
  133. return l2_vm_error(vm, "Array index out of bounds");
  134. }
  135. if (val->flags & L2_VAL_SBO) {
  136. return val->shortarray[k];
  137. }
  138. return val->array->data[k];
  139. }
  140. l2_word l2_value_arr_set(struct l2_vm *vm, struct l2_vm_value *val, l2_word k, l2_word v) {
  141. if (k >= val->extra.arr_length) {
  142. return l2_vm_error(vm, "Array index out of bounds");
  143. }
  144. if (val->flags & L2_VAL_SBO) {
  145. return val->shortarray[k] = v;
  146. }
  147. return val->array->data[k] = v;
  148. }
  149. void l2_vm_init(struct l2_vm *vm, unsigned char *ops, size_t opslen) {
  150. if (!stdio_inited) {
  151. std_output.w.write = l2_io_file_write;
  152. std_output.f = stdout;
  153. std_error.w.write = l2_io_file_write;
  154. std_error.f = stderr;
  155. stdio_inited = 1;
  156. }
  157. vm->std_output = &std_output.w;
  158. vm->std_error = &std_error.w;
  159. vm->halted = 0;
  160. vm->gc_scheduled = 0;
  161. vm->ops = ops;
  162. vm->opslen = opslen;
  163. vm->iptr = 0;
  164. vm->sptr = 0;
  165. vm->fsptr = 0;
  166. vm->values = NULL;
  167. vm->valuessize = 0;
  168. l2_bitset_init(&vm->valueset);
  169. // It's wasteful to allocate new 'none' variables all the time,
  170. // variable ID 0 should be the only 'none' variable in the system
  171. l2_word none_id = alloc_val(vm);
  172. vm->values[none_id].flags = L2_VAL_TYPE_NONE | L2_VAL_CONST;
  173. // Need to allocate a builtins namespace
  174. l2_word builtins = alloc_val(vm);
  175. vm->values[builtins].extra.ns_parent = 0;
  176. vm->values[builtins].ns = NULL; // Will be allocated on first insert
  177. vm->values[builtins].flags = L2_VAL_TYPE_NAMESPACE;
  178. vm->fstack[vm->fsptr].ns = builtins;
  179. vm->fstack[vm->fsptr].retptr = 0;
  180. vm->fstack[vm->fsptr].sptr = 0;
  181. vm->fsptr += 1;
  182. // Need to allocate a root namespace
  183. l2_word root = alloc_val(vm);
  184. vm->values[root].extra.ns_parent = builtins;
  185. vm->values[root].ns = NULL;
  186. vm->values[root].flags = L2_VAL_TYPE_NAMESPACE;
  187. vm->fstack[vm->fsptr].ns = root;
  188. vm->fstack[vm->fsptr].retptr = 0;
  189. vm->fstack[vm->fsptr].sptr = 0;
  190. vm->fsptr += 1;
  191. // None is always at 0
  192. vm->knone = 0;
  193. vm->values[vm->knone].flags = L2_VAL_TYPE_NONE | L2_VAL_CONST;
  194. // Define a C function variable for every builtin
  195. l2_word id;
  196. l2_word key = 1;
  197. #define XNAME(name, k) \
  198. l2_vm_namespace_set(&vm->values[builtins], key, vm->k); \
  199. key += 1;
  200. #define XATOM(name, k) \
  201. id = alloc_val(vm); \
  202. vm->values[id].flags = L2_VAL_TYPE_ATOM | L2_VAL_CONST; \
  203. vm->values[id].atom = key; \
  204. vm->k = id; \
  205. key += 1;
  206. #define XFUNCTION(name, f) \
  207. id = alloc_val(vm); \
  208. vm->values[id].flags = L2_VAL_TYPE_CFUNCTION | L2_VAL_CONST; \
  209. vm->values[id].cfunc = f; \
  210. l2_vm_namespace_set(&vm->values[builtins], key, id); \
  211. key += 1;
  212. #include "builtins.x.h"
  213. #undef XNAME
  214. #undef XATOM
  215. #undef XFUNCTION
  216. vm->gc_start = id + 1;
  217. }
  218. l2_word l2_vm_alloc(struct l2_vm *vm, enum l2_value_type typ, enum l2_value_flags flags) {
  219. l2_word id = alloc_val(vm);
  220. memset(&vm->values[id], 0, sizeof(vm->values[id]));
  221. vm->values[id].flags = typ | flags;
  222. return id;
  223. }
  224. l2_word l2_vm_error(struct l2_vm *vm, const char *fmt, ...) {
  225. l2_word id = alloc_val(vm);
  226. struct l2_vm_value *val = &vm->values[id];
  227. val->flags = L2_VAL_CONST | L2_VAL_TYPE_ERROR;
  228. char buf[256];
  229. va_list va;
  230. va_start(va, fmt);
  231. int n = vsnprintf(buf, sizeof(buf), fmt, va);
  232. if (n < 0) {
  233. const char *message = "Failed to generate error message!";
  234. val->error = malloc(strlen(message) + 1);
  235. strcpy(val->error, message);
  236. va_end(va);
  237. return id;
  238. } else if ((size_t)n + 1 < sizeof(buf)) {
  239. val->error = malloc(n + 1);
  240. strcpy(val->error, buf);
  241. va_end(va);
  242. return id;
  243. }
  244. val->error = malloc(n + 1);
  245. vsnprintf(val->error, n + 1, fmt, va);
  246. va_end(va);
  247. return id;
  248. }
  249. l2_word l2_vm_type_error(struct l2_vm *vm, struct l2_vm_value *val) {
  250. enum l2_value_type typ = l2_value_get_type(val);
  251. if (typ == L2_VAL_TYPE_ERROR) {
  252. return val - vm->values;
  253. }
  254. return l2_vm_error(vm, "Unexpected type %s", l2_value_type_name(l2_value_get_type(val)));
  255. }
  256. void l2_vm_free(struct l2_vm *vm) {
  257. // Skip ID 0, because that's always NONE
  258. for (size_t i = 1; i < vm->valuessize; ++i) {
  259. if (!l2_bitset_get(&vm->valueset, i)) {
  260. continue;
  261. }
  262. gc_free(vm, i);
  263. }
  264. free(vm->values);
  265. l2_bitset_free(&vm->valueset);
  266. }
  267. size_t l2_vm_gc(struct l2_vm *vm) {
  268. for (l2_word sptr = 0; sptr < vm->sptr; ++sptr) {
  269. gc_mark(vm, vm->stack[sptr]);
  270. }
  271. // Don't need to mark the first stack frame, since that's where all the
  272. // builtins live, and they aren't sweeped anyways
  273. for (l2_word fsptr = 1; fsptr < vm->fsptr; ++fsptr) {
  274. gc_mark(vm, vm->fstack[fsptr].ns);
  275. }
  276. return gc_sweep(vm);
  277. }
  278. void l2_vm_run(struct l2_vm *vm) {
  279. while (!vm->halted) {
  280. l2_vm_step(vm);
  281. }
  282. }
  283. static void call_func_with_args(struct l2_vm *vm, l2_word func_id, l2_word args_id) {
  284. l2_word stack_base = vm->sptr;
  285. vm->stack[vm->sptr++] = args_id;
  286. l2_word ns_id = alloc_val(vm);
  287. struct l2_vm_value *func = &vm->values[func_id]; // func might be stale after alloc_val
  288. vm->values[ns_id].extra.ns_parent = func->func.ns;
  289. vm->values[ns_id].ns = NULL;
  290. vm->values[ns_id].flags = L2_VAL_TYPE_NAMESPACE;
  291. vm->fstack[vm->fsptr].ns = ns_id;
  292. vm->fstack[vm->fsptr].retptr = vm->iptr;
  293. vm->fstack[vm->fsptr].sptr = stack_base;
  294. vm->fsptr += 1;
  295. vm->iptr = func->func.pos;
  296. }
  297. // The 'call_func' function assumes that all relevant values have been popped off
  298. // the stack, so that the return value can be pushed to the top of the stack
  299. // straight away
  300. static void call_func(
  301. struct l2_vm *vm, l2_word func_id,
  302. l2_word argc, l2_word *argv) {
  303. struct l2_vm_value *func = &vm->values[func_id];
  304. enum l2_value_type typ = l2_value_get_type(func);
  305. // C functions are called differently from language functions
  306. if (typ == L2_VAL_TYPE_CFUNCTION) {
  307. // Make this a while loop, because using call_func would
  308. // make the call stack depth unbounded
  309. vm->stack[vm->sptr++] = func->cfunc(vm, argc, argv);
  310. while (1) {
  311. l2_word cont_id = vm->stack[vm->sptr - 1];
  312. struct l2_vm_value *cont = &vm->values[cont_id];
  313. if (l2_value_get_type(cont) != L2_VAL_TYPE_CONTINUATION) {
  314. break;
  315. }
  316. // If there's no callback it's easy, just call the function
  317. // it wants us to call
  318. l2_word call_id = cont->extra.cont_call;
  319. if (cont->cont == NULL) {
  320. vm->sptr -= 1;
  321. call_func(vm, call_id, 0, NULL);
  322. break;
  323. }
  324. struct l2_vm_value *call = &vm->values[call_id];
  325. if (l2_value_get_type(call) == L2_VAL_TYPE_CFUNCTION) {
  326. int argc = 0;
  327. l2_word *argv = NULL;
  328. if (cont->cont && cont->cont->args != 0) {
  329. struct l2_vm_value *args = &vm->values[cont->cont->args];
  330. if (l2_value_get_type(args) != L2_VAL_TYPE_ARRAY) {
  331. vm->stack[vm->sptr - 1] = l2_vm_type_error(vm, args);
  332. break;
  333. }
  334. argc = args->extra.arr_length;
  335. if (args->flags & L2_VAL_SBO) {
  336. argv = args->shortarray;
  337. } else {
  338. argv = args->array->data;
  339. }
  340. }
  341. l2_word retval = call->cfunc(vm, argc, argv);
  342. vm->stack[vm->sptr - 1] = cont->cont->callback(vm, retval, cont_id);
  343. } else if (l2_value_get_type(call) == L2_VAL_TYPE_FUNCTION) {
  344. // Leave the continuation on the stack,
  345. // let the L2_OP_RET code deal with it
  346. cont->flags |= L2_VAL_CONT_CALLBACK;
  347. if (cont->cont && cont->cont->args) {
  348. call_func_with_args(vm, call_id, cont->cont->args);
  349. } else {
  350. call_func(vm, call_id, 0, NULL);
  351. }
  352. break;
  353. } else {
  354. l2_word err = l2_vm_type_error(vm, call);
  355. vm->stack[vm->sptr - 1] = cont->cont->callback(vm, err, cont_id);
  356. }
  357. }
  358. return;
  359. }
  360. // Don't interpret a non-function as a function
  361. if (typ != L2_VAL_TYPE_FUNCTION) {
  362. vm->stack[vm->sptr++] = l2_vm_error(vm, "Attempt to call non-function");
  363. return;
  364. }
  365. l2_word args_id = alloc_val(vm);
  366. struct l2_vm_value *args = &vm->values[args_id];
  367. args->extra.arr_length = argc;
  368. if (argc <= 2) {
  369. args->flags = L2_VAL_TYPE_ARRAY | L2_VAL_SBO;
  370. memcpy(args->shortarray, argv, argc * sizeof(l2_word));
  371. } else {
  372. args->flags = L2_VAL_TYPE_ARRAY;
  373. args->array = malloc(
  374. sizeof(struct l2_vm_array) + sizeof(l2_word) * argc);
  375. args->array->size = argc;
  376. memcpy(args->array->data, argv, argc * sizeof(l2_word));
  377. }
  378. call_func_with_args(vm, func_id, args_id);
  379. }
  380. static l2_word read_u4le(struct l2_vm *vm) {
  381. unsigned char *data = &vm->ops[vm->iptr];
  382. l2_word ret =
  383. (l2_word)data[0] |
  384. (l2_word)data[1] << 8 |
  385. (l2_word)data[2] << 16 |
  386. (l2_word)data[3] << 24;
  387. vm->iptr += 4;
  388. return ret;
  389. }
  390. static l2_word read_u1le(struct l2_vm *vm) {
  391. return vm->ops[vm->iptr++];
  392. }
  393. static double read_d8le(struct l2_vm *vm) {
  394. unsigned char *data = &vm->ops[vm->iptr];
  395. uint64_t integer = 0 |
  396. (uint64_t)data[0] |
  397. (uint64_t)data[1] << 8 |
  398. (uint64_t)data[2] << 16 |
  399. (uint64_t)data[3] << 24 |
  400. (uint64_t)data[4] << 32 |
  401. (uint64_t)data[5] << 40 |
  402. (uint64_t)data[6] << 48 |
  403. (uint64_t)data[7] << 56;
  404. double num;
  405. memcpy(&num, &integer, 8);
  406. vm->iptr += 8;
  407. return num;
  408. }
  409. void l2_vm_step(struct l2_vm *vm) {
  410. enum l2_opcode opcode = (enum l2_opcode)vm->ops[vm->iptr++];
  411. l2_word word;
  412. switch (opcode) {
  413. case L2_OP_NOP:
  414. break;
  415. case L2_OP_DISCARD:
  416. vm->sptr -= 1;
  417. if (l2_value_get_type(&vm->values[vm->stack[vm->sptr]]) == L2_VAL_TYPE_ERROR) {
  418. l2_io_printf(vm->std_error, "Error: %s\n", vm->values[vm->stack[vm->sptr]].error);
  419. vm->halted = 1;
  420. }
  421. break;
  422. case L2_OP_SWAP_DISCARD:
  423. vm->stack[vm->sptr - 2] = vm->stack[vm->sptr - 1];
  424. vm->sptr -= 1;
  425. if (l2_value_get_type(&vm->values[vm->stack[vm->sptr]]) == L2_VAL_TYPE_ERROR) {
  426. l2_io_printf(vm->std_error, "Error: %s\n", vm->values[vm->stack[vm->sptr]].error);
  427. vm->halted = 1;
  428. }
  429. break;
  430. case L2_OP_DUP:
  431. vm->stack[vm->sptr] = vm->ops[vm->sptr - 1];
  432. vm->sptr += 1;
  433. break;
  434. case L2_OP_ADD:
  435. vm->stack[vm->sptr - 2] += vm->stack[vm->sptr - 1];
  436. vm->sptr -= 1;
  437. break;
  438. #define X(read) \
  439. l2_word argc = read(vm); \
  440. vm->sptr -= argc; \
  441. l2_word *argv = vm->stack + vm->sptr; \
  442. l2_word func_id = vm->stack[--vm->sptr]; \
  443. call_func(vm, func_id, argc, argv)
  444. case L2_OP_FUNC_CALL_U4: { X(read_u4le); } break;
  445. case L2_OP_FUNC_CALL_U1: { X(read_u1le); } break;
  446. #undef X
  447. #define X(read) word = read(vm); vm->iptr += word;
  448. case L2_OP_RJMP_U4: { X(read_u4le); } break;
  449. case L2_OP_RJMP_U1: { X(read_u1le); } break;
  450. #undef X
  451. #define X(read) \
  452. l2_word key = read(vm); \
  453. struct l2_vm_value *ns = &vm->values[vm->fstack[vm->fsptr - 1].ns]; \
  454. vm->stack[vm->sptr++] = l2_vm_namespace_get(vm, ns, key);
  455. case L2_OP_STACK_FRAME_LOOKUP_U4: { X(read_u4le); } break;
  456. case L2_OP_STACK_FRAME_LOOKUP_U1: { X(read_u1le); } break;
  457. #undef X
  458. #define X(read) \
  459. l2_word key = read(vm); \
  460. l2_word val = vm->stack[vm->sptr - 1]; \
  461. struct l2_vm_value *ns = &vm->values[vm->fstack[vm->fsptr - 1].ns]; \
  462. l2_vm_namespace_set(ns, key, val);
  463. case L2_OP_STACK_FRAME_SET_U4: { X(read_u4le); } break;
  464. case L2_OP_STACK_FRAME_SET_U1: { X(read_u1le); } break;
  465. #undef X
  466. #define X(read) \
  467. l2_word key = read(vm); \
  468. l2_word val = vm->stack[vm->sptr - 1]; \
  469. struct l2_vm_value *ns = &vm->values[vm->fstack[vm->fsptr - 1].ns]; \
  470. if (l2_vm_namespace_replace(vm, ns, key, val) < 0) { \
  471. vm->stack[vm->sptr - 1] = l2_vm_error(vm, "Variable not found"); \
  472. }
  473. case L2_OP_STACK_FRAME_REPLACE_U4: { X(read_u4le); } break;
  474. case L2_OP_STACK_FRAME_REPLACE_U1: { X(read_u1le); } break;
  475. #undef X
  476. case L2_OP_RET:
  477. {
  478. l2_word retval = vm->stack[--vm->sptr];
  479. l2_word retptr = vm->fstack[vm->fsptr - 1].retptr;
  480. l2_word sptr = vm->fstack[vm->fsptr - 1].sptr;
  481. vm->fsptr -= 1;
  482. vm->sptr = sptr;
  483. vm->iptr = retptr;
  484. l2_word cont_id;
  485. struct l2_vm_value *cont = NULL;
  486. if (vm->sptr > 0) {
  487. cont_id = vm->stack[vm->sptr - 1];
  488. cont = &vm->values[cont_id];
  489. }
  490. int iscont =
  491. cont != NULL && l2_value_get_type(cont) == L2_VAL_TYPE_CONTINUATION;
  492. int nocallback =
  493. !iscont || (cont->flags & L2_VAL_CONT_CALLBACK && cont->cont == NULL);
  494. if (nocallback) {
  495. if (iscont) {
  496. vm->stack[vm->sptr - 1] = retval;
  497. } else {
  498. vm->stack[vm->sptr++] = retval;
  499. }
  500. break;
  501. }
  502. if (cont->flags & L2_VAL_CONT_CALLBACK) {
  503. retval = cont->cont->callback(vm, retval, cont_id);
  504. cont_id = retval;
  505. cont = &vm->values[cont_id];
  506. if (l2_value_get_type(cont) != L2_VAL_TYPE_CONTINUATION) {
  507. vm->stack[vm->sptr - 1] = retval;
  508. break;
  509. }
  510. }
  511. cont->flags |= L2_VAL_CONT_CALLBACK;
  512. if (cont->cont && cont->cont->args != 0) {
  513. call_func_with_args(vm, cont->extra.cont_call, cont->cont->args);
  514. } else {
  515. call_func(vm, cont->extra.cont_call, 0, NULL);
  516. }
  517. }
  518. break;
  519. case L2_OP_ALLOC_NONE:
  520. vm->stack[vm->sptr++] = 0;
  521. break;
  522. #define X(read) \
  523. word = alloc_val(vm); \
  524. vm->values[word].flags = L2_VAL_TYPE_ATOM; \
  525. vm->values[word].atom = read(vm); \
  526. vm->stack[vm->sptr++] = word;
  527. case L2_OP_ALLOC_ATOM_U4: { X(read_u4le); } break;
  528. case L2_OP_ALLOC_ATOM_U1: { X(read_u1le); } break;
  529. #undef X
  530. case L2_OP_ALLOC_REAL_D8:
  531. {
  532. word = alloc_val(vm);
  533. vm->values[word].flags = L2_VAL_TYPE_REAL;
  534. vm->values[word].real = read_d8le(vm);
  535. vm->stack[vm->sptr++] = word;
  536. }
  537. break;
  538. #define X(read) \
  539. word = alloc_val(vm); \
  540. l2_word length = read(vm); \
  541. l2_word offset = read(vm); \
  542. vm->values[word].flags = L2_VAL_TYPE_BUFFER; \
  543. vm->values[word].buffer = length > 0 ? malloc(length) : NULL; \
  544. vm->values[word].extra.buf_length = length; \
  545. memcpy(vm->values[word].buffer, vm->ops + offset, length); \
  546. vm->stack[vm->sptr] = word; \
  547. vm->sptr += 1;
  548. case L2_OP_ALLOC_BUFFER_STATIC_U4: { X(read_u4le); } break;
  549. case L2_OP_ALLOC_BUFFER_STATIC_U1: { X(read_u1le); } break;
  550. #undef X
  551. #define X(read) \
  552. l2_word count = read(vm); \
  553. l2_word arr_id = alloc_val(vm); \
  554. struct l2_vm_value *arr = &vm->values[arr_id]; \
  555. arr->extra.arr_length = count; \
  556. l2_word *data; \
  557. if (count <= 2) { \
  558. arr->flags = L2_VAL_TYPE_ARRAY | L2_VAL_SBO; \
  559. data = arr->shortarray; \
  560. } else { \
  561. arr->flags = L2_VAL_TYPE_ARRAY; \
  562. arr->array = malloc(sizeof(struct l2_vm_array) + count * sizeof(l2_word)); \
  563. arr->array->size = count; \
  564. data = arr->array->data; \
  565. } \
  566. for (l2_word i = 0; i < count; ++i) { \
  567. data[count - 1 - i] = vm->stack[--vm->sptr]; \
  568. } \
  569. vm->stack[vm->sptr++] = arr_id;
  570. case L2_OP_ALLOC_ARRAY_U4: { X(read_u4le); } break;
  571. case L2_OP_ALLOC_ARRAY_U1: { X(read_u1le); } break;
  572. #undef X
  573. case L2_OP_ALLOC_NAMESPACE:
  574. word = alloc_val(vm);
  575. vm->values[word].flags = L2_VAL_TYPE_NAMESPACE;
  576. vm->values[word].extra.ns_parent = 0;
  577. vm->values[word].ns = NULL; // Will be allocated on first insert
  578. vm->stack[vm->sptr] = word;
  579. vm->sptr += 1;
  580. break;
  581. #define X(read) \
  582. word = alloc_val(vm); \
  583. vm->values[word].flags = L2_VAL_TYPE_FUNCTION; \
  584. vm->values[word].func.pos = read(vm); \
  585. vm->values[word].func.ns = vm->fstack[vm->fsptr - 1].ns; \
  586. vm->stack[vm->sptr] = word; \
  587. vm->sptr += 1;
  588. case L2_OP_ALLOC_FUNCTION_U4: { X(read_u4le); } break;
  589. case L2_OP_ALLOC_FUNCTION_U1: { X(read_u1le); } break;
  590. #undef X
  591. #define X(read) \
  592. l2_word key = read(vm); \
  593. l2_word val = vm->stack[vm->sptr - 1]; \
  594. l2_word ns = vm->stack[vm->sptr - 2]; \
  595. l2_vm_namespace_set(&vm->values[ns], key, val);
  596. case L2_OP_NAMESPACE_SET_U4: { X(read_u4le); } break;
  597. case L2_OP_NAMESPACE_SET_U1: { X(read_u1le); } break;
  598. #undef X
  599. #define X(read) \
  600. l2_word key = read(vm); \
  601. l2_word ns = vm->stack[--vm->sptr]; \
  602. vm->stack[vm->sptr++] = l2_vm_namespace_get(vm, &vm->values[ns], key);
  603. case L2_OP_NAMESPACE_LOOKUP_U4: { X(read_u4le); } break;
  604. case L2_OP_NAMESPACE_LOOKUP_U1: { X(read_u1le); } break;
  605. #undef X
  606. #define X(read) \
  607. l2_word key = read(vm); \
  608. l2_word arr_id = vm->stack[--vm->sptr]; \
  609. struct l2_vm_value *arr = &vm->values[arr_id]; \
  610. if (l2_value_get_type(arr) != L2_VAL_TYPE_ARRAY) { \
  611. vm->stack[vm->sptr++] = l2_vm_type_error(vm, arr); \
  612. } else { \
  613. vm->stack[vm->sptr++] = l2_value_arr_get(vm, arr, key); \
  614. }
  615. case L2_OP_ARRAY_LOOKUP_U4: { X(read_u4le); } break;
  616. case L2_OP_ARRAY_LOOKUP_U1: { X(read_u1le); } break;
  617. #undef X
  618. #define X(read) \
  619. l2_word key = read(vm); \
  620. l2_word val = vm->stack[vm->sptr - 1]; \
  621. l2_word arr_id = vm->stack[vm->sptr - 2]; \
  622. struct l2_vm_value *arr = &vm->values[arr_id]; \
  623. if (l2_value_get_type(arr) != L2_VAL_TYPE_ARRAY) { \
  624. vm->stack[vm->sptr - 1] = l2_vm_type_error(vm, arr); \
  625. } else { \
  626. vm->stack[vm->sptr - 1] = l2_value_arr_set(vm, arr, key, val); \
  627. }
  628. case L2_OP_ARRAY_SET_U4: { X(read_u4le); } break;
  629. case L2_OP_ARRAY_SET_U1: { X(read_u1le); } break;
  630. case L2_OP_DYNAMIC_LOOKUP:
  631. {
  632. l2_word key_id = vm->stack[--vm->sptr];
  633. l2_word container_id = vm->stack[--vm->sptr];
  634. struct l2_vm_value *key = &vm->values[key_id];
  635. struct l2_vm_value *container = &vm->values[container_id];
  636. if (l2_value_get_type(container) == L2_VAL_TYPE_ARRAY) {
  637. if (l2_value_get_type(key) != L2_VAL_TYPE_REAL) {
  638. vm->stack[vm->sptr++] = l2_vm_type_error(vm, key);
  639. } else if (key->real >= container->extra.arr_length) {
  640. vm->stack[vm->sptr++] = l2_vm_error(vm, "Index out of range");
  641. } else {
  642. vm->stack[vm->sptr++] = container->array->data[(l2_word)key->real];
  643. }
  644. } else if (l2_value_get_type(container) == L2_VAL_TYPE_NAMESPACE) {
  645. if (l2_value_get_type(key) != L2_VAL_TYPE_ATOM) {
  646. vm->stack[vm->sptr++] = l2_vm_type_error(vm, key);
  647. } else {
  648. vm->stack[vm->sptr++] = l2_vm_namespace_get(vm, container, key->atom);
  649. }
  650. } else {
  651. vm->stack[vm->sptr++] = l2_vm_type_error(vm, container);
  652. }
  653. }
  654. break;
  655. case L2_OP_DYNAMIC_SET:
  656. {
  657. l2_word val = vm->stack[--vm->sptr];
  658. l2_word key_id = vm->stack[--vm->sptr];
  659. l2_word container_id = vm->stack[--vm->sptr];
  660. vm->stack[vm->sptr++] = val;
  661. struct l2_vm_value *key = &vm->values[key_id];
  662. struct l2_vm_value *container = &vm->values[container_id];
  663. if (l2_value_get_type(container) == L2_VAL_TYPE_ARRAY) {
  664. if (l2_value_get_type(key) != L2_VAL_TYPE_REAL) {
  665. vm->stack[vm->sptr - 1] = l2_vm_type_error(vm, key);
  666. } else if (key->real >= container->extra.arr_length) {
  667. vm->stack[vm->sptr - 1] = l2_vm_error(vm, "Index out of range");
  668. } else {
  669. container->array->data[(size_t)key->real] = val;
  670. }
  671. } else if (l2_value_get_type(container) == L2_VAL_TYPE_NAMESPACE) {
  672. if (l2_value_get_type(key) != L2_VAL_TYPE_ATOM) {
  673. vm->stack[vm->sptr - 1] = l2_vm_type_error(vm, key);
  674. } else {
  675. l2_vm_namespace_set(container, key->atom, val);
  676. }
  677. } else {
  678. vm->stack[vm->sptr - 1] = l2_vm_type_error(vm, container);
  679. }
  680. }
  681. break;
  682. case L2_OP_FUNC_CALL_INFIX:
  683. {
  684. l2_word rhs = vm->stack[--vm->sptr];
  685. l2_word func_id = vm->stack[--vm->sptr];
  686. l2_word lhs = vm->stack[--vm->sptr];
  687. l2_word argv[] = {lhs, rhs};
  688. call_func(vm, func_id, 2, argv);
  689. }
  690. break;
  691. case L2_OP_HALT:
  692. vm->halted = 1;
  693. break;
  694. }
  695. if (vm->gc_scheduled) {
  696. l2_vm_gc(vm);
  697. vm->gc_scheduled = 0;
  698. }
  699. }
  700. int l2_vm_val_is_true(struct l2_vm *vm, struct l2_vm_value *val) {
  701. l2_word true_atom = vm->values[vm->ktrue].atom;
  702. return l2_value_get_type(val) == L2_VAL_TYPE_ATOM && val->atom == true_atom;
  703. }