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.

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