/* * Copyright (c) 2024 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. */ #ifndef JANET_AMALG #include "features.h" #include #include "sysir.h" #include "util.h" #include "vector.h" #endif static const JanetPrimName prim_names[] = { {"array", JANET_PRIM_ARRAY}, {"boolean", JANET_PRIM_BOOLEAN}, {"f32", JANET_PRIM_F32}, {"f64", JANET_PRIM_F64}, {"pointer", JANET_PRIM_POINTER}, {"s16", JANET_PRIM_S16}, {"s32", JANET_PRIM_S32}, {"s64", JANET_PRIM_S64}, {"s8", JANET_PRIM_S8}, {"struct", JANET_PRIM_STRUCT}, {"u16", JANET_PRIM_U16}, {"u32", JANET_PRIM_U32}, {"u64", JANET_PRIM_U64}, {"u8", JANET_PRIM_U8}, {"union", JANET_PRIM_UNION}, {"void", JANET_PRIM_VOID}, }; const char *prim_to_prim_name[] = { "u8", "s8", "u16", "s16", "u32", "s32", "u64", "s64", "f32", "f64", "pointer", "boolean", "struct", "union", "array", "void", "unknown" }; /* Map sysops to names */ const char *janet_sysop_names[] = { "link-name", /* JANET_SYSOP_LINK_NAME */ "parameter-count", /* JANET_SYSOP_PARAMETER_COUNT */ "move", /* JANET_SYSOP_MOVE */ "cast", /* JANET_SYSOP_CAST */ "add", /* JANET_SYSOP_ADD */ "subtract", /* JANET_SYSOP_SUBTRACT */ "multiply", /* JANET_SYSOP_MULTIPLY */ "divide", /* JANET_SYSOP_DIVIDE */ "band", /* JANET_SYSOP_BAND */ "bor", /* JANET_SYSOP_BOR */ "bxor", /* JANET_SYSOP_BXOR */ "bnot", /* JANET_SYSOP_BNOT */ "shl", /* JANET_SYSOP_SHL */ "shr", /* JANET_SYSOP_SHR */ "load", /* JANET_SYSOP_LOAD */ "store", /* JANET_SYSOP_STORE */ "gt", /* JANET_SYSOP_GT */ "lt", /* JANET_SYSOP_LT */ "eq", /* JANET_SYSOP_EQ */ "neq", /* JANET_SYSOP_NEQ */ "gte", /* JANET_SYSOP_GTE */ "lte", /* JANET_SYSOP_LTE */ "call", /* JANET_SYSOP_CALL */ "syscall", /* JANET_SYSOP_SYSCALL */ "return", /* JANET_SYSOP_RETURN */ "jump", /* JANET_SYSOP_JUMP */ "branch", /* JANET_SYSOP_BRANCH */ "branch_not", /* JANET_SYSOP_BRANCH_NOT */ "address", /* JANET_SYSOP_ADDRESS */ "type-primitive", /* JANET_SYSOP_TYPE_PRIMITIVE */ "type-struct", /* JANET_SYSOP_TYPE_STRUCT */ "type-bind", /* JANET_SYSOP_TYPE_BIND */ "arg", /* JANET_SYSOP_ARG */ "field-getp", /* JANET_SYSOP_FIELD_GETP */ "array-getp", /* JANET_SYSOP_ARRAY_GETP */ "array-pgetp", /* JANET_SYSOP_ARRAY_PGETP */ "type-pointer", /* JANET_SYSOP_TYPE_POINTER */ "type-array", /* JANET_SYSOP_TYPE_ARRAY */ "type-union", /* JANET_SYSOP_TYPE_UNION */ "pointer-add", /* JANET_SYSOP_POINTER_ADD */ "pointer-subtract", /* JANET_SYSOP_POINTER_SUBTRACT */ "label", /* JANET_SYSOP_LABEL */ }; static const char *calling_convention_names[] = { "default", /* JANET_SYS_CC_DEFAULT */ "syscall", /* JANET_SYS_CC_SYSCALL */ "cdecl", /* JANET_SYS_CC_X86_CDECL */ "stdcall", /* JANET_SYS_CC_X86_STDCALL */ "fastcall", /* JANET_SYS_CC_X86_FASTCALL */ "sysv", /* JANET_SYS_CC_X64_SYSV */ "sysv-syscall", /* JANET_SYS_CC_X64_SYSV_SYSCALL */ "windows-x64", /* JANET_SYS_CC_X64_WINDOWS */ }; typedef struct { const char *name; JanetSysCallingConvention cc; } JanetSysCCName; static JanetSysCCName sys_calling_convention_names[] = { {"cdecl", JANET_SYS_CC_X86_CDECL}, {"default", JANET_SYS_CC_DEFAULT}, {"fastcall", JANET_SYS_CC_X86_FASTCALL}, {"stdcall", JANET_SYS_CC_X86_STDCALL}, {"syscall", JANET_SYS_CC_SYSCALL}, {"sysv", JANET_SYS_CC_X64_SYSV}, {"sysv-syscall", JANET_SYS_CC_X64_SYSV_SYSCALL}, {"windows-x64", JANET_SYS_CC_X64_WINDOWS}, }; typedef struct { const char *name; JanetSysOp op; } JanetSysInstrName; static const JanetSysInstrName sys_op_names[] = { {"add", JANET_SYSOP_ADD}, {"address", JANET_SYSOP_ADDRESS}, {"agetp", JANET_SYSOP_ARRAY_GETP}, {"apgetp", JANET_SYSOP_ARRAY_PGETP}, {"band", JANET_SYSOP_BAND}, {"bind", JANET_SYSOP_TYPE_BIND}, {"bnot", JANET_SYSOP_BNOT}, {"bor", JANET_SYSOP_BOR}, {"branch", JANET_SYSOP_BRANCH}, {"branch-not", JANET_SYSOP_BRANCH_NOT}, {"bxor", JANET_SYSOP_BXOR}, {"call", JANET_SYSOP_CALL}, {"cast", JANET_SYSOP_CAST}, {"divide", JANET_SYSOP_DIVIDE}, {"eq", JANET_SYSOP_EQ}, {"fgetp", JANET_SYSOP_FIELD_GETP}, {"gt", JANET_SYSOP_GT}, {"gte", JANET_SYSOP_GTE}, {"jump", JANET_SYSOP_JUMP}, {"label", JANET_SYSOP_LABEL}, {"link-name", JANET_SYSOP_LINK_NAME}, {"load", JANET_SYSOP_LOAD}, {"lt", JANET_SYSOP_LT}, {"lte", JANET_SYSOP_LTE}, {"move", JANET_SYSOP_MOVE}, {"multiply", JANET_SYSOP_MULTIPLY}, {"neq", JANET_SYSOP_NEQ}, {"parameter-count", JANET_SYSOP_PARAMETER_COUNT}, {"pointer-add", JANET_SYSOP_POINTER_ADD}, {"pointer-subtract", JANET_SYSOP_POINTER_SUBTRACT}, {"return", JANET_SYSOP_RETURN}, {"shl", JANET_SYSOP_SHL}, {"shr", JANET_SYSOP_SHR}, {"store", JANET_SYSOP_STORE}, {"subtract", JANET_SYSOP_SUBTRACT}, {"syscall", JANET_SYSOP_SYSCALL}, {"type-array", JANET_SYSOP_TYPE_ARRAY}, {"type-pointer", JANET_SYSOP_TYPE_POINTER}, {"type-prim", JANET_SYSOP_TYPE_PRIMITIVE}, {"type-struct", JANET_SYSOP_TYPE_STRUCT}, {"type-union", JANET_SYSOP_TYPE_UNION}, }; /* Utilities */ static JanetString *table_to_string_array(JanetTable *strings_to_indices, int32_t count) { if (0 == count) { return NULL; } janet_assert(count > 0, "bad count"); JanetString *strings = janet_malloc(count * sizeof(JanetString)); for (int32_t i = 0; i < count; i++) { strings[i] = NULL; } for (int32_t i = 0; i < strings_to_indices->capacity; i++) { JanetKV *kv = strings_to_indices->data + i; if (!janet_checktype(kv->key, JANET_NIL)) { uint32_t index = (uint32_t) janet_unwrap_number(kv->value); janet_assert(index < (uint32_t) count, "bad index"); strings[index] = janet_unwrap_string(kv->key); } } return strings; } /* Parse assembly */ static void instr_assert_length(JanetTuple tup, int32_t len, Janet x) { if (janet_tuple_length(tup) != len) { janet_panicf("expected instruction of length %d, got %p", len, x); } } static void instr_assert_min_length(JanetTuple tup, int32_t minlen, Janet x) { if (janet_tuple_length(tup) < minlen) { janet_panicf("expected instruction of at least length %d, got %p", minlen, x); } } static void instr_assert_max_length(JanetTuple tup, int32_t maxlen, Janet x) { if (janet_tuple_length(tup) > maxlen) { janet_panicf("expected instruction of at most length %d, got %p", maxlen, x); } } static uint32_t instr_read_operand(Janet x, JanetSysIR *ir) { if (janet_checktype(x, JANET_SYMBOL)) { Janet check = janet_table_get(ir->register_name_lookup, x); if (janet_checktype(check, JANET_NUMBER)) { return (uint32_t) janet_unwrap_number(check); } else { uint32_t operand = ir->register_count++; janet_table_put(ir->register_name_lookup, x, janet_wrap_number(operand)); return operand; } } if (!janet_checkuint(x)) janet_panicf("expected non-negative integer operand, got %p", x); uint32_t operand = (uint32_t) janet_unwrap_number(x); if (operand >= ir->register_count) { ir->register_count = operand + 1; } return operand; } static uint32_t instr_read_field(Janet x, JanetSysIR *ir) { if (!janet_checkuint(x)) janet_panicf("expected non-negative field index, got %p", x); (void) ir; /* Perhaps support syntax for named fields instead of numbered */ uint32_t operand = (uint32_t) janet_unwrap_number(x); return operand; } static uint64_t instr_read_u64(Janet x, JanetSysIR *ir) { if (!janet_checkuint64(x)) janet_panicf("expected unsigned 64 bit integer, got %p", x); (void) ir; return janet_getuinteger64(&x, 0); } typedef enum { READ_TYPE_REFERENCE, READ_TYPE_DEFINITION, READ_TYPE_FORWARD_REF, } ReadOpMode; static uint32_t instr_read_type_operand(Janet x, JanetSysIR *ir, ReadOpMode rmode) { JanetSysIRLinkage *linkage = ir->linkage; if (janet_checktype(x, JANET_SYMBOL)) { Janet check = janet_table_get(linkage->type_name_lookup, x); if (janet_checktype(check, JANET_NUMBER)) { double n = janet_unwrap_number(check); if (n < 0) { if (rmode == READ_TYPE_DEFINITION) { janet_table_put(linkage->type_name_lookup, x, janet_wrap_number(-n - 1)); } return (uint32_t)(-n - 1); } if (rmode == READ_TYPE_DEFINITION) { janet_panicf("cannot redefine type %p", x); } return (uint32_t) n; } else if (rmode == READ_TYPE_FORWARD_REF) { uint32_t operand = linkage->type_def_count++; janet_table_put(linkage->type_name_lookup, x, janet_wrap_number(-operand - 1)); return operand; } else if (rmode == READ_TYPE_DEFINITION) { uint32_t operand = linkage->type_def_count++; janet_table_put(linkage->type_name_lookup, x, janet_wrap_number(operand)); return operand; } else { janet_panicf("unknown type %p", x); } } if (!janet_checkuint(x)) janet_panicf("expected non-negative integer operand, got %p", x); uint32_t operand = (uint32_t) janet_unwrap_number(x); if (operand >= linkage->type_def_count) { linkage->type_def_count = operand + 1; } return operand; } static uint32_t instr_read_operand_or_const(Janet x, JanetSysIR *ir) { if (janet_checktype(x, JANET_TUPLE)) { JanetSysConstant jsc; const Janet *tup = janet_unwrap_tuple(x); if (janet_tuple_length(tup) != 2) janet_panicf("expected constant wrapped in tuple, got %p", x); Janet c = tup[1]; jsc.type = instr_read_type_operand(tup[0], ir, READ_TYPE_REFERENCE); jsc.value = c; for (int32_t i = 0; i < janet_v_count(ir->constants); i++) { if (ir->constants[i].type != jsc.type) continue; if (!janet_equals(ir->constants[i].value, c)) continue; /* Found a constant */ return JANET_SYS_CONSTANT_PREFIX + i; } uint32_t index = (uint32_t) janet_v_count(ir->constants); janet_v_push(ir->constants, jsc); return JANET_SYS_CONSTANT_PREFIX + index; } return instr_read_operand(x, ir); } static JanetPrim instr_read_prim(Janet x) { if (!janet_checktype(x, JANET_SYMBOL)) { janet_panicf("expected primitive type, got %p", x); } JanetSymbol sym_type = janet_unwrap_symbol(x); const JanetPrimName *namedata = janet_strbinsearch(prim_names, sizeof(prim_names) / sizeof(prim_names[0]), sizeof(prim_names[0]), sym_type); if (NULL == namedata) { janet_panicf("unknown primitive type %p", x); } return namedata->prim; } static JanetSysCallingConvention instr_read_cc(Janet x) { if (!janet_checktype(x, JANET_KEYWORD)) { janet_panicf("expected calling convention keyword, got %p", x); } JanetKeyword cc_name = janet_unwrap_keyword(x); const JanetSysCCName *namedata = janet_strbinsearch(sys_calling_convention_names, sizeof(sys_calling_convention_names) / sizeof(sys_calling_convention_names[0]), sizeof(sys_calling_convention_names[0]), cc_name); if (NULL == namedata) { janet_panicf("unknown calling convention %p", x); } return namedata->cc; } static uint32_t instr_read_label(JanetSysIR *sysir, Janet x) { uint32_t ret = 0; Janet check = janet_table_get(sysir->labels, x); if (janet_checktype(check, JANET_NIL)) { ret = sysir->label_count++; janet_table_put(sysir->labels, x, janet_wrap_number(ret)); } else { ret = (uint32_t) janet_unwrap_number(check); } return ret; } static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instructions) { JanetSysInstruction *ir = NULL; JanetTable *labels = out->labels; int found_parameter_count = 0; /* Parse instructions */ Janet x = janet_wrap_nil(); for (int32_t i = 0; i < instructions.len; i++) { x = instructions.items[i]; /* Shorthand for labels */ if (janet_checktype(x, JANET_KEYWORD)) { /* Check for existing label */ JanetSysInstruction instruction; instruction.opcode = JANET_SYSOP_LABEL; instruction.line = -1; instruction.column = -1; instruction.label.id = instr_read_label(out, x); Janet label_id = janet_wrap_number(instruction.label.id); Janet check_defined = janet_table_get(labels, label_id); if (janet_checktype(check_defined, JANET_NIL)) { janet_table_put(labels, label_id, x); } else { janet_panicf("label %v already defined", x); } janet_v_push(ir, instruction); continue; } if (!janet_checktype(x, JANET_TUPLE)) { janet_panicf("expected instruction to be tuple, got %p", x); } JanetTuple tuple = janet_unwrap_tuple(x); if (janet_tuple_length(tuple) < 1) { janet_panic("invalid instruction, no opcode"); } int32_t line = janet_tuple_sm_line(tuple); int32_t column = janet_tuple_sm_column(tuple); Janet opvalue = tuple[0]; if (!janet_checktype(opvalue, JANET_SYMBOL)) { janet_panicf("expected opcode symbol, found %p", opvalue); } JanetSymbol opsymbol = janet_unwrap_symbol(opvalue); const JanetSysInstrName *namedata = janet_strbinsearch(sys_op_names, sizeof(sys_op_names) / sizeof(sys_op_names[0]), sizeof(sys_op_names[0]), opsymbol); if (NULL == namedata) { janet_panicf("unknown instruction %.4p", x); } JanetSysOp opcode = namedata->op; JanetSysInstruction instruction; instruction.opcode = opcode; instruction.line = line; instruction.column = column; switch (opcode) { case JANET_SYSOP_ARG: janet_assert(0, "not reachable"); break; case JANET_SYSOP_LINK_NAME: instr_assert_length(tuple, 2, opvalue); if (out->link_name) { janet_panicf("cannot rename function %s", out->link_name); } out->link_name = janet_getstring(tuple, 1); break; case JANET_SYSOP_PARAMETER_COUNT: instr_assert_length(tuple, 2, opvalue); if (found_parameter_count) { janet_panic("duplicate parameter-count"); } found_parameter_count = 1; out->parameter_count = janet_getnat(tuple, 1); break; case JANET_SYSOP_ADD: case JANET_SYSOP_SUBTRACT: case JANET_SYSOP_MULTIPLY: case JANET_SYSOP_DIVIDE: case JANET_SYSOP_BAND: case JANET_SYSOP_BOR: case JANET_SYSOP_BXOR: case JANET_SYSOP_SHL: case JANET_SYSOP_SHR: case JANET_SYSOP_GT: case JANET_SYSOP_GTE: case JANET_SYSOP_LT: case JANET_SYSOP_LTE: case JANET_SYSOP_EQ: case JANET_SYSOP_NEQ: case JANET_SYSOP_POINTER_ADD: case JANET_SYSOP_POINTER_SUBTRACT: instr_assert_length(tuple, 4, opvalue); instruction.three.dest = instr_read_operand(tuple[1], out); instruction.three.lhs = instr_read_operand_or_const(tuple[2], out); instruction.three.rhs = instr_read_operand_or_const(tuple[3], out); janet_v_push(ir, instruction); break; case JANET_SYSOP_ARRAY_GETP: case JANET_SYSOP_ARRAY_PGETP: instr_assert_length(tuple, 4, opvalue); instruction.three.dest = instr_read_operand(tuple[1], out); instruction.three.lhs = instr_read_operand(tuple[2], out); instruction.three.rhs = instr_read_operand_or_const(tuple[3], out); janet_v_push(ir, instruction); break; case JANET_SYSOP_CALL: case JANET_SYSOP_SYSCALL: instr_assert_min_length(tuple, 4, opvalue); instruction.call.calling_convention = instr_read_cc(tuple[1]); instruction.call.flags = 0; if (janet_checktype(tuple[2], JANET_NIL)) { instruction.call.dest = 0; } else { instruction.call.dest = instr_read_operand(tuple[2], out); instruction.call.flags |= JANET_SYS_CALLFLAG_HAS_DEST; } instruction.call.arg_count = janet_tuple_length(tuple) - 4; instruction.call.callee = instr_read_operand_or_const(tuple[3], out); janet_v_push(ir, instruction); for (int32_t j = 4; j < janet_tuple_length(tuple); j += 3) { JanetSysInstruction arginstr; arginstr.opcode = JANET_SYSOP_ARG; arginstr.line = line; arginstr.column = column; arginstr.arg.args[0] = 0xcafe; arginstr.arg.args[1] = 0xcafe; arginstr.arg.args[2] = 0xcafe; int32_t remaining = janet_tuple_length(tuple) - j; if (remaining > 3) remaining = 3; for (int32_t k = 0; k < remaining; k++) { arginstr.arg.args[k] = instr_read_operand_or_const(tuple[j + k], out); } janet_v_push(ir, arginstr); } break; case JANET_SYSOP_LOAD: case JANET_SYSOP_STORE: case JANET_SYSOP_MOVE: case JANET_SYSOP_CAST: case JANET_SYSOP_BNOT: case JANET_SYSOP_ADDRESS: instr_assert_length(tuple, 3, opvalue); instruction.two.dest = instr_read_operand(tuple[1], out); instruction.two.src = instr_read_operand_or_const(tuple[2], out); janet_v_push(ir, instruction); break; case JANET_SYSOP_FIELD_GETP: instr_assert_length(tuple, 4, opvalue); instruction.field.r = instr_read_operand(tuple[1], out); instruction.field.st = instr_read_operand(tuple[2], out); instruction.field.field = instr_read_field(tuple[3], out); janet_v_push(ir, instruction); break; case JANET_SYSOP_RETURN: instr_assert_max_length(tuple, 2, opvalue); if (janet_tuple_length(tuple) == 2) { instruction.ret.value = instr_read_operand_or_const(tuple[1], out); instruction.ret.has_value = 1; } else { instruction.ret.has_value = 0; } janet_v_push(ir, instruction); break; case JANET_SYSOP_BRANCH: case JANET_SYSOP_BRANCH_NOT: instr_assert_length(tuple, 3, opvalue); instruction.branch.cond = instr_read_operand_or_const(tuple[1], out); instruction.branch.to = instr_read_label(out, tuple[2]); janet_v_push(ir, instruction); break; case JANET_SYSOP_JUMP: instr_assert_length(tuple, 2, opvalue); instruction.jump.to = instr_read_label(out, tuple[1]); janet_v_push(ir, instruction); break; case JANET_SYSOP_TYPE_PRIMITIVE: { instr_assert_length(tuple, 3, opvalue); instruction.type_prim.dest_type = instr_read_type_operand(tuple[1], out, READ_TYPE_DEFINITION); instruction.type_prim.prim = instr_read_prim(tuple[2]); janet_v_push(ir, instruction); break; } case JANET_SYSOP_TYPE_POINTER: { instr_assert_length(tuple, 3, opvalue); instruction.pointer.dest_type = instr_read_type_operand(tuple[1], out, READ_TYPE_DEFINITION); instruction.pointer.type = instr_read_type_operand(tuple[2], out, READ_TYPE_FORWARD_REF); janet_v_push(ir, instruction); break; } case JANET_SYSOP_TYPE_ARRAY: { instr_assert_length(tuple, 4, opvalue); instruction.array.dest_type = instr_read_type_operand(tuple[1], out, READ_TYPE_DEFINITION); instruction.array.type = instr_read_type_operand(tuple[2], out, READ_TYPE_REFERENCE); instruction.array.fixed_count = instr_read_u64(tuple[3], out); janet_v_push(ir, instruction); break; } case JANET_SYSOP_TYPE_STRUCT: case JANET_SYSOP_TYPE_UNION: { instr_assert_min_length(tuple, 1, opvalue); instruction.type_types.dest_type = instr_read_type_operand(tuple[1], out, READ_TYPE_DEFINITION); instruction.type_types.arg_count = janet_tuple_length(tuple) - 2; janet_v_push(ir, instruction); for (int32_t j = 2; j < janet_tuple_length(tuple); j += 3) { JanetSysInstruction arginstr; arginstr.opcode = JANET_SYSOP_ARG; arginstr.line = line; arginstr.column = column; arginstr.arg.args[0] = 0; arginstr.arg.args[1] = 0; arginstr.arg.args[2] = 0; int32_t remaining = janet_tuple_length(tuple) - j; if (remaining > 3) remaining = 3; for (int32_t k = 0; k < remaining; k++) { arginstr.arg.args[k] = instr_read_type_operand(tuple[j + k], out, READ_TYPE_REFERENCE); } janet_v_push(ir, arginstr); } break; } case JANET_SYSOP_TYPE_BIND: { instr_assert_length(tuple, 3, opvalue); instruction.type_bind.dest = instr_read_operand(tuple[1], out); instruction.type_bind.type = instr_read_type_operand(tuple[2], out, READ_TYPE_REFERENCE); janet_v_push(ir, instruction); break; } case JANET_SYSOP_LABEL: { instr_assert_length(tuple, 2, opvalue); Janet x = tuple[1]; if (!janet_checktype(x, JANET_KEYWORD)) { janet_panicf("expected keyword label, got %p", x); } instruction.label.id = instr_read_label(out, x); Janet label_id = janet_wrap_number(instruction.label.id); Janet check_defined = janet_table_get(labels, label_id); if (janet_checktype(check_defined, JANET_NIL)) { janet_table_put(labels, label_id, janet_wrap_number(janet_v_count(ir))); } else { janet_panicf("label %v already defined", x); } janet_v_push(ir, instruction); break; } } } uint32_t ircount = (uint32_t) janet_v_count(ir); out->instructions = janet_v_flatten(ir); out->instruction_count = ircount; /* Types only */ if (!out->link_name) { if (out->register_count) { janet_panic("cannot have runtime instructions in this context"); } if (out->parameter_count) { janet_panic("cannot have parameters in this context"); } if (out->constant_count) { janet_panic("cannot have constants in this context"); } out->constants = NULL; out->constant_count = 0; return; } /* Check last instruction is jump or return */ if (ircount == 0) { janet_panic("empty ir"); } int32_t lasti = ircount - 1; if ((ir[lasti].opcode != JANET_SYSOP_JUMP) && (ir[lasti].opcode != JANET_SYSOP_RETURN)) { janet_panicf("last instruction must be jump or return, got %p", x); } /* Check for valid number of function parameters */ if (out->parameter_count > out->register_count) { janet_panicf("too many parameters, only %u registers for %u parameters.", out->register_count, out->parameter_count); } /* Build constants */ out->constant_count = janet_v_count(out->constants); out->constants = janet_v_flatten(out->constants); } /* Get a type index given an operand */ uint32_t janet_sys_optype(JanetSysIR *ir, uint32_t op) { if (op <= JANET_SYS_MAX_OPERAND) { return ir->types[op]; } else { if (op - JANET_SYS_CONSTANT_PREFIX >= ir->constant_count) { janet_panic("invalid constant"); } return ir->constants[op - JANET_SYS_CONSTANT_PREFIX].type; } } uint32_t *janet_sys_callargs(JanetSysInstruction *instr, uint32_t *count) { uint32_t arg_count = 0; if (instr->opcode == JANET_SYSOP_CALL) { arg_count = instr->call.arg_count; } else if (instr->opcode == JANET_SYSOP_SYSCALL) { arg_count = instr->call.arg_count; } else if (instr->opcode == JANET_SYSOP_TYPE_UNION) { arg_count = instr->type_types.arg_count; } else if (instr->opcode == JANET_SYSOP_TYPE_STRUCT) { arg_count = instr->type_types.arg_count; } else { janet_assert(0, "bad callargs"); } uint32_t *args = janet_smalloc(sizeof(uint32_t) * arg_count); for (uint32_t i = 0; i < arg_count; i++) { uint32_t instr_index = 1 + i / 3; uint32_t sub_index = i % 3; args[i] = instr[instr_index].arg.args[sub_index]; } if (count != NULL) *count = arg_count; return args; } /* Get a printable representation of a type on type failure */ static Janet tname(JanetSysIR *ir, uint32_t typeid) { JanetSysIRLinkage *linkage = ir->linkage; JanetString name = linkage->type_names[typeid]; if (NULL != name) { return janet_wrap_string(name); } return janet_wrap_string(janet_formatc("type-id:%d", typeid)); } static void tcheck_redef(JanetSysIR *ir, uint32_t typeid) { JanetSysIRLinkage *linkage = ir->linkage; if (linkage->type_defs[typeid].prim != JANET_PRIM_UNKNOWN) { janet_panicf("in %p, cannot redefine type %V", ir->error_ctx, tname(ir, typeid)); } } /* Build up type tables */ static void janet_sysir_init_types(JanetSysIR *ir) { JanetSysIRLinkage *linkage = ir->linkage; JanetSysTypeField *fields = NULL; JanetSysTypeInfo *type_defs = janet_realloc(linkage->type_defs, sizeof(JanetSysTypeInfo) * (linkage->type_def_count)); uint32_t field_offset = linkage->field_def_count; uint32_t *types = janet_malloc(sizeof(uint32_t) * ir->register_count); linkage->type_defs = type_defs; ir->types = types; for (uint32_t i = 0; i < ir->register_count; i++) { ir->types[i] = 0; } for (uint32_t i = linkage->old_type_def_count; i < linkage->type_def_count; i++) { type_defs[i].prim = JANET_PRIM_UNKNOWN; } linkage->old_type_def_count = linkage->type_def_count; for (uint32_t i = 0; i < ir->instruction_count; i++) { JanetSysInstruction instruction = ir->instructions[i]; switch (instruction.opcode) { default: break; case JANET_SYSOP_TYPE_PRIMITIVE: { uint32_t type_def = instruction.type_prim.dest_type; tcheck_redef(ir, type_def); type_defs[type_def].prim = instruction.type_prim.prim; break; } case JANET_SYSOP_TYPE_STRUCT: case JANET_SYSOP_TYPE_UNION: { uint32_t type_def = instruction.type_types.dest_type; tcheck_redef(ir, type_def); type_defs[type_def].prim = (instruction.opcode == JANET_SYSOP_TYPE_STRUCT) ? JANET_PRIM_STRUCT : JANET_PRIM_UNION; type_defs[type_def].st.field_count = instruction.type_types.arg_count; type_defs[type_def].st.field_start = field_offset + (uint32_t) janet_v_count(fields); uint32_t count = 0; uint32_t *args = janet_sys_callargs(ir->instructions + i, &count); for (uint32_t j = 0; j < count; j++) { JanetSysTypeField field; field.type = args[j]; janet_v_push(fields, field); } janet_sfree(args); break; } case JANET_SYSOP_TYPE_POINTER: { uint32_t type_def = instruction.pointer.dest_type; tcheck_redef(ir, type_def); type_defs[type_def].prim = JANET_PRIM_POINTER; type_defs[type_def].pointer.type = instruction.pointer.type; break; } case JANET_SYSOP_TYPE_ARRAY: { uint32_t type_def = instruction.array.dest_type; tcheck_redef(ir, type_def); type_defs[type_def].prim = JANET_PRIM_ARRAY; type_defs[type_def].array.type = instruction.array.type; type_defs[type_def].array.fixed_count = instruction.array.fixed_count; break; } case JANET_SYSOP_TYPE_BIND: { uint32_t type = instruction.type_bind.type; uint32_t dest = instruction.type_bind.dest; types[dest] = type; break; } } } /* Append new fields to linkage */ if (janet_v_count(fields)) { uint32_t new_field_count = field_offset + janet_v_count(fields); linkage->field_defs = janet_realloc(linkage->field_defs, sizeof(JanetSysTypeField) * new_field_count); memcpy(linkage->field_defs + field_offset, fields, janet_v_count(fields) * sizeof(JanetSysTypeField)); linkage->field_def_count = new_field_count; janet_v_free(fields); } } /* Type checking */ static uint32_t tcheck_array_element(JanetSysIR *sysir, uint32_t t) { JanetSysIRLinkage *linkage = sysir->linkage; /* Dereference at most one pointer */ if (linkage->type_defs[t].prim == JANET_PRIM_POINTER) { t = linkage->type_defs[t].pointer.type; } while (linkage->type_defs[t].prim == JANET_PRIM_ARRAY) { t = linkage->type_defs[t].array.type; } return t; } static void tcheck_boolean(JanetSysIR *sysir, uint32_t t) { JanetSysIRLinkage *linkage = sysir->linkage; if (linkage->type_defs[t].prim != JANET_PRIM_BOOLEAN) { janet_panicf("type failure in %p, expected boolean, got %p", sysir->error_ctx, tname(sysir, t)); } } static void rcheck_boolean(JanetSysIR *sysir, uint32_t reg) { tcheck_boolean(sysir, janet_sys_optype(sysir, reg)); } static void tcheck_array(JanetSysIR *sysir, uint32_t t) { JanetSysIRLinkage *linkage = sysir->linkage; if (linkage->type_defs[t].prim != JANET_PRIM_ARRAY) { janet_panicf("type failure in %p, expected array, got %p", sysir->error_ctx, tname(sysir, t)); } } static void tcheck_number(JanetSysIR *sysir, uint32_t t) { JanetSysIRLinkage *linkage = sysir->linkage; JanetPrim t1 = linkage->type_defs[t].prim; if (t1 == JANET_PRIM_BOOLEAN || t1 == JANET_PRIM_POINTER || t1 == JANET_PRIM_UNION || t1 == JANET_PRIM_STRUCT || t1 == JANET_PRIM_ARRAY) { janet_panicf("type failure in %p, expected numeric type, got %p", sysir->error_ctx, tname(sysir, t1)); } } static void tcheck_number_or_pointer(JanetSysIR *sysir, uint32_t t) { JanetSysIRLinkage *linkage = sysir->linkage; JanetPrim t1 = linkage->type_defs[t].prim; if (t1 == JANET_PRIM_BOOLEAN || t1 == JANET_PRIM_UNION || t1 == JANET_PRIM_STRUCT || t1 == JANET_PRIM_ARRAY) { janet_panicf("type failure in %p, expected pointer or numeric type, got %p", sysir->error_ctx, tname(sysir, t1)); } } static void rcheck_number_or_pointer(JanetSysIR *sysir, uint32_t reg) { tcheck_number_or_pointer(sysir, janet_sys_optype(sysir, reg)); } static void tcheck_integer(JanetSysIR *sysir, uint32_t t) { JanetSysIRLinkage *linkage = sysir->linkage; JanetPrim t1 = linkage->type_defs[t].prim; if (t1 != JANET_PRIM_S32 && t1 != JANET_PRIM_S64 && t1 != JANET_PRIM_S16 && t1 != JANET_PRIM_S8 && t1 != JANET_PRIM_U32 && t1 != JANET_PRIM_U64 && t1 != JANET_PRIM_U16 && t1 != JANET_PRIM_U8) { janet_panicf("type failure in %p, expected integer type, got %p", sysir->error_ctx, tname(sysir, t1)); } } static void rcheck_integer(JanetSysIR *sysir, uint32_t reg) { tcheck_integer(sysir, janet_sys_optype(sysir, reg)); } static void tcheck_pointer(JanetSysIR *sysir, uint32_t t) { JanetSysIRLinkage *linkage = sysir->linkage; if (linkage->type_defs[t].prim != JANET_PRIM_POINTER) { janet_panicf("type failure in %p, expected pointer, got %p", sysir->error_ctx, tname(sysir, t)); } } static void rcheck_pointer(JanetSysIR *sysir, uint32_t reg) { tcheck_pointer(sysir, janet_sys_optype(sysir, reg)); } static void rcheck_pointer_equals(JanetSysIR *sysir, uint32_t preg, uint32_t elreg) { JanetSysIRLinkage *linkage = sysir->linkage; uint32_t t1 = janet_sys_optype(sysir, preg); if (linkage->type_defs[t1].prim != JANET_PRIM_POINTER) { janet_panicf("type failure in %p, expected pointer for array, got %p", sysir->error_ctx, tname(sysir, t1)); } uint32_t tp = linkage->type_defs[t1].pointer.type; uint32_t t2 = janet_sys_optype(sysir, elreg); if (t2 != tp) { janet_panicf("type failure in %p, %p is not compatible with a pointer to %p", sysir->error_ctx, tname(sysir, t2), tname(sysir, tp)); } } static void tcheck_struct_or_union(JanetSysIR *sysir, uint32_t t) { JanetSysIRLinkage *linkage = sysir->linkage; JanetPrim prim = linkage->type_defs[t].prim; if (prim != JANET_PRIM_STRUCT && prim != JANET_PRIM_UNION) { janet_panicf("type failure in %p expected struct or union, got %p", sysir->error_ctx, tname(sysir, t)); } } static void rcheck_equal(JanetSysIR *sysir, uint32_t reg1, uint32_t reg2) { if (reg1 == reg2) return; uint32_t t1 = janet_sys_optype(sysir, reg1); uint32_t t2 = janet_sys_optype(sysir, reg2); if (t1 != t2) { janet_panicf("type failure in %p, %p does not match %p", sysir->error_ctx, tname(sysir, t1), tname(sysir, t2)); } } static int tcheck_cast(JanetSysIR *sysir, uint32_t td, uint32_t ts) { JanetSysIRLinkage *linkage = sysir->linkage; if (td == ts) return 0; /* trivial case */ JanetPrim primd = linkage->type_defs[td].prim; JanetPrim prims = linkage->type_defs[ts].prim; if (primd == prims) { /* Pointer casting should be stricter than in C - for now, we * allow casts as long as size and aligment are identical. Also * no casting between arrays and pointers * * TODO - check array and pointer types have same alignment switch (primd) { default: return -1; case JANET_PRIM_ARRAY: return tcheck_cast(sysir, linkage->type_defs[td].array.type, linkage->type_defs[ts].array.type); case JANET_PRIM_POINTER: return tcheck_cast(sysir, linkage->type_defs[td].pointer.type, linkage->type_defs[ts].pointer.type); } return 0; */ return -1; /* TODO */ } /* Check that both src and dest are primitive numerics */ for (int i = 0; i < 2; i++) { JanetPrim p = i ? prims : primd; switch (p) { default: break; case JANET_PRIM_STRUCT: case JANET_PRIM_UNION: case JANET_PRIM_UNKNOWN: case JANET_PRIM_ARRAY: case JANET_PRIM_POINTER: case JANET_PRIM_VOID: return -1; } } return 0; } static void rcheck_cast(JanetSysIR *sysir, uint32_t dest, uint32_t src) { (void) sysir; (void) dest; (void) src; uint32_t td = janet_sys_optype(sysir, dest); uint32_t ts = janet_sys_optype(sysir, src); int notok = tcheck_cast(sysir, td, ts); if (notok) { janet_panicf("type failure in %p, %p cannot be cast to %p", sysir->error_ctx, tname(sysir, ts), tname(sysir, td)); } } static void rcheck_array_getp(JanetSysIR *sysir, uint32_t dest, uint32_t lhs, uint32_t rhs) { uint32_t tlhs = janet_sys_optype(sysir, lhs); uint32_t trhs = janet_sys_optype(sysir, rhs); uint32_t tdest = janet_sys_optype(sysir, dest); tcheck_array(sysir, tlhs); tcheck_integer(sysir, trhs); tcheck_pointer(sysir, tdest); JanetSysIRLinkage *linkage = sysir->linkage; uint32_t dtype = linkage->type_defs[tdest].pointer.type; uint32_t eltype = linkage->type_defs[tlhs].array.type; if (dtype != eltype) { janet_panicf("type failure in %p, %p does not match %p", sysir->error_ctx, tname(sysir, dtype), tname(sysir, eltype)); } } static void rcheck_array_pgetp(JanetSysIR *sysir, uint32_t dest, uint32_t lhs, uint32_t rhs) { uint32_t tlhs = janet_sys_optype(sysir, lhs); uint32_t trhs = janet_sys_optype(sysir, rhs); uint32_t tdest = janet_sys_optype(sysir, dest); tcheck_pointer(sysir, tlhs); tcheck_integer(sysir, trhs); tcheck_pointer(sysir, tdest); JanetSysIRLinkage *linkage = sysir->linkage; uint32_t aptype = linkage->type_defs[tlhs].pointer.type; if (linkage->type_defs[aptype].prim != JANET_PRIM_ARRAY) { janet_panicf("type failure in %p, expected array type but got %p", sysir->error_ctx, tname(sysir, aptype)); } uint32_t dtype = linkage->type_defs[tdest].pointer.type; uint32_t eltype = linkage->type_defs[aptype].array.type; if (dtype != eltype) { janet_panicf("type failure in %p, %p does not match %p", sysir->error_ctx, tname(sysir, dtype), tname(sysir, eltype)); } } static void rcheck_fgetp(JanetSysIR *sysir, uint32_t dest, uint32_t st, uint32_t field) { uint32_t tst = janet_sys_optype(sysir, st); uint32_t tdest = janet_sys_optype(sysir, dest); tcheck_pointer(sysir, dest); tcheck_struct_or_union(sysir, tst); JanetSysIRLinkage *linkage = sysir->linkage; if (field >= linkage->type_defs[tst].st.field_count) { janet_panicf("in %p, invalid field index %u", sysir->error_ctx, field); } uint32_t field_type = linkage->type_defs[tst].st.field_start + field; uint32_t tfield = linkage->field_defs[field_type].type; uint32_t tpdest = linkage->type_defs[tdest].pointer.type; if (tfield != tpdest) { janet_panicf("in %p, field of type %p does not match %p", sysir->error_ctx, tname(sysir, tfield), tname(sysir, tpdest)); } } /* Unlike C, only allow pointer on lhs for addition and subtraction */ static void rcheck_pointer_math(JanetSysIR *sysir, uint32_t dest, uint32_t lhs, uint32_t rhs) { rcheck_pointer_equals(sysir, dest, lhs); rcheck_integer(sysir, rhs); } static JanetString rname(JanetSysIR *sysir, uint32_t regid) { if (regid > JANET_SYS_MAX_OPERAND) { uint32_t id = regid - JANET_SYS_CONSTANT_PREFIX; return janet_formatc("constant:%u[%p]", id, sysir->constants[id]); } JanetString name = sysir->register_names[regid]; if (NULL == name) { return janet_formatc("value[%u]", regid); } return name; } static void janet_sysir_type_check(JanetSysIR *sysir) { /* Assert no unknown types */ JanetSysIRLinkage *linkage = sysir->linkage; for (uint32_t i = 0; i < sysir->register_count; i++) { uint32_t type = sysir->types[i]; JanetSysTypeInfo tinfo = linkage->type_defs[type]; sysir->error_ctx = janet_wrap_number(i); if (tinfo.prim == JANET_PRIM_UNKNOWN) { janet_panicf("in %p, unable to infer type for %s", sysir->error_ctx, rname(sysir, i)); } } int found_return = 0; for (uint32_t i = 0; i < sysir->instruction_count; i++) { JanetSysInstruction instruction = sysir->instructions[i]; sysir->error_ctx = janet_cstringv(janet_sysop_names[instruction.opcode]); switch (instruction.opcode) { case JANET_SYSOP_TYPE_PRIMITIVE: case JANET_SYSOP_TYPE_STRUCT: case JANET_SYSOP_TYPE_UNION: case JANET_SYSOP_TYPE_POINTER: case JANET_SYSOP_TYPE_ARRAY: case JANET_SYSOP_TYPE_BIND: case JANET_SYSOP_ARG: case JANET_SYSOP_LINK_NAME: case JANET_SYSOP_PARAMETER_COUNT: case JANET_SYSOP_JUMP: case JANET_SYSOP_LABEL: break; case JANET_SYSOP_RETURN: { uint32_t ret_type = 0; if (instruction.ret.has_value) { ret_type = sysir->types[instruction.ret.value]; } if (found_return) { if (instruction.ret.has_value && !sysir->has_return_type) { janet_panicf("in %p, void return type not compatible with non-void return type", sysir->error_ctx); } if ((!instruction.ret.has_value) && sysir->has_return_type) { janet_panicf("in %p, void return type not compatible with non-void return type", sysir->error_ctx); } if (sysir->has_return_type && sysir->return_type != ret_type) { janet_panicf("in %p, multiple return types are not allowed: %p and %p", sysir->error_ctx, tname(sysir, ret_type), tname(sysir, sysir->return_type)); } } else { sysir->return_type = ret_type; } sysir->has_return_type = instruction.ret.has_value; found_return = 1; break; } case JANET_SYSOP_MOVE: rcheck_equal(sysir, instruction.two.dest, instruction.two.src); break; case JANET_SYSOP_CAST: rcheck_cast(sysir, instruction.two.dest, instruction.two.src); break; case JANET_SYSOP_POINTER_ADD: case JANET_SYSOP_POINTER_SUBTRACT: rcheck_pointer_math(sysir, instruction.three.dest, instruction.three.lhs, instruction.three.rhs); break; case JANET_SYSOP_ADD: case JANET_SYSOP_SUBTRACT: case JANET_SYSOP_MULTIPLY: case JANET_SYSOP_DIVIDE: tcheck_number(sysir, tcheck_array_element(sysir, sysir->types[instruction.three.dest])); rcheck_equal(sysir, instruction.three.lhs, instruction.three.rhs); rcheck_equal(sysir, instruction.three.dest, instruction.three.lhs); break; case JANET_SYSOP_BAND: case JANET_SYSOP_BOR: case JANET_SYSOP_BXOR: tcheck_integer(sysir, tcheck_array_element(sysir, sysir->types[instruction.three.dest])); rcheck_equal(sysir, instruction.three.lhs, instruction.three.rhs); rcheck_equal(sysir, instruction.three.dest, instruction.three.lhs); break; case JANET_SYSOP_BNOT: tcheck_integer(sysir, tcheck_array_element(sysir, sysir->types[instruction.two.src])); rcheck_equal(sysir, instruction.two.dest, instruction.two.src); break; case JANET_SYSOP_SHL: case JANET_SYSOP_SHR: tcheck_integer(sysir, tcheck_array_element(sysir, sysir->types[instruction.three.lhs])); rcheck_equal(sysir, instruction.three.lhs, instruction.three.rhs); rcheck_equal(sysir, instruction.three.dest, instruction.three.lhs); break; case JANET_SYSOP_LOAD: rcheck_pointer_equals(sysir, instruction.two.src, instruction.two.dest); break; case JANET_SYSOP_STORE: rcheck_pointer_equals(sysir, instruction.two.dest, instruction.two.src); break; case JANET_SYSOP_GT: case JANET_SYSOP_LT: case JANET_SYSOP_EQ: case JANET_SYSOP_NEQ: case JANET_SYSOP_GTE: case JANET_SYSOP_LTE: /* TODO - allow arrays */ rcheck_number_or_pointer(sysir, instruction.three.lhs); rcheck_equal(sysir, instruction.three.lhs, instruction.three.rhs); //rcheck_equal(sysir, instruction.three.dest, instruction.three.lhs); tcheck_boolean(sysir, sysir->types[instruction.three.dest]); break; case JANET_SYSOP_ADDRESS: rcheck_pointer(sysir, sysir->types[instruction.two.dest]); break; case JANET_SYSOP_BRANCH: case JANET_SYSOP_BRANCH_NOT: rcheck_boolean(sysir, instruction.branch.cond); break; case JANET_SYSOP_SYSCALL: rcheck_integer(sysir, instruction.call.callee); break; case JANET_SYSOP_CALL: rcheck_pointer(sysir, instruction.call.callee); break; case JANET_SYSOP_ARRAY_GETP: rcheck_array_getp(sysir, instruction.three.dest, instruction.three.lhs, instruction.three.lhs); break; case JANET_SYSOP_ARRAY_PGETP: rcheck_array_pgetp(sysir, instruction.three.dest, instruction.three.lhs, instruction.three.lhs); break; case JANET_SYSOP_FIELD_GETP: rcheck_fgetp(sysir, instruction.field.r, instruction.field.st, instruction.field.field); break; } } } static void janet_sys_ir_linkage_init(JanetSysIRLinkage *linkage) { linkage->old_type_def_count = 0; linkage->type_def_count = 1; /* first type is always unknown by default */ linkage->field_def_count = 0; linkage->type_defs = NULL; linkage->field_defs = NULL; linkage->type_name_lookup = janet_table(0); linkage->irs = janet_table(0); linkage->ir_ordered = janet_array(0); linkage->type_names = NULL; } static void janet_sys_ir_init(JanetSysIR *out, JanetView instructions, JanetSysIRLinkage *linkage) { JanetSysIR ir; memset(&ir, 0, sizeof(ir)); memset(out, 0, sizeof(*out)); ir.instructions = NULL; ir.types = NULL; ir.constants = NULL; ir.link_name = NULL; ir.register_count = 0; ir.constant_count = 0; ir.return_type = 0; ir.parameter_count = 0; ir.register_name_lookup = janet_table(0); ir.labels = janet_table(0); ir.register_names = NULL; ir.linkage = linkage; ir.parameter_count = 0; ir.link_name = NULL; ir.error_ctx = janet_wrap_nil(); janet_sysir_init_instructions(&ir, instructions); /* Patch up name mapping arrays */ /* TODO - make more efficient, don't rebuild from scratch every time */ if (linkage->type_names) janet_free(linkage->type_names); linkage->type_names = table_to_string_array(linkage->type_name_lookup, linkage->type_def_count); ir.register_names = table_to_string_array(ir.register_name_lookup, ir.register_count); janet_sysir_init_types(&ir); janet_sysir_type_check(&ir); *out = ir; if (ir.link_name != NULL) { janet_table_put(linkage->irs, janet_wrap_string(ir.link_name), janet_wrap_abstract(out)); } janet_array_push(linkage->ir_ordered, janet_wrap_abstract(out)); } /* Lowering to C */ static const char *c_prim_names[] = { "uint8_t", "int8_t", "uint16_t", "int16_t", "uint32_t", "int32_t", "uint64_t", "int64_t", "float", "double", "void *", "bool" }; static void op_or_const(JanetSysIR *ir, JanetBuffer *buf, uint32_t reg) { if (reg < JANET_SYS_MAX_OPERAND) { janet_formatb(buf, "_r%u", reg); } else { uint32_t constant_id = reg - JANET_SYS_CONSTANT_PREFIX; janet_formatb(buf, "%v", ir->constants[constant_id].value); } } static void emit_binop(JanetSysIR *ir, JanetBuffer *buffer, JanetBuffer *tempbuf, JanetSysInstruction instruction, const char *op) { uint32_t operand_type = ir->types[instruction.three.dest]; tempbuf->count = 0; uint32_t index_index = 0; int is_pointer = 0; JanetSysIRLinkage *linkage = ir->linkage; /* Top-level pointer semantics */ if (linkage->type_defs[operand_type].prim == JANET_PRIM_POINTER) { operand_type = linkage->type_defs[operand_type].pointer.type; is_pointer = 1; } /* Add nested for loops for any dimensionality of array */ while (linkage->type_defs[operand_type].prim == JANET_PRIM_ARRAY) { janet_formatb(buffer, " for (size_t _j%u = 0; _j%u < %u; _j%u++) ", index_index, index_index, linkage->type_defs[operand_type].array.fixed_count, index_index); if (is_pointer) { janet_formatb(tempbuf, "->els[_j%u]", index_index); is_pointer = 0; } else { janet_formatb(tempbuf, ".els[_j%u]", index_index); } operand_type = linkage->type_defs[operand_type].array.type; index_index++; } if (is_pointer) { janet_formatb(buffer, " *_r%u = *_r%u %s *_r%u;\n", instruction.three.dest, instruction.three.lhs, op, instruction.three.rhs); janet_formatb(buffer, " *_r%u = *", instruction.three.dest); op_or_const(ir, buffer, instruction.three.lhs); janet_formatb(buffer, " %s ", op); op_or_const(ir, buffer, instruction.three.rhs); janet_formatb(buffer, ";\n"); } else { Janet index_part = janet_wrap_buffer(tempbuf); janet_formatb(buffer, " _r%u%V = ", instruction.three.dest, index_part); op_or_const(ir, buffer, instruction.three.lhs); janet_formatb(buffer, "%V %s ", index_part, op); op_or_const(ir, buffer, instruction.three.rhs); janet_formatb(buffer, "%V;\n", index_part); } } void janet_sys_ir_lower_to_c(JanetSysIRLinkage *linkage, JanetBuffer *buffer) { JanetBuffer *tempbuf = janet_buffer(0); #define EMITBINOP(OP) emit_binop(ir, buffer, tempbuf, instruction, OP) /* Prelude */ janet_formatb(buffer, "#include \n#include \n#include \n#include \n#include \n\n"); /* Emit type defs */ for (uint32_t j = 0; j < (uint32_t) linkage->ir_ordered->count; j++) { JanetSysIR *ir = janet_unwrap_abstract(linkage->ir_ordered->data[j]); for (uint32_t i = 0; i < ir->instruction_count; i++) { JanetSysInstruction instruction = ir->instructions[i]; switch (instruction.opcode) { default: continue; case JANET_SYSOP_TYPE_PRIMITIVE: case JANET_SYSOP_TYPE_STRUCT: case JANET_SYSOP_TYPE_UNION: case JANET_SYSOP_TYPE_POINTER: case JANET_SYSOP_TYPE_ARRAY: break; } if (instruction.line > 0) { janet_formatb(buffer, "#line %d\n", instruction.line); } switch (instruction.opcode) { default: break; case JANET_SYSOP_TYPE_PRIMITIVE: janet_formatb(buffer, "typedef %s _t%u;\n", c_prim_names[instruction.type_prim.prim], instruction.type_prim.dest_type); break; case JANET_SYSOP_TYPE_STRUCT: case JANET_SYSOP_TYPE_UNION: janet_formatb(buffer, (instruction.opcode == JANET_SYSOP_TYPE_STRUCT) ? "typedef struct {\n" : "typedef union {\n"); for (uint32_t j = 0; j < instruction.type_types.arg_count; j++) { uint32_t offset = j / 3 + 1; uint32_t index = j % 3; JanetSysInstruction arg_instruction = ir->instructions[i + offset]; janet_formatb(buffer, " _t%u _f%u;\n", arg_instruction.arg.args[index], j); } janet_formatb(buffer, "} _t%u;\n", instruction.type_types.dest_type); break; case JANET_SYSOP_TYPE_POINTER: janet_formatb(buffer, "typedef _t%u *_t%u;\n", instruction.pointer.type, instruction.pointer.dest_type); break; case JANET_SYSOP_TYPE_ARRAY: janet_formatb(buffer, "typedef struct { _t%u els[%u]; } _t%u;\n", instruction.array.type, instruction.array.fixed_count, instruction.array.dest_type); break; } } } /* Emit function header */ for (uint32_t j = 0; j < (uint32_t) linkage->ir_ordered->count; j++) { JanetSysIR *ir = janet_unwrap_abstract(linkage->ir_ordered->data[j]); if (ir->link_name == NULL) { continue; } janet_formatb(buffer, "\n\n_t%u %s(", ir->return_type, (ir->link_name != NULL) ? ir->link_name : janet_cstring("_thunk")); for (uint32_t i = 0; i < ir->parameter_count; i++) { if (i) janet_buffer_push_cstring(buffer, ", "); janet_formatb(buffer, "_t%u _r%u", ir->types[i], i); } janet_buffer_push_cstring(buffer, ")\n{\n"); for (uint32_t i = ir->parameter_count; i < ir->register_count; i++) { janet_formatb(buffer, " _t%u _r%u;\n", ir->types[i], i); } janet_buffer_push_cstring(buffer, "\n"); /* Emit body */ for (uint32_t i = 0; i < ir->instruction_count; i++) { JanetSysInstruction instruction = ir->instructions[i]; if (instruction.line > 0) { janet_formatb(buffer, "#line %d\n", instruction.line); } switch (instruction.opcode) { case JANET_SYSOP_TYPE_PRIMITIVE: case JANET_SYSOP_TYPE_BIND: case JANET_SYSOP_TYPE_STRUCT: case JANET_SYSOP_TYPE_UNION: case JANET_SYSOP_TYPE_POINTER: case JANET_SYSOP_TYPE_ARRAY: case JANET_SYSOP_ARG: case JANET_SYSOP_LINK_NAME: case JANET_SYSOP_PARAMETER_COUNT: break; case JANET_SYSOP_LABEL: { janet_formatb(buffer, "\n_label_%u:\n", instruction.label.id); break; } case JANET_SYSOP_ADDRESS: janet_formatb(buffer, " _r%u = (char *) &", instruction.two.dest); op_or_const(ir, buffer, instruction.two.src); janet_formatb(buffer, ";\n"); break; case JANET_SYSOP_JUMP: janet_formatb(buffer, " goto _label_%u;\n", instruction.jump.to); break; case JANET_SYSOP_BRANCH: case JANET_SYSOP_BRANCH_NOT: janet_formatb(buffer, instruction.opcode == JANET_SYSOP_BRANCH ? " if (" : " if (!"); op_or_const(ir, buffer, instruction.branch.cond); janet_formatb(buffer, ") goto _label_%u;\n", instruction.branch.to); break; case JANET_SYSOP_RETURN: if (instruction.ret.has_value) { janet_buffer_push_cstring(buffer, " return "); op_or_const(ir, buffer, instruction.ret.value); janet_buffer_push_cstring(buffer, ";\n"); } else { janet_buffer_push_cstring(buffer, " return;\n"); } break; case JANET_SYSOP_ADD: case JANET_SYSOP_POINTER_ADD: EMITBINOP("+"); break; case JANET_SYSOP_SUBTRACT: case JANET_SYSOP_POINTER_SUBTRACT: EMITBINOP("-"); break; case JANET_SYSOP_MULTIPLY: EMITBINOP("*"); break; case JANET_SYSOP_DIVIDE: EMITBINOP("/"); break; case JANET_SYSOP_GT: EMITBINOP(">"); break; case JANET_SYSOP_GTE: EMITBINOP(">"); break; case JANET_SYSOP_LT: EMITBINOP("<"); break; case JANET_SYSOP_LTE: EMITBINOP("<="); break; case JANET_SYSOP_EQ: EMITBINOP("=="); break; case JANET_SYSOP_NEQ: EMITBINOP("!="); break; case JANET_SYSOP_BAND: EMITBINOP("&"); break; case JANET_SYSOP_BOR: EMITBINOP("|"); break; case JANET_SYSOP_BXOR: EMITBINOP("^"); break; case JANET_SYSOP_SHL: EMITBINOP("<<"); break; case JANET_SYSOP_SHR: EMITBINOP(">>"); break; case JANET_SYSOP_SYSCALL: case JANET_SYSOP_CALL: { if (instruction.call.flags & JANET_SYS_CALLFLAG_HAS_DEST) { janet_formatb(buffer, " _r%u = ", instruction.call.dest); } else { janet_formatb(buffer, " "); } if (instruction.opcode == JANET_SYSOP_SYSCALL) { janet_formatb(buffer, "syscall("); op_or_const(ir, buffer, instruction.call.callee); } else { op_or_const(ir, buffer, instruction.call.callee); janet_formatb(buffer, "("); } uint32_t count; uint32_t *args = janet_sys_callargs(ir->instructions + i, &count); for (uint32_t j = 0; j < count; j++) { if (j || instruction.opcode == JANET_SYSOP_SYSCALL) janet_formatb(buffer, ", "); op_or_const(ir, buffer, args[j]); } janet_formatb(buffer, ");\n"); break; } case JANET_SYSOP_CAST: { uint32_t to = ir->types[instruction.two.dest]; janet_formatb(buffer, " _r%u = (_t%u) ", instruction.two.dest, to); op_or_const(ir, buffer, instruction.two.src); janet_formatb(buffer, ";\n"); break; } case JANET_SYSOP_MOVE: janet_formatb(buffer, " _r%u = ", instruction.two.dest); op_or_const(ir, buffer, instruction.two.src); janet_formatb(buffer, ";\n"); break; case JANET_SYSOP_BNOT: janet_formatb(buffer, " _r%u = ~", instruction.two.dest); op_or_const(ir, buffer, instruction.two.src); janet_formatb(buffer, ";\n"); break; case JANET_SYSOP_LOAD: janet_formatb(buffer, " _r%u = *(", instruction.two.dest); op_or_const(ir, buffer, instruction.two.src); janet_formatb(buffer, ");\n"); break; case JANET_SYSOP_STORE: janet_formatb(buffer, " *(_r%u) = ", instruction.two.dest); op_or_const(ir, buffer, instruction.two.src); janet_formatb(buffer, ";\n"); break; case JANET_SYSOP_FIELD_GETP: janet_formatb(buffer, " _r%u = &(_r%u._f%u);\n", instruction.field.r, instruction.field.st, instruction.field.field); janet_formatb(buffer, " _r%u = &(", instruction.field.r); janet_formatb(buffer, "._f%u);\n", instruction.field.field); break; case JANET_SYSOP_ARRAY_GETP: janet_formatb(buffer, " _r%u = &(_r%u.els[", instruction.three.dest, instruction.three.lhs); op_or_const(ir, buffer, instruction.three.rhs); janet_buffer_push_cstring(buffer, "]);\n"); break; case JANET_SYSOP_ARRAY_PGETP: janet_formatb(buffer, " _r%u = &(_r%u->els[", instruction.three.dest, instruction.three.lhs); op_or_const(ir, buffer, instruction.three.rhs); janet_buffer_push_cstring(buffer, "]);\n"); break; } } janet_buffer_push_cstring(buffer, "}\n"); #undef EMITBINOP } } /* Convert IR linkage back to Janet ASM */ static Janet janet_sys_get_desttype(JanetSysIRLinkage *linkage, uint32_t destt) { if (linkage->type_names[destt] == NULL) { return janet_wrap_number(destt); } else { return janet_wrap_symbol(linkage->type_names[destt]); } } static Janet wrap_op(JanetSysIR *ir, uint32_t reg) { if (reg <= JANET_SYS_MAX_OPERAND) { return janet_wrap_number(reg); } Janet *tuple = janet_tuple_begin(2); JanetSysConstant jsc = ir->constants[reg - JANET_SYS_CONSTANT_PREFIX]; tuple[0] = janet_sys_get_desttype(ir->linkage, jsc.type); tuple[1] = jsc.value; janet_tuple_flag(tuple) |= JANET_TUPLE_FLAG_BRACKETCTOR; return janet_wrap_tuple(janet_tuple_end(tuple)); } static Janet wrap_dest(uint32_t reg) { return janet_wrap_number(reg); } void janet_sys_ir_lower_to_ir(JanetSysIRLinkage *linkage, JanetArray *into) { /* Emit type defs */ JanetArray *typedefs = janet_array(0); for (uint32_t j = 0; j < (uint32_t) linkage->ir_ordered->count; j++) { JanetSysIR *ir = janet_unwrap_abstract(linkage->ir_ordered->data[j]); for (uint32_t i = 0; i < ir->instruction_count; i++) { JanetSysInstruction instruction = ir->instructions[i]; Janet *build_tuple = NULL; switch (instruction.opcode) { default: continue; case JANET_SYSOP_TYPE_PRIMITIVE: build_tuple = janet_tuple_begin(3); build_tuple[0] = janet_csymbolv("type-prim"); build_tuple[1] = janet_sys_get_desttype(linkage, instruction.type_prim.dest_type); build_tuple[2] = janet_csymbolv(prim_to_prim_name[instruction.type_prim.prim]); break; case JANET_SYSOP_TYPE_STRUCT: case JANET_SYSOP_TYPE_UNION: build_tuple = janet_tuple_begin(2 + instruction.type_types.arg_count); build_tuple[0] = janet_csymbolv(instruction.opcode == JANET_SYSOP_TYPE_STRUCT ? "type-struct" : "type-union"); build_tuple[1] = janet_sys_get_desttype(linkage, instruction.type_types.dest_type); for (uint32_t j = 0; j < instruction.type_types.arg_count; j++) { uint32_t offset = j / 3 + 1; uint32_t index = j % 3; JanetSysInstruction arg_instruction = ir->instructions[i + offset]; build_tuple[j + 2] = janet_sys_get_desttype(linkage, arg_instruction.arg.args[index]); } break; case JANET_SYSOP_TYPE_POINTER: build_tuple = janet_tuple_begin(3); build_tuple[0] = janet_csymbolv("type-pointer"); build_tuple[1] = janet_sys_get_desttype(linkage, instruction.pointer.dest_type); build_tuple[2] = janet_sys_get_desttype(linkage, instruction.pointer.type); break; case JANET_SYSOP_TYPE_ARRAY: build_tuple = janet_tuple_begin(4); build_tuple[0] = janet_csymbolv("type-array"); build_tuple[1] = janet_sys_get_desttype(linkage, instruction.array.dest_type); build_tuple[2] = janet_sys_get_desttype(linkage, instruction.array.type); build_tuple[4] = janet_wrap_number(instruction.array.fixed_count); break; } const Janet *tuple = janet_tuple_end(build_tuple); if (instruction.line > 0) { janet_tuple_sm_line(tuple) = instruction.line; janet_tuple_sm_column(tuple) = instruction.column; } janet_array_push(typedefs, janet_wrap_tuple(tuple)); } } janet_array_push(into, janet_wrap_array(typedefs)); for (uint32_t j = 0; j < (uint32_t) linkage->ir_ordered->count; j++) { JanetSysIR *ir = janet_unwrap_abstract(linkage->ir_ordered->data[j]); JanetArray *linkage_ir = janet_array(0); /* Linkage header */ if (ir->link_name) { Janet *build_tuple = janet_tuple_begin(2); build_tuple[0] = janet_csymbolv("link-name"); build_tuple[1] = janet_wrap_string(ir->link_name); janet_array_push(linkage_ir, janet_wrap_tuple(janet_tuple_end(build_tuple))); } Janet *build_tuple = janet_tuple_begin(2); build_tuple[0] = janet_csymbolv("parameter-count"); build_tuple[1] = janet_wrap_number(ir->parameter_count); janet_array_push(linkage_ir, janet_wrap_tuple(janet_tuple_end(build_tuple))); /* Lift type bindings to top of IR */ for (uint32_t i = 0; i < ir->instruction_count; i++) { JanetSysInstruction instruction = ir->instructions[i]; Janet *build_tuple = NULL; switch (instruction.opcode) { default: continue; case JANET_SYSOP_TYPE_BIND: build_tuple = janet_tuple_begin(3); build_tuple[0] = janet_csymbolv(janet_sysop_names[instruction.opcode]); build_tuple[1] = janet_wrap_number(instruction.two.dest); build_tuple[2] = janet_sys_get_desttype(linkage, instruction.two.src); /* TODO - use named types if possible */ break; } if (instruction.line > 0) { janet_tuple_sm_line(build_tuple) = instruction.line; janet_tuple_sm_column(build_tuple) = instruction.column; } const Janet *tuple = janet_tuple_end(build_tuple); janet_array_push(linkage_ir, janet_wrap_tuple(tuple)); } /* Emit other instructions */ for (uint32_t i = 0; i < ir->instruction_count; i++) { JanetSysInstruction instruction = ir->instructions[i]; Janet *build_tuple = NULL; switch (instruction.opcode) { default: continue; case JANET_SYSOP_MOVE: case JANET_SYSOP_CAST: case JANET_SYSOP_BNOT: case JANET_SYSOP_LOAD: case JANET_SYSOP_STORE: case JANET_SYSOP_ADDRESS: build_tuple = janet_tuple_begin(3); build_tuple[0] = janet_csymbolv(janet_sysop_names[instruction.opcode]); build_tuple[1] = wrap_dest(instruction.two.dest); build_tuple[2] = wrap_op(ir, instruction.two.src); break; case JANET_SYSOP_ADD: case JANET_SYSOP_SUBTRACT: case JANET_SYSOP_MULTIPLY: case JANET_SYSOP_DIVIDE: case JANET_SYSOP_BAND: case JANET_SYSOP_BOR: case JANET_SYSOP_BXOR: case JANET_SYSOP_GT: case JANET_SYSOP_GTE: case JANET_SYSOP_LT: case JANET_SYSOP_LTE: case JANET_SYSOP_EQ: case JANET_SYSOP_NEQ: case JANET_SYSOP_POINTER_ADD: case JANET_SYSOP_POINTER_SUBTRACT: case JANET_SYSOP_SHL: case JANET_SYSOP_SHR: case JANET_SYSOP_ARRAY_GETP: case JANET_SYSOP_ARRAY_PGETP: build_tuple = janet_tuple_begin(4); build_tuple[0] = janet_csymbolv(janet_sysop_names[instruction.opcode]); build_tuple[1] = wrap_dest(instruction.three.dest); build_tuple[2] = wrap_op(ir, instruction.three.lhs); build_tuple[3] = wrap_op(ir, instruction.three.rhs); break; case JANET_SYSOP_LABEL: build_tuple = janet_tuple_begin(2); build_tuple[0] = janet_csymbolv("label"); build_tuple[1] = janet_table_get(ir->labels, janet_wrap_number(instruction.label.id)); break; case JANET_SYSOP_RETURN: build_tuple = janet_tuple_begin(instruction.ret.has_value ? 2 : 1); build_tuple[0] = janet_csymbolv("return"); if (instruction.ret.has_value) build_tuple[1] = wrap_op(ir, instruction.ret.value); break; case JANET_SYSOP_BRANCH: case JANET_SYSOP_BRANCH_NOT: build_tuple = janet_tuple_begin(3); build_tuple[0] = janet_csymbolv(janet_sysop_names[instruction.opcode]); build_tuple[1] = wrap_op(ir, instruction.branch.cond); build_tuple[2] = janet_table_get(ir->labels, janet_wrap_number(instruction.branch.to)); break; case JANET_SYSOP_JUMP: build_tuple = janet_tuple_begin(2); build_tuple[0] = janet_csymbolv(janet_sysop_names[instruction.opcode]); build_tuple[1] = janet_table_get(ir->labels, janet_wrap_number(instruction.jump.to)); break; case JANET_SYSOP_FIELD_GETP: build_tuple = janet_tuple_begin(4); build_tuple[0] = janet_csymbolv(janet_sysop_names[instruction.opcode]); build_tuple[1] = wrap_dest(instruction.field.r); build_tuple[2] = wrap_op(ir, instruction.field.st); build_tuple[3] = janet_wrap_number(instruction.field.field); break; case JANET_SYSOP_CALL: case JANET_SYSOP_SYSCALL: build_tuple = janet_tuple_begin(4 + instruction.call.arg_count); build_tuple[0] = janet_csymbolv(janet_sysop_names[instruction.opcode]); build_tuple[1] = janet_ckeywordv(calling_convention_names[instruction.call.calling_convention]); build_tuple[2] = (instruction.call.flags & JANET_SYS_CALLFLAG_HAS_DEST) ? wrap_dest(instruction.call.dest) : janet_wrap_nil(); build_tuple[3] = wrap_op(ir, instruction.call.callee); uint32_t *args = janet_sys_callargs(ir->instructions + i, NULL); for (uint32_t k = 0; k < instruction.call.arg_count; k++) { build_tuple[4 + k] = wrap_op(ir, args[k]); } janet_sfree(args); break; } if (instruction.line > 0) { janet_tuple_sm_line(build_tuple) = instruction.line; janet_tuple_sm_column(build_tuple) = instruction.column; } const Janet *tuple = janet_tuple_end(build_tuple); janet_array_push(linkage_ir, janet_wrap_tuple(tuple)); } /* Can get empty linkage after lifting type defs */ if (linkage_ir->count > 0) { janet_array_push(into, janet_wrap_array(linkage_ir)); } } } /* Bindings */ static int sysir_gc(void *p, size_t s) { JanetSysIR *ir = (JanetSysIR *)p; (void) s; janet_free(ir->constants); janet_free(ir->types); janet_free(ir->instructions); janet_free(ir->register_names); return 0; } static int sysir_gcmark(void *p, size_t s) { JanetSysIR *ir = (JanetSysIR *)p; (void) s; for (uint32_t i = 0; i < ir->register_count; i++) { if (ir->register_names[i] != NULL) { janet_mark(janet_wrap_string(ir->register_names[i])); } } for (uint32_t i = 0; i < ir->constant_count; i++) { janet_mark(ir->constants[i].value); } if (ir->link_name != NULL) { janet_mark(janet_wrap_string(ir->link_name)); } janet_mark(janet_wrap_table(ir->labels)); janet_mark(janet_wrap_table(ir->register_name_lookup)); janet_mark(janet_wrap_abstract(ir->linkage)); janet_mark(ir->error_ctx); return 0; } static int sysir_context_gc(void *p, size_t s) { JanetSysIRLinkage *linkage = (JanetSysIRLinkage *)p; (void) s; janet_free(linkage->field_defs); janet_free(linkage->type_defs); janet_free(linkage->type_names); return 0; } static int sysir_context_gcmark(void *p, size_t s) { JanetSysIRLinkage *linkage = (JanetSysIRLinkage *)p; (void) s; janet_mark(janet_wrap_table(linkage->type_name_lookup)); janet_mark(janet_wrap_table(linkage->irs)); janet_mark(janet_wrap_array(linkage->ir_ordered)); for (uint32_t i = 0; i < linkage->type_def_count; i++) { if (linkage->type_names[i] != NULL) { janet_mark(janet_wrap_string(linkage->type_names[i])); } } return 0; } static const JanetAbstractType janet_sysir_type = { "core/sysir", sysir_gc, sysir_gcmark, JANET_ATEND_GCMARK }; static const JanetAbstractType janet_sysir_context_type = { "core/sysir-context", sysir_context_gc, sysir_context_gcmark, JANET_ATEND_GCMARK }; JANET_CORE_FN(cfun_sysir_context, "(sysir/context)", "Create a linkage context to compile functions in. All functions that share a context can be linked against one another, share " "type declarations, share global state, and be compiled to a single object or executable. Returns a new context.") { janet_fixarity(argc, 0); (void) argv; JanetSysIRLinkage *linkage = janet_abstract(&janet_sysir_context_type, sizeof(JanetSysIRLinkage)); janet_sys_ir_linkage_init(linkage); return janet_wrap_abstract(linkage); } JANET_CORE_FN(cfun_sysir_asm, "(sysir/asm context ir)", "Compile the system dialect IR into an object that can be manipulated, optimized, or lowered to other targets like C.") { janet_fixarity(argc, 2); JanetSysIRLinkage *linkage = janet_getabstract(argv, 0, &janet_sysir_context_type); JanetView instructions = janet_getindexed(argv, 1); JanetSysIR *sysir = janet_abstract(&janet_sysir_type, sizeof(JanetSysIR)); janet_sys_ir_init(sysir, instructions, linkage); return janet_wrap_abstract(sysir); } JANET_CORE_FN(cfun_sysir_toc, "(sysir/to-c context &opt buffer)", "Lower some IR to a C function. Return a modified buffer that can be passed to a C compiler.") { janet_arity(argc, 1, 2); JanetSysIRLinkage *ir = janet_getabstract(argv, 0, &janet_sysir_context_type); JanetBuffer *buffer = janet_optbuffer(argv, argc, 1, 0); janet_sys_ir_lower_to_c(ir, buffer); return janet_wrap_buffer(buffer); } JANET_CORE_FN(cfun_sysir_toir, "(sysir/to-ir context &opt array)", "Raise IR back to IR after running other optimizations on it. Returns an array with various linkages.") { janet_arity(argc, 1, 2); JanetSysIRLinkage *ir = janet_getabstract(argv, 0, &janet_sysir_context_type); JanetArray *array = janet_optarray(argv, argc, 1, 0); janet_sys_ir_lower_to_ir(ir, array); return janet_wrap_array(array); } JANET_CORE_FN(cfun_sysir_tox64, "(sysir/to-x64 context &opt buffer options)", "Lower IR to x64 machine code.") { janet_arity(argc, 1, 3); JanetSysIRLinkage *ir = janet_getabstract(argv, 0, &janet_sysir_context_type); JanetBuffer *buffer = janet_optbuffer(argv, argc, 1, 0); janet_sys_ir_lower_to_x64(ir, buffer); return janet_wrap_buffer(buffer); } void janet_lib_sysir(JanetTable *env) { JanetRegExt cfuns[] = { JANET_CORE_REG("sysir/context", cfun_sysir_context), JANET_CORE_REG("sysir/asm", cfun_sysir_asm), JANET_CORE_REG("sysir/to-c", cfun_sysir_toc), JANET_CORE_REG("sysir/to-ir", cfun_sysir_toir), JANET_CORE_REG("sysir/to-x64", cfun_sysir_tox64), JANET_REG_END }; janet_core_cfuns_ext(env, NULL, cfuns); }