/* * Copyright (c) 2017 Calvin Rose * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to * deal in the Software without restriction, including without limitation the * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or * sell copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS * IN THE SOFTWARE. */ #include #include int dst_stl_exit(int32_t argn, Dst *argv, Dst *ret) { (void)ret; int32_t exitcode = 0; if (argn > 0) { exitcode = dst_hash(argv[0]); } exit(exitcode); } int dst_stl_print(int32_t argn, Dst *argv, Dst *ret) { (void)ret; int32_t i; for (i = 0; i < argn; ++i) { int32_t j, len; const uint8_t *vstr = dst_to_string(argv[i]); len = dst_string_length(vstr); for (j = 0; j < len; ++j) { putc(vstr[j], stdout); } } putc('\n', stdout); return 0; } int dst_stl_describe(int32_t argn, Dst *argv, Dst *ret) { (void)ret; int32_t i; for (i = 0; i < argn; ++i) { int32_t j, len; const uint8_t *vstr = dst_description(argv[i]); len = dst_string_length(vstr); for (j = 0; j < len; ++j) { putc(vstr[j], stdout); } } putc('\n', stdout); return 0; } int dst_stl_string(int32_t argn, Dst *argv, Dst *ret) { int32_t i; DstBuffer b; dst_buffer_init(&b, 0); for (i = 0; i < argn; ++i) { int32_t len; const uint8_t *str = dst_to_string(argv[i]); len = dst_string_length(str); dst_buffer_push_bytes(&b, str, len); } *ret = dst_stringv(b.data, b.count); dst_buffer_deinit(&b); return 0; } int dst_stl_asm(int32_t argn, Dst *argv, Dst *ret) { DstAssembleOptions opts; DstAssembleResult res; if (argn < 1) { *ret = dst_cstringv("expected assembly source"); return 1; } opts.source = argv[0]; opts.flags = 0; res = dst_asm(opts); if (res.status == DST_ASSEMBLE_OK) { *ret = dst_wrap_function(dst_asm_func(res)); return 0; } else { *ret = dst_wrap_string(res.error); return 1; } } int dst_stl_disasm(int32_t argn, Dst *argv, Dst *ret) { DstFunction *f; if (argn < 1 || !dst_checktype(argv[0], DST_FUNCTION)) { *ret = dst_cstringv("expected function"); return 1; } f = dst_unwrap_function(argv[0]); *ret = dst_disasm(f->def); return 0; } int dst_stl_tuple(int32_t argn, Dst *argv, Dst *ret) { *ret = dst_wrap_tuple(dst_tuple_n(argv, argn)); return 0; } int dst_stl_array(int32_t argn, Dst *argv, Dst *ret) { DstArray *array = dst_array(argn); array->count = argn; memcpy(array->data, argv, argn * sizeof(Dst)); *ret = dst_wrap_array(array); return 0; } int dst_stl_table(int32_t argn, Dst *argv, Dst *ret) { int32_t i; DstTable *table = dst_table(argn >> 1); if (argn & 1) { *ret = dst_cstringv("expected even number of arguments"); return 1; } for (i = 0; i < argn; i += 2) { dst_table_put(table, argv[i], argv[i + 1]); } *ret = dst_wrap_table(table); return 0; } int dst_stl_struct(int32_t argn, Dst *argv, Dst *ret) { int32_t i; DstKV *st = dst_struct_begin(argn >> 1); if (argn & 1) { *ret = dst_cstringv("expected even number of arguments"); return 1; } for (i = 0; i < argn; i += 2) { dst_struct_put(st, argv[i], argv[i + 1]); } *ret = dst_wrap_struct(dst_struct_end(st)); return 0; } int dst_stl_fiber(int32_t argn, Dst *argv, Dst *ret) { DstFiber *fiber; if (argn < 1) { *ret = dst_cstringv("expected at least one argument"); return 1; } if (!dst_checktype(argv[0], DST_FUNCTION)) { *ret = dst_cstringv("expected a function"); return 1; } fiber = dst_fiber(64); dst_fiber_funcframe(fiber, dst_unwrap_function(argv[0])); fiber->parent = dst_vm_fiber; *ret = dst_wrap_fiber(fiber); return 0; } int dst_stl_buffer(int32_t argn, Dst *argv, Dst *ret) { DstBuffer *buffer = dst_buffer(10); int32_t i; for (i = 0; i < argn; ++i) { const uint8_t *bytes = dst_to_string(argv[i]); int32_t len = dst_string_length(bytes); dst_buffer_push_bytes(buffer, bytes, len); } *ret = dst_wrap_buffer(buffer); return 0; } int dst_stl_gensym(int32_t argn, Dst *argv, Dst *ret) { if (argn > 1) { *ret = dst_cstringv("expected one argument"); return 1; } if (argn == 0) { *ret = dst_wrap_symbol(dst_symbol_gen(NULL, 0)); } else { const uint8_t *s = dst_to_string(argv[0]); *ret = dst_wrap_symbol(dst_symbol_gen(s, dst_string_length(s))); } return 0; } int dst_stl_length(int32_t argn, Dst *argv, Dst *ret) { if (argn != 1) { *ret = dst_cstringv("expected at least 1 argument"); return 1; } *ret = dst_wrap_integer(dst_length(argv[0])); return 0; } int dst_stl_get(int32_t argn, Dst *argv, Dst *ret) { int32_t i; Dst ds; if (argn < 1) { *ret = dst_cstringv("expected at least 1 argument"); return 1; } ds = argv[0]; for (i = 1; i < argn; i++) { ds = dst_get(ds, argv[i]); if (dst_checktype(ds, DST_NIL)) break; } *ret = ds; return 0; } int dst_stl_status(int32_t argn, Dst *argv, Dst *ret) { const char *status; if (argn != 1) { *ret = dst_cstringv("expected 1 argument"); return 1; } if (!dst_checktype(argv[0], DST_FIBER)) { *ret = dst_cstringv("expected fiber"); return 1; } switch(dst_unwrap_fiber(argv[0])->status) { case DST_FIBER_PENDING: status = "pending"; break; case DST_FIBER_NEW: status = "new"; break; case DST_FIBER_ALIVE: status = "alive"; break; case DST_FIBER_DEAD: status = "dead"; break; case DST_FIBER_ERROR: status = "error"; break; } *ret = dst_cstringv(status); return 0; } int dst_stl_put(int32_t argn, Dst *argv, Dst *ret) { Dst ds, key, value; if (argn < 3) { *ret = dst_cstringv("expected at least 3 arguments"); return 1; } if (dst_stl_get(argn - 2, argv, ret)) { return 1; } ds = *ret; key = argv[argn - 2]; value = argv[argn - 1]; dst_put(ds, key, value); return 0; } static int dst_stl_equal(int32_t argn, Dst *argv, Dst *ret) { int32_t i; for (i = 0; i < argn - 1; i++) { if (!dst_equals(argv[i], argv[i+1])) { *ret = dst_wrap_false(); return 0; } } *ret = dst_wrap_true(); return 0; } static int dst_stl_notequal(int32_t argn, Dst *argv, Dst *ret) { int32_t i; for (i = 0; i < argn - 1; i++) { if (dst_equals(argv[i], argv[i+1])) { *ret = dst_wrap_false(); return 0; } } *ret = dst_wrap_true(); return 0; } static int dst_stl_not(int32_t argn, Dst *argv, Dst *ret) { *ret = dst_wrap_boolean(argn == 0 || !dst_truthy(argv[0])); return 0; } #define DST_DEFINE_COMPARATOR(name, pred)\ static int dst_stl_##name(int32_t argn, Dst *argv, Dst *ret) {\ int32_t i;\ for (i = 0; i < argn - 1; i++) {\ if (dst_compare(argv[i], argv[i+1]) pred) {\ *ret = dst_wrap_false();\ return 0;\ }\ }\ *ret = dst_wrap_true();\ return 0;\ } DST_DEFINE_COMPARATOR(ascending, >= 0) DST_DEFINE_COMPARATOR(descending, <= 0) DST_DEFINE_COMPARATOR(notdescending, > 0) DST_DEFINE_COMPARATOR(notascending, < 0) static DstReg stl[] = { {"int", dst_int}, {"real", dst_real}, {"print", dst_stl_print}, {"describe", dst_stl_describe}, {"string", dst_stl_string}, {"table", dst_stl_table}, {"array", dst_stl_array}, {"tuple", dst_stl_tuple}, {"struct", dst_stl_struct}, {"fiber", dst_stl_fiber}, {"status", dst_stl_status}, {"buffer", dst_stl_buffer}, {"gensym", dst_stl_gensym}, {"asm", dst_stl_asm}, {"disasm", dst_stl_disasm}, {"get", dst_stl_get}, {"put", dst_stl_put}, {"length", dst_stl_length}, {"+", dst_add}, {"-", dst_subtract}, {"*", dst_multiply}, {"/", dst_divide}, {"%", dst_modulo}, {"cos", dst_cos}, {"sin", dst_sin}, {"tan", dst_tan}, {"acos", dst_acos}, {"asin", dst_asin}, {"atan", dst_atan}, {"exp", dst_exp}, {"log", dst_log}, {"log10", dst_log10}, {"sqrt", dst_sqrt}, {"floor", dst_floor}, {"ceil", dst_ceil}, {"pow", dst_pow}, {"=", dst_stl_equal}, {"not=", dst_stl_notequal}, {"<", dst_stl_ascending}, {">", dst_stl_descending}, {"<=", dst_stl_notdescending}, {">=", dst_stl_notascending}, {"|", dst_bor}, {"&", dst_band}, {"^", dst_bxor}, {">>", dst_lshift}, {"<<", dst_rshift}, {">>>", dst_lshiftu}, {"not", dst_stl_not}, {"fopen", dst_stl_fileopen}, {"fclose", dst_stl_fileclose}, {"fwrite", dst_stl_filewrite}, {"fread", dst_stl_fileread}, {"exit!", dst_stl_exit} }; Dst dst_loadstl(int flags) { Dst ret = dst_loadreg(stl, sizeof(stl)/sizeof(DstReg)); if (flags & DST_LOAD_ROOT) { dst_gcroot(ret); } if (dst_checktype(ret, DST_TABLE)) { DstTable *v = dst_table(1); dst_table_put(v, dst_csymbolv("value"), ret); dst_put(ret, dst_csymbolv("_env"), dst_wrap_table(v)); } return ret; }