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.

vm.c 22KB

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