mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2025-06-12 19:44:12 +00:00
Code Issues 1 Releases Wiki Activity
janet/src/core/sysir.c
Calvin Rose 232a8faa35 More work compile-opt.
2024-06-13 07:27:48 -05:00

1888 lines
78 KiB
C
Raw Blame History

/*
* 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 <janet.h>
#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 <stddef.h>\n#include <stdint.h>\n#include <stdbool.h>\n#include <stdio.h>\n#include <sys/syscall.h>\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);
}
Reference in New Issue View Git Blame Copy Permalink