From 6b74400f2a36ef66d13a277234569d9f56ce3de5 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 3 Apr 2023 09:21:44 -0500 Subject: [PATCH 01/21] Create system IR that can compile to C. Work ongoing, still needs better pointer support, as well as composite types. --- Makefile | 1 + meson.build | 1 + src/boot/boot.janet | 1 + src/core/compile.c | 1 + src/core/compile.h | 3 + src/core/sysir.c | 750 ++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 757 insertions(+) create mode 100644 src/core/sysir.c diff --git a/Makefile b/Makefile index 6aa76508..46a9c5c6 100644 --- a/Makefile +++ b/Makefile @@ -136,6 +136,7 @@ JANET_CORE_SOURCES=src/core/abstract.c \ src/core/strtod.c \ src/core/struct.c \ src/core/symcache.c \ + src/core/sysir.c \ src/core/table.c \ src/core/tuple.c \ src/core/util.c \ diff --git a/meson.build b/meson.build index 02e6d96d..b67908cb 100644 --- a/meson.build +++ b/meson.build @@ -138,6 +138,7 @@ core_src = [ 'src/core/strtod.c', 'src/core/struct.c', 'src/core/symcache.c', + 'src/core/sysir.c', 'src/core/table.c', 'src/core/tuple.c', 'src/core/util.c', diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 5ab4bc87..60bfce78 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4063,6 +4063,7 @@ "src/core/strtod.c" "src/core/struct.c" "src/core/symcache.c" + "src/core/sysir.c" "src/core/table.c" "src/core/tuple.c" "src/core/util.c" diff --git a/src/core/compile.c b/src/core/compile.c index 3c31049f..a7549082 100644 --- a/src/core/compile.c +++ b/src/core/compile.c @@ -1110,4 +1110,5 @@ void janet_lib_compile(JanetTable *env) { JANET_REG_END }; janet_core_cfuns_ext(env, NULL, cfuns); + janet_lib_sysir(env); } diff --git a/src/core/compile.h b/src/core/compile.h index dc6ae912..3371cb79 100644 --- a/src/core/compile.h +++ b/src/core/compile.h @@ -266,4 +266,7 @@ JanetSlot janetc_cslot(Janet x); /* Search for a symbol */ JanetSlot janetc_resolve(JanetCompiler *c, const uint8_t *sym); +/* Load the system dialect IR */ +void janet_lib_sysir(JanetTable *env); + #endif diff --git a/src/core/sysir.c b/src/core/sysir.c new file mode 100644 index 00000000..fa723eb1 --- /dev/null +++ b/src/core/sysir.c @@ -0,0 +1,750 @@ +/* +* Copyright (c) 2023 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. +*/ + +/* TODO + * - pointer math, pointer types + * - callk - allow linking to other named functions + * - composite types - support for load, store, move, and function args. + * Have some mechanism for field access (dest = src.offset) + * - support for stack allocation of arrays + * - more math intrinsics + * - better C interface for building up IR + */ + +#ifndef JANET_AMALG +#include "features.h" +#include +#include "util.h" +#include +#endif + +typedef enum { + JANET_PRIM_U8, + JANET_PRIM_S8, + JANET_PRIM_U16, + JANET_PRIM_S16, + JANET_PRIM_U32, + JANET_PRIM_S32, + JANET_PRIM_U64, + JANET_PRIM_S64, + JANET_PRIM_F32, + JANET_PRIM_F64, + JANET_PRIM_POINTER, + JANET_PRIM_BOOLEAN +} JanetPrim; + +typedef struct { + const char *name; + JanetPrim prim; +} JanetPrimName; + +static const JanetPrimName prim_names[] = { + {"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}, + {"u16", JANET_PRIM_U16}, + {"u32", JANET_PRIM_U32}, + {"u64", JANET_PRIM_U64}, + {"u8", JANET_PRIM_U8}, +}; + +static const char *prim_names_by_id[] = { + "u8", + "s8", + "u16", + "s16", + "u32", + "s32", + "u64", + "s64", + "f32", + "f64", + "pointer", + "boolean", +}; + +typedef enum { + JANET_SYSOPVAR_THREE, + JANET_SYSOPVAR_TWO, + JANET_SYSOPVAR_ONE, + JANET_SYSOPVAR_JUMP, + JANET_SYSOPVAR_BRANCH, + JANET_SYSOPVAR_CALL, + JANET_SYSOPVAR_CONSTANT +} JanetSysOpVariant; + +typedef enum { + JANET_SYSOP_MOVE, + JANET_SYSOP_ADD, + JANET_SYSOP_SUBTRACT, + JANET_SYSOP_MULTIPLY, + JANET_SYSOP_DIVIDE, + JANET_SYSOP_BAND, + JANET_SYSOP_BOR, + JANET_SYSOP_BXOR, + JANET_SYSOP_BNOT, + JANET_SYSOP_SHL, + JANET_SYSOP_SHR, + JANET_SYSOP_LOAD, + JANET_SYSOP_STORE, + JANET_SYSOP_GT, + JANET_SYSOP_LT, + JANET_SYSOP_EQ, + JANET_SYSOP_NEQ, + JANET_SYSOP_GTE, + JANET_SYSOP_LTE, + JANET_SYSOP_CONSTANT, + JANET_SYSOP_CALL, + JANET_SYSOP_RETURN, + JANET_SYSOP_JUMP, + JANET_SYSOP_BRANCH, + JANET_SYSOP_PUSH1, + JANET_SYSOP_PUSH2, + JANET_SYSOP_PUSH3, + JANET_SYSOP_ADDRESS, +} JanetSysOp; + +static const JanetSysOpVariant op_variants[] = { + JANET_SYSOPVAR_TWO, /* JANET_SYSOP_MOVE */ + JANET_SYSOPVAR_THREE, /* JANET_SYSOP_ADD */ + JANET_SYSOPVAR_THREE, /* JANET_SYSOP_SUBTRACT */ + JANET_SYSOPVAR_THREE, /* JANET_SYSOP_MULTIPLY */ + JANET_SYSOPVAR_THREE, /* JANET_SYSOP_DIVIDE */ + JANET_SYSOPVAR_THREE, /* JANET_SYSOP_BAND */ + JANET_SYSOPVAR_THREE, /* JANET_SYSOP_BOR */ + JANET_SYSOPVAR_THREE, /* JANET_SYSOP_BXOR */ + JANET_SYSOPVAR_TWO, /* JANET_SYSOP_BNOT */ + JANET_SYSOPVAR_THREE, /* JANET_SYSOP_SHL */ + JANET_SYSOPVAR_THREE, /* JANET_SYSOP_SHR */ + JANET_SYSOPVAR_TWO, /* JANET_SYSOP_LOAD */ + JANET_SYSOPVAR_TWO, /* JANET_SYSOP_STORE */ + JANET_SYSOPVAR_THREE, /* JANET_SYSOP_GT */ + JANET_SYSOPVAR_THREE, /* JANET_SYSOP_LT */ + JANET_SYSOPVAR_THREE, /* JANET_SYSOP_EQ */ + JANET_SYSOPVAR_THREE, /* JANET_SYSOP_NEQ */ + JANET_SYSOPVAR_THREE, /* JANET_SYSOP_GTE */ + JANET_SYSOPVAR_THREE, /* JANET_SYSOP_LTE */ + JANET_SYSOPVAR_CONSTANT, /* JANET_SYSOP_CONSTANT */ + JANET_SYSOPVAR_CALL, /* JANET_SYSOP_CALL */ + JANET_SYSOPVAR_ONE, /* JANET_SYSOP_RETURN */ + JANET_SYSOPVAR_JUMP, /* JANET_SYSOP_JUMP */ + JANET_SYSOPVAR_BRANCH, /* JANET_SYSOP_BRANCH */ + JANET_SYSOPVAR_ONE, /* JANET_SYSOP_PUSH1 */ + JANET_SYSOPVAR_TWO, /* JANET_SYSOP_PUSH1 */ + JANET_SYSOPVAR_THREE, /* JANET_SYSOP_PUSH1 */ + JANET_SYSOPVAR_TWO, /* JANET_SYSOP_ADDRESS */ +}; + +typedef struct { + const char *name; + JanetSysOp op; +} JanetSysInstrName; + +static const JanetSysInstrName sys_op_names[] = { + {"add", JANET_SYSOP_ADD}, + {"address", JANET_SYSOP_ADDRESS}, + {"band", JANET_SYSOP_BAND}, + {"bnot", JANET_SYSOP_BNOT}, + {"bor", JANET_SYSOP_BOR}, + {"branch", JANET_SYSOP_BRANCH}, + {"bxor", JANET_SYSOP_BXOR}, + {"call", JANET_SYSOP_CALL}, + {"constant", JANET_SYSOP_CONSTANT}, + {"divide", JANET_SYSOP_DIVIDE}, + {"eq", JANET_SYSOP_EQ}, + {"gt", JANET_SYSOP_GT}, + {"gte", JANET_SYSOP_GTE}, + {"jump", JANET_SYSOP_JUMP}, + {"load", JANET_SYSOP_LOAD}, + {"lt", JANET_SYSOP_LT}, + {"lte", JANET_SYSOP_LTE}, + {"move", JANET_SYSOP_MOVE}, + {"multiply", JANET_SYSOP_MULTIPLY}, + {"neq", JANET_SYSOP_NEQ}, + {"push1", JANET_SYSOP_PUSH1}, + {"push2", JANET_SYSOP_PUSH2}, + {"push3", JANET_SYSOP_PUSH3}, + {"return", JANET_SYSOP_RETURN}, + {"shl", JANET_SYSOP_SHL}, + {"shr", JANET_SYSOP_SHR}, + {"store", JANET_SYSOP_STORE}, + {"subtract", JANET_SYSOP_SUBTRACT}, +}; + +typedef struct { + JanetSysOp opcode; + union { + struct { + uint32_t dest; + uint32_t lhs; + uint32_t rhs; + } three; + struct { + uint32_t dest; + uint32_t callee; + } call; + struct { + uint32_t dest; + uint32_t src; + } two; + struct { + uint32_t src; + } one; + struct { + uint32_t to; + } jump; + struct { + uint32_t cond; + uint32_t to; + } branch; + struct { + uint32_t dest; + uint32_t constant; + } constant; + }; +} JanetSysInstruction; + +typedef struct { + JanetString link_name; + uint32_t instruction_count; + uint32_t type_count; + uint32_t constant_count; + JanetPrim *types; + JanetPrim return_type; + JanetSysInstruction *instructions; + Janet *constants; + uint32_t parameter_count; +} JanetSysIR; + +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 %v", len, x); + } +} + +static uint32_t instr_read_operand(Janet x, int32_t max_operand) { + int32_t operand = 0; + int fail = 0; + if (!janet_checkint(x)) fail = 1; + if (!fail) { + operand = janet_unwrap_integer(x); + if (operand < 0) fail = 1; + if (operand > max_operand) fail = 1; + } + if (fail) janet_panicf("expected integer operand in range [0, %d], got %v", max_operand, x); + return (uint32_t) operand; +} + +static uint32_t instr_read_label(Janet x, JanetTable *labels, int32_t max_label) { + int32_t operand = 0; + int fail = 0; + Janet check = janet_table_get(labels, x); + if (!janet_checktype(check, JANET_NIL)) return (uint32_t) janet_unwrap_number(check); + if (!janet_checkint(x)) fail = 1; + if (!fail) { + operand = janet_unwrap_integer(x); + if (operand < 0) fail = 1; + if (operand > max_label) fail = 1; + } + if (fail) janet_panicf("expected label in range [0, %d], got %v", max_label, x); + return (uint32_t) operand; +} + +static void janet_sysir_init_types(JanetSysIR *out, JanetView types) { + uint32_t type_count = types.len; + out->types = janet_malloc(sizeof(JanetPrim) * type_count); + for (int32_t i = 0; i < types.len; i++) { + Janet x = types.items[i]; + if (!janet_checktype(x, JANET_SYMBOL)) { + janet_panicf("expected primitive type, got %v", 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 type %v", x); + } + out->types[i] = namedata->prim; + } + out->type_count = type_count; +} + +#define U_FLAGS ((1u << JANET_PRIM_U8) | (1u << JANET_PRIM_U16) | (1u << JANET_PRIM_U32) | (1u << JANET_PRIM_U64)) +#define S_FLAGS ((1u << JANET_PRIM_S8) | (1u << JANET_PRIM_S16) | (1u << JANET_PRIM_S32) | (1u << JANET_PRIM_S64)) +#define F_FLAGS ((1u << JANET_PRIM_F32) | (1u << JANET_PRIM_F64)) +#define NUMBER_FLAGS (U_FLAGS | S_FLAGS | F_FLAGS) +#define INTEGER_FLAGS (U_FLAGS | S_FLAGS) + +/* Mainly check the instruction arguments are of compatible types */ +static void check_instruction_well_formed(JanetSysInstruction instruction, Janet x, JanetSysIR *ir) { + int fail = 0; + switch (instruction.opcode) { + /* TODO */ + /* case JANET_SYSOP_CALL: */ + /* case JANET_SYSOP_CONSTANT: */ + /* case JANET_SYSOP_JUMP: */ + /* case JANET_SYSOP_ADDRESS: */ + default: + break; + case JANET_SYSOP_ADD: + case JANET_SYSOP_SUBTRACT: + case JANET_SYSOP_MULTIPLY: + case JANET_SYSOP_DIVIDE: + { + JanetPrim pdest = ir->types[instruction.three.dest]; + JanetPrim plhs = ir->types[instruction.three.lhs]; + JanetPrim prhs = ir->types[instruction.three.rhs]; + if ((pdest != prhs) || (prhs != plhs)) fail = 1; + if (!((1u << pdest) & NUMBER_FLAGS)) fail = 1; + break; + } + case JANET_SYSOP_LT: + case JANET_SYSOP_LTE: + case JANET_SYSOP_GT: + case JANET_SYSOP_GTE: + case JANET_SYSOP_EQ: + case JANET_SYSOP_NEQ: + { + JanetPrim pdest = ir->types[instruction.three.dest]; + JanetPrim plhs = ir->types[instruction.three.lhs]; + JanetPrim prhs = ir->types[instruction.three.rhs]; + if ((pdest != JANET_PRIM_BOOLEAN) || (prhs != plhs)) fail = 1; + if (!((1u << pdest) & NUMBER_FLAGS)) fail = 1; + break; + } + case JANET_SYSOP_BAND: + case JANET_SYSOP_BOR: + case JANET_SYSOP_BXOR: + { + JanetPrim pdest = ir->types[instruction.three.dest]; + JanetPrim plhs = ir->types[instruction.three.lhs]; + JanetPrim prhs = ir->types[instruction.three.rhs]; + if (pdest != plhs) fail = 1; + if (pdest != prhs) fail = 1; + if (!((1u << pdest) & INTEGER_FLAGS)) fail = 1; + break; + } + case JANET_SYSOP_SHR: + case JANET_SYSOP_SHL: + { + JanetPrim pdest = ir->types[instruction.three.dest]; + JanetPrim plhs = ir->types[instruction.three.lhs]; + JanetPrim prhs = ir->types[instruction.three.rhs]; + if (pdest != plhs) fail = 1; + if (!((1u << pdest) & INTEGER_FLAGS)) fail = 1; + if (!((1u << prhs) & U_FLAGS)) fail = 1; + break; + } + case JANET_SYSOP_BRANCH: + { + JanetPrim pcond = ir->types[instruction.branch.cond]; + if (!((1u << pcond) & ((1u << JANET_PRIM_BOOLEAN) | INTEGER_FLAGS))) fail = 1; + break; + } + case JANET_SYSOP_MOVE: + { + JanetPrim pdest = ir->types[instruction.two.dest]; + JanetPrim psrc = ir->types[instruction.two.src]; + if (pdest != psrc) fail = 1; + break; + } + case JANET_SYSOP_BNOT: + { + JanetPrim pdest = ir->types[instruction.two.dest]; + JanetPrim psrc = ir->types[instruction.two.src]; + if (pdest != psrc) fail = 1; + if (!((1u << pdest) & INTEGER_FLAGS)) fail = 1; + break; + } + case JANET_SYSOP_ADDRESS: + { + JanetPrim pdest = ir->types[instruction.two.dest]; + if (pdest != JANET_PRIM_POINTER) fail = 1; + break; + } + } + if (fail) janet_panicf("invalid types for instruction %v", x); +} + +static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instructions) { + uint32_t pending_count = instructions.len; + JanetSysInstruction *ir = janet_malloc(sizeof(JanetSysInstruction) * pending_count); + out->instructions = ir; + uint32_t cursor = 0; + int32_t max_op = out->type_count - 1; + int32_t max_label = 0; + int inside_call = false; + /* TODO - preserve labels in generated output (c) */ + JanetTable *labels = janet_table(0); + JanetTable *constant_cache = janet_table(0); + uint32_t next_constant = 0; + for (int32_t i = 0; i < instructions.len; i++) { + Janet x = instructions.items[i]; + if (janet_checktype(x, JANET_KEYWORD)) { + janet_table_put(labels, x, janet_wrap_integer(max_label)); + } else { + max_label++; + } + } + pending_count = max_label; + max_label--; + Janet x = janet_wrap_nil(); + for (int32_t i = 0; i < instructions.len; i++) { + x = instructions.items[i]; + if (janet_checktype(x, JANET_KEYWORD)) continue; + if (!janet_checktype(x, JANET_TUPLE)) { + janet_panicf("expected instruction to be tuple, got %v", x); + } + JanetTuple tuple = janet_unwrap_tuple(x); + if (janet_tuple_length(tuple) < 1) { + janet_panic("invalid instruction, no opcode"); + } + Janet opvalue = tuple[0]; + if (!janet_checktype(opvalue, JANET_SYMBOL)) { + janet_panicf("expected opcode symbol, found %v", 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 %v", x); + } + JanetSysOp opcode = namedata->op; + JanetSysOpVariant variant = op_variants[opcode]; + JanetSysInstruction instruction; + instruction.opcode = opcode; + if (inside_call) { + if (opcode == JANET_SYSOP_CALL) { + inside_call = 0; + } else if (opcode != JANET_SYSOP_PUSH1 && + opcode != JANET_SYSOP_PUSH2 && + opcode != JANET_SYSOP_PUSH3) { + janet_panicf("push instructions may only be followed by other push instructions until a call, got %v", + x); + } + } + switch (variant) { + case JANET_SYSOPVAR_THREE: + instr_assert_length(tuple, 4, opvalue); + instruction.three.dest = instr_read_operand(tuple[1], max_op); + instruction.three.lhs = instr_read_operand(tuple[2], max_op); + instruction.three.rhs = instr_read_operand(tuple[3], max_op); + break; + case JANET_SYSOPVAR_CALL: + /* TODO - fallthrough for now */ + case JANET_SYSOPVAR_TWO: + instr_assert_length(tuple, 3, opvalue); + instruction.two.dest = instr_read_operand(tuple[1], max_op); + instruction.two.src = instr_read_operand(tuple[2], max_op); + break; + case JANET_SYSOPVAR_ONE: + instr_assert_length(tuple, 2, opvalue); + instruction.one.src = instr_read_operand(tuple[1], max_op); + break; + case JANET_SYSOPVAR_BRANCH: + instr_assert_length(tuple, 3, opvalue); + instruction.branch.cond = instr_read_operand(tuple[1], max_op); + instruction.branch.to = instr_read_label(tuple[2], labels, max_label); + break; + case JANET_SYSOPVAR_JUMP: + instr_assert_length(tuple, 2, opvalue); + instruction.jump.to = instr_read_label(tuple[1], labels, max_label); + break; + case JANET_SYSOPVAR_CONSTANT: + { + instr_assert_length(tuple, 3, opvalue); + instruction.constant.dest = instr_read_operand(tuple[1], max_op); + Janet c = tuple[2]; + Janet check = janet_table_get(constant_cache, c); + if (janet_checktype(check, JANET_NUMBER)) { + instruction.constant.constant = (uint32_t) janet_unwrap_number(check); + } else { + instruction.constant.constant = next_constant; + janet_table_put(constant_cache, c, janet_wrap_integer(next_constant)); + next_constant++; + } + break; + } + } + check_instruction_well_formed(instruction, x, out); + ir[cursor++] = instruction; + } + /* Check last instruction is jump or return */ + if ((ir[cursor - 1].opcode != JANET_SYSOP_JUMP) && (ir[cursor - 1].opcode != JANET_SYSOP_RETURN)) { + janet_panicf("last instruction must be jump or return, got %v", x); + } + + /* Detect return type */ + int found_return = 0; + for (uint32_t i = 0; i < pending_count; i++) { + JanetSysInstruction instruction = ir[i]; + if (instruction.opcode == JANET_SYSOP_RETURN) { + JanetPrim ret_type = out->types[instruction.one.src]; + if (found_return) { + if (out->return_type != ret_type) { + janet_panicf("multiple return types: %s and %s", prim_names_by_id[ret_type], prim_names_by_id[out->return_type]); + } + } else { + out->return_type = ret_type; + } + found_return = 1; + } + } + + ir = janet_realloc(ir, sizeof(JanetSysInstruction) * pending_count); + out->instructions = ir; + out->instruction_count = pending_count; + + /* Build constants */ + out->constant_count = next_constant; + out->constants = janet_malloc(sizeof(Janet) * out->constant_count); + for (int32_t i = 0; i < constant_cache->capacity; i++) { + JanetKV kv = constant_cache->data[i]; + if (!janet_checktype(kv.key, JANET_NIL)) { + int32_t index = janet_unwrap_integer(kv.value); + out->constants[index] = kv.key; + } + } + + /* TODO - check if constants are valid since they aren't convered in check_instruction_well_formed */ +} + +void janet_sys_ir_init_from_table(JanetSysIR *ir, JanetTable *table) { + ir->instructions = NULL; + ir->types = NULL; + ir->constants = NULL; + ir->link_name = NULL; + ir->type_count = 0; + ir->constant_count = 0; + ir->return_type = JANET_PRIM_S32; + ir->parameter_count = 0; + Janet assembly = janet_table_get(table, janet_ckeywordv("instructions")); + Janet types = janet_table_get(table, janet_ckeywordv("types")); + Janet param_count = janet_table_get(table, janet_ckeywordv("parameter-count")); + Janet link_namev = janet_table_get(table, janet_ckeywordv("link-name")); + JanetView asm_view = janet_getindexed(&assembly, 0); + JanetView type_view = janet_getindexed(&types, 0); + JanetString link_name = janet_getstring(&link_namev, 0); + int32_t parameter_count = janet_getnat(¶m_count, 0); + ir->parameter_count = parameter_count; + ir->link_name = link_name; + janet_sysir_init_types(ir, type_view); + janet_sysir_init_instructions(ir, asm_view); +} + +/* 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", + "char *", + "bool" +}; + +void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { + +#define EMITBINOP(OP) \ + janet_formatb(buffer, "_r%u = _r%u " OP " _r%u;\n", instruction.three.dest, instruction.three.lhs, instruction.three.rhs) + + janet_formatb(buffer, "%s %s(", c_prim_names[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, "%s _r%u", c_prim_names[ir->types[i]], i); + } + janet_buffer_push_cstring(buffer, ")\n{\n"); + for (uint32_t i = ir->parameter_count; i < ir->type_count; i++) { + janet_formatb(buffer, " %s _r%u;\n", c_prim_names[ir->types[i]], i); + } + janet_buffer_push_cstring(buffer, "\n"); + JanetBuffer *call_buffer = janet_buffer(0); + for (uint32_t i = 0; i < ir->instruction_count; i++) { + janet_formatb(buffer, "_i%u:\n ", i); + JanetSysInstruction instruction = ir->instructions[i]; + switch (instruction.opcode) { + case JANET_SYSOP_CONSTANT: + { + const char *cast = c_prim_names[ir->types[instruction.two.dest]]; + janet_formatb(buffer, "_r%u = (%s) %j;\n", instruction.two.dest, cast, ir->constants[instruction.two.src]); + break; + } + case JANET_SYSOP_ADDRESS: + janet_formatb(buffer, "_r%u = &_r%u;\n", instruction.two.dest, instruction.two.src); + break; + case JANET_SYSOP_JUMP: + janet_formatb(buffer, "goto _i%u;\n", instruction.jump.to); + break; + case JANET_SYSOP_BRANCH: + janet_formatb(buffer, "if (_r%u) goto _i%u;\n", instruction.branch.cond, instruction.branch.to); + break; + case JANET_SYSOP_RETURN: + janet_formatb(buffer, "return _r%u;\n", instruction.one.src); + break; + case JANET_SYSOP_ADD: + EMITBINOP("+"); + break; + case JANET_SYSOP_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_PUSH1: + janet_formatb(call_buffer, "%s_r%u", call_buffer->count ? ", " : "", instruction.one.src); + janet_buffer_push_cstring(buffer, "/* push1 */\n"); + break; + case JANET_SYSOP_PUSH2: + janet_formatb(call_buffer, "%s_r%u, _r%u", call_buffer->count ? ", " : "", instruction.two.dest, instruction.two.src); + janet_buffer_push_cstring(buffer, "/* push2 */\n"); + break; + case JANET_SYSOP_PUSH3: + janet_formatb(call_buffer, "%s_r%u, _r%u, _r%u", call_buffer->count ? ", " : "", instruction.three.dest, instruction.three.lhs, instruction.three.rhs); + janet_buffer_push_cstring(buffer, "/* push3 */\n"); + break; + case JANET_SYSOP_CALL: + janet_formatb(buffer, "_r%u = _r%u(%s);\n", instruction.call.dest, instruction.call.callee, call_buffer->data); + call_buffer->count = 0; + break; + case JANET_SYSOP_MOVE: + janet_formatb(buffer, "_r%u = _r%u;\n", instruction.two.dest, instruction.two.src); + break; + case JANET_SYSOP_BNOT: + janet_formatb(buffer, "_r%u = ~_r%u;\n", instruction.two.dest, instruction.two.src); + break; + case JANET_SYSOP_LOAD: + janet_formatb(buffer, "_r%u = *_r%u", instruction.two.dest, instruction.two.src); + break; + case JANET_SYSOP_STORE: + janet_formatb(buffer, "*_r%u = _r%u", instruction.two.dest, instruction.two.src); + break; + } + } + + janet_buffer_push_cstring(buffer, "}\n"); +#undef EMITBINOP + +} + +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); + return 0; +} + +static int sysir_gcmark(void *p, size_t s) { + JanetSysIR *ir = (JanetSysIR *)p; + (void) s; + for (uint32_t i = 0; i < ir->constant_count; i++) { + janet_mark(ir->constants[i]); + } + if (ir->link_name != NULL) { + janet_mark(janet_wrap_string(ir->link_name)); + } + return 0; +} + +static const JanetAbstractType janet_sysir_type = { + "core/sysir", + sysir_gc, + sysir_gcmark, + JANET_ATEND_GCMARK +}; + +JANET_CORE_FN(cfun_sysir_asm, + "(sysdialect/asm assembly)", + "Compile the system dialect IR into an object that can be manipulated, optimized, or lowered to other targets like C.") { + janet_fixarity(argc, 1); + JanetTable *tab = janet_gettable(argv, 0); + JanetSysIR *sysir = janet_abstract(&janet_sysir_type, sizeof(JanetSysIR)); + janet_sys_ir_init_from_table(sysir, tab); + return janet_wrap_abstract(sysir); +} + +JANET_CORE_FN(cfun_sysir_toc, + "(sysdialect/to-c sysir &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); + JanetSysIR *ir = janet_getabstract(argv, 0, &janet_sysir_type); + JanetBuffer *buffer = janet_optbuffer(argv, argc, 1, 0); + janet_sys_ir_lower_to_c(ir, buffer); + return janet_wrap_buffer(buffer); +} + +void janet_lib_sysir(JanetTable *env) { + JanetRegExt cfuns[] = { + JANET_CORE_REG("sysdialect/asm", cfun_sysir_asm), + JANET_CORE_REG("sysdialect/to-c", cfun_sysir_toc), + JANET_REG_END + }; + janet_core_cfuns_ext(env, NULL, cfuns); +} From fd7579dd071f6f9d0d364530ee9d8604406a8041 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 8 Apr 2023 10:51:46 -0500 Subject: [PATCH 02/21] More work on the sys-ir. --- src/core/sysir.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/core/sysir.c b/src/core/sysir.c index fa723eb1..ec0d7530 100644 --- a/src/core/sysir.c +++ b/src/core/sysir.c @@ -600,7 +600,7 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { break; } case JANET_SYSOP_ADDRESS: - janet_formatb(buffer, "_r%u = &_r%u;\n", instruction.two.dest, instruction.two.src); + janet_formatb(buffer, "_r%u = (char *) &_r%u;\n", instruction.two.dest, instruction.two.src); break; case JANET_SYSOP_JUMP: janet_formatb(buffer, "goto _i%u;\n", instruction.jump.to); @@ -679,10 +679,10 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { janet_formatb(buffer, "_r%u = ~_r%u;\n", instruction.two.dest, instruction.two.src); break; case JANET_SYSOP_LOAD: - janet_formatb(buffer, "_r%u = *_r%u", instruction.two.dest, instruction.two.src); + janet_formatb(buffer, "_r%u = *((%s *) _r%u)", instruction.two.dest, c_prim_names[ir->types[instruction.two.dest]], instruction.two.src); break; case JANET_SYSOP_STORE: - janet_formatb(buffer, "*_r%u = _r%u", instruction.two.dest, instruction.two.src); + janet_formatb(buffer, "*((%s *) _r%u) = _r%u", c_prim_names[ir->types[instruction.two.src]], instruction.two.dest, instruction.two.src); break; } } From ef94a0f0b4cf9afd390e05a358f35f1f12d857fe Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 12 May 2023 18:10:52 -0500 Subject: [PATCH 03/21] Rename sysdialect to sysir --- examples/sysdialect_asm.janet | 10 ++ src/core/sysir.c | 194 ++++++++++++++++------------------ 2 files changed, 102 insertions(+), 102 deletions(-) create mode 100644 examples/sysdialect_asm.janet diff --git a/examples/sysdialect_asm.janet b/examples/sysdialect_asm.janet new file mode 100644 index 00000000..f1919039 --- /dev/null +++ b/examples/sysdialect_asm.janet @@ -0,0 +1,10 @@ +(def ir-asm + @{:instructions + '((add 2 1 0) + (return 2)) + :types + '(s32 s32 s32) + :parameter-count 2 + :link-name "add_2_ints"}) + +(-> ir-asm sysir/asm sysir/to-c print) diff --git a/src/core/sysir.c b/src/core/sysir.c index ec0d7530..9464953a 100644 --- a/src/core/sysir.c +++ b/src/core/sysir.c @@ -284,7 +284,7 @@ static void janet_sysir_init_types(JanetSysIR *out, JanetView types) { } 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); + sizeof(prim_names) / sizeof(prim_names[0]), sizeof(prim_names[0]), sym_type); if (NULL == namedata) { janet_panicf("unknown type %v", x); } @@ -313,81 +313,73 @@ static void check_instruction_well_formed(JanetSysInstruction instruction, Janet case JANET_SYSOP_ADD: case JANET_SYSOP_SUBTRACT: case JANET_SYSOP_MULTIPLY: - case JANET_SYSOP_DIVIDE: - { - JanetPrim pdest = ir->types[instruction.three.dest]; - JanetPrim plhs = ir->types[instruction.three.lhs]; - JanetPrim prhs = ir->types[instruction.three.rhs]; - if ((pdest != prhs) || (prhs != plhs)) fail = 1; - if (!((1u << pdest) & NUMBER_FLAGS)) fail = 1; - break; - } + case JANET_SYSOP_DIVIDE: { + JanetPrim pdest = ir->types[instruction.three.dest]; + JanetPrim plhs = ir->types[instruction.three.lhs]; + JanetPrim prhs = ir->types[instruction.three.rhs]; + if ((pdest != prhs) || (prhs != plhs)) fail = 1; + if (!((1u << pdest) & NUMBER_FLAGS)) fail = 1; + break; + } case JANET_SYSOP_LT: case JANET_SYSOP_LTE: case JANET_SYSOP_GT: case JANET_SYSOP_GTE: case JANET_SYSOP_EQ: - case JANET_SYSOP_NEQ: - { - JanetPrim pdest = ir->types[instruction.three.dest]; - JanetPrim plhs = ir->types[instruction.three.lhs]; - JanetPrim prhs = ir->types[instruction.three.rhs]; - if ((pdest != JANET_PRIM_BOOLEAN) || (prhs != plhs)) fail = 1; - if (!((1u << pdest) & NUMBER_FLAGS)) fail = 1; - break; - } + case JANET_SYSOP_NEQ: { + JanetPrim pdest = ir->types[instruction.three.dest]; + JanetPrim plhs = ir->types[instruction.three.lhs]; + JanetPrim prhs = ir->types[instruction.three.rhs]; + if ((pdest != JANET_PRIM_BOOLEAN) || (prhs != plhs)) fail = 1; + if (!((1u << pdest) & NUMBER_FLAGS)) fail = 1; + break; + } case JANET_SYSOP_BAND: case JANET_SYSOP_BOR: - case JANET_SYSOP_BXOR: - { - JanetPrim pdest = ir->types[instruction.three.dest]; - JanetPrim plhs = ir->types[instruction.three.lhs]; - JanetPrim prhs = ir->types[instruction.three.rhs]; - if (pdest != plhs) fail = 1; - if (pdest != prhs) fail = 1; - if (!((1u << pdest) & INTEGER_FLAGS)) fail = 1; - break; - } + case JANET_SYSOP_BXOR: { + JanetPrim pdest = ir->types[instruction.three.dest]; + JanetPrim plhs = ir->types[instruction.three.lhs]; + JanetPrim prhs = ir->types[instruction.three.rhs]; + if (pdest != plhs) fail = 1; + if (pdest != prhs) fail = 1; + if (!((1u << pdest) & INTEGER_FLAGS)) fail = 1; + break; + } case JANET_SYSOP_SHR: - case JANET_SYSOP_SHL: - { - JanetPrim pdest = ir->types[instruction.three.dest]; - JanetPrim plhs = ir->types[instruction.three.lhs]; - JanetPrim prhs = ir->types[instruction.three.rhs]; - if (pdest != plhs) fail = 1; - if (!((1u << pdest) & INTEGER_FLAGS)) fail = 1; - if (!((1u << prhs) & U_FLAGS)) fail = 1; - break; - } - case JANET_SYSOP_BRANCH: - { - JanetPrim pcond = ir->types[instruction.branch.cond]; - if (!((1u << pcond) & ((1u << JANET_PRIM_BOOLEAN) | INTEGER_FLAGS))) fail = 1; - break; - } - case JANET_SYSOP_MOVE: - { - JanetPrim pdest = ir->types[instruction.two.dest]; - JanetPrim psrc = ir->types[instruction.two.src]; - if (pdest != psrc) fail = 1; - break; - } - case JANET_SYSOP_BNOT: - { - JanetPrim pdest = ir->types[instruction.two.dest]; - JanetPrim psrc = ir->types[instruction.two.src]; - if (pdest != psrc) fail = 1; - if (!((1u << pdest) & INTEGER_FLAGS)) fail = 1; - break; - } - case JANET_SYSOP_ADDRESS: - { - JanetPrim pdest = ir->types[instruction.two.dest]; - if (pdest != JANET_PRIM_POINTER) fail = 1; - break; - } + case JANET_SYSOP_SHL: { + JanetPrim pdest = ir->types[instruction.three.dest]; + JanetPrim plhs = ir->types[instruction.three.lhs]; + JanetPrim prhs = ir->types[instruction.three.rhs]; + if (pdest != plhs) fail = 1; + if (!((1u << pdest) & INTEGER_FLAGS)) fail = 1; + if (!((1u << prhs) & U_FLAGS)) fail = 1; + break; + } + case JANET_SYSOP_BRANCH: { + JanetPrim pcond = ir->types[instruction.branch.cond]; + if (!((1u << pcond) & ((1u << JANET_PRIM_BOOLEAN) | INTEGER_FLAGS))) fail = 1; + break; + } + case JANET_SYSOP_MOVE: { + JanetPrim pdest = ir->types[instruction.two.dest]; + JanetPrim psrc = ir->types[instruction.two.src]; + if (pdest != psrc) fail = 1; + break; + } + case JANET_SYSOP_BNOT: { + JanetPrim pdest = ir->types[instruction.two.dest]; + JanetPrim psrc = ir->types[instruction.two.src]; + if (pdest != psrc) fail = 1; + if (!((1u << pdest) & INTEGER_FLAGS)) fail = 1; + break; + } + case JANET_SYSOP_ADDRESS: { + JanetPrim pdest = ir->types[instruction.two.dest]; + if (pdest != JANET_PRIM_POINTER) fail = 1; + break; + } } - if (fail) janet_panicf("invalid types for instruction %v", x); + if (fail) janet_panicf("invalid types for instruction %V", x); } static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instructions) { @@ -417,7 +409,7 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction x = instructions.items[i]; if (janet_checktype(x, JANET_KEYWORD)) continue; if (!janet_checktype(x, JANET_TUPLE)) { - janet_panicf("expected instruction to be tuple, got %v", x); + janet_panicf("expected instruction to be tuple, got %V", x); } JanetTuple tuple = janet_unwrap_tuple(x); if (janet_tuple_length(tuple) < 1) { @@ -425,13 +417,13 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction } Janet opvalue = tuple[0]; if (!janet_checktype(opvalue, JANET_SYMBOL)) { - janet_panicf("expected opcode symbol, found %v", opvalue); + janet_panicf("expected opcode symbol, found %V", 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); + sizeof(sys_op_names) / sizeof(sys_op_names[0]), sizeof(sys_op_names[0]), opsymbol); if (NULL == namedata) { - janet_panicf("unknown instruction %v", x); + janet_panicf("unknown instruction %.4p", x); } JanetSysOp opcode = namedata->op; JanetSysOpVariant variant = op_variants[opcode]; @@ -441,10 +433,10 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction if (opcode == JANET_SYSOP_CALL) { inside_call = 0; } else if (opcode != JANET_SYSOP_PUSH1 && - opcode != JANET_SYSOP_PUSH2 && - opcode != JANET_SYSOP_PUSH3) { + opcode != JANET_SYSOP_PUSH2 && + opcode != JANET_SYSOP_PUSH3) { janet_panicf("push instructions may only be followed by other push instructions until a call, got %v", - x); + x); } } switch (variant) { @@ -455,7 +447,7 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction instruction.three.rhs = instr_read_operand(tuple[3], max_op); break; case JANET_SYSOPVAR_CALL: - /* TODO - fallthrough for now */ + /* TODO - fallthrough for now */ case JANET_SYSOPVAR_TWO: instr_assert_length(tuple, 3, opvalue); instruction.two.dest = instr_read_operand(tuple[1], max_op); @@ -474,21 +466,20 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction instr_assert_length(tuple, 2, opvalue); instruction.jump.to = instr_read_label(tuple[1], labels, max_label); break; - case JANET_SYSOPVAR_CONSTANT: - { - instr_assert_length(tuple, 3, opvalue); - instruction.constant.dest = instr_read_operand(tuple[1], max_op); - Janet c = tuple[2]; - Janet check = janet_table_get(constant_cache, c); - if (janet_checktype(check, JANET_NUMBER)) { - instruction.constant.constant = (uint32_t) janet_unwrap_number(check); - } else { - instruction.constant.constant = next_constant; - janet_table_put(constant_cache, c, janet_wrap_integer(next_constant)); - next_constant++; - } - break; + case JANET_SYSOPVAR_CONSTANT: { + instr_assert_length(tuple, 3, opvalue); + instruction.constant.dest = instr_read_operand(tuple[1], max_op); + Janet c = tuple[2]; + Janet check = janet_table_get(constant_cache, c); + if (janet_checktype(check, JANET_NUMBER)) { + instruction.constant.constant = (uint32_t) janet_unwrap_number(check); + } else { + instruction.constant.constant = next_constant; + janet_table_put(constant_cache, c, janet_wrap_integer(next_constant)); + next_constant++; } + break; + } } check_instruction_well_formed(instruction, x, out); ir[cursor++] = instruction; @@ -506,7 +497,7 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction JanetPrim ret_type = out->types[instruction.one.src]; if (found_return) { if (out->return_type != ret_type) { - janet_panicf("multiple return types: %s and %s", prim_names_by_id[ret_type], prim_names_by_id[out->return_type]); + janet_panicf("multiple return types is not allowed: %s and %s", prim_names_by_id[ret_type], prim_names_by_id[out->return_type]); } } else { out->return_type = ret_type; @@ -518,7 +509,7 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction ir = janet_realloc(ir, sizeof(JanetSysInstruction) * pending_count); out->instructions = ir; out->instruction_count = pending_count; - + /* Build constants */ out->constant_count = next_constant; out->constants = janet_malloc(sizeof(Janet) * out->constant_count); @@ -593,12 +584,11 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { janet_formatb(buffer, "_i%u:\n ", i); JanetSysInstruction instruction = ir->instructions[i]; switch (instruction.opcode) { - case JANET_SYSOP_CONSTANT: - { - const char *cast = c_prim_names[ir->types[instruction.two.dest]]; - janet_formatb(buffer, "_r%u = (%s) %j;\n", instruction.two.dest, cast, ir->constants[instruction.two.src]); - break; - } + case JANET_SYSOP_CONSTANT: { + const char *cast = c_prim_names[ir->types[instruction.two.dest]]; + janet_formatb(buffer, "_r%u = (%s) %j;\n", instruction.two.dest, cast, ir->constants[instruction.two.src]); + break; + } case JANET_SYSOP_ADDRESS: janet_formatb(buffer, "_r%u = (char *) &_r%u;\n", instruction.two.dest, instruction.two.src); break; @@ -721,7 +711,7 @@ static const JanetAbstractType janet_sysir_type = { }; JANET_CORE_FN(cfun_sysir_asm, - "(sysdialect/asm assembly)", + "(sysir/asm assembly)", "Compile the system dialect IR into an object that can be manipulated, optimized, or lowered to other targets like C.") { janet_fixarity(argc, 1); JanetTable *tab = janet_gettable(argv, 0); @@ -731,8 +721,8 @@ JANET_CORE_FN(cfun_sysir_asm, } JANET_CORE_FN(cfun_sysir_toc, - "(sysdialect/to-c sysir &opt buffer)", - "Lower some IR to a C function. Return a modified buffer that can be passed to a C compiler.") { + "(sysir/to-c sysir &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); JanetSysIR *ir = janet_getabstract(argv, 0, &janet_sysir_type); JanetBuffer *buffer = janet_optbuffer(argv, argc, 1, 0); @@ -742,8 +732,8 @@ JANET_CORE_FN(cfun_sysir_toc, void janet_lib_sysir(JanetTable *env) { JanetRegExt cfuns[] = { - JANET_CORE_REG("sysdialect/asm", cfun_sysir_asm), - JANET_CORE_REG("sysdialect/to-c", cfun_sysir_toc), + JANET_CORE_REG("sysir/asm", cfun_sysir_asm), + JANET_CORE_REG("sysir/to-c", cfun_sysir_toc), JANET_REG_END }; janet_core_cfuns_ext(env, NULL, cfuns); From 29af4a932dc8c8d509a12da14bc2b766526724e9 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 12 May 2023 19:08:00 -0500 Subject: [PATCH 04/21] Fix NAN typo. --- src/core/math.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/math.c b/src/core/math.c index c65294d0..c5aea93f 100644 --- a/src/core/math.c +++ b/src/core/math.c @@ -317,7 +317,7 @@ static double janet_gcd(double x, double y) { #ifdef NAN return NAN; #else - return 0.0 \ 0.0; + return 0.0 / 0.0; #endif } if (isinf(x) || isinf(y)) return INFINITY; From 7cc176f0c079805c7d3ae774da3c0b0b9e807fac Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 16 Jul 2023 16:08:28 -0500 Subject: [PATCH 05/21] Add source mapping to emitted C. --- src/core/sysir.c | 25 ++++++++++++++++++------- 1 file changed, 18 insertions(+), 7 deletions(-) diff --git a/src/core/sysir.c b/src/core/sysir.c index 9464953a..78c0f6dd 100644 --- a/src/core/sysir.c +++ b/src/core/sysir.c @@ -21,13 +21,15 @@ */ /* TODO - * - pointer math, pointer types - * - callk - allow linking to other named functions - * - composite types - support for load, store, move, and function args. - * Have some mechanism for field access (dest = src.offset) - * - support for stack allocation of arrays - * - more math intrinsics - * - better C interface for building up IR + * [ ] pointer math, pointer types + * [ ] callk - allow linking to other named functions + * [ ] composite types - support for load, store, move, and function args. + * [ ] Have some mechanism for field access (dest = src.offset) + * [ ] Related, move type creation as opcodes like in SPIRV - have separate virtual "type slots" and value slots for this. + * [ ] support for stack allocation of arrays + * [ ] more math intrinsics + * [ ] source mapping (using built in Janet source mapping metadata on tuples) + * [ ] better C interface for building up IR */ #ifndef JANET_AMALG @@ -226,6 +228,8 @@ typedef struct { uint32_t constant; } constant; }; + int32_t line; + int32_t column; } JanetSysInstruction; typedef struct { @@ -415,6 +419,8 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction 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 %V", opvalue); @@ -482,6 +488,8 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction } } check_instruction_well_formed(instruction, x, out); + instruction.line = line; + instruction.column = column; ir[cursor++] = instruction; } /* Check last instruction is jump or return */ @@ -583,6 +591,9 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { for (uint32_t i = 0; i < ir->instruction_count; i++) { janet_formatb(buffer, "_i%u:\n ", i); JanetSysInstruction instruction = ir->instructions[i]; + if (instruction.line > 0) { + janet_formatb(buffer, "#line %d\n ", instruction.line); + } switch (instruction.opcode) { case JANET_SYSOP_CONSTANT: { const char *cast = c_prim_names[ir->types[instruction.two.dest]]; From cfa32d58a7b758d57a741f4bd078ff2690b85c5d Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 6 Aug 2023 15:50:21 -0500 Subject: [PATCH 06/21] More work on sysir, add initial work for recursive types. --- examples/sysdialect_asm.janet | 21 +- src/core/sysir.c | 748 +++++++++++++++++++++------------- 2 files changed, 482 insertions(+), 287 deletions(-) diff --git a/examples/sysdialect_asm.janet b/examples/sysdialect_asm.janet index f1919039..0d5d18d4 100644 --- a/examples/sysdialect_asm.janet +++ b/examples/sysdialect_asm.janet @@ -1,10 +1,17 @@ (def ir-asm @{:instructions - '((add 2 1 0) - (return 2)) - :types - '(s32 s32 s32) - :parameter-count 2 - :link-name "add_2_ints"}) + '((prim 0 s32) + (bind 0 0) + (bind 1 0) + (bind 2 0) + #(constant 0 10) + (constant 1 20) + (add 2 1 0) + (return 2)) + :parameter-count 0 + :link-name "main"}) -(-> ir-asm sysir/asm sysir/to-c print) +(def as (sysir/asm ir-asm)) +(print :did-assemble) +(os/sleep 0.5) +(print (sysir/to-c as)) diff --git a/src/core/sysir.c b/src/core/sysir.c index 78c0f6dd..e4cb89b3 100644 --- a/src/core/sysir.c +++ b/src/core/sysir.c @@ -22,7 +22,7 @@ /* TODO * [ ] pointer math, pointer types - * [ ] callk - allow linking to other named functions + * [x] callk - allow linking to other named functions * [ ] composite types - support for load, store, move, and function args. * [ ] Have some mechanism for field access (dest = src.offset) * [ ] Related, move type creation as opcodes like in SPIRV - have separate virtual "type slots" and value slots for this. @@ -89,18 +89,9 @@ static const char *prim_names_by_id[] = { "boolean", }; -typedef enum { - JANET_SYSOPVAR_THREE, - JANET_SYSOPVAR_TWO, - JANET_SYSOPVAR_ONE, - JANET_SYSOPVAR_JUMP, - JANET_SYSOPVAR_BRANCH, - JANET_SYSOPVAR_CALL, - JANET_SYSOPVAR_CONSTANT -} JanetSysOpVariant; - typedef enum { JANET_SYSOP_MOVE, + JANET_SYSOP_CAST, JANET_SYSOP_ADD, JANET_SYSOP_SUBTRACT, JANET_SYSOP_MULTIPLY, @@ -124,43 +115,14 @@ typedef enum { JANET_SYSOP_RETURN, JANET_SYSOP_JUMP, JANET_SYSOP_BRANCH, - JANET_SYSOP_PUSH1, - JANET_SYSOP_PUSH2, - JANET_SYSOP_PUSH3, JANET_SYSOP_ADDRESS, + JANET_SYSOP_CALLK, + JANET_SYSOP_TYPE_PRIMITIVE, + JANET_SYSOP_TYPE_STRUCT, + JANET_SYSOP_TYPE_BIND, + JANET_SYSOP_ARG } JanetSysOp; -static const JanetSysOpVariant op_variants[] = { - JANET_SYSOPVAR_TWO, /* JANET_SYSOP_MOVE */ - JANET_SYSOPVAR_THREE, /* JANET_SYSOP_ADD */ - JANET_SYSOPVAR_THREE, /* JANET_SYSOP_SUBTRACT */ - JANET_SYSOPVAR_THREE, /* JANET_SYSOP_MULTIPLY */ - JANET_SYSOPVAR_THREE, /* JANET_SYSOP_DIVIDE */ - JANET_SYSOPVAR_THREE, /* JANET_SYSOP_BAND */ - JANET_SYSOPVAR_THREE, /* JANET_SYSOP_BOR */ - JANET_SYSOPVAR_THREE, /* JANET_SYSOP_BXOR */ - JANET_SYSOPVAR_TWO, /* JANET_SYSOP_BNOT */ - JANET_SYSOPVAR_THREE, /* JANET_SYSOP_SHL */ - JANET_SYSOPVAR_THREE, /* JANET_SYSOP_SHR */ - JANET_SYSOPVAR_TWO, /* JANET_SYSOP_LOAD */ - JANET_SYSOPVAR_TWO, /* JANET_SYSOP_STORE */ - JANET_SYSOPVAR_THREE, /* JANET_SYSOP_GT */ - JANET_SYSOPVAR_THREE, /* JANET_SYSOP_LT */ - JANET_SYSOPVAR_THREE, /* JANET_SYSOP_EQ */ - JANET_SYSOPVAR_THREE, /* JANET_SYSOP_NEQ */ - JANET_SYSOPVAR_THREE, /* JANET_SYSOP_GTE */ - JANET_SYSOPVAR_THREE, /* JANET_SYSOP_LTE */ - JANET_SYSOPVAR_CONSTANT, /* JANET_SYSOP_CONSTANT */ - JANET_SYSOPVAR_CALL, /* JANET_SYSOP_CALL */ - JANET_SYSOPVAR_ONE, /* JANET_SYSOP_RETURN */ - JANET_SYSOPVAR_JUMP, /* JANET_SYSOP_JUMP */ - JANET_SYSOPVAR_BRANCH, /* JANET_SYSOP_BRANCH */ - JANET_SYSOPVAR_ONE, /* JANET_SYSOP_PUSH1 */ - JANET_SYSOPVAR_TWO, /* JANET_SYSOP_PUSH1 */ - JANET_SYSOPVAR_THREE, /* JANET_SYSOP_PUSH1 */ - JANET_SYSOPVAR_TWO, /* JANET_SYSOP_ADDRESS */ -}; - typedef struct { const char *name; JanetSysOp op; @@ -170,11 +132,13 @@ static const JanetSysInstrName sys_op_names[] = { {"add", JANET_SYSOP_ADD}, {"address", JANET_SYSOP_ADDRESS}, {"band", JANET_SYSOP_BAND}, + {"bind", JANET_SYSOP_TYPE_BIND}, {"bnot", JANET_SYSOP_BNOT}, {"bor", JANET_SYSOP_BOR}, {"branch", JANET_SYSOP_BRANCH}, {"bxor", JANET_SYSOP_BXOR}, {"call", JANET_SYSOP_CALL}, + {"cast", JANET_SYSOP_CAST}, {"constant", JANET_SYSOP_CONSTANT}, {"divide", JANET_SYSOP_DIVIDE}, {"eq", JANET_SYSOP_EQ}, @@ -187,16 +151,20 @@ static const JanetSysInstrName sys_op_names[] = { {"move", JANET_SYSOP_MOVE}, {"multiply", JANET_SYSOP_MULTIPLY}, {"neq", JANET_SYSOP_NEQ}, - {"push1", JANET_SYSOP_PUSH1}, - {"push2", JANET_SYSOP_PUSH2}, - {"push3", JANET_SYSOP_PUSH3}, + {"prim", JANET_SYSOP_TYPE_PRIMITIVE}, {"return", JANET_SYSOP_RETURN}, {"shl", JANET_SYSOP_SHL}, {"shr", JANET_SYSOP_SHR}, {"store", JANET_SYSOP_STORE}, + {"struct", JANET_SYSOP_TYPE_STRUCT}, {"subtract", JANET_SYSOP_SUBTRACT}, }; +typedef struct { + size_t field_count; + JanetPrim prim; +} JanetSysTypeInfo; + typedef struct { JanetSysOp opcode; union { @@ -208,6 +176,7 @@ typedef struct { struct { uint32_t dest; uint32_t callee; + uint32_t arg_count; } call; struct { uint32_t dest; @@ -227,6 +196,26 @@ typedef struct { uint32_t dest; uint32_t constant; } constant; + struct { + uint32_t dest; + uint32_t constant; + uint32_t arg_count; + } callk; + struct { + uint32_t dest_type; + uint32_t prim; + } type_prim; + struct { + uint32_t dest_type; + uint32_t arg_count; + } type_types; + struct { + uint32_t dest; + uint32_t type; + } type_bind; + struct { + uint32_t args[3]; + } arg; }; int32_t line; int32_t column; @@ -235,179 +224,81 @@ typedef struct { typedef struct { JanetString link_name; uint32_t instruction_count; - uint32_t type_count; + uint32_t register_count; + uint32_t type_def_count; uint32_t constant_count; - JanetPrim *types; - JanetPrim return_type; + uint32_t return_type; + uint32_t *types; + JanetSysTypeInfo *type_defs; JanetSysInstruction *instructions; Janet *constants; uint32_t parameter_count; } JanetSysIR; +/* 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 %v", len, x); } } -static uint32_t instr_read_operand(Janet x, int32_t max_operand) { - int32_t operand = 0; - int fail = 0; - if (!janet_checkint(x)) fail = 1; - if (!fail) { - operand = janet_unwrap_integer(x); - if (operand < 0) fail = 1; - if (operand > max_operand) fail = 1; +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 ength %d, got %v", minlen, x); } - if (fail) janet_panicf("expected integer operand in range [0, %d], got %v", max_operand, x); - return (uint32_t) operand; } -static uint32_t instr_read_label(Janet x, JanetTable *labels, int32_t max_label) { - int32_t operand = 0; - int fail = 0; +static uint32_t instr_read_operand(Janet x, JanetSysIR *ir) { + if (!janet_checkuint(x)) janet_panicf("expected non-negative integer operand, got %v", 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_type_operand(Janet x, JanetSysIR *ir) { + if (!janet_checkuint(x)) janet_panicf("expected non-negative integer operand, got %v", x); + uint32_t operand = (uint32_t) janet_unwrap_number(x); + if (operand >= ir->type_def_count) { + ir->type_def_count = operand + 1; + } + return operand; +} + +static JanetPrim instr_read_prim(Janet x) { + if (!janet_checktype(x, JANET_SYMBOL)) { + janet_panicf("expected primitive type, got %v", 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 type %v", x); + } + return namedata->prim; +} + +static uint32_t instr_read_label(Janet x, JanetTable *labels) { Janet check = janet_table_get(labels, x); if (!janet_checktype(check, JANET_NIL)) return (uint32_t) janet_unwrap_number(check); - if (!janet_checkint(x)) fail = 1; - if (!fail) { - operand = janet_unwrap_integer(x); - if (operand < 0) fail = 1; - if (operand > max_label) fail = 1; - } - if (fail) janet_panicf("expected label in range [0, %d], got %v", max_label, x); - return (uint32_t) operand; -} - -static void janet_sysir_init_types(JanetSysIR *out, JanetView types) { - uint32_t type_count = types.len; - out->types = janet_malloc(sizeof(JanetPrim) * type_count); - for (int32_t i = 0; i < types.len; i++) { - Janet x = types.items[i]; - if (!janet_checktype(x, JANET_SYMBOL)) { - janet_panicf("expected primitive type, got %v", 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 type %v", x); - } - out->types[i] = namedata->prim; - } - out->type_count = type_count; -} - -#define U_FLAGS ((1u << JANET_PRIM_U8) | (1u << JANET_PRIM_U16) | (1u << JANET_PRIM_U32) | (1u << JANET_PRIM_U64)) -#define S_FLAGS ((1u << JANET_PRIM_S8) | (1u << JANET_PRIM_S16) | (1u << JANET_PRIM_S32) | (1u << JANET_PRIM_S64)) -#define F_FLAGS ((1u << JANET_PRIM_F32) | (1u << JANET_PRIM_F64)) -#define NUMBER_FLAGS (U_FLAGS | S_FLAGS | F_FLAGS) -#define INTEGER_FLAGS (U_FLAGS | S_FLAGS) - -/* Mainly check the instruction arguments are of compatible types */ -static void check_instruction_well_formed(JanetSysInstruction instruction, Janet x, JanetSysIR *ir) { - int fail = 0; - switch (instruction.opcode) { - /* TODO */ - /* case JANET_SYSOP_CALL: */ - /* case JANET_SYSOP_CONSTANT: */ - /* case JANET_SYSOP_JUMP: */ - /* case JANET_SYSOP_ADDRESS: */ - default: - break; - case JANET_SYSOP_ADD: - case JANET_SYSOP_SUBTRACT: - case JANET_SYSOP_MULTIPLY: - case JANET_SYSOP_DIVIDE: { - JanetPrim pdest = ir->types[instruction.three.dest]; - JanetPrim plhs = ir->types[instruction.three.lhs]; - JanetPrim prhs = ir->types[instruction.three.rhs]; - if ((pdest != prhs) || (prhs != plhs)) fail = 1; - if (!((1u << pdest) & NUMBER_FLAGS)) fail = 1; - break; - } - case JANET_SYSOP_LT: - case JANET_SYSOP_LTE: - case JANET_SYSOP_GT: - case JANET_SYSOP_GTE: - case JANET_SYSOP_EQ: - case JANET_SYSOP_NEQ: { - JanetPrim pdest = ir->types[instruction.three.dest]; - JanetPrim plhs = ir->types[instruction.three.lhs]; - JanetPrim prhs = ir->types[instruction.three.rhs]; - if ((pdest != JANET_PRIM_BOOLEAN) || (prhs != plhs)) fail = 1; - if (!((1u << pdest) & NUMBER_FLAGS)) fail = 1; - break; - } - case JANET_SYSOP_BAND: - case JANET_SYSOP_BOR: - case JANET_SYSOP_BXOR: { - JanetPrim pdest = ir->types[instruction.three.dest]; - JanetPrim plhs = ir->types[instruction.three.lhs]; - JanetPrim prhs = ir->types[instruction.three.rhs]; - if (pdest != plhs) fail = 1; - if (pdest != prhs) fail = 1; - if (!((1u << pdest) & INTEGER_FLAGS)) fail = 1; - break; - } - case JANET_SYSOP_SHR: - case JANET_SYSOP_SHL: { - JanetPrim pdest = ir->types[instruction.three.dest]; - JanetPrim plhs = ir->types[instruction.three.lhs]; - JanetPrim prhs = ir->types[instruction.three.rhs]; - if (pdest != plhs) fail = 1; - if (!((1u << pdest) & INTEGER_FLAGS)) fail = 1; - if (!((1u << prhs) & U_FLAGS)) fail = 1; - break; - } - case JANET_SYSOP_BRANCH: { - JanetPrim pcond = ir->types[instruction.branch.cond]; - if (!((1u << pcond) & ((1u << JANET_PRIM_BOOLEAN) | INTEGER_FLAGS))) fail = 1; - break; - } - case JANET_SYSOP_MOVE: { - JanetPrim pdest = ir->types[instruction.two.dest]; - JanetPrim psrc = ir->types[instruction.two.src]; - if (pdest != psrc) fail = 1; - break; - } - case JANET_SYSOP_BNOT: { - JanetPrim pdest = ir->types[instruction.two.dest]; - JanetPrim psrc = ir->types[instruction.two.src]; - if (pdest != psrc) fail = 1; - if (!((1u << pdest) & INTEGER_FLAGS)) fail = 1; - break; - } - case JANET_SYSOP_ADDRESS: { - JanetPrim pdest = ir->types[instruction.two.dest]; - if (pdest != JANET_PRIM_POINTER) fail = 1; - break; - } - } - if (fail) janet_panicf("invalid types for instruction %V", x); + if (!janet_checkuint(x)) janet_panicf("expected non-negative integer label, got %v", x); + return (uint32_t) janet_unwrap_number(x); } static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instructions) { - uint32_t pending_count = instructions.len; - JanetSysInstruction *ir = janet_malloc(sizeof(JanetSysInstruction) * pending_count); + + // TODO - add labels back + + JanetSysInstruction *ir = janet_malloc(sizeof(JanetSysInstruction) * 100); out->instructions = ir; uint32_t cursor = 0; - int32_t max_op = out->type_count - 1; - int32_t max_label = 0; - int inside_call = false; - /* TODO - preserve labels in generated output (c) */ JanetTable *labels = janet_table(0); JanetTable *constant_cache = janet_table(0); uint32_t next_constant = 0; - for (int32_t i = 0; i < instructions.len; i++) { - Janet x = instructions.items[i]; - if (janet_checktype(x, JANET_KEYWORD)) { - janet_table_put(labels, x, janet_wrap_integer(max_label)); - } else { - max_label++; - } - } - pending_count = max_label; - max_label--; + + /* Parse instructions */ Janet x = janet_wrap_nil(); for (int32_t i = 0; i < instructions.len; i++) { x = instructions.items[i]; @@ -432,127 +323,366 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction janet_panicf("unknown instruction %.4p", x); } JanetSysOp opcode = namedata->op; - JanetSysOpVariant variant = op_variants[opcode]; JanetSysInstruction instruction; instruction.opcode = opcode; - if (inside_call) { - if (opcode == JANET_SYSOP_CALL) { - inside_call = 0; - } else if (opcode != JANET_SYSOP_PUSH1 && - opcode != JANET_SYSOP_PUSH2 && - opcode != JANET_SYSOP_PUSH3) { - janet_panicf("push instructions may only be followed by other push instructions until a call, got %v", - x); - } - } - switch (variant) { - case JANET_SYSOPVAR_THREE: + instruction.line = line; + instruction.column = column; + switch (opcode) { + case JANET_SYSOP_CALLK: + case JANET_SYSOP_ARG: + janet_panicf("invalid instruction %v", x); + 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: instr_assert_length(tuple, 4, opvalue); - instruction.three.dest = instr_read_operand(tuple[1], max_op); - instruction.three.lhs = instr_read_operand(tuple[2], max_op); - instruction.three.rhs = instr_read_operand(tuple[3], max_op); + instruction.three.dest = instr_read_operand(tuple[1], out); + instruction.three.lhs = instr_read_operand(tuple[2], out); + instruction.three.rhs = instr_read_operand(tuple[3], out); + ir[cursor++] = instruction; break; - case JANET_SYSOPVAR_CALL: - /* TODO - fallthrough for now */ - case JANET_SYSOPVAR_TWO: + case JANET_SYSOP_CALL: + instr_assert_min_length(tuple, 2, opvalue); + instruction.call.dest = instr_read_operand(tuple[1], out); + Janet c = tuple[2]; + if (janet_checktype(c, JANET_SYMBOL)) { + Janet check = janet_table_get(constant_cache, c); + if (janet_checktype(check, JANET_NUMBER)) { + instruction.callk.constant = (uint32_t) janet_unwrap_number(check); + } else { + instruction.callk.constant = next_constant; + janet_table_put(constant_cache, c, janet_wrap_integer(next_constant)); + next_constant++; + } + opcode = JANET_SYSOP_CALLK; + instruction.opcode = opcode; + } else { + instruction.call.callee = instr_read_operand(tuple[2], out); + } + instruction.call.arg_count = janet_tuple_length(tuple) - 2; + ir[cursor++] = instruction; + for (int32_t j = 3; 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_operand(tuple[j + k], out); + } + ir[cursor++] = 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], max_op); - instruction.two.src = instr_read_operand(tuple[2], max_op); + instruction.two.dest = instr_read_operand(tuple[1], out); + instruction.two.src = instr_read_operand(tuple[2], out); + ir[cursor++] = instruction; break; - case JANET_SYSOPVAR_ONE: + case JANET_SYSOP_RETURN: instr_assert_length(tuple, 2, opvalue); - instruction.one.src = instr_read_operand(tuple[1], max_op); + instruction.one.src = instr_read_operand(tuple[1], out); + ir[cursor++] = instruction; break; - case JANET_SYSOPVAR_BRANCH: + case JANET_SYSOP_BRANCH: instr_assert_length(tuple, 3, opvalue); - instruction.branch.cond = instr_read_operand(tuple[1], max_op); - instruction.branch.to = instr_read_label(tuple[2], labels, max_label); + instruction.branch.cond = instr_read_operand(tuple[1], out); + instruction.branch.to = instr_read_label(tuple[2], labels); + ir[cursor++] = instruction; break; - case JANET_SYSOPVAR_JUMP: + case JANET_SYSOP_JUMP: instr_assert_length(tuple, 2, opvalue); - instruction.jump.to = instr_read_label(tuple[1], labels, max_label); + instruction.jump.to = instr_read_label(tuple[1], labels); + ir[cursor++] = instruction; break; - case JANET_SYSOPVAR_CONSTANT: { + case JANET_SYSOP_CONSTANT: { instr_assert_length(tuple, 3, opvalue); - instruction.constant.dest = instr_read_operand(tuple[1], max_op); + instruction.constant.dest = instr_read_operand(tuple[1], out); Janet c = tuple[2]; Janet check = janet_table_get(constant_cache, c); if (janet_checktype(check, JANET_NUMBER)) { instruction.constant.constant = (uint32_t) janet_unwrap_number(check); } else { instruction.constant.constant = next_constant; - janet_table_put(constant_cache, c, janet_wrap_integer(next_constant)); + janet_table_put(constant_cache, c, janet_wrap_number(next_constant)); next_constant++; } + ir[cursor++] = 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); + instruction.type_prim.prim = instr_read_prim(tuple[2]); + ir[cursor++] = instruction; + break; + } + case JANET_SYSOP_TYPE_STRUCT: { + instr_assert_length(tuple, 1, opvalue); + instruction.type_types.dest_type = instr_read_type_operand(tuple[1], out); + instruction.type_types.arg_count = janet_tuple_length(tuple) - 1; + ir[cursor++] = 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); + } + ir[cursor++] = arginstr; + } + ir[cursor++] = instruction; + 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); + ir[cursor++] = instruction; break; } } - check_instruction_well_formed(instruction, x, out); - instruction.line = line; - instruction.column = column; - ir[cursor++] = instruction; } + /* Check last instruction is jump or return */ if ((ir[cursor - 1].opcode != JANET_SYSOP_JUMP) && (ir[cursor - 1].opcode != JANET_SYSOP_RETURN)) { janet_panicf("last instruction must be jump or return, got %v", x); } - /* Detect return type */ - int found_return = 0; - for (uint32_t i = 0; i < pending_count; i++) { - JanetSysInstruction instruction = ir[i]; - if (instruction.opcode == JANET_SYSOP_RETURN) { - JanetPrim ret_type = out->types[instruction.one.src]; - if (found_return) { - if (out->return_type != ret_type) { - janet_panicf("multiple return types is not allowed: %s and %s", prim_names_by_id[ret_type], prim_names_by_id[out->return_type]); - } - } else { - out->return_type = ret_type; - } - found_return = 1; - } - } - - ir = janet_realloc(ir, sizeof(JanetSysInstruction) * pending_count); + /* Fix up instructions table */ + ir = janet_realloc(ir, sizeof(JanetSysInstruction) * cursor); out->instructions = ir; - out->instruction_count = pending_count; + out->instruction_count = cursor; /* Build constants */ out->constant_count = next_constant; - out->constants = janet_malloc(sizeof(Janet) * out->constant_count); + out->constants = next_constant ? janet_malloc(sizeof(Janet) * out->constant_count) : NULL; for (int32_t i = 0; i < constant_cache->capacity; i++) { JanetKV kv = constant_cache->data[i]; if (!janet_checktype(kv.key, JANET_NIL)) { - int32_t index = janet_unwrap_integer(kv.value); + uint32_t index = (uint32_t) janet_unwrap_number(kv.value); out->constants[index] = kv.key; } } +} - /* TODO - check if constants are valid since they aren't convered in check_instruction_well_formed */ +/* Build up type tables */ + +static void janet_sysir_init_types(JanetSysIR *sysir) { + if (sysir->type_def_count == 0) { + sysir->type_def_count++; + } + JanetSysTypeInfo *type_defs = janet_malloc(sizeof(JanetSysTypeInfo) * (sysir->type_def_count)); + uint32_t *types = janet_malloc(sizeof(uint32_t) * sysir->register_count); + sysir->type_defs = type_defs; + sysir->types = types; + sysir->type_defs[0].field_count = 0; + sysir->type_defs[0].prim = JANET_PRIM_S32; + for (uint32_t i = 0; i < sysir->instruction_count; i++) { + sysir->types[i] = 0; + } + + for (uint32_t i = 0; i < sysir->instruction_count; i++) { + JanetSysInstruction instruction = sysir->instructions[i]; + switch (instruction.opcode) { + default: + break; + case JANET_SYSOP_TYPE_PRIMITIVE: { + uint32_t type_def = instruction.type_prim.dest_type; + type_defs[type_def].field_count = 0; + type_defs[type_def].prim = instruction.type_prim.prim; + break; + } + case JANET_SYSOP_TYPE_STRUCT: { + uint32_t type_def = instruction.type_types.dest_type; + type_defs[type_def].field_count = 0; /* TODO */ + type_defs[type_def].prim = JANET_PRIM_POINTER; /* TODO */ + break; + } + case JANET_SYSOP_TYPE_BIND: { + uint32_t type = instruction.type_bind.type; + uint32_t dest = instruction.type_bind.dest; + types[dest] = type; + break; + } + } + } +} + +/* Type checking */ + +static void tcheck_boolean(JanetSysIR *sysir, uint32_t reg1) { + uint32_t t1 = sysir->types[reg1]; + if (t1 != JANET_PRIM_BOOLEAN) { + janet_panicf("type failure, expected boolean, got type-id:%d", t1); /* TODO improve this */ + } +} + +static void tcheck_integer(JanetSysIR *sysir, uint32_t reg1) { + uint32_t t1 = sysir->types[reg1]; + 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, expected integer, got type-id:%d", t1); /* TODO improve this */ + } +} + +static void tcheck_pointer(JanetSysIR *sysir, uint32_t reg1) { + uint32_t t1 = sysir->types[reg1]; + if (t1 != JANET_PRIM_POINTER) { + janet_panicf("type failure, expected pointer, got type-id:%d", t1); + } +} + +static void tcheck_equal(JanetSysIR *sysir, uint32_t reg1, uint32_t reg2) { + uint32_t t1 = sysir->types[reg1]; + uint32_t t2 = sysir->types[reg2]; + if (t1 != t2) { + janet_panicf("type failure, type-id:%d does not match type-id:%d", t1, t2); /* TODO improve this */ + } +} + +static void janet_sysir_type_check(JanetSysIR *sysir) { + int found_return = 0; + for (uint32_t i = 0; i < sysir->instruction_count; i++) { + JanetSysInstruction instruction = sysir->instructions[i]; + switch (instruction.opcode) { + case JANET_SYSOP_TYPE_PRIMITIVE: + case JANET_SYSOP_TYPE_STRUCT: + case JANET_SYSOP_TYPE_BIND: + case JANET_SYSOP_ARG: + case JANET_SYSOP_JUMP: + break; + case JANET_SYSOP_RETURN: { + uint32_t ret_type = sysir->types[instruction.one.src]; + if (found_return) { + if (sysir->return_type != ret_type) { + janet_panicf("multiple return types are not allowed: type-id:%d and type-id:%d", ret_type, sysir->return_type); + } + } else { + sysir->return_type = ret_type; + } + found_return = 1; + break; + } + case JANET_SYSOP_MOVE: + tcheck_equal(sysir, instruction.two.dest, instruction.two.src); + break; + case JANET_SYSOP_CAST: + break; + case JANET_SYSOP_ADD: + case JANET_SYSOP_SUBTRACT: + case JANET_SYSOP_MULTIPLY: + case JANET_SYSOP_DIVIDE: + tcheck_equal(sysir, instruction.three.lhs, instruction.three.rhs); + tcheck_equal(sysir, instruction.three.dest, instruction.three.lhs); + break; + case JANET_SYSOP_BAND: + case JANET_SYSOP_BOR: + case JANET_SYSOP_BXOR: + tcheck_integer(sysir, instruction.three.lhs); + tcheck_equal(sysir, instruction.three.lhs, instruction.three.rhs); + tcheck_equal(sysir, instruction.three.dest, instruction.three.lhs); + break; + case JANET_SYSOP_BNOT: + tcheck_integer(sysir, instruction.two.src); + tcheck_equal(sysir, instruction.two.dest, instruction.two.src); + break; + case JANET_SYSOP_SHL: + case JANET_SYSOP_SHR: + tcheck_integer(sysir, instruction.three.lhs); + tcheck_equal(sysir, instruction.three.lhs, instruction.three.rhs); + tcheck_equal(sysir, instruction.three.dest, instruction.three.lhs); + break; + case JANET_SYSOP_LOAD: + tcheck_pointer(sysir, instruction.two.src); + break; + case JANET_SYSOP_STORE: + tcheck_pointer(sysir, instruction.two.dest); + 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: + tcheck_equal(sysir, instruction.three.lhs, instruction.three.rhs); + tcheck_equal(sysir, instruction.three.dest, instruction.three.lhs); + tcheck_boolean(sysir, instruction.three.dest); + break; + case JANET_SYSOP_ADDRESS: + tcheck_pointer(sysir, instruction.two.dest); + break; + case JANET_SYSOP_BRANCH: + tcheck_boolean(sysir, instruction.branch.cond); + break; + case JANET_SYSOP_CONSTANT: + /* TODO - check constant matches type */ + break; + case JANET_SYSOP_CALL: + tcheck_pointer(sysir, instruction.call.callee); + break; + case JANET_SYSOP_CALLK: + /* TODO - check function return type */ + break; + } + } } void janet_sys_ir_init_from_table(JanetSysIR *ir, JanetTable *table) { ir->instructions = NULL; ir->types = NULL; + ir->type_defs = NULL; ir->constants = NULL; ir->link_name = NULL; - ir->type_count = 0; + ir->register_count = 0; + ir->type_def_count = 0; ir->constant_count = 0; - ir->return_type = JANET_PRIM_S32; + ir->return_type = 0; ir->parameter_count = 0; Janet assembly = janet_table_get(table, janet_ckeywordv("instructions")); - Janet types = janet_table_get(table, janet_ckeywordv("types")); Janet param_count = janet_table_get(table, janet_ckeywordv("parameter-count")); Janet link_namev = janet_table_get(table, janet_ckeywordv("link-name")); JanetView asm_view = janet_getindexed(&assembly, 0); - JanetView type_view = janet_getindexed(&types, 0); JanetString link_name = janet_getstring(&link_namev, 0); int32_t parameter_count = janet_getnat(¶m_count, 0); ir->parameter_count = parameter_count; ir->link_name = link_name; - janet_sysir_init_types(ir, type_view); janet_sysir_init_instructions(ir, asm_view); + janet_sysir_init_types(ir); + janet_sysir_type_check(ir); } /* Lowering to C */ @@ -577,27 +707,78 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { #define EMITBINOP(OP) \ janet_formatb(buffer, "_r%u = _r%u " OP " _r%u;\n", instruction.three.dest, instruction.three.lhs, instruction.three.rhs) - janet_formatb(buffer, "%s %s(", c_prim_names[ir->return_type], (ir->link_name != NULL) ? ir->link_name : janet_cstring("_thunk")); + janet_formatb(buffer, "#include \n\n"); + + /* Emit type defs */ + 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: + 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: + janet_formatb(buffer, "typedef struct {\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; + } + } + + /* Emit header */ + janet_formatb(buffer, "_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, "%s _r%u", c_prim_names[ir->types[i]], i); + 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->type_count; i++) { - janet_formatb(buffer, " %s _r%u;\n", c_prim_names[ir->types[i]], i); + 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"); - JanetBuffer *call_buffer = janet_buffer(0); + + /* Emit body */ for (uint32_t i = 0; i < ir->instruction_count; i++) { - janet_formatb(buffer, "_i%u:\n ", i); JanetSysInstruction instruction = ir->instructions[i]; + /* Skip instruction label for some opcodes */ + switch (instruction.opcode) { + case JANET_SYSOP_TYPE_PRIMITIVE: + case JANET_SYSOP_TYPE_BIND: + case JANET_SYSOP_TYPE_STRUCT: + case JANET_SYSOP_ARG: + continue; + default: + break; + } + janet_formatb(buffer, "_i%u:\n ", 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_ARG: + break; case JANET_SYSOP_CONSTANT: { - const char *cast = c_prim_names[ir->types[instruction.two.dest]]; - janet_formatb(buffer, "_r%u = (%s) %j;\n", instruction.two.dest, cast, ir->constants[instruction.two.src]); + uint32_t cast = ir->types[instruction.two.dest]; + janet_formatb(buffer, "_r%u = (_t%u) %j;\n", instruction.two.dest, cast, ir->constants[instruction.two.src]); break; } case JANET_SYSOP_ADDRESS: @@ -657,21 +838,28 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { case JANET_SYSOP_SHR: EMITBINOP(">>"); break; - case JANET_SYSOP_PUSH1: - janet_formatb(call_buffer, "%s_r%u", call_buffer->count ? ", " : "", instruction.one.src); - janet_buffer_push_cstring(buffer, "/* push1 */\n"); - break; - case JANET_SYSOP_PUSH2: - janet_formatb(call_buffer, "%s_r%u, _r%u", call_buffer->count ? ", " : "", instruction.two.dest, instruction.two.src); - janet_buffer_push_cstring(buffer, "/* push2 */\n"); - break; - case JANET_SYSOP_PUSH3: - janet_formatb(call_buffer, "%s_r%u, _r%u, _r%u", call_buffer->count ? ", " : "", instruction.three.dest, instruction.three.lhs, instruction.three.rhs); - janet_buffer_push_cstring(buffer, "/* push3 */\n"); - break; case JANET_SYSOP_CALL: - janet_formatb(buffer, "_r%u = _r%u(%s);\n", instruction.call.dest, instruction.call.callee, call_buffer->data); - call_buffer->count = 0; + janet_formatb(buffer, "_r%u = _r%u(", instruction.call.dest, instruction.call.callee); + for (uint32_t j = 0; j < instruction.call.arg_count; j++) { + uint32_t offset = j / 3 + 1; + uint32_t index = j % 3; + JanetSysInstruction arg_instruction = ir->instructions[i + offset]; + janet_formatb(buffer, j ? ", _r%u" : "_r%u", arg_instruction.arg.args[index]); + } + janet_formatb(buffer, ");\n"); + break; + case JANET_SYSOP_CALLK: + janet_formatb(buffer, "_r%u = %j(", instruction.callk.dest, instruction.callk.constant); + for (uint32_t j = 0; j < instruction.callk.arg_count; j++) { + uint32_t offset = j / 3 + 1; + uint32_t index = j % 3; + JanetSysInstruction arg_instruction = ir->instructions[i + offset]; + janet_formatb(buffer, j ? ", _r%u" : "_r%u", arg_instruction.arg.args[index]); + } + janet_formatb(buffer, ");\n"); + break; + case JANET_SYSOP_CAST: + janet_formatb(buffer, "_r%u = _r%u;\n", instruction.two.dest, instruction.two.src); break; case JANET_SYSOP_MOVE: janet_formatb(buffer, "_r%u = _r%u;\n", instruction.two.dest, instruction.two.src); From 75be5fd4c6e07cf616edfc25f3592b2533e2d9a8 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 6 Aug 2023 20:00:49 -0500 Subject: [PATCH 07/21] Update sysir to have better field support. --- examples/sysdialect_asm.janet | 3 + src/core/sysir.c | 103 +++++++++++++++++++++++++++++----- temp.c | 24 -------- 3 files changed, 92 insertions(+), 38 deletions(-) delete mode 100644 temp.c diff --git a/examples/sysdialect_asm.janet b/examples/sysdialect_asm.janet index 4d09976e..a9f82aaf 100644 --- a/examples/sysdialect_asm.janet +++ b/examples/sysdialect_asm.janet @@ -10,12 +10,15 @@ (bind 3 1) (bind 4 1) (bind 5 1) + (bind 6 2) (constant 0 10) (constant 0 21) (add 2 1 0) (constant 3 1.77) (call 3 sin 3) (cast 4 2) + (fset 2 6 0) + (fset 3 6 1) (add 5 4 3) (return 5)) :parameter-count 0 diff --git a/src/core/sysir.c b/src/core/sysir.c index 58437304..3b31dc9c 100644 --- a/src/core/sysir.c +++ b/src/core/sysir.c @@ -23,12 +23,12 @@ /* TODO * [ ] pointer math, pointer types * [x] callk - allow linking to other named functions - * [ ] composite types - support for load, store, move, and function args. - * [ ] Have some mechanism for field access (dest = src.offset) - * [ ] Related, move type creation as opcodes like in SPIRV - have separate virtual "type slots" and value slots for this. + * [x] composite types - support for load, store, move, and function args. + * [x] Have some mechanism for field access (dest = src.offset) + * [x] Related, move type creation as opcodes like in SPIRV - have separate virtual "type slots" and value slots for this. * [ ] support for stack allocation of arrays * [ ] more math intrinsics - * [ ] source mapping (using built in Janet source mapping metadata on tuples) + * [x] source mapping (using built in Janet source mapping metadata on tuples) * [ ] better C interface for building up IR */ @@ -36,6 +36,7 @@ #include "features.h" #include #include "util.h" +#include "vector.h" #include #endif @@ -69,6 +70,7 @@ static const JanetPrimName prim_names[] = { {"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}, @@ -153,8 +155,13 @@ static const JanetSysInstrName sys_op_names[] = { typedef struct { JanetPrim prim; uint32_t field_count; + uint32_t field_start; } JanetSysTypeInfo; +typedef struct { + uint32_t type; +} JanetSysTypeField; + typedef struct { JanetSysOp opcode; union { @@ -206,6 +213,11 @@ typedef struct { struct { uint32_t args[3]; } arg; + struct { + uint32_t r; + uint32_t st; + uint32_t field; + } field; }; int32_t line; int32_t column; @@ -216,10 +228,12 @@ typedef struct { uint32_t instruction_count; uint32_t register_count; uint32_t type_def_count; + uint32_t field_def_count; uint32_t constant_count; uint32_t return_type; uint32_t *types; JanetSysTypeInfo *type_defs; + JanetSysTypeField *field_defs; JanetSysInstruction *instructions; Janet *constants; uint32_t parameter_count; @@ -248,6 +262,13 @@ static uint32_t instr_read_operand(Janet x, JanetSysIR *ir) { return operand; } +static uint32_t instr_read_field(Janet x, JanetSysIR *ir) { + if (!janet_checkuint(x)) janet_panicf("expected non-negative field index, got %v", x); + (void) ir; /* Perhaps support syntax for named fields instead of numbered */ + uint32_t operand = (uint32_t) janet_unwrap_number(x); + return operand; +} + static uint32_t instr_read_type_operand(Janet x, JanetSysIR *ir) { if (!janet_checkuint(x)) janet_panicf("expected non-negative integer operand, got %v", x); uint32_t operand = (uint32_t) janet_unwrap_number(x); @@ -390,6 +411,14 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction instruction.two.src = instr_read_operand(tuple[2], out); ir[cursor++] = instruction; break; + case JANET_SYSOP_FIELD_GET: + case JANET_SYSOP_FIELD_SET: + 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); + ir[cursor++] = instruction; + break; case JANET_SYSOP_RETURN: instr_assert_length(tuple, 2, opvalue); instruction.one.src = instr_read_operand(tuple[1], out); @@ -483,8 +512,8 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction } /* Build up type tables */ - static void janet_sysir_init_types(JanetSysIR *sysir) { + JanetSysTypeField *fields = NULL; if (sysir->type_def_count == 0) { sysir->type_def_count++; } @@ -494,6 +523,7 @@ static void janet_sysir_init_types(JanetSysIR *sysir) { sysir->types = types; sysir->type_defs[0].field_count = 0; sysir->type_defs[0].prim = JANET_PRIM_S32; +_i4: for (uint32_t i = 0; i < sysir->register_count; i++) { sysir->types[i] = 0; } @@ -511,8 +541,18 @@ static void janet_sysir_init_types(JanetSysIR *sysir) { } case JANET_SYSOP_TYPE_STRUCT: { uint32_t type_def = instruction.type_types.dest_type; - type_defs[type_def].field_count = 0; /* TODO */ + type_defs[type_def].field_count = instruction.type_types.arg_count; type_defs[type_def].prim = JANET_PRIM_STRUCT; + type_defs[type_def].field_start = (uint32_t) janet_v_count(fields); + 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 = sysir->instructions[i + offset]; + uint32_t arg = arg_instruction.arg.args[index]; + JanetSysTypeField field; + field.type = arg; + janet_v_push(fields, field); + } break; } case JANET_SYSOP_TYPE_BIND: { @@ -523,19 +563,21 @@ static void janet_sysir_init_types(JanetSysIR *sysir) { } } } + + sysir->field_defs = janet_v_flatten(fields); } /* Type checking */ static void tcheck_boolean(JanetSysIR *sysir, uint32_t reg1) { uint32_t t1 = sysir->types[reg1]; - if (t1 != JANET_PRIM_BOOLEAN) { + if (sysir->type_defs[t1].prim != JANET_PRIM_BOOLEAN) { janet_panicf("type failure, expected boolean, got type-id:%d", t1); /* TODO improve this */ } } static void tcheck_integer(JanetSysIR *sysir, uint32_t reg1) { - uint32_t t1 = sysir->types[reg1]; + JanetPrim t1 = sysir->type_defs[sysir->types[reg1]].prim; if (t1 != JANET_PRIM_S32 && t1 != JANET_PRIM_S64 && t1 != JANET_PRIM_S16 && @@ -550,11 +592,18 @@ static void tcheck_integer(JanetSysIR *sysir, uint32_t reg1) { static void tcheck_pointer(JanetSysIR *sysir, uint32_t reg1) { uint32_t t1 = sysir->types[reg1]; - if (t1 != JANET_PRIM_POINTER) { + if (sysir->type_defs[t1].prim != JANET_PRIM_POINTER) { janet_panicf("type failure, expected pointer, got type-id:%d", t1); } } +static void tcheck_struct(JanetSysIR *sysir, uint32_t reg1) { + uint32_t t1 = sysir->types[reg1]; + if (sysir->type_defs[t1].prim != JANET_PRIM_STRUCT) { + janet_panicf("type failure, expected struct, got type-id:%d", t1); + } +} + static void tcheck_equal(JanetSysIR *sysir, uint32_t reg1, uint32_t reg2) { uint32_t t1 = sysir->types[reg1]; uint32_t t2 = sysir->types[reg2]; @@ -643,6 +692,20 @@ static void janet_sysir_type_check(JanetSysIR *sysir) { case JANET_SYSOP_CALL: tcheck_pointer(sysir, instruction.call.callee); break; + case JANET_SYSOP_FIELD_GET: + case JANET_SYSOP_FIELD_SET: + tcheck_struct(sysir, instruction.field.st); + uint32_t struct_type = sysir->types[instruction.field.st]; + if (instruction.field.field >= sysir->type_defs[struct_type].field_count) { + janet_panicf("invalid field index %u", instruction.field.field); + } + uint32_t field_type = sysir->type_defs[struct_type].field_start + instruction.field.field; + uint32_t tfield = sysir->field_defs[field_type].type; + uint32_t tdest = sysir->types[instruction.field.r]; + if (tfield != tdest) { + janet_panicf("field of type type-id:%d does not match type-id:%d", tfield, tdest); + } + break; case JANET_SYSOP_CALLK: /* TODO - check function return type */ break; @@ -654,10 +717,12 @@ void janet_sys_ir_init_from_table(JanetSysIR *ir, JanetTable *table) { ir->instructions = NULL; ir->types = NULL; ir->type_defs = NULL; + ir->field_defs = NULL; ir->constants = NULL; ir->link_name = NULL; ir->register_count = 0; ir->type_def_count = 0; + ir->field_def_count = 0; ir->constant_count = 0; ir->return_type = 0; ir->parameter_count = 0; @@ -696,7 +761,7 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { #define EMITBINOP(OP) \ janet_formatb(buffer, "_r%u = _r%u " OP " _r%u;\n", instruction.three.dest, instruction.three.lhs, instruction.three.rhs) - janet_formatb(buffer, "#include \n\n"); + janet_formatb(buffer, "#include \n#include \n\n"); /* Emit type defs */ for (uint32_t i = 0; i < ir->instruction_count; i++) { @@ -755,10 +820,11 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { default: break; } - janet_formatb(buffer, "_i%u:\n ", i); + janet_formatb(buffer, "_i%u:\n", i); if (instruction.line > 0) { janet_formatb(buffer, "#line %d\n ", instruction.line); } + janet_buffer_push_cstring(buffer, " "); switch (instruction.opcode) { case JANET_SYSOP_TYPE_PRIMITIVE: case JANET_SYSOP_TYPE_BIND: @@ -848,7 +914,8 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { janet_formatb(buffer, ");\n"); break; case JANET_SYSOP_CAST: - janet_formatb(buffer, "_r%u = _r%u;\n", instruction.two.dest, instruction.two.src); + /* TODO - making casting rules explicit instead of just from C */ + janet_formatb(buffer, "_r%u = (_t%u) _r%u;\n", instruction.two.dest, ir->types[instruction.two.dest], instruction.two.src); break; case JANET_SYSOP_MOVE: janet_formatb(buffer, "_r%u = _r%u;\n", instruction.two.dest, instruction.two.src); @@ -857,10 +924,16 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { janet_formatb(buffer, "_r%u = ~_r%u;\n", instruction.two.dest, instruction.two.src); break; case JANET_SYSOP_LOAD: - janet_formatb(buffer, "_r%u = *((%s *) _r%u)", instruction.two.dest, c_prim_names[ir->types[instruction.two.dest]], instruction.two.src); + janet_formatb(buffer, "_r%u = *((%s *) _r%u);\n", instruction.two.dest, c_prim_names[ir->types[instruction.two.dest]], instruction.two.src); break; case JANET_SYSOP_STORE: - janet_formatb(buffer, "*((%s *) _r%u) = _r%u", c_prim_names[ir->types[instruction.two.src]], instruction.two.dest, instruction.two.src); + janet_formatb(buffer, "*((%s *) _r%u) = _r%u;\n", c_prim_names[ir->types[instruction.two.src]], instruction.two.dest, instruction.two.src); + break; + case JANET_SYSOP_FIELD_GET: + janet_formatb(buffer, "_r%u = _r%u._f%u;\n", instruction.field.r, instruction.field.st, instruction.field.field); + break; + case JANET_SYSOP_FIELD_SET: + janet_formatb(buffer, "_r%u._f%u = _r%u;\n", instruction.field.st, instruction.field.field, instruction.field.r); break; } } @@ -876,6 +949,8 @@ static int sysir_gc(void *p, size_t s) { janet_free(ir->constants); janet_free(ir->types); janet_free(ir->instructions); + janet_free(ir->type_defs); + janet_free(ir->field_defs); return 0; } diff --git a/temp.c b/temp.c deleted file mode 100644 index ed7491f5..00000000 --- a/temp.c +++ /dev/null @@ -1,24 +0,0 @@ -#include - -#line 3 -typedef int32_t _t0; -_t0 main() -{ - _t0 _r0; - _t0 _r1; - _t0 _r2; - -_i4: - #line 7 - _r0 = (_t0) 10; -_i5: - #line 8 - _r1 = (_t0) 20; -_i6: - #line 9 - _r2 = _r1 + _r0; -_i7: - #line 10 - return _r2; -} - From 3fe4cfd14c280167211cefecf0fa796fda401f16 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 7 Aug 2023 09:10:15 -0500 Subject: [PATCH 08/21] Add labels back to sysir --- examples/sysdialect_asm.janet | 6 +- src/core/sysir.c | 218 ++++++++++++++++++++++++++-------- 2 files changed, 171 insertions(+), 53 deletions(-) diff --git a/examples/sysdialect_asm.janet b/examples/sysdialect_asm.janet index a9f82aaf..7c9a1236 100644 --- a/examples/sysdialect_asm.janet +++ b/examples/sysdialect_asm.janet @@ -3,7 +3,7 @@ '((prim 0 s32) (prim 1 f64) (struct 2 0 1) - (struct 3) + (pointer 3 0) (bind 0 0) (bind 1 0) (bind 2 0) @@ -13,6 +13,7 @@ (bind 6 2) (constant 0 10) (constant 0 21) + :location (add 2 1 0) (constant 3 1.77) (call 3 sin 3) @@ -20,9 +21,10 @@ (fset 2 6 0) (fset 3 6 1) (add 5 4 3) + (jump :location) (return 5)) :parameter-count 0 - :link-name "main"}) + :link-name "test_function"}) (def as (sysir/asm ir-asm)) (print (sysir/to-c as)) diff --git a/src/core/sysir.c b/src/core/sysir.c index 3b31dc9c..d4920fb3 100644 --- a/src/core/sysir.c +++ b/src/core/sysir.c @@ -111,6 +111,7 @@ typedef enum { JANET_SYSOP_ARG, JANET_SYSOP_FIELD_GET, JANET_SYSOP_FIELD_SET, + JANET_SYSOP_TYPE_POINTER } JanetSysOp; typedef struct { @@ -143,6 +144,7 @@ static const JanetSysInstrName sys_op_names[] = { {"move", JANET_SYSOP_MOVE}, {"multiply", JANET_SYSOP_MULTIPLY}, {"neq", JANET_SYSOP_NEQ}, + {"pointer", JANET_SYSOP_TYPE_POINTER}, {"prim", JANET_SYSOP_TYPE_PRIMITIVE}, {"return", JANET_SYSOP_RETURN}, {"shl", JANET_SYSOP_SHL}, @@ -154,8 +156,15 @@ static const JanetSysInstrName sys_op_names[] = { typedef struct { JanetPrim prim; - uint32_t field_count; - uint32_t field_start; + union { + struct { + uint32_t field_count; + uint32_t field_start; + } st; + struct { + uint32_t type; + } pointer; + }; } JanetSysTypeInfo; typedef struct { @@ -183,11 +192,17 @@ typedef struct { uint32_t src; } one; struct { - uint32_t to; + union { + uint32_t to; + Janet temp_label; + }; } jump; struct { uint32_t cond; - uint32_t to; + union { + uint32_t to; + Janet temp_label; + }; } branch; struct { uint32_t dest; @@ -218,6 +233,10 @@ typedef struct { uint32_t st; uint32_t field; } field; + struct { + uint32_t dest_type; + uint32_t type; + } pointer; }; int32_t line; int32_t column; @@ -291,20 +310,30 @@ static JanetPrim instr_read_prim(Janet x) { return namedata->prim; } -static uint32_t instr_read_label(Janet x, JanetTable *labels) { +static uint32_t instr_read_label(JanetSysIR *sysir, Janet x, JanetTable *labels) { + uint32_t ret = 0; Janet check = janet_table_get(labels, x); - if (!janet_checktype(check, JANET_NIL)) return (uint32_t) janet_unwrap_number(check); - if (!janet_checkuint(x)) janet_panicf("expected non-negative integer label, got %v", x); - return (uint32_t) janet_unwrap_number(x); + if (!janet_checktype(check, JANET_NIL)) { + ret = (uint32_t) janet_unwrap_number(check); + } else { + if (janet_checktype(x, JANET_KEYWORD)) janet_panicf("unknown label %v", x); + if (!janet_checkuint(x)) janet_panicf("expected non-negative integer label, got %v", x); + ret = (uint32_t) janet_unwrap_number(x); + } + if (ret >= sysir->instruction_count) { + janet_panicf("label outside of range [0, %u), got %u", sysir->instruction_count, ret); + } + return ret; } +typedef struct { + uint32_t instr; + Janet label; +} LabelTarget; + static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instructions) { - // TODO - add labels back - - JanetSysInstruction *ir = janet_malloc(sizeof(JanetSysInstruction) * 100); - out->instructions = ir; - uint32_t cursor = 0; + JanetSysInstruction *ir = NULL; JanetTable *labels = janet_table(0); JanetTable *constant_cache = janet_table(0); uint32_t next_constant = 0; @@ -313,7 +342,10 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction Janet x = janet_wrap_nil(); for (int32_t i = 0; i < instructions.len; i++) { x = instructions.items[i]; - if (janet_checktype(x, JANET_KEYWORD)) continue; + if (janet_checktype(x, JANET_KEYWORD)) { + janet_table_put(labels, x, janet_wrap_number(janet_v_count(ir))); + continue; + } if (!janet_checktype(x, JANET_TUPLE)) { janet_panicf("expected instruction to be tuple, got %V", x); } @@ -341,7 +373,7 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction switch (opcode) { case JANET_SYSOP_CALLK: case JANET_SYSOP_ARG: - janet_panicf("invalid instruction %v", x); + janet_assert(0, "not reachable"); break; case JANET_SYSOP_ADD: case JANET_SYSOP_SUBTRACT: @@ -362,13 +394,14 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction instruction.three.dest = instr_read_operand(tuple[1], out); instruction.three.lhs = instr_read_operand(tuple[2], out); instruction.three.rhs = instr_read_operand(tuple[3], out); - ir[cursor++] = instruction; + janet_v_push(ir, instruction); break; case JANET_SYSOP_CALL: instr_assert_min_length(tuple, 2, opvalue); instruction.call.dest = instr_read_operand(tuple[1], out); Janet c = tuple[2]; if (janet_checktype(c, JANET_SYMBOL)) { + instruction.callk.arg_count = janet_tuple_length(tuple) - 3; Janet check = janet_table_get(constant_cache, c); if (janet_checktype(check, JANET_NUMBER)) { instruction.callk.constant = (uint32_t) janet_unwrap_number(check); @@ -380,10 +413,10 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction opcode = JANET_SYSOP_CALLK; instruction.opcode = opcode; } else { + instruction.call.arg_count = janet_tuple_length(tuple) - 3; instruction.call.callee = instr_read_operand(tuple[2], out); } - instruction.call.arg_count = janet_tuple_length(tuple) - 3; - ir[cursor++] = instruction; + janet_v_push(ir, instruction); for (int32_t j = 3; j < janet_tuple_length(tuple); j += 3) { JanetSysInstruction arginstr; arginstr.opcode = JANET_SYSOP_ARG; @@ -397,7 +430,7 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction for (int32_t k = 0; k < remaining; k++) { arginstr.arg.args[k] = instr_read_operand(tuple[j + k], out); } - ir[cursor++] = arginstr; + janet_v_push(ir, arginstr); } break; case JANET_SYSOP_LOAD: @@ -409,7 +442,7 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction instr_assert_length(tuple, 3, opvalue); instruction.two.dest = instr_read_operand(tuple[1], out); instruction.two.src = instr_read_operand(tuple[2], out); - ir[cursor++] = instruction; + janet_v_push(ir, instruction); break; case JANET_SYSOP_FIELD_GET: case JANET_SYSOP_FIELD_SET: @@ -417,23 +450,23 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction 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); - ir[cursor++] = instruction; + janet_v_push(ir, instruction); break; case JANET_SYSOP_RETURN: instr_assert_length(tuple, 2, opvalue); instruction.one.src = instr_read_operand(tuple[1], out); - ir[cursor++] = instruction; + janet_v_push(ir, instruction); break; case JANET_SYSOP_BRANCH: instr_assert_length(tuple, 3, opvalue); instruction.branch.cond = instr_read_operand(tuple[1], out); - instruction.branch.to = instr_read_label(tuple[2], labels); - ir[cursor++] = instruction; + instruction.branch.temp_label = tuple[2]; + janet_v_push(ir, instruction); break; case JANET_SYSOP_JUMP: instr_assert_length(tuple, 2, opvalue); - instruction.jump.to = instr_read_label(tuple[1], labels); - ir[cursor++] = instruction; + instruction.jump.temp_label = tuple[1]; + janet_v_push(ir, instruction); break; case JANET_SYSOP_CONSTANT: { instr_assert_length(tuple, 3, opvalue); @@ -447,21 +480,28 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction janet_table_put(constant_cache, c, janet_wrap_number(next_constant)); next_constant++; } - ir[cursor++] = instruction; + 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); instruction.type_prim.prim = instr_read_prim(tuple[2]); - ir[cursor++] = instruction; + 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); + instruction.pointer.type = instr_read_type_operand(tuple[2], out); + janet_v_push(ir, instruction); break; } case JANET_SYSOP_TYPE_STRUCT: { instr_assert_min_length(tuple, 1, opvalue); instruction.type_types.dest_type = instr_read_type_operand(tuple[1], out); instruction.type_types.arg_count = janet_tuple_length(tuple) - 2; - ir[cursor++] = instruction; + janet_v_push(ir, instruction); for (int32_t j = 2; j < janet_tuple_length(tuple); j += 3) { JanetSysInstruction arginstr; arginstr.opcode = JANET_SYSOP_ARG; @@ -475,7 +515,7 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction for (int32_t k = 0; k < remaining; k++) { arginstr.arg.args[k] = instr_read_type_operand(tuple[j + k], out); } - ir[cursor++] = arginstr; + janet_v_push(ir, arginstr); } break; } @@ -483,21 +523,43 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction 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); - ir[cursor++] = instruction; + janet_v_push(ir, instruction); break; } } } /* Check last instruction is jump or return */ - if ((ir[cursor - 1].opcode != JANET_SYSOP_JUMP) && (ir[cursor - 1].opcode != JANET_SYSOP_RETURN)) { + uint32_t ircount = (uint32_t) janet_v_count(ir); + 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 %v", x); } /* Fix up instructions table */ - ir = janet_realloc(ir, sizeof(JanetSysInstruction) * cursor); - out->instructions = ir; - out->instruction_count = cursor; + out->instructions = janet_v_flatten(ir); + out->instruction_count = ircount; + + /* Fix up labels */ + for (uint32_t i = 0; i < ircount; i++) { + JanetSysInstruction instruction = out->instructions[i]; + uint32_t label_target; + switch (instruction.opcode) { + default: + break; + case JANET_SYSOP_BRANCH: + label_target = instr_read_label(out, instruction.branch.temp_label, labels); + out->instructions[i].branch.to = label_target; + break; + case JANET_SYSOP_JUMP: + label_target = instr_read_label(out, instruction.jump.temp_label, labels); + out->instructions[i].jump.to = label_target; + break; + } + } /* Build constants */ out->constant_count = next_constant; @@ -521,9 +583,7 @@ static void janet_sysir_init_types(JanetSysIR *sysir) { uint32_t *types = janet_malloc(sizeof(uint32_t) * sysir->register_count); sysir->type_defs = type_defs; sysir->types = types; - sysir->type_defs[0].field_count = 0; sysir->type_defs[0].prim = JANET_PRIM_S32; -_i4: for (uint32_t i = 0; i < sysir->register_count; i++) { sysir->types[i] = 0; } @@ -535,15 +595,14 @@ _i4: break; case JANET_SYSOP_TYPE_PRIMITIVE: { uint32_t type_def = instruction.type_prim.dest_type; - type_defs[type_def].field_count = 0; type_defs[type_def].prim = instruction.type_prim.prim; break; } case JANET_SYSOP_TYPE_STRUCT: { uint32_t type_def = instruction.type_types.dest_type; - type_defs[type_def].field_count = instruction.type_types.arg_count; type_defs[type_def].prim = JANET_PRIM_STRUCT; - type_defs[type_def].field_start = (uint32_t) janet_v_count(fields); + type_defs[type_def].st.field_count = instruction.type_types.arg_count; + type_defs[type_def].st.field_start = (uint32_t) janet_v_count(fields); for (uint32_t j = 0; j < instruction.type_types.arg_count; j++) { uint32_t offset = j / 3 + 1; uint32_t index = j % 3; @@ -555,6 +614,12 @@ _i4: } break; } + case JANET_SYSOP_TYPE_POINTER: { + uint32_t type_def = instruction.pointer.dest_type; + type_defs[type_def].prim = JANET_PRIM_POINTER; + type_defs[type_def].pointer.type = instruction.pointer.type; + break; + } case JANET_SYSOP_TYPE_BIND: { uint32_t type = instruction.type_bind.type; uint32_t dest = instruction.type_bind.dest; @@ -576,17 +641,26 @@ static void tcheck_boolean(JanetSysIR *sysir, uint32_t reg1) { } } +static void tcheck_number(JanetSysIR *sysir, uint32_t reg1) { + JanetPrim t1 = sysir->type_defs[sysir->types[reg1]].prim; + if (t1 == JANET_PRIM_BOOLEAN || + t1 == JANET_PRIM_POINTER || + t1 == JANET_PRIM_STRUCT) { + janet_panicf("type failure, expected numeric type, got type-id:%d", t1); /* TODO improve this */ + } +} + static void tcheck_integer(JanetSysIR *sysir, uint32_t reg1) { JanetPrim t1 = sysir->type_defs[sysir->types[reg1]].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, expected integer, got type-id:%d", t1); /* TODO improve this */ + 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, expected integer type, got type-id:%d", t1); /* TODO improve this */ } } @@ -612,6 +686,36 @@ static void tcheck_equal(JanetSysIR *sysir, uint32_t reg1, uint32_t reg2) { } } +static void tcheck_cast(JanetSysIR *sysir, uint32_t dest, uint32_t src) { + (void) sysir; + (void) dest; + (void) src; + /* TODO - casting rules */ +} + +static void tcheck_constant(JanetSysIR *sysir, uint32_t dest, Janet c) { + (void) sysir; + (void) dest; + (void) c; + /* TODO - validate the the constant C can be represented as dest */ +} + +/* Add and subtract can be used for pointer math as well as normal arithmetic. Unlike C, only + * allow pointer on lhs for addition. */ +static void tcheck_pointer_math(JanetSysIR *sysir, uint32_t dest, uint32_t lhs, uint32_t rhs) { + uint32_t tdest = sysir->types[dest]; + uint32_t tlhs = sysir->types[lhs]; + if (tdest != tlhs) { + janet_panicf("type failure, type-id:%d does not match type-id:%d", tdest, tlhs); + } + uint32_t pdest = sysir->type_defs[tdest].prim; + if (pdest == JANET_PRIM_POINTER) { + tcheck_integer(sysir, rhs); + } else { + tcheck_equal(sysir, lhs, rhs); + } +} + static void janet_sysir_type_check(JanetSysIR *sysir) { int found_return = 0; for (uint32_t i = 0; i < sysir->instruction_count; i++) { @@ -619,6 +723,7 @@ static void janet_sysir_type_check(JanetSysIR *sysir) { switch (instruction.opcode) { case JANET_SYSOP_TYPE_PRIMITIVE: case JANET_SYSOP_TYPE_STRUCT: + case JANET_SYSOP_TYPE_POINTER: case JANET_SYSOP_TYPE_BIND: case JANET_SYSOP_ARG: case JANET_SYSOP_JUMP: @@ -639,11 +744,15 @@ static void janet_sysir_type_check(JanetSysIR *sysir) { tcheck_equal(sysir, instruction.two.dest, instruction.two.src); break; case JANET_SYSOP_CAST: + tcheck_cast(sysir, instruction.two.dest, instruction.two.src); break; case JANET_SYSOP_ADD: case JANET_SYSOP_SUBTRACT: + tcheck_pointer_math(sysir, instruction.three.dest, instruction.three.lhs, instruction.three.rhs); + break; case JANET_SYSOP_MULTIPLY: case JANET_SYSOP_DIVIDE: + tcheck_number(sysir, instruction.three.dest); tcheck_equal(sysir, instruction.three.lhs, instruction.three.rhs); tcheck_equal(sysir, instruction.three.dest, instruction.three.lhs); break; @@ -687,7 +796,7 @@ static void janet_sysir_type_check(JanetSysIR *sysir) { tcheck_boolean(sysir, instruction.branch.cond); break; case JANET_SYSOP_CONSTANT: - /* TODO - check constant matches type */ + tcheck_constant(sysir, instruction.constant.dest, sysir->constants[instruction.constant.constant]); break; case JANET_SYSOP_CALL: tcheck_pointer(sysir, instruction.call.callee); @@ -696,10 +805,10 @@ static void janet_sysir_type_check(JanetSysIR *sysir) { case JANET_SYSOP_FIELD_SET: tcheck_struct(sysir, instruction.field.st); uint32_t struct_type = sysir->types[instruction.field.st]; - if (instruction.field.field >= sysir->type_defs[struct_type].field_count) { + if (instruction.field.field >= sysir->type_defs[struct_type].st.field_count) { janet_panicf("invalid field index %u", instruction.field.field); } - uint32_t field_type = sysir->type_defs[struct_type].field_start + instruction.field.field; + uint32_t field_type = sysir->type_defs[struct_type].st.field_start + instruction.field.field; uint32_t tfield = sysir->field_defs[field_type].type; uint32_t tdest = sysir->types[instruction.field.r]; if (tfield != tdest) { @@ -771,6 +880,7 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { continue; case JANET_SYSOP_TYPE_PRIMITIVE: case JANET_SYSOP_TYPE_STRUCT: + case JANET_SYSOP_TYPE_POINTER: break; } if (instruction.line > 0) { @@ -792,6 +902,10 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { } 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; + } } @@ -815,6 +929,7 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { case JANET_SYSOP_TYPE_PRIMITIVE: case JANET_SYSOP_TYPE_BIND: case JANET_SYSOP_TYPE_STRUCT: + case JANET_SYSOP_TYPE_POINTER: case JANET_SYSOP_ARG: continue; default: @@ -829,6 +944,7 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { case JANET_SYSOP_TYPE_PRIMITIVE: case JANET_SYSOP_TYPE_BIND: case JANET_SYSOP_TYPE_STRUCT: + case JANET_SYSOP_TYPE_POINTER: case JANET_SYSOP_ARG: break; case JANET_SYSOP_CONSTANT: { From de2440d458f1370375d61c09efe4d423a2e191a7 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 7 Aug 2023 10:54:41 -0500 Subject: [PATCH 09/21] Lots todo --- src/core/sysir.c | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/src/core/sysir.c b/src/core/sysir.c index d4920fb3..b7dc5142 100644 --- a/src/core/sysir.c +++ b/src/core/sysir.c @@ -21,7 +21,18 @@ */ /* TODO - * [ ] pointer math, pointer types + * [ ] named fields (for debugging mostly) + * [ ] better type errors (perhaps mostly for compiler debugging - full type system goes on top) + * [ ] x86/x64 machine code target + * [ ] target specific extensions - custom instructions and custom primitives + * [ ] better casting semantics + * [ ] fixed-size array types + * [ ] recursive pointer types + * [ ] union types? + * [ ] incremental compilation - save type definitions for later + * [ ] Extension to C target for interfacing with Janet + * [ ] malloc/alloca exposure (only some targets) + * [x] pointer math, pointer types * [x] callk - allow linking to other named functions * [x] composite types - support for load, store, move, and function args. * [x] Have some mechanism for field access (dest = src.offset) @@ -326,11 +337,6 @@ static uint32_t instr_read_label(JanetSysIR *sysir, Janet x, JanetTable *labels) return ret; } -typedef struct { - uint32_t instr; - Janet label; -} LabelTarget; - static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instructions) { JanetSysInstruction *ir = NULL; From 8007806c8ee0ed43f59e2ab53471c72aa921b7f9 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 8 Aug 2023 18:56:02 -0500 Subject: [PATCH 10/21] Add better support for arrays and struct fields in IR. Also add option for named registers. --- examples/sysdialect_asm.janet | 9 +- src/core/sysir.c | 181 ++++++++++++++++++++++++++++------ 2 files changed, 154 insertions(+), 36 deletions(-) diff --git a/examples/sysdialect_asm.janet b/examples/sysdialect_asm.janet index 7c9a1236..702a9639 100644 --- a/examples/sysdialect_asm.janet +++ b/examples/sysdialect_asm.janet @@ -4,11 +4,12 @@ (prim 1 f64) (struct 2 0 1) (pointer 3 0) + (array 4 1 1024) (bind 0 0) (bind 1 0) (bind 2 0) (bind 3 1) - (bind 4 1) + (bind bob 1) (bind 5 1) (bind 6 2) (constant 0 10) @@ -17,10 +18,8 @@ (add 2 1 0) (constant 3 1.77) (call 3 sin 3) - (cast 4 2) - (fset 2 6 0) - (fset 3 6 1) - (add 5 4 3) + (cast bob 2) + (add 5 bob 3) (jump :location) (return 5)) :parameter-count 0 diff --git a/src/core/sysir.c b/src/core/sysir.c index b7dc5142..174de0a3 100644 --- a/src/core/sysir.c +++ b/src/core/sysir.c @@ -22,11 +22,13 @@ /* TODO * [ ] named fields (for debugging mostly) + * [ ] named registers and types * [ ] better type errors (perhaps mostly for compiler debugging - full type system goes on top) * [ ] x86/x64 machine code target * [ ] target specific extensions - custom instructions and custom primitives * [ ] better casting semantics - * [ ] fixed-size array types + * [ ] separate pointer arithmetic from generalized arithmetic (easier to instrument code for safety)? + * [x] fixed-size array types * [ ] recursive pointer types * [ ] union types? * [ ] incremental compilation - save type definitions for later @@ -37,7 +39,7 @@ * [x] composite types - support for load, store, move, and function args. * [x] Have some mechanism for field access (dest = src.offset) * [x] Related, move type creation as opcodes like in SPIRV - have separate virtual "type slots" and value slots for this. - * [ ] support for stack allocation of arrays + * [x] support for stack allocation of arrays * [ ] more math intrinsics * [x] source mapping (using built in Janet source mapping metadata on tuples) * [ ] better C interface for building up IR @@ -65,6 +67,7 @@ typedef enum { JANET_PRIM_POINTER, JANET_PRIM_BOOLEAN, JANET_PRIM_STRUCT, + JANET_PRIM_ARRAY, } JanetPrim; typedef struct { @@ -73,6 +76,7 @@ typedef struct { } JanetPrimName; static const JanetPrimName prim_names[] = { + {"array", JANET_PRIM_ARRAY}, {"boolean", JANET_PRIM_BOOLEAN}, {"f32", JANET_PRIM_F32}, {"f64", JANET_PRIM_F64}, @@ -120,9 +124,11 @@ typedef enum { JANET_SYSOP_TYPE_STRUCT, JANET_SYSOP_TYPE_BIND, JANET_SYSOP_ARG, - JANET_SYSOP_FIELD_GET, - JANET_SYSOP_FIELD_SET, - JANET_SYSOP_TYPE_POINTER + JANET_SYSOP_FIELD_GETP, + JANET_SYSOP_ARRAY_GETP, + JANET_SYSOP_ARRAY_PGETP, + JANET_SYSOP_TYPE_POINTER, + JANET_SYSOP_TYPE_ARRAY } JanetSysOp; typedef struct { @@ -133,6 +139,9 @@ typedef struct { static const JanetSysInstrName sys_op_names[] = { {"add", JANET_SYSOP_ADD}, {"address", JANET_SYSOP_ADDRESS}, + {"agetp", JANET_SYSOP_ARRAY_GETP}, + {"apgetp", JANET_SYSOP_ARRAY_PGETP}, + {"array", JANET_SYSOP_TYPE_ARRAY}, {"band", JANET_SYSOP_BAND}, {"bind", JANET_SYSOP_TYPE_BIND}, {"bnot", JANET_SYSOP_BNOT}, @@ -144,8 +153,7 @@ static const JanetSysInstrName sys_op_names[] = { {"constant", JANET_SYSOP_CONSTANT}, {"divide", JANET_SYSOP_DIVIDE}, {"eq", JANET_SYSOP_EQ}, - {"fget", JANET_SYSOP_FIELD_GET}, - {"fset", JANET_SYSOP_FIELD_SET}, + {"fgetp", JANET_SYSOP_FIELD_GETP}, {"gt", JANET_SYSOP_GT}, {"gte", JANET_SYSOP_GTE}, {"jump", JANET_SYSOP_JUMP}, @@ -175,6 +183,10 @@ typedef struct { struct { uint32_t type; } pointer; + struct { + uint32_t type; + uint64_t fixed_count; + } array; }; } JanetSysTypeInfo; @@ -248,6 +260,11 @@ typedef struct { uint32_t dest_type; uint32_t type; } pointer; + struct { + uint32_t dest_type; + uint32_t type; + uint64_t fixed_count; + } array; }; int32_t line; int32_t column; @@ -266,6 +283,7 @@ typedef struct { JanetSysTypeField *field_defs; JanetSysInstruction *instructions; Janet *constants; + JanetTable *register_names; uint32_t parameter_count; } JanetSysIR; @@ -284,6 +302,16 @@ static void instr_assert_min_length(JanetTuple tup, int32_t minlen, Janet x) { } static uint32_t instr_read_operand(Janet x, JanetSysIR *ir) { + if (janet_checktype(x, JANET_SYMBOL)) { + Janet check = janet_table_get(ir->register_names, 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_names, x, janet_wrap_number(operand)); + return operand; + } + } if (!janet_checkuint(x)) janet_panicf("expected non-negative integer operand, got %v", x); uint32_t operand = (uint32_t) janet_unwrap_number(x); if (operand >= ir->register_count) { @@ -299,6 +327,12 @@ static uint32_t instr_read_field(Janet x, JanetSysIR *ir) { return operand; } +static uint64_t instr_read_u64(Janet x, JanetSysIR *ir) { + if (!janet_checkuint64(x)) janet_panicf("expected unsigned 64 bit integer, got %v", x); + (void) ir; + return janet_getuinteger64(&x, 0); +} + static uint32_t instr_read_type_operand(Janet x, JanetSysIR *ir) { if (!janet_checkuint(x)) janet_panicf("expected non-negative integer operand, got %v", x); uint32_t operand = (uint32_t) janet_unwrap_number(x); @@ -322,6 +356,7 @@ static JanetPrim instr_read_prim(Janet x) { } static uint32_t instr_read_label(JanetSysIR *sysir, Janet x, JanetTable *labels) { + (void) sysir; uint32_t ret = 0; Janet check = janet_table_get(labels, x); if (!janet_checktype(check, JANET_NIL)) { @@ -331,9 +366,6 @@ static uint32_t instr_read_label(JanetSysIR *sysir, Janet x, JanetTable *labels) if (!janet_checkuint(x)) janet_panicf("expected non-negative integer label, got %v", x); ret = (uint32_t) janet_unwrap_number(x); } - if (ret >= sysir->instruction_count) { - janet_panicf("label outside of range [0, %u), got %u", sysir->instruction_count, ret); - } return ret; } @@ -396,6 +428,8 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction case JANET_SYSOP_LTE: case JANET_SYSOP_EQ: case JANET_SYSOP_NEQ: + 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); @@ -450,8 +484,7 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction instruction.two.src = instr_read_operand(tuple[2], out); janet_v_push(ir, instruction); break; - case JANET_SYSOP_FIELD_GET: - case JANET_SYSOP_FIELD_SET: + 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); @@ -503,6 +536,14 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction 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); + instruction.array.type = instr_read_type_operand(tuple[2], out); + instruction.array.fixed_count = instr_read_u64(tuple[3], out); + janet_v_push(ir, instruction); + break; + } case JANET_SYSOP_TYPE_STRUCT: { instr_assert_min_length(tuple, 1, opvalue); instruction.type_types.dest_type = instr_read_type_operand(tuple[1], out); @@ -626,6 +667,13 @@ static void janet_sysir_init_types(JanetSysIR *sysir) { type_defs[type_def].pointer.type = instruction.pointer.type; break; } + case JANET_SYSOP_TYPE_ARRAY: { + uint32_t type_def = instruction.array.dest_type; + 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; @@ -647,6 +695,13 @@ static void tcheck_boolean(JanetSysIR *sysir, uint32_t reg1) { } } +static void tcheck_array(JanetSysIR *sysir, uint32_t reg1) { + uint32_t t1 = sysir->types[reg1]; + if (sysir->type_defs[t1].prim != JANET_PRIM_ARRAY) { + janet_panicf("type failure, expected array, got type-id:%d", t1); /* TODO improve this */ + } +} + static void tcheck_number(JanetSysIR *sysir, uint32_t reg1) { JanetPrim t1 = sysir->type_defs[sysir->types[reg1]].prim; if (t1 == JANET_PRIM_BOOLEAN || @@ -677,6 +732,18 @@ static void tcheck_pointer(JanetSysIR *sysir, uint32_t reg1) { } } +static void tcheck_pointer_equals(JanetSysIR *sysir, uint32_t preg, uint32_t elreg) { + uint32_t t1 = sysir->types[preg]; + if (sysir->type_defs[t1].prim != JANET_PRIM_POINTER) { + janet_panicf("type failure, expected pointer, got type-id:%d", t1); + } + uint32_t tp = sysir->type_defs[t1].pointer.type; + uint32_t t2 = sysir->types[elreg]; + if (t2 != tp) { + janet_panicf("type failure, type-id:%d is not compatible with a pointer to type-id:%d", t2, tp); + } +} + static void tcheck_struct(JanetSysIR *sysir, uint32_t reg1) { uint32_t t1 = sysir->types[reg1]; if (sysir->type_defs[t1].prim != JANET_PRIM_STRUCT) { @@ -706,6 +773,32 @@ static void tcheck_constant(JanetSysIR *sysir, uint32_t dest, Janet c) { /* TODO - validate the the constant C can be represented as dest */ } +static void tcheck_array_getp(JanetSysIR *sysir, uint32_t dest, uint32_t lhs, uint32_t rhs) { + tcheck_array(sysir, lhs); + tcheck_integer(sysir, rhs); + tcheck_pointer(sysir, dest); + uint32_t dtype = sysir->type_defs[sysir->types[dest]].pointer.type; + uint32_t eltype = sysir->type_defs[sysir->types[lhs]].array.type; + if (dtype != eltype) { + janet_panicf("type failure, type-id:%d does not match type-id:%d", dtype, eltype); + } +} + +static void tcheck_array_pgetp(JanetSysIR *sysir, uint32_t dest, uint32_t lhs, uint32_t rhs) { + tcheck_pointer(sysir, lhs); + tcheck_integer(sysir, rhs); + tcheck_pointer(sysir, dest); + uint32_t aptype = sysir->type_defs[sysir->types[lhs]].pointer.type; + if (sysir->type_defs[aptype].prim != JANET_PRIM_ARRAY) { + janet_panicf("type failure, expected array type but got type-id:%d", aptype); + } + uint32_t dtype = sysir->type_defs[sysir->types[dest]].pointer.type; + uint32_t eltype = sysir->type_defs[aptype].array.type; + if (dtype != eltype) { + janet_panicf("type failure, type-id:%d does not match type-id:%d", dtype, eltype); + } +} + /* Add and subtract can be used for pointer math as well as normal arithmetic. Unlike C, only * allow pointer on lhs for addition. */ static void tcheck_pointer_math(JanetSysIR *sysir, uint32_t dest, uint32_t lhs, uint32_t rhs) { @@ -730,9 +823,15 @@ static void janet_sysir_type_check(JanetSysIR *sysir) { case JANET_SYSOP_TYPE_PRIMITIVE: case JANET_SYSOP_TYPE_STRUCT: case JANET_SYSOP_TYPE_POINTER: + case JANET_SYSOP_TYPE_ARRAY: case JANET_SYSOP_TYPE_BIND: case JANET_SYSOP_ARG: + break; case JANET_SYSOP_JUMP: + ; + if (instruction.jump.to >= sysir->instruction_count) { + janet_panicf("label outside of range [0, %u), got %u", sysir->instruction_count, instruction.jump.to); + } break; case JANET_SYSOP_RETURN: { uint32_t ret_type = sysir->types[instruction.one.src]; @@ -780,10 +879,10 @@ static void janet_sysir_type_check(JanetSysIR *sysir) { tcheck_equal(sysir, instruction.three.dest, instruction.three.lhs); break; case JANET_SYSOP_LOAD: - tcheck_pointer(sysir, instruction.two.src); + tcheck_pointer_equals(sysir, instruction.two.src, instruction.two.dest); break; case JANET_SYSOP_STORE: - tcheck_pointer(sysir, instruction.two.dest); + tcheck_pointer_equals(sysir, instruction.two.dest, instruction.two.src); break; case JANET_SYSOP_GT: case JANET_SYSOP_LT: @@ -800,6 +899,9 @@ static void janet_sysir_type_check(JanetSysIR *sysir) { break; case JANET_SYSOP_BRANCH: tcheck_boolean(sysir, instruction.branch.cond); + if (instruction.branch.to >= sysir->instruction_count) { + janet_panicf("label outside of range [0, %u), got %u", sysir->instruction_count, instruction.branch.to); + } break; case JANET_SYSOP_CONSTANT: tcheck_constant(sysir, instruction.constant.dest, sysir->constants[instruction.constant.constant]); @@ -807,8 +909,14 @@ static void janet_sysir_type_check(JanetSysIR *sysir) { case JANET_SYSOP_CALL: tcheck_pointer(sysir, instruction.call.callee); break; - case JANET_SYSOP_FIELD_GET: - case JANET_SYSOP_FIELD_SET: + case JANET_SYSOP_ARRAY_GETP: + tcheck_array_getp(sysir, instruction.three.dest, instruction.three.lhs, instruction.three.lhs); + break; + case JANET_SYSOP_ARRAY_PGETP: + tcheck_array_pgetp(sysir, instruction.three.dest, instruction.three.lhs, instruction.three.lhs); + break; + case JANET_SYSOP_FIELD_GETP: + tcheck_pointer(sysir, instruction.field.r); tcheck_struct(sysir, instruction.field.st); uint32_t struct_type = sysir->types[instruction.field.st]; if (instruction.field.field >= sysir->type_defs[struct_type].st.field_count) { @@ -817,8 +925,9 @@ static void janet_sysir_type_check(JanetSysIR *sysir) { uint32_t field_type = sysir->type_defs[struct_type].st.field_start + instruction.field.field; uint32_t tfield = sysir->field_defs[field_type].type; uint32_t tdest = sysir->types[instruction.field.r]; - if (tfield != tdest) { - janet_panicf("field of type type-id:%d does not match type-id:%d", tfield, tdest); + uint32_t tpdest = sysir->type_defs[tdest].pointer.type; + if (tfield != tpdest) { + janet_panicf("field of type type-id:%d does not match type-id:%d", tfield, tpdest); } break; case JANET_SYSOP_CALLK: @@ -841,6 +950,7 @@ void janet_sys_ir_init_from_table(JanetSysIR *ir, JanetTable *table) { ir->constant_count = 0; ir->return_type = 0; ir->parameter_count = 0; + ir->register_names = janet_table(0); Janet assembly = janet_table_get(table, janet_ckeywordv("instructions")); Janet param_count = janet_table_get(table, janet_ckeywordv("parameter-count")); Janet link_namev = janet_table_get(table, janet_ckeywordv("link-name")); @@ -867,7 +977,7 @@ static const char *c_prim_names[] = { "int64_t", "float", "double", - "char *", + "void *", "bool" }; @@ -887,6 +997,7 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { case JANET_SYSOP_TYPE_PRIMITIVE: case JANET_SYSOP_TYPE_STRUCT: case JANET_SYSOP_TYPE_POINTER: + case JANET_SYSOP_TYPE_ARRAY: break; } if (instruction.line > 0) { @@ -904,26 +1015,28 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { 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 _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 header */ + /* Emit function header */ janet_formatb(buffer, "_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_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_formatb(buffer, " _t%u _r%u;\n", ir->types[i], i); } janet_buffer_push_cstring(buffer, "\n"); @@ -936,6 +1049,7 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { case JANET_SYSOP_TYPE_BIND: case JANET_SYSOP_TYPE_STRUCT: case JANET_SYSOP_TYPE_POINTER: + case JANET_SYSOP_TYPE_ARRAY: case JANET_SYSOP_ARG: continue; default: @@ -951,6 +1065,7 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { case JANET_SYSOP_TYPE_BIND: case JANET_SYSOP_TYPE_STRUCT: case JANET_SYSOP_TYPE_POINTER: + case JANET_SYSOP_TYPE_ARRAY: case JANET_SYSOP_ARG: break; case JANET_SYSOP_CONSTANT: { @@ -1036,7 +1151,7 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { janet_formatb(buffer, ");\n"); break; case JANET_SYSOP_CAST: - /* TODO - making casting rules explicit instead of just from C */ + /* TODO - make casting rules explicit instead of just whatever C does */ janet_formatb(buffer, "_r%u = (_t%u) _r%u;\n", instruction.two.dest, ir->types[instruction.two.dest], instruction.two.src); break; case JANET_SYSOP_MOVE: @@ -1046,16 +1161,19 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { janet_formatb(buffer, "_r%u = ~_r%u;\n", instruction.two.dest, instruction.two.src); break; case JANET_SYSOP_LOAD: - janet_formatb(buffer, "_r%u = *((%s *) _r%u);\n", instruction.two.dest, c_prim_names[ir->types[instruction.two.dest]], instruction.two.src); + janet_formatb(buffer, "_r%u = *(_r%u);\n", instruction.two.dest, instruction.two.src); break; case JANET_SYSOP_STORE: - janet_formatb(buffer, "*((%s *) _r%u) = _r%u;\n", c_prim_names[ir->types[instruction.two.src]], instruction.two.dest, instruction.two.src); + janet_formatb(buffer, "*(_r%u) = _r%u;\n", instruction.two.dest, instruction.two.src); break; - case JANET_SYSOP_FIELD_GET: - janet_formatb(buffer, "_r%u = _r%u._f%u;\n", instruction.field.r, instruction.field.st, instruction.field.field); + case JANET_SYSOP_FIELD_GETP: + janet_formatb(buffer, "_r%u = &(_r%u._f%u);\n", instruction.field.r, instruction.field.st, instruction.field.field); break; - case JANET_SYSOP_FIELD_SET: - janet_formatb(buffer, "_r%u._f%u = _r%u;\n", instruction.field.st, instruction.field.field, instruction.field.r); + case JANET_SYSOP_ARRAY_GETP: + janet_formatb(buffer, "_r%u = &(_r%u.els[_r%u]);\n", instruction.three.dest, instruction.three.lhs, instruction.three.rhs); + break; + case JANET_SYSOP_ARRAY_PGETP: + janet_formatb(buffer, "_r%u = &(_r%u->els[_r%u]);\n", instruction.three.dest, instruction.three.lhs, instruction.three.rhs); break; } } @@ -1079,6 +1197,7 @@ static int sysir_gc(void *p, size_t s) { static int sysir_gcmark(void *p, size_t s) { JanetSysIR *ir = (JanetSysIR *)p; (void) s; + janet_mark(janet_wrap_table(ir->register_names)); for (uint32_t i = 0; i < ir->constant_count; i++) { janet_mark(ir->constants[i]); } From d9912f38f82eb172e4928d17f4a4304f23149e79 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 12 Aug 2023 10:29:24 -0500 Subject: [PATCH 11/21] Add union types and change name of type constructor instructions. --- examples/sysdialect_asm.janet | 31 ++++++++++++++++---------- src/core/sysir.c | 42 ++++++++++++++++++++++++++--------- 2 files changed, 51 insertions(+), 22 deletions(-) diff --git a/examples/sysdialect_asm.janet b/examples/sysdialect_asm.janet index 702a9639..12409c0a 100644 --- a/examples/sysdialect_asm.janet +++ b/examples/sysdialect_asm.janet @@ -1,17 +1,23 @@ (def ir-asm @{:instructions - '((prim 0 s32) - (prim 1 f64) - (struct 2 0 1) - (pointer 3 0) - (array 4 1 1024) - (bind 0 0) - (bind 1 0) - (bind 2 0) - (bind 3 1) - (bind bob 1) - (bind 5 1) - (bind 6 2) + '( + # Types + (type-prim Int s32) + (type-prim Double f64) + (type-struct MyPair 0 1) + (type-pointer PInt 0) + (type-array DoubleArray 1 1024) + + # Declarations + (bind 0 Int) + (bind 1 Int) + (bind 2 Int) + (bind 3 Double) + (bind bob Double) + (bind 5 Double) + (bind 6 MyPair) + + # Code (constant 0 10) (constant 0 21) :location @@ -19,6 +25,7 @@ (constant 3 1.77) (call 3 sin 3) (cast bob 2) + (call bob test_function) (add 5 bob 3) (jump :location) (return 5)) diff --git a/src/core/sysir.c b/src/core/sysir.c index 174de0a3..671f1c3c 100644 --- a/src/core/sysir.c +++ b/src/core/sysir.c @@ -22,7 +22,7 @@ /* TODO * [ ] named fields (for debugging mostly) - * [ ] named registers and types + * [x] named registers and types * [ ] better type errors (perhaps mostly for compiler debugging - full type system goes on top) * [ ] x86/x64 machine code target * [ ] target specific extensions - custom instructions and custom primitives @@ -30,7 +30,7 @@ * [ ] separate pointer arithmetic from generalized arithmetic (easier to instrument code for safety)? * [x] fixed-size array types * [ ] recursive pointer types - * [ ] union types? + * [x] union types? * [ ] incremental compilation - save type definitions for later * [ ] Extension to C target for interfacing with Janet * [ ] malloc/alloca exposure (only some targets) @@ -128,7 +128,8 @@ typedef enum { JANET_SYSOP_ARRAY_GETP, JANET_SYSOP_ARRAY_PGETP, JANET_SYSOP_TYPE_POINTER, - JANET_SYSOP_TYPE_ARRAY + JANET_SYSOP_TYPE_ARRAY, + JANET_SYSOP_TYPE_UNION, } JanetSysOp; typedef struct { @@ -141,7 +142,6 @@ static const JanetSysInstrName sys_op_names[] = { {"address", JANET_SYSOP_ADDRESS}, {"agetp", JANET_SYSOP_ARRAY_GETP}, {"apgetp", JANET_SYSOP_ARRAY_PGETP}, - {"array", JANET_SYSOP_TYPE_ARRAY}, {"band", JANET_SYSOP_BAND}, {"bind", JANET_SYSOP_TYPE_BIND}, {"bnot", JANET_SYSOP_BNOT}, @@ -163,14 +163,16 @@ static const JanetSysInstrName sys_op_names[] = { {"move", JANET_SYSOP_MOVE}, {"multiply", JANET_SYSOP_MULTIPLY}, {"neq", JANET_SYSOP_NEQ}, - {"pointer", JANET_SYSOP_TYPE_POINTER}, - {"prim", JANET_SYSOP_TYPE_PRIMITIVE}, {"return", JANET_SYSOP_RETURN}, {"shl", JANET_SYSOP_SHL}, {"shr", JANET_SYSOP_SHR}, {"store", JANET_SYSOP_STORE}, - {"struct", JANET_SYSOP_TYPE_STRUCT}, {"subtract", JANET_SYSOP_SUBTRACT}, + {"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}, }; typedef struct { @@ -284,6 +286,7 @@ typedef struct { JanetSysInstruction *instructions; Janet *constants; JanetTable *register_names; + JanetTable *type_names; uint32_t parameter_count; } JanetSysIR; @@ -334,6 +337,16 @@ static uint64_t instr_read_u64(Janet x, JanetSysIR *ir) { } static uint32_t instr_read_type_operand(Janet x, JanetSysIR *ir) { + if (janet_checktype(x, JANET_SYMBOL)) { + Janet check = janet_table_get(ir->type_names, x); + if (janet_checktype(check, JANET_NUMBER)) { + return (uint32_t) janet_unwrap_number(check); + } else { + uint32_t operand = ir->type_def_count++; + janet_table_put(ir->type_names, x, janet_wrap_number(operand)); + return operand; + } + } if (!janet_checkuint(x)) janet_panicf("expected non-negative integer operand, got %v", x); uint32_t operand = (uint32_t) janet_unwrap_number(x); if (operand >= ir->type_def_count) { @@ -544,7 +557,8 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction janet_v_push(ir, instruction); break; } - case JANET_SYSOP_TYPE_STRUCT: { + 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); instruction.type_types.arg_count = janet_tuple_length(tuple) - 2; @@ -645,7 +659,8 @@ static void janet_sysir_init_types(JanetSysIR *sysir) { type_defs[type_def].prim = instruction.type_prim.prim; break; } - case JANET_SYSOP_TYPE_STRUCT: { + case JANET_SYSOP_TYPE_STRUCT: + case JANET_SYSOP_TYPE_UNION: { uint32_t type_def = instruction.type_types.dest_type; type_defs[type_def].prim = JANET_PRIM_STRUCT; type_defs[type_def].st.field_count = instruction.type_types.arg_count; @@ -822,6 +837,7 @@ static void janet_sysir_type_check(JanetSysIR *sysir) { 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: @@ -951,6 +967,7 @@ void janet_sys_ir_init_from_table(JanetSysIR *ir, JanetTable *table) { ir->return_type = 0; ir->parameter_count = 0; ir->register_names = janet_table(0); + ir->type_names = janet_table(0); Janet assembly = janet_table_get(table, janet_ckeywordv("instructions")); Janet param_count = janet_table_get(table, janet_ckeywordv("parameter-count")); Janet link_namev = janet_table_get(table, janet_ckeywordv("link-name")); @@ -996,6 +1013,7 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { 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; @@ -1010,7 +1028,8 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { 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: - janet_formatb(buffer, "typedef struct {\n"); + 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; @@ -1048,6 +1067,7 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { 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: @@ -1064,6 +1084,7 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { 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: @@ -1198,6 +1219,7 @@ static int sysir_gcmark(void *p, size_t s) { JanetSysIR *ir = (JanetSysIR *)p; (void) s; janet_mark(janet_wrap_table(ir->register_names)); + janet_mark(janet_wrap_table(ir->type_names)); for (uint32_t i = 0; i < ir->constant_count; i++) { janet_mark(ir->constants[i]); } From a2bd98390e692b614f2eb8316818b4756a80c509 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 12 Aug 2023 13:42:52 -0500 Subject: [PATCH 12/21] More work on the sysir. --- .../basic1.janet} | 0 examples/sysir/basic2.janet | 62 +++++ src/core/sysir.c | 224 +++++++++++------- 3 files changed, 206 insertions(+), 80 deletions(-) rename examples/{sysdialect_asm.janet => sysir/basic1.janet} (100%) create mode 100644 examples/sysir/basic2.janet diff --git a/examples/sysdialect_asm.janet b/examples/sysir/basic1.janet similarity index 100% rename from examples/sysdialect_asm.janet rename to examples/sysir/basic1.janet diff --git a/examples/sysir/basic2.janet b/examples/sysir/basic2.janet new file mode 100644 index 00000000..01c10503 --- /dev/null +++ b/examples/sysir/basic2.janet @@ -0,0 +1,62 @@ +### typedef struct {float x; float y; float z;} Vec3; +### +### Vec3 addv(Vec3 a, Vec3 b) { +### Vec3 ret; +### ret.x = a.x + b.x; +### ret.y = a.y + b.y; +### ret.z = a.z + b.z; +### return ret; +### } + +# Use fgetp for code gen + +(def ir-asm + @{:instructions + '( + # Types + (type-prim Real f32) + (type-struct Vec3 Real Real Real) + (type-pointer PReal Real) + + # Declarations + (bind position Vec3) + (bind velocity Vec3) + (bind next-position Vec3) + (bind dest Real) + (bind lhs Real) + (bind rhs Real) + (bind pdest PReal) + (bind plhs PReal) + (bind prhs PReal) + + # Code + (fgetp pdest next-position 0) + (fgetp plhs position 0) + (fgetp prhs velocity 0) + (load lhs plhs) + (load rhs prhs) + (add dest lhs rhs) + (store pdest dest) + + (fgetp pdest next-position 1) + (fgetp plhs position 1) + (fgetp prhs velocity 1) + (load lhs plhs) + (load rhs prhs) + (add dest lhs rhs) + (store pdest dest) + + (fgetp pdest next-position 2) + (fgetp plhs position 2) + (fgetp prhs velocity 2) + (load lhs plhs) + (load rhs prhs) + (add dest lhs rhs) + (store pdest dest) + + (return next-position)) + :parameter-count 2 + :link-name "addv"}) + +(def as (sysir/asm ir-asm)) +(print (sysir/to-c as)) diff --git a/src/core/sysir.c b/src/core/sysir.c index 671f1c3c..e37ca76c 100644 --- a/src/core/sysir.c +++ b/src/core/sysir.c @@ -67,6 +67,7 @@ typedef enum { JANET_PRIM_POINTER, JANET_PRIM_BOOLEAN, JANET_PRIM_STRUCT, + JANET_PRIM_UNION, JANET_PRIM_ARRAY, } JanetPrim; @@ -284,12 +285,41 @@ typedef struct { JanetSysTypeInfo *type_defs; JanetSysTypeField *field_defs; JanetSysInstruction *instructions; + JanetString *register_names; + JanetString *type_names; Janet *constants; - JanetTable *register_names; - JanetTable *type_names; uint32_t parameter_count; } JanetSysIR; +typedef struct { + JanetSysIR ir; + JanetTable *register_names; + JanetTable *type_names; + JanetTable *labels; +} JanetSysIRBuilder; + +/* 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) { @@ -304,53 +334,53 @@ static void instr_assert_min_length(JanetTuple tup, int32_t minlen, Janet x) { } } -static uint32_t instr_read_operand(Janet x, JanetSysIR *ir) { +static uint32_t instr_read_operand(Janet x, JanetSysIRBuilder *ir) { if (janet_checktype(x, JANET_SYMBOL)) { Janet check = janet_table_get(ir->register_names, x); if (janet_checktype(check, JANET_NUMBER)) { return (uint32_t) janet_unwrap_number(check); } else { - uint32_t operand = ir->register_count++; + uint32_t operand = ir->ir.register_count++; janet_table_put(ir->register_names, x, janet_wrap_number(operand)); return operand; } } if (!janet_checkuint(x)) janet_panicf("expected non-negative integer operand, got %v", x); uint32_t operand = (uint32_t) janet_unwrap_number(x); - if (operand >= ir->register_count) { - ir->register_count = operand + 1; + if (operand >= ir->ir.register_count) { + ir->ir.register_count = operand + 1; } return operand; } -static uint32_t instr_read_field(Janet x, JanetSysIR *ir) { +static uint32_t instr_read_field(Janet x, JanetSysIRBuilder *ir) { if (!janet_checkuint(x)) janet_panicf("expected non-negative field index, got %v", 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) { +static uint64_t instr_read_u64(Janet x, JanetSysIRBuilder *ir) { if (!janet_checkuint64(x)) janet_panicf("expected unsigned 64 bit integer, got %v", x); (void) ir; return janet_getuinteger64(&x, 0); } -static uint32_t instr_read_type_operand(Janet x, JanetSysIR *ir) { +static uint32_t instr_read_type_operand(Janet x, JanetSysIRBuilder *ir) { if (janet_checktype(x, JANET_SYMBOL)) { Janet check = janet_table_get(ir->type_names, x); if (janet_checktype(check, JANET_NUMBER)) { return (uint32_t) janet_unwrap_number(check); } else { - uint32_t operand = ir->type_def_count++; + uint32_t operand = ir->ir.type_def_count++; janet_table_put(ir->type_names, x, janet_wrap_number(operand)); return operand; } } if (!janet_checkuint(x)) janet_panicf("expected non-negative integer operand, got %v", x); uint32_t operand = (uint32_t) janet_unwrap_number(x); - if (operand >= ir->type_def_count) { - ir->type_def_count = operand + 1; + if (operand >= ir->ir.type_def_count) { + ir->ir.type_def_count = operand + 1; } return operand; } @@ -368,10 +398,10 @@ static JanetPrim instr_read_prim(Janet x) { return namedata->prim; } -static uint32_t instr_read_label(JanetSysIR *sysir, Janet x, JanetTable *labels) { +static uint32_t instr_read_label(JanetSysIRBuilder *sysir, Janet x) { (void) sysir; uint32_t ret = 0; - Janet check = janet_table_get(labels, x); + Janet check = janet_table_get(sysir->labels, x); if (!janet_checktype(check, JANET_NIL)) { ret = (uint32_t) janet_unwrap_number(check); } else { @@ -382,10 +412,10 @@ static uint32_t instr_read_label(JanetSysIR *sysir, Janet x, JanetTable *labels) return ret; } -static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instructions) { +static void janet_sysir_init_instructions(JanetSysIRBuilder *out, JanetView instructions) { JanetSysInstruction *ir = NULL; - JanetTable *labels = janet_table(0); + JanetTable *labels = out->labels; JanetTable *constant_cache = janet_table(0); uint32_t next_constant = 0; @@ -601,56 +631,56 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction } /* Fix up instructions table */ - out->instructions = janet_v_flatten(ir); - out->instruction_count = ircount; + out->ir.instructions = janet_v_flatten(ir); + out->ir.instruction_count = ircount; /* Fix up labels */ for (uint32_t i = 0; i < ircount; i++) { - JanetSysInstruction instruction = out->instructions[i]; + JanetSysInstruction instruction = out->ir.instructions[i]; uint32_t label_target; switch (instruction.opcode) { default: break; case JANET_SYSOP_BRANCH: - label_target = instr_read_label(out, instruction.branch.temp_label, labels); - out->instructions[i].branch.to = label_target; + label_target = instr_read_label(out, instruction.branch.temp_label); + out->ir.instructions[i].branch.to = label_target; break; case JANET_SYSOP_JUMP: - label_target = instr_read_label(out, instruction.jump.temp_label, labels); - out->instructions[i].jump.to = label_target; + label_target = instr_read_label(out, instruction.jump.temp_label); + out->ir.instructions[i].jump.to = label_target; break; } } /* Build constants */ - out->constant_count = next_constant; - out->constants = next_constant ? janet_malloc(sizeof(Janet) * out->constant_count) : NULL; + out->ir.constant_count = next_constant; + out->ir.constants = next_constant ? janet_malloc(sizeof(Janet) * out->ir.constant_count) : NULL; for (int32_t i = 0; i < constant_cache->capacity; i++) { JanetKV kv = constant_cache->data[i]; if (!janet_checktype(kv.key, JANET_NIL)) { uint32_t index = (uint32_t) janet_unwrap_number(kv.value); - out->constants[index] = kv.key; + out->ir.constants[index] = kv.key; } } } /* Build up type tables */ -static void janet_sysir_init_types(JanetSysIR *sysir) { +static void janet_sysir_init_types(JanetSysIR *ir) { JanetSysTypeField *fields = NULL; - if (sysir->type_def_count == 0) { - sysir->type_def_count++; + if (ir->type_def_count == 0) { + ir->type_def_count++; } - JanetSysTypeInfo *type_defs = janet_malloc(sizeof(JanetSysTypeInfo) * (sysir->type_def_count)); - uint32_t *types = janet_malloc(sizeof(uint32_t) * sysir->register_count); - sysir->type_defs = type_defs; - sysir->types = types; - sysir->type_defs[0].prim = JANET_PRIM_S32; - for (uint32_t i = 0; i < sysir->register_count; i++) { - sysir->types[i] = 0; + JanetSysTypeInfo *type_defs = janet_malloc(sizeof(JanetSysTypeInfo) * (ir->type_def_count)); + uint32_t *types = janet_malloc(sizeof(uint32_t) * ir->register_count); + ir->type_defs = type_defs; + ir->types = types; + ir->type_defs[0].prim = JANET_PRIM_S32; + for (uint32_t i = 0; i < ir->register_count; i++) { + ir->types[i] = 0; } - for (uint32_t i = 0; i < sysir->instruction_count; i++) { - JanetSysInstruction instruction = sysir->instructions[i]; + for (uint32_t i = 0; i < ir->instruction_count; i++) { + JanetSysInstruction instruction = ir->instructions[i]; switch (instruction.opcode) { default: break; @@ -662,13 +692,15 @@ static void janet_sysir_init_types(JanetSysIR *sysir) { case JANET_SYSOP_TYPE_STRUCT: case JANET_SYSOP_TYPE_UNION: { uint32_t type_def = instruction.type_types.dest_type; - type_defs[type_def].prim = JANET_PRIM_STRUCT; + 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 = (uint32_t) janet_v_count(fields); 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 = sysir->instructions[i + offset]; + JanetSysInstruction arg_instruction = ir->instructions[i + offset]; uint32_t arg = arg_instruction.arg.args[index]; JanetSysTypeField field; field.type = arg; @@ -698,22 +730,31 @@ static void janet_sysir_init_types(JanetSysIR *sysir) { } } - sysir->field_defs = janet_v_flatten(fields); + ir->field_defs = janet_v_flatten(fields); } /* Type checking */ +/* Get a printable representation of a type on type failure */ +static Janet tname(JanetSysIR *ir, uint32_t typeid) { + JanetString name = ir->type_names[typeid]; + if (NULL != name) { + return janet_wrap_string(name); + } + return janet_wrap_string(janet_formatc("type-id:%d", typeid)); +} + static void tcheck_boolean(JanetSysIR *sysir, uint32_t reg1) { uint32_t t1 = sysir->types[reg1]; if (sysir->type_defs[t1].prim != JANET_PRIM_BOOLEAN) { - janet_panicf("type failure, expected boolean, got type-id:%d", t1); /* TODO improve this */ + janet_panicf("type failure, expected boolean, got %V", tname(sysir, t1)); } } static void tcheck_array(JanetSysIR *sysir, uint32_t reg1) { uint32_t t1 = sysir->types[reg1]; if (sysir->type_defs[t1].prim != JANET_PRIM_ARRAY) { - janet_panicf("type failure, expected array, got type-id:%d", t1); /* TODO improve this */ + janet_panicf("type failure, expected array, got %V", tname(sysir, t1)); } } @@ -721,8 +762,9 @@ static void tcheck_number(JanetSysIR *sysir, uint32_t reg1) { JanetPrim t1 = sysir->type_defs[sysir->types[reg1]].prim; if (t1 == JANET_PRIM_BOOLEAN || t1 == JANET_PRIM_POINTER || + t1 == JANET_PRIM_UNION || t1 == JANET_PRIM_STRUCT) { - janet_panicf("type failure, expected numeric type, got type-id:%d", t1); /* TODO improve this */ + janet_panicf("type failure, expected numeric type, got %V", tname(sysir, t1)); } } @@ -736,33 +778,36 @@ static void tcheck_integer(JanetSysIR *sysir, uint32_t reg1) { t1 != JANET_PRIM_U64 && t1 != JANET_PRIM_U16 && t1 != JANET_PRIM_U8) { - janet_panicf("type failure, expected integer type, got type-id:%d", t1); /* TODO improve this */ + janet_panicf("type failure, expected integer type, got %V", tname(sysir, t1)); } } static void tcheck_pointer(JanetSysIR *sysir, uint32_t reg1) { uint32_t t1 = sysir->types[reg1]; if (sysir->type_defs[t1].prim != JANET_PRIM_POINTER) { - janet_panicf("type failure, expected pointer, got type-id:%d", t1); + janet_panicf("type failure, expected pointer, got %V", tname(sysir, t1)); } } static void tcheck_pointer_equals(JanetSysIR *sysir, uint32_t preg, uint32_t elreg) { uint32_t t1 = sysir->types[preg]; if (sysir->type_defs[t1].prim != JANET_PRIM_POINTER) { - janet_panicf("type failure, expected pointer, got type-id:%d", t1); + janet_panicf("type failure, expected pointer, got %V", tname(sysir, t1)); } uint32_t tp = sysir->type_defs[t1].pointer.type; uint32_t t2 = sysir->types[elreg]; if (t2 != tp) { - janet_panicf("type failure, type-id:%d is not compatible with a pointer to type-id:%d", t2, tp); + janet_panicf("type failure, %V is not compatible with a pointer to %V", + tname(sysir, t2), + tname(sysir, tp)); } } -static void tcheck_struct(JanetSysIR *sysir, uint32_t reg1) { +static void tcheck_struct_or_union(JanetSysIR *sysir, uint32_t reg1) { uint32_t t1 = sysir->types[reg1]; - if (sysir->type_defs[t1].prim != JANET_PRIM_STRUCT) { - janet_panicf("type failure, expected struct, got type-id:%d", t1); + JanetPrim prim = sysir->type_defs[t1].prim; + if (prim != JANET_PRIM_STRUCT && prim != JANET_PRIM_UNION) { + janet_panicf("type failure, expected struct or union, got %v", tname(sysir, t1)); } } @@ -770,7 +815,9 @@ static void tcheck_equal(JanetSysIR *sysir, uint32_t reg1, uint32_t reg2) { uint32_t t1 = sysir->types[reg1]; uint32_t t2 = sysir->types[reg2]; if (t1 != t2) { - janet_panicf("type failure, type-id:%d does not match type-id:%d", t1, t2); /* TODO improve this */ + janet_panicf("type failure, %V does not match %V", + tname(sysir, t1), + tname(sysir, t2)); } } @@ -795,7 +842,7 @@ static void tcheck_array_getp(JanetSysIR *sysir, uint32_t dest, uint32_t lhs, ui uint32_t dtype = sysir->type_defs[sysir->types[dest]].pointer.type; uint32_t eltype = sysir->type_defs[sysir->types[lhs]].array.type; if (dtype != eltype) { - janet_panicf("type failure, type-id:%d does not match type-id:%d", dtype, eltype); + janet_panicf("type failure, %V does not match %V", tname(sysir, dtype), tname(sysir, eltype)); } } @@ -805,12 +852,12 @@ static void tcheck_array_pgetp(JanetSysIR *sysir, uint32_t dest, uint32_t lhs, u tcheck_pointer(sysir, dest); uint32_t aptype = sysir->type_defs[sysir->types[lhs]].pointer.type; if (sysir->type_defs[aptype].prim != JANET_PRIM_ARRAY) { - janet_panicf("type failure, expected array type but got type-id:%d", aptype); + janet_panicf("type failure, expected array type but got %V", tname(sysir, aptype)); } uint32_t dtype = sysir->type_defs[sysir->types[dest]].pointer.type; uint32_t eltype = sysir->type_defs[aptype].array.type; if (dtype != eltype) { - janet_panicf("type failure, type-id:%d does not match type-id:%d", dtype, eltype); + janet_panicf("type failure, %V does not match %V", tname(sysir, dtype), tname(sysir, eltype)); } } @@ -820,7 +867,8 @@ static void tcheck_pointer_math(JanetSysIR *sysir, uint32_t dest, uint32_t lhs, uint32_t tdest = sysir->types[dest]; uint32_t tlhs = sysir->types[lhs]; if (tdest != tlhs) { - janet_panicf("type failure, type-id:%d does not match type-id:%d", tdest, tlhs); + janet_panicf("type failure, %V does not match %V", tname(sysir, tdest), + tname(sysir, tlhs)); } uint32_t pdest = sysir->type_defs[tdest].prim; if (pdest == JANET_PRIM_POINTER) { @@ -853,7 +901,9 @@ static void janet_sysir_type_check(JanetSysIR *sysir) { uint32_t ret_type = sysir->types[instruction.one.src]; if (found_return) { if (sysir->return_type != ret_type) { - janet_panicf("multiple return types are not allowed: type-id:%d and type-id:%d", ret_type, sysir->return_type); + janet_panicf("multiple return types are not allowed: %V and %V", + tname(sysir, ret_type), + tname(sysir, sysir->return_type)); } } else { sysir->return_type = ret_type; @@ -933,7 +983,7 @@ static void janet_sysir_type_check(JanetSysIR *sysir) { break; case JANET_SYSOP_FIELD_GETP: tcheck_pointer(sysir, instruction.field.r); - tcheck_struct(sysir, instruction.field.st); + tcheck_struct_or_union(sysir, instruction.field.st); uint32_t struct_type = sysir->types[instruction.field.st]; if (instruction.field.field >= sysir->type_defs[struct_type].st.field_count) { janet_panicf("invalid field index %u", instruction.field.field); @@ -943,7 +993,9 @@ static void janet_sysir_type_check(JanetSysIR *sysir) { uint32_t tdest = sysir->types[instruction.field.r]; uint32_t tpdest = sysir->type_defs[tdest].pointer.type; if (tfield != tpdest) { - janet_panicf("field of type type-id:%d does not match type-id:%d", tfield, tpdest); + janet_panicf("field of type %V does not match %V", + tname(sysir, tfield), + tname(sysir, tpdest)); } break; case JANET_SYSOP_CALLK: @@ -953,32 +1005,44 @@ static void janet_sysir_type_check(JanetSysIR *sysir) { } } -void janet_sys_ir_init_from_table(JanetSysIR *ir, JanetTable *table) { - ir->instructions = NULL; - ir->types = NULL; - ir->type_defs = NULL; - ir->field_defs = NULL; - ir->constants = NULL; - ir->link_name = NULL; - ir->register_count = 0; - ir->type_def_count = 0; - ir->field_def_count = 0; - ir->constant_count = 0; - ir->return_type = 0; - ir->parameter_count = 0; - ir->register_names = janet_table(0); - ir->type_names = janet_table(0); +void janet_sys_ir_init_from_table(JanetSysIR *out, JanetTable *table) { + JanetSysIRBuilder b; + + b.ir.instructions = NULL; + b.ir.types = NULL; + b.ir.type_defs = NULL; + b.ir.field_defs = NULL; + b.ir.constants = NULL; + b.ir.link_name = NULL; + b.ir.register_count = 0; + b.ir.type_def_count = 0; + b.ir.field_def_count = 0; + b.ir.constant_count = 0; + b.ir.return_type = 0; + b.ir.parameter_count = 0; + + b.register_names = janet_table(0); + b.type_names = janet_table(0); + b.labels = janet_table(0); + Janet assembly = janet_table_get(table, janet_ckeywordv("instructions")); Janet param_count = janet_table_get(table, janet_ckeywordv("parameter-count")); Janet link_namev = janet_table_get(table, janet_ckeywordv("link-name")); JanetView asm_view = janet_getindexed(&assembly, 0); JanetString link_name = janet_getstring(&link_namev, 0); int32_t parameter_count = janet_getnat(¶m_count, 0); - ir->parameter_count = parameter_count; - ir->link_name = link_name; - janet_sysir_init_instructions(ir, asm_view); - janet_sysir_init_types(ir); - janet_sysir_type_check(ir); + b.ir.parameter_count = parameter_count; + b.ir.link_name = link_name; + + janet_sysir_init_instructions(&b, asm_view); + + b.ir.type_names = table_to_string_array(b.type_names, b.ir.type_def_count); + b.ir.register_names = table_to_string_array(b.register_names, b.ir.register_count); + + janet_sysir_init_types(&b.ir); + janet_sysir_type_check(&b.ir); + + *out = b.ir; } /* Lowering to C */ @@ -1051,7 +1115,7 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { janet_formatb(buffer, "_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_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++) { From 91e459e4a54a70b04906104b357569c1799ae42f Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 12 Aug 2023 13:43:51 -0500 Subject: [PATCH 13/21] Format sysir. --- src/core/sysir.c | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/core/sysir.c b/src/core/sysir.c index e37ca76c..d3070407 100644 --- a/src/core/sysir.c +++ b/src/core/sysir.c @@ -693,8 +693,8 @@ static void janet_sysir_init_types(JanetSysIR *ir) { case JANET_SYSOP_TYPE_UNION: { uint32_t type_def = instruction.type_types.dest_type; type_defs[type_def].prim = (instruction.opcode == JANET_SYSOP_TYPE_STRUCT) - ? JANET_PRIM_STRUCT - : JANET_PRIM_UNION; + ? 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 = (uint32_t) janet_v_count(fields); for (uint32_t j = 0; j < instruction.type_types.arg_count; j++) { @@ -798,8 +798,8 @@ static void tcheck_pointer_equals(JanetSysIR *sysir, uint32_t preg, uint32_t elr uint32_t t2 = sysir->types[elreg]; if (t2 != tp) { janet_panicf("type failure, %V is not compatible with a pointer to %V", - tname(sysir, t2), - tname(sysir, tp)); + tname(sysir, t2), + tname(sysir, tp)); } } @@ -816,8 +816,8 @@ static void tcheck_equal(JanetSysIR *sysir, uint32_t reg1, uint32_t reg2) { uint32_t t2 = sysir->types[reg2]; if (t1 != t2) { janet_panicf("type failure, %V does not match %V", - tname(sysir, t1), - tname(sysir, t2)); + tname(sysir, t1), + tname(sysir, t2)); } } @@ -868,7 +868,7 @@ static void tcheck_pointer_math(JanetSysIR *sysir, uint32_t dest, uint32_t lhs, uint32_t tlhs = sysir->types[lhs]; if (tdest != tlhs) { janet_panicf("type failure, %V does not match %V", tname(sysir, tdest), - tname(sysir, tlhs)); + tname(sysir, tlhs)); } uint32_t pdest = sysir->type_defs[tdest].prim; if (pdest == JANET_PRIM_POINTER) { @@ -902,8 +902,8 @@ static void janet_sysir_type_check(JanetSysIR *sysir) { if (found_return) { if (sysir->return_type != ret_type) { janet_panicf("multiple return types are not allowed: %V and %V", - tname(sysir, ret_type), - tname(sysir, sysir->return_type)); + tname(sysir, ret_type), + tname(sysir, sysir->return_type)); } } else { sysir->return_type = ret_type; @@ -994,8 +994,8 @@ static void janet_sysir_type_check(JanetSysIR *sysir) { uint32_t tpdest = sysir->type_defs[tdest].pointer.type; if (tfield != tpdest) { janet_panicf("field of type %V does not match %V", - tname(sysir, tfield), - tname(sysir, tpdest)); + tname(sysir, tfield), + tname(sysir, tpdest)); } break; case JANET_SYSOP_CALLK: From 1e1e7a5cfd6e68d9d938cbea1295415f5e837380 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 12 Aug 2023 13:47:23 -0500 Subject: [PATCH 14/21] Update garbage collection for sysir abstract type. --- src/core/sysir.c | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/src/core/sysir.c b/src/core/sysir.c index d3070407..3b1b3744 100644 --- a/src/core/sysir.c +++ b/src/core/sysir.c @@ -1067,7 +1067,7 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { #define EMITBINOP(OP) \ janet_formatb(buffer, "_r%u = _r%u " OP " _r%u;\n", instruction.three.dest, instruction.three.lhs, instruction.three.rhs) - janet_formatb(buffer, "#include \n#include \n\n"); + janet_formatb(buffer, "#include \n\n"); /* Emit type defs */ for (uint32_t i = 0; i < ir->instruction_count; i++) { @@ -1276,14 +1276,24 @@ static int sysir_gc(void *p, size_t s) { janet_free(ir->instructions); janet_free(ir->type_defs); janet_free(ir->field_defs); + janet_free(ir->register_names); + janet_free(ir->type_names); return 0; } static int sysir_gcmark(void *p, size_t s) { JanetSysIR *ir = (JanetSysIR *)p; (void) s; - janet_mark(janet_wrap_table(ir->register_names)); - janet_mark(janet_wrap_table(ir->type_names)); + 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->type_def_count; i++) { + if (ir->type_names[i] != NULL) { + janet_mark(janet_wrap_string(ir->type_names[i])); + } + } for (uint32_t i = 0; i < ir->constant_count; i++) { janet_mark(ir->constants[i]); } From 4b8e7a416f801c913e052775585d88cb7ce0e592 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 12 Aug 2023 17:36:06 -0500 Subject: [PATCH 15/21] Have separate instructions for pointer arith --- examples/sysir/typeerr0.janet | 56 ++++++++++++++++++++++ src/core/sysir.c | 87 +++++++++++++++++++++-------------- 2 files changed, 109 insertions(+), 34 deletions(-) create mode 100644 examples/sysir/typeerr0.janet diff --git a/examples/sysir/typeerr0.janet b/examples/sysir/typeerr0.janet new file mode 100644 index 00000000..8f4b764c --- /dev/null +++ b/examples/sysir/typeerr0.janet @@ -0,0 +1,56 @@ +### typedef struct {float x; float y; float z;} Vec3; +### +### Vec3 addv(Vec3 a, Vec3 b) { +### Vec3 ret; +### ret.x = a.x + b.x; +### ret.y = a.y + b.y; +### ret.z = a.z + b.z; +### return ret; +### } + +(def ir-asm + @{:instructions + '( + # Types + (type-prim Real f32) + (type-struct Vec3 Real Real Real) + (type-pointer PReal Real) + + # Declarations + (bind position Vec3) + (bind velocity Vec3) + (bind next-position Vec3) + (bind dest Real) + (bind lhs Real) + (bind rhs Real) + (bind pdest PReal) + (bind plhs PReal) + (bind prhs PReal) + + # Code (has type errors) + (fgetp pdest next-position 0) + (fgetp plhs position 0) + (fgetp prhs velocity 0) + (add dest plhs prhs) + (store pdest dest) + + (fgetp pdest next-position 1) + (fgetp plhs position 1) + (fgetp prhs velocity 1) + (add dest lhs rhs) + (load lhs plhs) + (load rhs prhs) + (store pdest dest) + + (fgetp pdest next-position 2) + (fgetp plhs position 2) + (fgetp prhs velocity 2) + (add dest plhs prhs) + (store pdest dest) + + (return next-position)) + :parameter-count 2 + :link-name "addv_with_err"}) + +(def as (sysir/asm ir-asm)) +(print (sysir/to-c as)) diff --git a/src/core/sysir.c b/src/core/sysir.c index 3b1b3744..b5b23960 100644 --- a/src/core/sysir.c +++ b/src/core/sysir.c @@ -20,14 +20,21 @@ * IN THE SOFTWARE. */ +/**** + * + * The System Dialect Intermediate Representation (sysir) is a compiler intermediate representation + * that is a target of a language frontend. Sysir can then be retargeted to C or direct to machine + * code for JIT or AOT compilation. + */ + /* TODO * [ ] named fields (for debugging mostly) * [x] named registers and types - * [ ] better type errors (perhaps mostly for compiler debugging - full type system goes on top) + * [x] better type errors (perhaps mostly for compiler debugging - full type system goes on top) * [ ] x86/x64 machine code target * [ ] target specific extensions - custom instructions and custom primitives * [ ] better casting semantics - * [ ] separate pointer arithmetic from generalized arithmetic (easier to instrument code for safety)? + * [x] separate pointer arithmetic from generalized arithmetic (easier to instrument code for safety)? * [x] fixed-size array types * [ ] recursive pointer types * [x] union types? @@ -42,7 +49,15 @@ * [x] support for stack allocation of arrays * [ ] more math intrinsics * [x] source mapping (using built in Janet source mapping metadata on tuples) - * [ ] better C interface for building up IR + * [ ] unit type or void type + * [ ] (typed) function pointer types and remove calling untyped pointers + * [ ] APL array semantics for binary operands (maybe?) + * [ ] a few built-in array combinators (maybe?) + * [ ] partial evaluator (maybe?) + * [ ] sysir interpreter (maybe?) + * [ ] multiple error messages in one pass + * [ ] better verification of constants + * [ ] forward type inference */ #ifndef JANET_AMALG @@ -131,6 +146,8 @@ typedef enum { JANET_SYSOP_TYPE_POINTER, JANET_SYSOP_TYPE_ARRAY, JANET_SYSOP_TYPE_UNION, + JANET_SYSOP_POINTER_ADD, + JANET_SYSOP_POINTER_SUBTRACT, } JanetSysOp; typedef struct { @@ -164,6 +181,8 @@ static const JanetSysInstrName sys_op_names[] = { {"move", JANET_SYSOP_MOVE}, {"multiply", JANET_SYSOP_MULTIPLY}, {"neq", JANET_SYSOP_NEQ}, + {"pointer-add", JANET_SYSOP_POINTER_ADD}, + {"pointer-subtract", JANET_SYSOP_POINTER_SUBTRACT}, {"return", JANET_SYSOP_RETURN}, {"shl", JANET_SYSOP_SHL}, {"shr", JANET_SYSOP_SHR}, @@ -473,6 +492,8 @@ static void janet_sysir_init_instructions(JanetSysIRBuilder *out, JanetView inst case JANET_SYSOP_NEQ: case JANET_SYSOP_ARRAY_GETP: case JANET_SYSOP_ARRAY_PGETP: + 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(tuple[2], out); @@ -861,21 +882,29 @@ static void tcheck_array_pgetp(JanetSysIR *sysir, uint32_t dest, uint32_t lhs, u } } +static void tcheck_fgetp(JanetSysIR *sysir, uint32_t dest, uint32_t st, uint32_t field) { + tcheck_pointer(sysir, dest); + tcheck_struct_or_union(sysir, st); + uint32_t struct_type = sysir->types[st]; + if (field >= sysir->type_defs[struct_type].st.field_count) { + janet_panicf("invalid field index %u", field); + } + uint32_t field_type = sysir->type_defs[struct_type].st.field_start + field; + uint32_t tfield = sysir->field_defs[field_type].type; + uint32_t tdest = sysir->types[dest]; + uint32_t tpdest = sysir->type_defs[tdest].pointer.type; + if (tfield != tpdest) { + janet_panicf("field of type %V does not match %V", + tname(sysir, tfield), + tname(sysir, tpdest)); + } +} + /* Add and subtract can be used for pointer math as well as normal arithmetic. Unlike C, only * allow pointer on lhs for addition. */ static void tcheck_pointer_math(JanetSysIR *sysir, uint32_t dest, uint32_t lhs, uint32_t rhs) { - uint32_t tdest = sysir->types[dest]; - uint32_t tlhs = sysir->types[lhs]; - if (tdest != tlhs) { - janet_panicf("type failure, %V does not match %V", tname(sysir, tdest), - tname(sysir, tlhs)); - } - uint32_t pdest = sysir->type_defs[tdest].prim; - if (pdest == JANET_PRIM_POINTER) { - tcheck_integer(sysir, rhs); - } else { - tcheck_equal(sysir, lhs, rhs); - } + tcheck_pointer_equals(sysir, dest, lhs); + tcheck_integer(sysir, rhs); } static void janet_sysir_type_check(JanetSysIR *sysir) { @@ -917,10 +946,12 @@ static void janet_sysir_type_check(JanetSysIR *sysir) { case JANET_SYSOP_CAST: tcheck_cast(sysir, instruction.two.dest, instruction.two.src); break; - case JANET_SYSOP_ADD: - case JANET_SYSOP_SUBTRACT: + case JANET_SYSOP_POINTER_ADD: + case JANET_SYSOP_POINTER_SUBTRACT: tcheck_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, instruction.three.dest); @@ -930,7 +961,7 @@ static void janet_sysir_type_check(JanetSysIR *sysir) { case JANET_SYSOP_BAND: case JANET_SYSOP_BOR: case JANET_SYSOP_BXOR: - tcheck_integer(sysir, instruction.three.lhs); + tcheck_integer(sysir, instruction.three.dest); tcheck_equal(sysir, instruction.three.lhs, instruction.three.rhs); tcheck_equal(sysir, instruction.three.dest, instruction.three.lhs); break; @@ -982,21 +1013,7 @@ static void janet_sysir_type_check(JanetSysIR *sysir) { tcheck_array_pgetp(sysir, instruction.three.dest, instruction.three.lhs, instruction.three.lhs); break; case JANET_SYSOP_FIELD_GETP: - tcheck_pointer(sysir, instruction.field.r); - tcheck_struct_or_union(sysir, instruction.field.st); - uint32_t struct_type = sysir->types[instruction.field.st]; - if (instruction.field.field >= sysir->type_defs[struct_type].st.field_count) { - janet_panicf("invalid field index %u", instruction.field.field); - } - uint32_t field_type = sysir->type_defs[struct_type].st.field_start + instruction.field.field; - uint32_t tfield = sysir->field_defs[field_type].type; - uint32_t tdest = sysir->types[instruction.field.r]; - uint32_t tpdest = sysir->type_defs[tdest].pointer.type; - if (tfield != tpdest) { - janet_panicf("field of type %V does not match %V", - tname(sysir, tfield), - tname(sysir, tpdest)); - } + tcheck_fgetp(sysir, instruction.field.r, instruction.field.st, instruction.field.field); break; case JANET_SYSOP_CALLK: /* TODO - check function return type */ @@ -1007,6 +1024,7 @@ static void janet_sysir_type_check(JanetSysIR *sysir) { void janet_sys_ir_init_from_table(JanetSysIR *out, JanetTable *table) { JanetSysIRBuilder b; + memset(out, 0, sizeof(*out)); b.ir.instructions = NULL; b.ir.types = NULL; @@ -1171,9 +1189,11 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { janet_formatb(buffer, "return _r%u;\n", instruction.one.src); 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: @@ -1236,7 +1256,6 @@ void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { janet_formatb(buffer, ");\n"); break; case JANET_SYSOP_CAST: - /* TODO - make casting rules explicit instead of just whatever C does */ janet_formatb(buffer, "_r%u = (_t%u) _r%u;\n", instruction.two.dest, ir->types[instruction.two.dest], instruction.two.src); break; case JANET_SYSOP_MOVE: From b939671b791453a7e92fada844c517d3016a150e Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 13 Aug 2023 11:07:38 -0500 Subject: [PATCH 16/21] Add check for redefining types. --- examples/sysir/typeerr1.janet | 15 ++++++++ src/core/sysir.c | 70 ++++++++++++++++++++++++++--------- 2 files changed, 67 insertions(+), 18 deletions(-) create mode 100644 examples/sysir/typeerr1.janet diff --git a/examples/sysir/typeerr1.janet b/examples/sysir/typeerr1.janet new file mode 100644 index 00000000..462fcaa5 --- /dev/null +++ b/examples/sysir/typeerr1.janet @@ -0,0 +1,15 @@ +(def ir-asm + @{:instructions + '( + # Types + (type-prim Real f32) + (type-prim 1 s32) + + (bind bob Real) + + (return bob)) + :parameter-count 0 + :link-name "redefine_type_fail"}) + +(def as (sysir/asm ir-asm)) +(print (sysir/to-c as)) diff --git a/src/core/sysir.c b/src/core/sysir.c index b5b23960..bc303b9a 100644 --- a/src/core/sysir.c +++ b/src/core/sysir.c @@ -58,6 +58,7 @@ * [ ] multiple error messages in one pass * [ ] better verification of constants * [ ] forward type inference + * [x] don't allow redefining types */ #ifndef JANET_AMALG @@ -84,6 +85,7 @@ typedef enum { JANET_PRIM_STRUCT, JANET_PRIM_UNION, JANET_PRIM_ARRAY, + JANET_PRIM_UNKNOWN } JanetPrim; typedef struct { @@ -106,6 +108,7 @@ static const JanetPrimName prim_names[] = { {"u32", JANET_PRIM_U32}, {"u64", JANET_PRIM_U64}, {"u8", JANET_PRIM_U8}, + {"union", JANET_PRIM_UNION}, }; typedef enum { @@ -412,7 +415,7 @@ static JanetPrim instr_read_prim(Janet 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 type %v", x); + janet_panicf("unknown primitive type %v", x); } return namedata->prim; } @@ -685,20 +688,34 @@ static void janet_sysir_init_instructions(JanetSysIRBuilder *out, JanetView inst } } +/* Get a printable representation of a type on type failure */ +static Janet tname(JanetSysIR *ir, uint32_t typeid) { + JanetString name = ir->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) { + if (ir->type_defs[typeid].prim != JANET_PRIM_UNKNOWN) { + janet_panicf("cannot redefine type %V", tname(ir, typeid)); + } +} + /* Build up type tables */ static void janet_sysir_init_types(JanetSysIR *ir) { JanetSysTypeField *fields = NULL; - if (ir->type_def_count == 0) { - ir->type_def_count++; - } JanetSysTypeInfo *type_defs = janet_malloc(sizeof(JanetSysTypeInfo) * (ir->type_def_count)); uint32_t *types = janet_malloc(sizeof(uint32_t) * ir->register_count); ir->type_defs = type_defs; ir->types = types; - ir->type_defs[0].prim = JANET_PRIM_S32; for (uint32_t i = 0; i < ir->register_count; i++) { ir->types[i] = 0; } + for (uint32_t i = 0; i < ir->type_def_count; i++) { + type_defs[i].prim = JANET_PRIM_UNKNOWN; + } for (uint32_t i = 0; i < ir->instruction_count; i++) { JanetSysInstruction instruction = ir->instructions[i]; @@ -707,12 +724,14 @@ static void janet_sysir_init_types(JanetSysIR *ir) { 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; @@ -731,12 +750,14 @@ static void janet_sysir_init_types(JanetSysIR *ir) { } 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; @@ -756,15 +777,6 @@ static void janet_sysir_init_types(JanetSysIR *ir) { /* Type checking */ -/* Get a printable representation of a type on type failure */ -static Janet tname(JanetSysIR *ir, uint32_t typeid) { - JanetString name = ir->type_names[typeid]; - if (NULL != name) { - return janet_wrap_string(name); - } - return janet_wrap_string(janet_formatc("type-id:%d", typeid)); -} - static void tcheck_boolean(JanetSysIR *sysir, uint32_t reg1) { uint32_t t1 = sysir->types[reg1]; if (sysir->type_defs[t1].prim != JANET_PRIM_BOOLEAN) { @@ -900,14 +912,33 @@ static void tcheck_fgetp(JanetSysIR *sysir, uint32_t dest, uint32_t st, uint32_t } } -/* Add and subtract can be used for pointer math as well as normal arithmetic. Unlike C, only - * allow pointer on lhs for addition. */ +/* Unlike C, only allow pointer on lhs for addition and subtraction */ static void tcheck_pointer_math(JanetSysIR *sysir, uint32_t dest, uint32_t lhs, uint32_t rhs) { tcheck_pointer_equals(sysir, dest, lhs); tcheck_integer(sysir, rhs); } +static JanetString rname(JanetSysIR *sysir, uint32_t regid) { + 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) { + + /* TODO - type inference */ + + /* Assert no unknown types */ + for (uint32_t i = 0; i < sysir->register_count; i++) { + uint32_t type = sysir->types[i]; + JanetSysTypeInfo tinfo = sysir->type_defs[type]; + if (tinfo.prim == JANET_PRIM_UNKNOWN) { + janet_panicf("unable to infer type for %V", rname(sysir, i)); + } + } + int found_return = 0; for (uint32_t i = 0; i < sysir->instruction_count; i++) { JanetSysInstruction instruction = sysir->instructions[i]; @@ -1033,7 +1064,7 @@ void janet_sys_ir_init_from_table(JanetSysIR *out, JanetTable *table) { b.ir.constants = NULL; b.ir.link_name = NULL; b.ir.register_count = 0; - b.ir.type_def_count = 0; + b.ir.type_def_count = 1; /* first type is always unknown by default */ b.ir.field_def_count = 0; b.ir.constant_count = 0; b.ir.return_type = 0; @@ -1048,8 +1079,11 @@ void janet_sys_ir_init_from_table(JanetSysIR *out, JanetTable *table) { Janet link_namev = janet_table_get(table, janet_ckeywordv("link-name")); JanetView asm_view = janet_getindexed(&assembly, 0); JanetString link_name = janet_getstring(&link_namev, 0); - int32_t parameter_count = janet_getnat(¶m_count, 0); + uint32_t parameter_count = (uint32_t) janet_getnat(¶m_count, 0); b.ir.parameter_count = parameter_count; + if (parameter_count > b.ir.register_count) { + janet_panic("too many parameters"); + } b.ir.link_name = link_name; janet_sysir_init_instructions(&b, asm_view); From 46bda4e6fae55bae1a0b0c64e445b92c4abf3170 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 16 Aug 2023 14:09:25 -0500 Subject: [PATCH 17/21] Stub out type inference pass. --- src/core/sysir.c | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/src/core/sysir.c b/src/core/sysir.c index bc303b9a..b62aeb6e 100644 --- a/src/core/sysir.c +++ b/src/core/sysir.c @@ -31,6 +31,7 @@ * [ ] named fields (for debugging mostly) * [x] named registers and types * [x] better type errors (perhaps mostly for compiler debugging - full type system goes on top) + * [ ] support for switch-case * [ ] x86/x64 machine code target * [ ] target specific extensions - custom instructions and custom primitives * [ ] better casting semantics @@ -928,7 +929,21 @@ static JanetString rname(JanetSysIR *sysir, uint32_t regid) { static void janet_sysir_type_check(JanetSysIR *sysir) { - /* TODO - type inference */ + /* Simple forward type inference */ + int forward_progress; + do { + forward_progress = 0; + for (uint32_t i = 0; i < sysir->instruction_count; i++) { + JanetSysInstruction instruction = sysir->instructions[i]; + switch (instruction.opcode) { + default: + break; + case JANET_SYSOP_MOVE: + tcheck_equal(sysir, instruction.two.dest, instruction.two.src); + break; + } + } + } while (forward_progress); /* Assert no unknown types */ for (uint32_t i = 0; i < sysir->register_count; i++) { From e5893d06928baf7932d25332bc4c28f05d94cce9 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 20 Aug 2023 14:50:46 -0500 Subject: [PATCH 18/21] Fix reference counting for threaded abstract types. Was very borked. The sweep phase should drop references to unused abstracts but wasn't, resulting in each collection decrementing the count by one until 0 was hit, even if other threads maintained a reference. --- src/core/abstract.c | 2 +- src/core/gc.c | 12 +++++++----- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/src/core/abstract.c b/src/core/abstract.c index 84879801..b8b21ebf 100644 --- a/src/core/abstract.c +++ b/src/core/abstract.c @@ -182,7 +182,7 @@ void janet_os_mutex_lock(JanetOSMutex *mutex) { void janet_os_mutex_unlock(JanetOSMutex *mutex) { int ret = pthread_mutex_unlock((pthread_mutex_t *) mutex); - if (ret) janet_panic("cannot release lock"); + if (ret) janet_panicf("cannot release lock: %s", strerror(ret)); } void janet_os_rwlock_init(JanetOSRWLock *rwlock) { diff --git a/src/core/gc.c b/src/core/gc.c index f0ecdd9a..9e7ecba5 100644 --- a/src/core/gc.c +++ b/src/core/gc.c @@ -364,20 +364,22 @@ void janet_sweep() { /* If not visited... */ if (!janet_truthy(items[i].value)) { void *abst = janet_unwrap_abstract(items[i].key); + if (0 == janet_abstract_decref(abst)) { /* Run finalizer */ JanetAbstractHead *head = janet_abstract_head(abst); if (head->type->gc) { janet_assert(!head->type->gc(head->data, head->size), "finalizer failed"); } - /* Mark as tombstone in place */ - items[i].key = janet_wrap_nil(); - items[i].value = janet_wrap_false(); - janet_vm.threaded_abstracts.deleted++; - janet_vm.threaded_abstracts.count--; /* Free memory */ janet_free(janet_abstract_head(abst)); } + + /* Mark as tombstone in place */ + items[i].key = janet_wrap_nil(); + items[i].value = janet_wrap_false(); + janet_vm.threaded_abstracts.deleted++; + janet_vm.threaded_abstracts.count--; } /* Reset for next sweep */ From 61791e4a4cdab8ed6a30746f6118724dacc94148 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 3 Sep 2023 10:18:37 -0500 Subject: [PATCH 19/21] Update docstring. --- src/core/os.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/core/os.c b/src/core/os.c index 1fcd2102..bc82bf46 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -853,7 +853,8 @@ static void janet_signal_trampoline(int sig) { JANET_CORE_FN(os_sigaction, "(os/sigaction which &opt handler interrupt-interpreter)", - "Add a signal handler for a given action. Use nil for the `handler` argument to remove a signal handler.") { + "Add a signal handler for a given action. Use nil for the `handler` argument to remove a signal handler. " + "All signal handlers are the same as supported by `os/proc-kill`.") { janet_sandbox_assert(JANET_SANDBOX_SIGNAL); janet_arity(argc, 1, 3); #ifdef JANET_WINDOWS From efbc46c69e72849b3c43360f3c0074e3f45bb1f9 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 3 Sep 2023 12:32:28 -0500 Subject: [PATCH 20/21] Add support for using operators on arrays (and pointers to arrays). Allows more expressive yet type checked representation of array algorithms. --- examples/sysir/arrays1.janet | 18 ++++ examples/sysir/arrays2.janet | 20 +++++ src/core/sysir.c | 160 ++++++++++++++++++++++------------- 3 files changed, 140 insertions(+), 58 deletions(-) create mode 100644 examples/sysir/arrays1.janet create mode 100644 examples/sysir/arrays2.janet diff --git a/examples/sysir/arrays1.janet b/examples/sysir/arrays1.janet new file mode 100644 index 00000000..8ec055c3 --- /dev/null +++ b/examples/sysir/arrays1.janet @@ -0,0 +1,18 @@ +(def ir-asm + @{:instructions + '( + # Types + (type-prim Double f64) + (type-array BigVec Double 100) + + # Declarations + (bind 0 BigVec) + (bind 1 BigVec) + (bind 2 BigVec) + (add 2 0 1) + (return 2)) + :parameter-count 2 + :link-name "add_vector"}) + +(def as (sysir/asm ir-asm)) +(print (sysir/to-c as)) diff --git a/examples/sysir/arrays2.janet b/examples/sysir/arrays2.janet new file mode 100644 index 00000000..ba00b496 --- /dev/null +++ b/examples/sysir/arrays2.janet @@ -0,0 +1,20 @@ + +(def ir-asm + @{:instructions + '( + # Types + (type-prim Double f64) + (type-array BigVec Double 100) + (type-pointer BigVecP BigVec) + + # Declarations + (bind 0 BigVecP) + (bind 1 BigVecP) + (bind 2 BigVecP) + (add 2 0 1) + (return 2)) + :parameter-count 2 + :link-name "add_vectorp"}) + +(def as (sysir/asm ir-asm)) +(print (sysir/to-c as)) diff --git a/src/core/sysir.c b/src/core/sysir.c index b62aeb6e..2a98d629 100644 --- a/src/core/sysir.c +++ b/src/core/sysir.c @@ -778,32 +778,52 @@ static void janet_sysir_init_types(JanetSysIR *ir) { /* Type checking */ -static void tcheck_boolean(JanetSysIR *sysir, uint32_t reg1) { - uint32_t t1 = sysir->types[reg1]; - if (sysir->type_defs[t1].prim != JANET_PRIM_BOOLEAN) { - janet_panicf("type failure, expected boolean, got %V", tname(sysir, t1)); +static uint32_t tcheck_array_element(JanetSysIR *sysir, uint32_t t) { + /* Dereference at most one pointer */ + if (sysir->type_defs[t].prim == JANET_PRIM_POINTER) { + t = sysir->type_defs[t].pointer.type; + } + while (sysir->type_defs[t].prim == JANET_PRIM_ARRAY) { + t = sysir->type_defs[t].array.type; + } + return t; +} + +static void tcheck_boolean(JanetSysIR *sysir, uint32_t t) { + if (sysir->type_defs[t].prim != JANET_PRIM_BOOLEAN) { + janet_panicf("type failure, expected boolean, got %V", tname(sysir, t)); } } -static void tcheck_array(JanetSysIR *sysir, uint32_t reg1) { - uint32_t t1 = sysir->types[reg1]; - if (sysir->type_defs[t1].prim != JANET_PRIM_ARRAY) { - janet_panicf("type failure, expected array, got %V", tname(sysir, t1)); +static void tcheck_array(JanetSysIR *sysir, uint32_t t) { + if (sysir->type_defs[t].prim != JANET_PRIM_ARRAY) { + janet_panicf("type failure, expected array, got %V", tname(sysir, t)); } } -static void tcheck_number(JanetSysIR *sysir, uint32_t reg1) { - JanetPrim t1 = sysir->type_defs[sysir->types[reg1]].prim; +static void tcheck_number(JanetSysIR *sysir, uint32_t t) { + JanetPrim t1 = sysir->type_defs[t].prim; if (t1 == JANET_PRIM_BOOLEAN || t1 == JANET_PRIM_POINTER || t1 == JANET_PRIM_UNION || - t1 == JANET_PRIM_STRUCT) { + t1 == JANET_PRIM_STRUCT || + t1 == JANET_PRIM_ARRAY) { janet_panicf("type failure, expected numeric type, got %V", tname(sysir, t1)); } } -static void tcheck_integer(JanetSysIR *sysir, uint32_t reg1) { - JanetPrim t1 = sysir->type_defs[sysir->types[reg1]].prim; +static void tcheck_number_or_pointer(JanetSysIR *sysir, uint32_t t) { + JanetPrim t1 = sysir->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, expected pointer or numeric type, got %V", tname(sysir, t1)); + } +} + +static void tcheck_integer(JanetSysIR *sysir, uint32_t t) { + JanetPrim t1 = sysir->type_defs[t].prim; if (t1 != JANET_PRIM_S32 && t1 != JANET_PRIM_S64 && t1 != JANET_PRIM_S16 && @@ -816,10 +836,9 @@ static void tcheck_integer(JanetSysIR *sysir, uint32_t reg1) { } } -static void tcheck_pointer(JanetSysIR *sysir, uint32_t reg1) { - uint32_t t1 = sysir->types[reg1]; - if (sysir->type_defs[t1].prim != JANET_PRIM_POINTER) { - janet_panicf("type failure, expected pointer, got %V", tname(sysir, t1)); +static void tcheck_pointer(JanetSysIR *sysir, uint32_t t) { + if (sysir->type_defs[t].prim != JANET_PRIM_POINTER) { + janet_panicf("type failure, expected pointer, got %V", tname(sysir, t)); } } @@ -837,11 +856,10 @@ static void tcheck_pointer_equals(JanetSysIR *sysir, uint32_t preg, uint32_t elr } } -static void tcheck_struct_or_union(JanetSysIR *sysir, uint32_t reg1) { - uint32_t t1 = sysir->types[reg1]; - JanetPrim prim = sysir->type_defs[t1].prim; +static void tcheck_struct_or_union(JanetSysIR *sysir, uint32_t t) { + JanetPrim prim = sysir->type_defs[t].prim; if (prim != JANET_PRIM_STRUCT && prim != JANET_PRIM_UNION) { - janet_panicf("type failure, expected struct or union, got %v", tname(sysir, t1)); + janet_panicf("type failure, expected struct or union, got %v", tname(sysir, t)); } } @@ -870,9 +888,9 @@ static void tcheck_constant(JanetSysIR *sysir, uint32_t dest, Janet c) { } static void tcheck_array_getp(JanetSysIR *sysir, uint32_t dest, uint32_t lhs, uint32_t rhs) { - tcheck_array(sysir, lhs); - tcheck_integer(sysir, rhs); - tcheck_pointer(sysir, dest); + tcheck_array(sysir, sysir->types[lhs]); + tcheck_integer(sysir, sysir->types[rhs]); + tcheck_pointer(sysir, sysir->types[dest]); uint32_t dtype = sysir->type_defs[sysir->types[dest]].pointer.type; uint32_t eltype = sysir->type_defs[sysir->types[lhs]].array.type; if (dtype != eltype) { @@ -881,9 +899,9 @@ static void tcheck_array_getp(JanetSysIR *sysir, uint32_t dest, uint32_t lhs, ui } static void tcheck_array_pgetp(JanetSysIR *sysir, uint32_t dest, uint32_t lhs, uint32_t rhs) { - tcheck_pointer(sysir, lhs); - tcheck_integer(sysir, rhs); - tcheck_pointer(sysir, dest); + tcheck_pointer(sysir, sysir->types[lhs]); + tcheck_integer(sysir, sysir->types[rhs]); + tcheck_pointer(sysir, sysir->types[dest]); uint32_t aptype = sysir->type_defs[sysir->types[lhs]].pointer.type; if (sysir->type_defs[aptype].prim != JANET_PRIM_ARRAY) { janet_panicf("type failure, expected array type but got %V", tname(sysir, aptype)); @@ -896,8 +914,8 @@ static void tcheck_array_pgetp(JanetSysIR *sysir, uint32_t dest, uint32_t lhs, u } static void tcheck_fgetp(JanetSysIR *sysir, uint32_t dest, uint32_t st, uint32_t field) { - tcheck_pointer(sysir, dest); - tcheck_struct_or_union(sysir, st); + tcheck_pointer(sysir, sysir->types[dest]); + tcheck_struct_or_union(sysir, sysir->types[st]); uint32_t struct_type = sysir->types[st]; if (field >= sysir->type_defs[struct_type].st.field_count) { janet_panicf("invalid field index %u", field); @@ -916,7 +934,7 @@ static void tcheck_fgetp(JanetSysIR *sysir, uint32_t dest, uint32_t st, uint32_t /* Unlike C, only allow pointer on lhs for addition and subtraction */ static void tcheck_pointer_math(JanetSysIR *sysir, uint32_t dest, uint32_t lhs, uint32_t rhs) { tcheck_pointer_equals(sysir, dest, lhs); - tcheck_integer(sysir, rhs); + tcheck_integer(sysir, sysir->types[rhs]); } static JanetString rname(JanetSysIR *sysir, uint32_t regid) { @@ -929,21 +947,7 @@ static JanetString rname(JanetSysIR *sysir, uint32_t regid) { static void janet_sysir_type_check(JanetSysIR *sysir) { - /* Simple forward type inference */ - int forward_progress; - do { - forward_progress = 0; - for (uint32_t i = 0; i < sysir->instruction_count; i++) { - JanetSysInstruction instruction = sysir->instructions[i]; - switch (instruction.opcode) { - default: - break; - case JANET_SYSOP_MOVE: - tcheck_equal(sysir, instruction.two.dest, instruction.two.src); - break; - } - } - } while (forward_progress); + /* TODO: Simple forward type inference */ /* Assert no unknown types */ for (uint32_t i = 0; i < sysir->register_count; i++) { @@ -1000,24 +1004,24 @@ static void janet_sysir_type_check(JanetSysIR *sysir) { case JANET_SYSOP_SUBTRACT: case JANET_SYSOP_MULTIPLY: case JANET_SYSOP_DIVIDE: - tcheck_number(sysir, instruction.three.dest); + tcheck_number(sysir, tcheck_array_element(sysir, sysir->types[instruction.three.dest])); tcheck_equal(sysir, instruction.three.lhs, instruction.three.rhs); tcheck_equal(sysir, instruction.three.dest, instruction.three.lhs); break; case JANET_SYSOP_BAND: case JANET_SYSOP_BOR: case JANET_SYSOP_BXOR: - tcheck_integer(sysir, instruction.three.dest); + tcheck_integer(sysir, tcheck_array_element(sysir, sysir->types[instruction.three.dest])); tcheck_equal(sysir, instruction.three.lhs, instruction.three.rhs); tcheck_equal(sysir, instruction.three.dest, instruction.three.lhs); break; case JANET_SYSOP_BNOT: - tcheck_integer(sysir, instruction.two.src); + tcheck_integer(sysir, tcheck_array_element(sysir, sysir->types[instruction.two.src])); tcheck_equal(sysir, instruction.two.dest, instruction.two.src); break; case JANET_SYSOP_SHL: case JANET_SYSOP_SHR: - tcheck_integer(sysir, instruction.three.lhs); + tcheck_integer(sysir, tcheck_array_element(sysir, sysir->types[instruction.three.lhs])); tcheck_equal(sysir, instruction.three.lhs, instruction.three.rhs); tcheck_equal(sysir, instruction.three.dest, instruction.three.lhs); break; @@ -1033,15 +1037,17 @@ static void janet_sysir_type_check(JanetSysIR *sysir) { case JANET_SYSOP_NEQ: case JANET_SYSOP_GTE: case JANET_SYSOP_LTE: + /* TODO - allow arrays */ + tcheck_number_or_pointer(sysir, sysir->types[instruction.three.lhs]); tcheck_equal(sysir, instruction.three.lhs, instruction.three.rhs); tcheck_equal(sysir, instruction.three.dest, instruction.three.lhs); - tcheck_boolean(sysir, instruction.three.dest); + tcheck_boolean(sysir, sysir->types[instruction.three.dest]); break; case JANET_SYSOP_ADDRESS: - tcheck_pointer(sysir, instruction.two.dest); + tcheck_pointer(sysir, sysir->types[instruction.two.dest]); break; case JANET_SYSOP_BRANCH: - tcheck_boolean(sysir, instruction.branch.cond); + tcheck_boolean(sysir, sysir->types[instruction.branch.cond]); if (instruction.branch.to >= sysir->instruction_count) { janet_panicf("label outside of range [0, %u), got %u", sysir->instruction_count, instruction.branch.to); } @@ -1050,7 +1056,7 @@ static void janet_sysir_type_check(JanetSysIR *sysir) { tcheck_constant(sysir, instruction.constant.dest, sysir->constants[instruction.constant.constant]); break; case JANET_SYSOP_CALL: - tcheck_pointer(sysir, instruction.call.callee); + tcheck_pointer(sysir, sysir->types[instruction.call.callee]); break; case JANET_SYSOP_ARRAY_GETP: tcheck_array_getp(sysir, instruction.three.dest, instruction.three.lhs, instruction.three.lhs); @@ -1096,12 +1102,12 @@ void janet_sys_ir_init_from_table(JanetSysIR *out, JanetTable *table) { JanetString link_name = janet_getstring(&link_namev, 0); uint32_t parameter_count = (uint32_t) janet_getnat(¶m_count, 0); b.ir.parameter_count = parameter_count; - if (parameter_count > b.ir.register_count) { - janet_panic("too many parameters"); - } b.ir.link_name = link_name; janet_sysir_init_instructions(&b, asm_view); + if (parameter_count > b.ir.register_count) { + janet_panicf("too many parameters, only %u registers for %u parameters.", b.ir.register_count, parameter_count); + } b.ir.type_names = table_to_string_array(b.type_names, b.ir.type_def_count); b.ir.register_names = table_to_string_array(b.register_names, b.ir.register_count); @@ -1129,10 +1135,48 @@ static const char *c_prim_names[] = { "bool" }; +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; + + /* Top-level pointer semantics */ + if (ir->type_defs[operand_type].prim == JANET_PRIM_POINTER) { + operand_type = ir->type_defs[operand_type].pointer.type; + is_pointer = 1; + } + + /* Add nested for loops for any dimensionality of array */ + while (ir->type_defs[operand_type].prim == JANET_PRIM_ARRAY) { + /* TODO - turn to do while to handle max uint32_t size */ + janet_formatb(buffer, "for (size_t _j%u = 0; _j%u < %u; _j%u++) ", + index_index, index_index, + ir->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 = ir->type_defs[operand_type].array.type; + index_index++; + } + + Janet index_part = janet_wrap_buffer(tempbuf); + janet_formatb(buffer, "_r%u%V = _r%u%V %s _r%u%V;\n", + instruction.three.dest, index_part, + instruction.three.lhs, index_part, + op, + instruction.three.rhs, index_part); +} + void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) { -#define EMITBINOP(OP) \ - janet_formatb(buffer, "_r%u = _r%u " OP " _r%u;\n", instruction.three.dest, instruction.three.lhs, instruction.three.rhs) + JanetBuffer *tempbuf = janet_buffer(0); + +#define EMITBINOP(OP) emit_binop(ir, buffer, tempbuf, instruction, OP) janet_formatb(buffer, "#include \n\n"); From 97963d1396d04f4905b0eee1778e6e7e9c4feed8 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 5 Sep 2023 17:01:31 -0500 Subject: [PATCH 21/21] Update printing for operating on pointers. --- src/core/sysir.c | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/src/core/sysir.c b/src/core/sysir.c index 2a98d629..3c8a2e7f 100644 --- a/src/core/sysir.c +++ b/src/core/sysir.c @@ -1149,7 +1149,7 @@ static void emit_binop(JanetSysIR *ir, JanetBuffer *buffer, JanetBuffer *tempbuf /* Add nested for loops for any dimensionality of array */ while (ir->type_defs[operand_type].prim == JANET_PRIM_ARRAY) { - /* TODO - turn to do while to handle max uint32_t size */ + /* TODO - handle fixed_count == SIZE_MAX */ janet_formatb(buffer, "for (size_t _j%u = 0; _j%u < %u; _j%u++) ", index_index, index_index, ir->type_defs[operand_type].array.fixed_count, @@ -1164,12 +1164,20 @@ static void emit_binop(JanetSysIR *ir, JanetBuffer *buffer, JanetBuffer *tempbuf index_index++; } - Janet index_part = janet_wrap_buffer(tempbuf); - janet_formatb(buffer, "_r%u%V = _r%u%V %s _r%u%V;\n", - instruction.three.dest, index_part, - instruction.three.lhs, index_part, - op, - instruction.three.rhs, index_part); + if (is_pointer) { + janet_formatb(buffer, "*_r%u = *_r%u %s *_r%u;\n", + instruction.three.dest, + instruction.three.lhs, + op, + instruction.three.rhs); + } else { + Janet index_part = janet_wrap_buffer(tempbuf); + janet_formatb(buffer, "_r%u%V = _r%u%V %s _r%u%V;\n", + instruction.three.dest, index_part, + instruction.three.lhs, index_part, + op, + instruction.three.rhs, index_part); + } } void janet_sys_ir_lower_to_c(JanetSysIR *ir, JanetBuffer *buffer) {