mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2025-01-23 13:46:52 +00:00
Code Issues 1 Releases Wiki Activity

Add typed constants and lots more.

Browse Source
This commit is contained in:
Calvin Rose 2024-06-11 19:37:11 -05:00
parent f0395763b7
commit c31d8b52ff
8 changed files with 473 additions and 294 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@ -37,6 +37,7 @@ temp.janet
temp.c
temp*janet
temp*.c
temp.*
scratch.janet
scratch.c

78
examples/sysir/frontend.janet
View File

@ -54,6 +54,7 @@
(add-prim-type 'float 'f32)
(add-prim-type 'double 'f64)
(add-prim-type 'int 's32)
(add-prim-type 'long 's64)
(add-prim-type 'pointer 'pointer)
(add-prim-type 'boolean 'boolean)
(sysir/asm ctx into)
@ -75,12 +76,13 @@
(defn visit1
"Take in a form and compile code and put it into `into`. Return result slot."
[code into &opt no-return]
[code into &opt no-return type-hint]
(cond
# Compile a constant
(or (string? code) (number? code) (boolean? code))
~(,code)
(string? code) ~(pointer ,code)
(boolean? code) ~(boolean ,code)
(number? code) ~(,(or type-hint 'long) ,code)
# Binding
(symbol? code)
@ -94,12 +96,12 @@
(case op
# Arithmetic
'+ (do-binop 'add args into)
'- (do-binop 'subtract args into)
'* (do-binop 'multiply args into)
'/ (do-binop 'divide args into)
'<< (do-binop 'shl args into)
'>> (do-binop 'shl args into)
'+ (do-binop 'add args into type-hint)
'- (do-binop 'subtract args into type-hint)
'* (do-binop 'multiply args into type-hint)
'/ (do-binop 'divide args into type-hint)
'<< (do-binop 'shl args into type-hint)
'>> (do-binop 'shl args into type-hint)
# Comparison
'= (do-comp 'eq args into)
@ -114,12 +116,11 @@
(do
(assert (= 2 (length args)))
(def [xtype x] args)
(def result (visit1 x into))
(def result (visit1 x into false xtype))
(if (tuple? result) # constant
(let [r (get-slot)]
(array/push into ~(bind ,r ,xtype))
(array/push into ~(move ,r ,result))
r)
(let [[t y] result]
(assertf (= t xtype) "type mismatch, %p doesn't match %p" t xtype)
[xtype y])
(do
(array/push into ~(bind ,result ,xtype))
result)))
@ -235,7 +236,7 @@
(def ret (if no-return nil (get-slot)))
(each arg args
(array/push slots (visit1 arg into)))
(array/push into ~(call :default ,ret [,op] ,;slots))
(array/push into ~(call :default ,ret [pointer ,op] ,;slots))
ret)))
(errorf "cannot compile %q" code)))
@ -243,10 +244,10 @@
(varfn do-binop
"Emit an operation such as (+ x y).
Extended to support any number of arguments such as (+ x y z ...)"
[opcode args into]
[opcode args into type-hint]
(var final nil)
(each arg args
(def right (visit1 arg into))
(def right (visit1 arg into false type-hint))
(set final
(if final
(let [result (get-slot)]
@ -317,40 +318,8 @@
(errorf "unknown form %v" form)))
###
### Setup
###
###
(def simple
'(defn simple [x:int]
(def xyz:int (+ 1 2 3))
(return (* x 2 x))))
(def myprog
'(defn myprog []
(def xyz:int (+ 1 2 3))
(def abc:int (* 4 5 6))
(def x:boolean (= 5 7))
(var i:int 0)
(while (< i 10)
(set i (+ 1 i))
(printf (the pointer "i = %d\n") (the int i)))
(printf (the pointer "hello, world!\n%d\n") (the int (if x abc xyz)))
(return (/ abc xyz))))
(def doloop
'(defn doloop [x:int y:int]
(var i:int x)
(while (< i y)
(set i (+ 1 i))
(printf "i = %d\n" (the int i)))
(return x)))
(def main-fn
'(defn _start:void []
(syscall 1 1 "Hello, world!\n" 14)
(syscall 60 0)
#(write 1 "Hello, world!\n" 14)
(return)))
(def ctx (sysir/context))
(setup-default-types ctx)
@ -370,12 +339,3 @@
(defn dumpc
[]
(print (sysir/to-c ctx)))
####
#(compile1 myprog)
#(compile1 doloop)
(compile1 main-fn)
#(dump)
#(dumpc)
(dumpx64)

5
examples/sysir/run_samples.sh Executable file
View File

@ -0,0 +1,5 @@
#!/usr/bin/env bash
build/janet examples/sysir/samples.janet > temp.nasm
nasm -felf64 temp.nasm -l temp.lst -o temp.o
ld -o temp.bin -dynamic-linker /lib64/ld-linux-x86-64.so.2 -lc temp.o
./temp.bin

45
examples/sysir/samples.janet Normal file
View File

@ -0,0 +1,45 @@
(use ./frontend)
(def simple
'(defn simple [x:int]
(def xyz:int (+ 1 2 3))
(return (* x 2 x))))
(def myprog
'(defn myprog []
(def xyz:int (+ 1 2 3))
(def abc:int (* 4 5 6))
(def x:boolean (= 5 7))
(var i:int 0)
(while (< i 10)
(set i (+ 1 i))
(printf "i = %d\n" i))
(printf "hello, world!\n%d\n" (the int (if x abc xyz)))
(return (/ abc xyz))))
(def doloop
'(defn doloop [x:int y:int]
(var i:int x)
(while (< i y)
(set i (the int (+ 1 i)))
(printf "i = %d\n" (the int i)))
(return x)))
(def main-fn
'(defn _start:void []
(syscall 1 1 "Hello, world!\n" 14)
(doloop 10 20)
(exit (the int 0))
(return)))
####
#(compile1 myprog)
(compile1 doloop)
(compile1 main-fn)
#(dump)
#(dumpc)
(dumpx64)
# Run with
# janet examples/sysir/scratch.janet > temp.nasm && nasm -felf64 temp.nasm -l temp.lst && ld temp.o && ./a.out

10
src/boot/boot.janet
View File

@ -158,6 +158,16 @@
[fmt & args]
(error (string/format fmt ;args)))
(defmacro assertf
"Throw an error if x is not truthy. Will not evaluate `err` if x is truthy."
[x fmt & args]
(def v (gensym))
~(do
(def ,v ,x)
(if ,v
,v
(,error (,string/format ,fmt ,;args)))))
(defmacro default
``Define a default value for an optional argument.
Expands to `(def sym (if (= nil sym) val sym))`.``

316
src/core/sysir.c
View File

@ -20,44 +20,6 @@
* IN THE SOFTWARE.
*/
/****
* The System Dialect Intermediate Representation (sysir) is a compiler intermediate representation
* that for "System Janet" a dialect for "System Programming". Sysir can then be retargeted to C or direct to machine
* code for JIT or AOT compilation.
*/
/* TODO
* [x] encode constants directly in 3 address codes - makes codegen easier
* [ ] typed constants
* [x] named registers and types
* [x] better type errors (perhaps mostly for compiler debugging - full type system goes on top)
* [-] x86/x64 machine code target - in progress
* [ ] LLVM target
* [ ] target specific extensions - custom instructions and custom primitives
* [ ] better casting semantics
* [x] separate pointer arithmetic from generalized arithmetic (easier to instrument code for safety)?
* [x] fixed-size array types
* [ ] recursive pointer types
* [ ] global and thread local state
* [x] union types?
* [x] incremental compilation - save type definitions for later
* [ ] Extension to C target for interfacing with Janet
* [x] pointer math, pointer types
* [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.
* [x] support for stack allocation of arrays
* [ ] more math intrinsics
* [x] source mapping (using built in Janet source mapping metadata on tuples)
* [x] unit type or void type
* [ ] (typed) function pointer types and remove calling untyped pointers
* [x] APL array semantics for binary operands (maybe?)
* [ ] a few built-in array combinators (maybe?)
* [ ] multiple error messages in one pass
* [ ] better verification of constants
* [x] don't allow redefining types
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
@ -253,19 +215,19 @@ static JanetString *table_to_string_array(JanetTable *strings_to_indices, int32_
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);
janet_panicf("expected instruction of length %d, got %p", len, x);
}
}
static void instr_assert_min_length(JanetTuple tup, int32_t minlen, Janet x) {
if (janet_tuple_length(tup) < minlen) {
janet_panicf("expected instruction of at least length %d, got %v", minlen, x);
janet_panicf("expected instruction of at least length %d, got %p", minlen, x);
}
}
static void instr_assert_max_length(JanetTuple tup, int32_t maxlen, Janet x) {
if (janet_tuple_length(tup) > maxlen) {
janet_panicf("expected instruction of at most length %d, got %v", maxlen, x);
janet_panicf("expected instruction of at most length %d, got %p", maxlen, x);
}
}
@ -280,7 +242,7 @@ static uint32_t instr_read_operand(Janet x, JanetSysIR *ir) {
return operand;
}
}
if (!janet_checkuint(x)) janet_panicf("expected non-negative integer operand, got %v", x);
if (!janet_checkuint(x)) janet_panicf("expected non-negative integer operand, got %p", x);
uint32_t operand = (uint32_t) janet_unwrap_number(x);
if (operand >= ir->register_count) {
ir->register_count = operand + 1;
@ -288,57 +250,54 @@ static uint32_t instr_read_operand(Janet x, JanetSysIR *ir) {
return operand;
}
static uint32_t instr_read_operand_or_const(Janet x, JanetSysIR *ir) {
JanetTable *constant_cache = ir->constants_lookup;
if (janet_checktype(x, JANET_TUPLE)) {
const Janet *tup = janet_unwrap_tuple(x);
if (janet_tuple_length(tup) != 1) janet_panicf("expected constant wrapped in tuple, got %v", x);
Janet c = tup[0];
int32_t index;
Janet check = janet_table_get(constant_cache, c);
if (janet_checktype(check, JANET_NUMBER)) {
index = (int32_t) janet_unwrap_number(check);
} else {
index = constant_cache->count;
janet_table_put(constant_cache, c, janet_wrap_number(index));
janet_v_push(ir->constants, c);
}
return JANET_SYS_CONSTANT_PREFIX + (uint32_t) index;
}
return instr_read_operand(x, ir);
}
static uint32_t instr_read_field(Janet x, JanetSysIR *ir) {
if (!janet_checkuint(x)) janet_panicf("expected non-negative field index, got %v", x);
if (!janet_checkuint(x)) janet_panicf("expected non-negative field index, got %p", x);
(void) ir; /* Perhaps support syntax for named fields instead of numbered */
uint32_t operand = (uint32_t) janet_unwrap_number(x);
return operand;
}
static uint64_t instr_read_u64(Janet x, JanetSysIR *ir) {
if (!janet_checkuint64(x)) janet_panicf("expected unsigned 64 bit integer, got %v", x);
if (!janet_checkuint64(x)) janet_panicf("expected unsigned 64 bit integer, got %p", x);
(void) ir;
return janet_getuinteger64(&x, 0);
}
static uint32_t instr_read_type_operand(Janet x, JanetSysIR *ir, int is_definition) {
typedef enum {
READ_TYPE_REFERENCE,
READ_TYPE_DEFINITION,
READ_TYPE_FORWARD_REF,
} ReadOpMode;
static uint32_t instr_read_type_operand(Janet x, JanetSysIR *ir, ReadOpMode rmode) {
JanetSysIRLinkage *linkage = ir->linkage;
if (janet_checktype(x, JANET_SYMBOL)) {
Janet check = janet_table_get(linkage->type_name_lookup, x);
if (janet_checktype(check, JANET_NUMBER)) {
if (is_definition) {
janet_panicf("cannot redefine type %v", x);
double n = janet_unwrap_number(check);
if (n < 0) {
if (rmode == READ_TYPE_DEFINITION) {
janet_table_put(linkage->type_name_lookup, x, janet_wrap_number(-n - 1));
}
return (uint32_t)(-n - 1);
}
return (uint32_t) janet_unwrap_number(check);
} else if (is_definition) {
if (rmode == READ_TYPE_DEFINITION) {
janet_panicf("cannot redefine type %p", x);
}
return (uint32_t) n;
} else if (rmode == READ_TYPE_FORWARD_REF) {
uint32_t operand = linkage->type_def_count++;
janet_table_put(linkage->type_name_lookup, x, janet_wrap_number(-operand - 1));
return operand;
} else if (rmode == READ_TYPE_DEFINITION) {
uint32_t operand = linkage->type_def_count++;
janet_table_put(linkage->type_name_lookup, x, janet_wrap_number(operand));
return operand;
} else {
janet_panicf("unknown type %v", x);
janet_panicf("unknown type %p", x);
}
}
if (!janet_checkuint(x)) janet_panicf("expected non-negative integer operand, got %v", x);
if (!janet_checkuint(x)) janet_panicf("expected non-negative integer operand, got %p", x);
uint32_t operand = (uint32_t) janet_unwrap_number(x);
if (operand >= linkage->type_def_count) {
linkage->type_def_count = operand + 1;
@ -346,29 +305,50 @@ static uint32_t instr_read_type_operand(Janet x, JanetSysIR *ir, int is_definiti
return operand;
}
static uint32_t instr_read_operand_or_const(Janet x, JanetSysIR *ir) {
if (janet_checktype(x, JANET_TUPLE)) {
JanetSysConstant jsc;
const Janet *tup = janet_unwrap_tuple(x);
if (janet_tuple_length(tup) != 2) janet_panicf("expected constant wrapped in tuple, got %p", x);
Janet c = tup[1];
jsc.type = instr_read_type_operand(tup[0], ir, READ_TYPE_REFERENCE);
jsc.value = c;
for (int32_t i = 0; i < janet_v_count(ir->constants); i++) {
if (ir->constants[i].type != jsc.type) continue;
if (!janet_equals(ir->constants[i].value, c)) continue;
/* Found a constant */
return i;
}
uint32_t index = (uint32_t) janet_v_count(ir->constants);
janet_v_push(ir->constants, jsc);
return JANET_SYS_CONSTANT_PREFIX + index;
}
return instr_read_operand(x, ir);
}
static JanetPrim instr_read_prim(Janet x) {
if (!janet_checktype(x, JANET_SYMBOL)) {
janet_panicf("expected primitive type, got %v", x);
janet_panicf("expected primitive type, got %p", x);
}
JanetSymbol sym_type = janet_unwrap_symbol(x);
const JanetPrimName *namedata = janet_strbinsearch(prim_names,
sizeof(prim_names) / sizeof(prim_names[0]), sizeof(prim_names[0]), sym_type);
if (NULL == namedata) {
janet_panicf("unknown primitive type %v", x);
janet_panicf("unknown primitive type %p", x);
}
return namedata->prim;
}
static JanetSysCallingConvention instr_read_cc(Janet x) {
if (!janet_checktype(x, JANET_KEYWORD)) {
janet_panicf("expected calling convention keyword, got %v", x);
janet_panicf("expected calling convention keyword, got %p", x);
}
JanetKeyword cc_name = janet_unwrap_keyword(x);
const JanetSysCCName *namedata = janet_strbinsearch(sys_calling_convention_names,
sizeof(sys_calling_convention_names) / sizeof(sys_calling_convention_names[0]),
sizeof(sys_calling_convention_names[0]), cc_name);
if (NULL == namedata) {
janet_panicf("unknown calling convention %v", x);
janet_panicf("unknown calling convention %p", x);
}
return namedata->cc;
}
@ -414,7 +394,7 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction
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 %p", x);
}
JanetTuple tuple = janet_unwrap_tuple(x);
if (janet_tuple_length(tuple) < 1) {
@ -424,7 +404,7 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction
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);
janet_panicf("expected opcode symbol, found %p", opvalue);
}
JanetSymbol opsymbol = janet_unwrap_symbol(opvalue);
const JanetSysInstrName *namedata = janet_strbinsearch(sys_op_names,
@ -471,8 +451,6 @@ 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:
case JANET_SYSOP_POINTER_ADD:
case JANET_SYSOP_POINTER_SUBTRACT:
instr_assert_length(tuple, 4, opvalue);
@ -481,16 +459,24 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction
instruction.three.rhs = instr_read_operand_or_const(tuple[3], out);
janet_v_push(ir, instruction);
break;
case JANET_SYSOP_ARRAY_GETP:
case JANET_SYSOP_ARRAY_PGETP:
instr_assert_length(tuple, 4, opvalue);
instruction.three.dest = instr_read_operand(tuple[1], out);
instruction.three.lhs = instr_read_operand(tuple[2], out);
instruction.three.rhs = instr_read_operand_or_const(tuple[3], out);
janet_v_push(ir, instruction);
break;
case JANET_SYSOP_CALL:
case JANET_SYSOP_SYSCALL:
instr_assert_min_length(tuple, 4, opvalue);
instruction.call.calling_convention = instr_read_cc(tuple[1]);
instruction.call.flags = 0;
if (janet_checktype(tuple[2], JANET_NIL)) {
instruction.call.dest = 0;
instruction.call.has_dest = 0;
} else {
instruction.call.dest = instr_read_operand(tuple[2], out);
instruction.call.has_dest = 1;
instruction.call.flags |= JANET_SYS_CALLFLAG_HAS_DEST;
}
instruction.call.arg_count = janet_tuple_length(tuple) - 4;
instruction.call.callee = instr_read_operand_or_const(tuple[3], out);
@ -553,22 +539,22 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView 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, 1);
instruction.type_prim.dest_type = instr_read_type_operand(tuple[1], out, READ_TYPE_DEFINITION);
instruction.type_prim.prim = instr_read_prim(tuple[2]);
janet_v_push(ir, instruction);
break;
}
case JANET_SYSOP_TYPE_POINTER: {
instr_assert_length(tuple, 3, opvalue);
instruction.pointer.dest_type = instr_read_type_operand(tuple[1], out, 1);
instruction.pointer.type = instr_read_type_operand(tuple[2], out, 0);
instruction.pointer.dest_type = instr_read_type_operand(tuple[1], out, READ_TYPE_DEFINITION);
instruction.pointer.type = instr_read_type_operand(tuple[2], out, READ_TYPE_FORWARD_REF);
janet_v_push(ir, instruction);
break;
}
case JANET_SYSOP_TYPE_ARRAY: {
instr_assert_length(tuple, 4, opvalue);
instruction.array.dest_type = instr_read_type_operand(tuple[1], out, 1);
instruction.array.type = instr_read_type_operand(tuple[2], out, 0);
instruction.array.dest_type = instr_read_type_operand(tuple[1], out, READ_TYPE_DEFINITION);
instruction.array.type = instr_read_type_operand(tuple[2], out, READ_TYPE_REFERENCE);
instruction.array.fixed_count = instr_read_u64(tuple[3], out);
janet_v_push(ir, instruction);
break;
@ -576,7 +562,7 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction
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, 1);
instruction.type_types.dest_type = instr_read_type_operand(tuple[1], out, READ_TYPE_DEFINITION);
instruction.type_types.arg_count = janet_tuple_length(tuple) - 2;
janet_v_push(ir, instruction);
for (int32_t j = 2; j < janet_tuple_length(tuple); j += 3) {
@ -590,7 +576,7 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction
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, 0);
arginstr.arg.args[k] = instr_read_type_operand(tuple[j + k], out, READ_TYPE_REFERENCE);
}
janet_v_push(ir, arginstr);
}
@ -599,7 +585,7 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction
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, 0);
instruction.type_bind.type = instr_read_type_operand(tuple[2], out, READ_TYPE_REFERENCE);
janet_v_push(ir, instruction);
break;
}
@ -607,7 +593,7 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction
instr_assert_length(tuple, 2, opvalue);
Janet x = tuple[1];
if (!janet_checktype(x, JANET_KEYWORD)) {
janet_panicf("expected keyword label, got %v", x);
janet_panicf("expected keyword label, got %p", x);
}
instruction.label.id = instr_read_label(out, x);
Janet label_id = janet_wrap_number(instruction.label.id);
@ -649,7 +635,7 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction
}
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 %q", x);
janet_panicf("last instruction must be jump or return, got %p", x);
}
@ -665,6 +651,15 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction
out->constants = janet_v_flatten(out->constants);
}
/* Get a type index given an operand */
uint32_t janet_sys_optype(JanetSysIR *ir, uint32_t op) {
if (op <= JANET_SYS_MAX_OPERAND) {
return ir->types[op];
} else {
return ir->constants[op - JANET_SYS_CONSTANT_PREFIX].type;
}
}
uint32_t *janet_sys_callargs(JanetSysInstruction *instr, uint32_t *count) {
uint32_t arg_count = 0;
if (instr->opcode == JANET_SYSOP_CALL) {
@ -803,20 +798,18 @@ static uint32_t tcheck_array_element(JanetSysIR *sysir, uint32_t t) {
static void tcheck_boolean(JanetSysIR *sysir, uint32_t t) {
JanetSysIRLinkage *linkage = sysir->linkage;
if (linkage->type_defs[t].prim != JANET_PRIM_BOOLEAN) {
janet_panicf("type failure, expected boolean, got %V", tname(sysir, t));
janet_panicf("type failure, expected boolean, got %p", tname(sysir, t));
}
}
static void rcheck_boolean(JanetSysIR *sysir, uint32_t reg) {
if (reg <= JANET_SYS_MAX_OPERAND) {
tcheck_boolean(sysir, sysir->types[reg]);
}
tcheck_boolean(sysir, janet_sys_optype(sysir, reg));
}
static void tcheck_array(JanetSysIR *sysir, uint32_t t) {
JanetSysIRLinkage *linkage = sysir->linkage;
if (linkage->type_defs[t].prim != JANET_PRIM_ARRAY) {
janet_panicf("type failure, expected array, got %V", tname(sysir, t));
janet_panicf("type failure, expected array, got %p", tname(sysir, t));
}
}
@ -828,7 +821,7 @@ static void tcheck_number(JanetSysIR *sysir, uint32_t t) {
t1 == JANET_PRIM_UNION ||
t1 == JANET_PRIM_STRUCT ||
t1 == JANET_PRIM_ARRAY) {
janet_panicf("type failure, expected numeric type, got %V", tname(sysir, t1));
janet_panicf("type failure, expected numeric type, got %p", tname(sysir, t1));
}
}
@ -839,15 +832,12 @@ static void tcheck_number_or_pointer(JanetSysIR *sysir, uint32_t t) {
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));
janet_panicf("type failure, expected pointer or numeric type, got %p", tname(sysir, t1));
}
}
static void rcheck_number_or_pointer(JanetSysIR *sysir, uint32_t reg) {
if (reg <= JANET_SYS_MAX_OPERAND) {
tcheck_number_or_pointer(sysir, sysir->types[reg]);
}
// TODO - check constants
tcheck_number_or_pointer(sysir, janet_sys_optype(sysir, reg));
}
static void tcheck_integer(JanetSysIR *sysir, uint32_t t) {
@ -861,39 +851,35 @@ static void tcheck_integer(JanetSysIR *sysir, uint32_t t) {
t1 != JANET_PRIM_U64 &&
t1 != JANET_PRIM_U16 &&
t1 != JANET_PRIM_U8) {
janet_panicf("type failure, expected integer type, got %V", tname(sysir, t1));
janet_panicf("type failure, expected integer type, got %p", tname(sysir, t1));
}
}
static void rcheck_integer(JanetSysIR *sysir, uint32_t reg) {
if (reg <= JANET_SYS_MAX_OPERAND) {
tcheck_integer(sysir, sysir->types[reg]);
}
tcheck_integer(sysir, janet_sys_optype(sysir, reg));
}
static void tcheck_pointer(JanetSysIR *sysir, uint32_t t) {
JanetSysIRLinkage *linkage = sysir->linkage;
if (linkage->type_defs[t].prim != JANET_PRIM_POINTER) {
janet_panicf("type failure, expected pointer, got %V", tname(sysir, t));
janet_panicf("type failure, expected pointer, got %p", tname(sysir, t));
}
}
static void rcheck_pointer(JanetSysIR *sysir, uint32_t reg) {
if (reg <= JANET_SYS_MAX_OPERAND) {
tcheck_pointer(sysir, sysir->types[reg]);
}
tcheck_pointer(sysir, janet_sys_optype(sysir, reg));
}
static void rcheck_pointer_equals(JanetSysIR *sysir, uint32_t preg, uint32_t elreg) {
JanetSysIRLinkage *linkage = sysir->linkage;
uint32_t t1 = sysir->types[preg];
uint32_t t1 = janet_sys_optype(sysir, preg);
if (linkage->type_defs[t1].prim != JANET_PRIM_POINTER) {
janet_panicf("type failure, expected pointer, got %V", tname(sysir, t1));
janet_panicf("type failure, expected pointer, got %p", tname(sysir, t1));
}
uint32_t tp = linkage->type_defs[t1].pointer.type;
uint32_t t2 = sysir->types[elreg];
uint32_t t2 = janet_sys_optype(sysir, elreg);
if (t2 != tp) {
janet_panicf("type failure, %V is not compatible with a pointer to %V",
janet_panicf("type failure, %V is not compatible with a pointer to %p",
tname(sysir, t2),
tname(sysir, tp));
}
@ -903,17 +889,16 @@ static void tcheck_struct_or_union(JanetSysIR *sysir, uint32_t t) {
JanetSysIRLinkage *linkage = sysir->linkage;
JanetPrim prim = linkage->type_defs[t].prim;
if (prim != JANET_PRIM_STRUCT && prim != JANET_PRIM_UNION) {
janet_panicf("type failure, expected struct or union, got %v", tname(sysir, t));
janet_panicf("type failure, expected struct or union, got %p", tname(sysir, t));
}
}
static void rcheck_equal(JanetSysIR *sysir, uint32_t reg1, uint32_t reg2) {
if (reg1 == reg2) return;
if (reg1 > JANET_SYS_MAX_OPERAND || reg2 > JANET_SYS_MAX_OPERAND) return;
uint32_t t1 = sysir->types[reg1];
uint32_t t2 = sysir->types[reg2];
uint32_t t1 = janet_sys_optype(sysir, reg1);
uint32_t t2 = janet_sys_optype(sysir, reg2);
if (t1 != t2) {
janet_panicf("type failure, %V does not match %V",
janet_panicf("type failure, %p does not match %p",
tname(sysir, t1),
tname(sysir, t2));
}
@ -965,60 +950,64 @@ static void rcheck_cast(JanetSysIR *sysir, uint32_t dest, uint32_t src) {
(void) sysir;
(void) dest;
(void) src;
uint32_t td = sysir->types[dest];
uint32_t ts = sysir->types[src];
uint32_t td = janet_sys_optype(sysir, dest);
uint32_t ts = janet_sys_optype(sysir, src);
int notok = tcheck_cast(sysir, td, ts);
if (notok) {
janet_panicf("type failure, %V cannot be cast to %V",
janet_panicf("type failure, %p cannot be cast to %p",
tname(sysir, ts),
tname(sysir, td));
}
}
static void rcheck_array_getp(JanetSysIR *sysir, uint32_t dest, uint32_t lhs, uint32_t rhs) {
tcheck_array(sysir, sysir->types[lhs]);
if (rhs <= JANET_SYS_MAX_OPERAND) {
tcheck_integer(sysir, sysir->types[rhs]);
}
tcheck_pointer(sysir, sysir->types[dest]);
uint32_t tlhs = janet_sys_optype(sysir, lhs);
uint32_t trhs = janet_sys_optype(sysir, rhs);
uint32_t tdest = janet_sys_optype(sysir, dest);
tcheck_array(sysir, tlhs);
tcheck_integer(sysir, trhs);
tcheck_pointer(sysir, tdest);
JanetSysIRLinkage *linkage = sysir->linkage;
uint32_t dtype = linkage->type_defs[sysir->types[dest]].pointer.type;
uint32_t eltype = linkage->type_defs[sysir->types[lhs]].array.type;
uint32_t dtype = linkage->type_defs[tdest].pointer.type;
uint32_t eltype = linkage->type_defs[tlhs].array.type;
if (dtype != eltype) {
janet_panicf("type failure, %V does not match %V", tname(sysir, dtype), tname(sysir, eltype));
janet_panicf("type failure, %p does not match %p", tname(sysir, dtype), tname(sysir, eltype));
}
}
static void rcheck_array_pgetp(JanetSysIR *sysir, uint32_t dest, uint32_t lhs, uint32_t rhs) {
tcheck_pointer(sysir, sysir->types[lhs]);
rcheck_integer(sysir, rhs);
tcheck_pointer(sysir, sysir->types[dest]);
uint32_t tlhs = janet_sys_optype(sysir, lhs);
uint32_t trhs = janet_sys_optype(sysir, rhs);
uint32_t tdest = janet_sys_optype(sysir, dest);
tcheck_pointer(sysir, tlhs);
tcheck_integer(sysir, trhs);
tcheck_pointer(sysir, tdest);
JanetSysIRLinkage *linkage = sysir->linkage;
uint32_t aptype = linkage->type_defs[sysir->types[lhs]].pointer.type;
uint32_t aptype = linkage->type_defs[tlhs].pointer.type;
if (linkage->type_defs[aptype].prim != JANET_PRIM_ARRAY) {
janet_panicf("type failure, expected array type but got %V", tname(sysir, aptype));
janet_panicf("type failure, expected array type but got %p", tname(sysir, aptype));
}
uint32_t dtype = linkage->type_defs[sysir->types[dest]].pointer.type;
uint32_t dtype = linkage->type_defs[tdest].pointer.type;
uint32_t eltype = linkage->type_defs[aptype].array.type;
if (dtype != eltype) {
janet_panicf("type failure, %V does not match %V", tname(sysir, dtype), tname(sysir, eltype));
janet_panicf("type failure, %p does not match %p", tname(sysir, dtype), tname(sysir, eltype));
}
}
static void rcheck_fgetp(JanetSysIR *sysir, uint32_t dest, uint32_t st, uint32_t field) {
tcheck_pointer(sysir, sysir->types[dest]);
tcheck_struct_or_union(sysir, sysir->types[st]);
uint32_t tst = janet_sys_optype(sysir, st);
uint32_t tdest = janet_sys_optype(sysir, dest);
tcheck_pointer(sysir, dest);
tcheck_struct_or_union(sysir, tst);
JanetSysIRLinkage *linkage = sysir->linkage;
uint32_t struct_type = sysir->types[st];
if (field >= linkage->type_defs[struct_type].st.field_count) {
if (field >= linkage->type_defs[tst].st.field_count) {
janet_panicf("invalid field index %u", field);
}
uint32_t field_type = linkage->type_defs[struct_type].st.field_start + field;
uint32_t field_type = linkage->type_defs[tst].st.field_start + field;
uint32_t tfield = linkage->field_defs[field_type].type;
uint32_t tdest = sysir->types[dest];
uint32_t tpdest = linkage->type_defs[tdest].pointer.type;
if (tfield != tpdest) {
janet_panicf("field of type %V does not match %V",
janet_panicf("field of type %p does not match %p",
tname(sysir, tfield),
tname(sysir, tpdest));
}
@ -1033,7 +1022,7 @@ static void rcheck_pointer_math(JanetSysIR *sysir, uint32_t dest, uint32_t lhs,
static JanetString rname(JanetSysIR *sysir, uint32_t regid) {
if (regid > JANET_SYS_MAX_OPERAND) {
uint32_t id = regid - JANET_SYS_CONSTANT_PREFIX;
return janet_formatc("constant:%u[%v]", id, sysir->constants[id]);
return janet_formatc("constant:%u[%p]", id, sysir->constants[id]);
}
JanetString name = sysir->register_names[regid];
if (NULL == name) {
@ -1042,13 +1031,6 @@ static JanetString rname(JanetSysIR *sysir, uint32_t regid) {
return name;
}
static int reg_is_unknown_type(JanetSysIR *sysir, uint32_t reg) {
JanetSysIRLinkage *linkage = sysir->linkage;
if (reg > JANET_SYS_MAX_OPERAND) return -1;
uint32_t t = sysir->types[reg];
return (linkage->type_defs[t].prim == JANET_PRIM_UNKNOWN);
}
static void janet_sysir_type_check(JanetSysIR *sysir) {
/* Assert no unknown types */
@ -1090,7 +1072,7 @@ static void janet_sysir_type_check(JanetSysIR *sysir) {
janet_panic("void return type not compatible with non-void return type");
}
if (sysir->has_return_type && sysir->return_type != ret_type) {
janet_panicf("multiple return types are not allowed: %V and %V",
janet_panicf("multiple return types are not allowed: %p and %p",
tname(sysir, ret_type),
tname(sysir, sysir->return_type));
}
@ -1206,7 +1188,6 @@ static void janet_sys_ir_init(JanetSysIR *out, JanetView instructions, JanetSysI
ir.return_type = 0;
ir.parameter_count = 0;
ir.register_name_lookup = janet_table(0);
ir.constants_lookup = janet_table(0);
ir.labels = janet_table(0);
ir.register_names = NULL;
ir.linkage = linkage;
@ -1471,7 +1452,7 @@ void janet_sys_ir_lower_to_c(JanetSysIRLinkage *linkage, JanetBuffer *buffer) {
break;
case JANET_SYSOP_SYSCALL:
case JANET_SYSOP_CALL: {
if (instruction.call.has_dest) {
if (instruction.call.flags & JANET_SYS_CALLFLAG_HAS_DEST) {
janet_formatb(buffer, " _r%u = ", instruction.call.dest);
} else {
janet_formatb(buffer, " ");
@ -1494,7 +1475,9 @@ void janet_sys_ir_lower_to_c(JanetSysIRLinkage *linkage, JanetBuffer *buffer) {
}
case JANET_SYSOP_CAST: {
uint32_t to = ir->types[instruction.two.dest];
janet_formatb(buffer, " _r%u = (_t%u) (_r%u);\n", instruction.two.dest, to, instruction.two.src);
janet_formatb(buffer, " _r%u = (_t%u) ", instruction.two.dest, to);
op_or_const(ir, buffer, instruction.two.src);
janet_formatb(buffer, ";\n");
break;
}
case JANET_SYSOP_MOVE:
@ -1523,12 +1506,14 @@ void janet_sys_ir_lower_to_c(JanetSysIRLinkage *linkage, JanetBuffer *buffer) {
janet_formatb(buffer, "._f%u);\n", instruction.field.field);
break;
case JANET_SYSOP_ARRAY_GETP:
// TODO
//janet_formatb(buffer, " _r%u = &(_r%u.els[_r%u]);\n", instruction.three.dest, instruction.three.lhs, instruction.three.rhs);
janet_formatb(buffer, " _r%u = &(_r%u.els[", instruction.three.dest, instruction.three.lhs);
op_or_const(ir, buffer, instruction.three.rhs);
janet_buffer_push_cstring(buffer, "]);\n");
break;
case JANET_SYSOP_ARRAY_PGETP:
// TODO
//janet_formatb(buffer, " _r%u = &(_r%u->els[_r%u]);\n", instruction.three.dest, instruction.three.lhs, instruction.three.rhs);
janet_formatb(buffer, " _r%u = &(_r%u->els[", instruction.three.dest, instruction.three.lhs);
op_or_const(ir, buffer, instruction.three.rhs);
janet_buffer_push_cstring(buffer, "]);\n");
break;
}
}
@ -1545,8 +1530,10 @@ static Janet wrap_op(JanetSysIR *ir, uint32_t reg) {
if (reg <= JANET_SYS_MAX_OPERAND) {
return janet_wrap_number(reg);
}
Janet *tuple = janet_tuple_begin(1);
tuple[0] = ir->constants[reg - JANET_SYS_CONSTANT_PREFIX];
Janet *tuple = janet_tuple_begin(2);
JanetSysConstant jsc = ir->constants[reg - JANET_SYS_CONSTANT_PREFIX];
tuple[0] = janet_wrap_number(jsc.type);
tuple[1] = jsc.value;
janet_tuple_flag(tuple) |= JANET_TUPLE_FLAG_BRACKETCTOR;
return janet_wrap_tuple(janet_tuple_end(tuple));
}
@ -1725,7 +1712,7 @@ void janet_sys_ir_lower_to_ir(JanetSysIRLinkage *linkage, JanetArray *into) {
build_tuple = janet_tuple_begin(4 + instruction.call.arg_count);
build_tuple[0] = janet_csymbolv(janet_sysop_names[instruction.opcode]);
build_tuple[1] = janet_ckeywordv(calling_convention_names[instruction.call.calling_convention]);
build_tuple[2] = instruction.call.has_dest ? wrap_dest(instruction.call.dest) : janet_wrap_nil();
build_tuple[2] = (instruction.call.flags & JANET_SYS_CALLFLAG_HAS_DEST) ? wrap_dest(instruction.call.dest) : janet_wrap_nil();
build_tuple[3] = wrap_op(ir, instruction.call.callee);
uint32_t *args = janet_sys_callargs(ir->instructions + i, NULL);
for (uint32_t k = 0; k < instruction.call.arg_count; k++) {
@ -1769,14 +1756,13 @@ static int sysir_gcmark(void *p, size_t s) {
}
}
for (uint32_t i = 0; i < ir->constant_count; i++) {
janet_mark(ir->constants[i]);
janet_mark(ir->constants[i].value);
}
if (ir->link_name != NULL) {
janet_mark(janet_wrap_string(ir->link_name));
}
janet_mark(janet_wrap_table(ir->labels));
janet_mark(janet_wrap_table(ir->register_name_lookup));
janet_mark(janet_wrap_table(ir->constants_lookup));
janet_mark(janet_wrap_abstract(ir->linkage));
return 0;
}

59
src/core/sysir.h
View File

@ -25,6 +25,46 @@
* that for "System Janet" a dialect for "System Programming". Sysir can then be retargeted to C or direct to machine
* code for JIT or AOT compilation.
*/
/* TODO
* [x] encode constants directly in 3 address codes - makes codegen easier
* [x] typed constants
* [x] named registers and types
* [x] better type errors (perhaps mostly for compiler debugging - full type system goes on top)
* [-] x86/x64 machine code target - in progress
* [ ] handle floating point types
* [ ] handle array types
* [ ] emit machine code directly
* [ ] target specific extensions - custom instructions and custom primitives
* [ ] better casting semantics
* [x] separate pointer arithmetic from generalized arithmetic (easier to instrument code for safety)?
* [x] fixed-size array types
* [x] recursive pointer types
* [ ] global and thread local state
* [x] union types?
* [x] incremental compilation - save type definitions for later
* [ ] Extension to C target for interfacing with Janet
* [x] pointer math, pointer types
* [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.
* [x] support for stack allocation of arrays
* [ ] more math intrinsics
* [x] source mapping (using built in Janet source mapping metadata on tuples)
* [x] unit type or void type
* [ ] (typed) function pointer types and remove calling untyped pointers
* [x] APL array semantics for binary operands (maybe?)
* [ ] a few built-in array combinators (maybe?)
* [ ] multiple error messages in one pass
* [ ] better verification of constants
* [x] don't allow redefining types
* [ ] generate elf/mach-o/pe directly
* [ ] elf
* [ ] mach-o
* [ ] pe
* [ ] generate dwarf info
*/
#ifndef JANET_SYSIR_H
#define JANET_SYSIR_H
@ -125,6 +165,9 @@ typedef struct {
uint32_t type;
} JanetSysTypeField;
#define JANET_SYS_CALLFLAG_HAS_DEST 1
#define JANET_SYS_CALLFLAG_VARARGS 2
/* Allow read arguments to be constants to allow
* encoding immediates. This makes codegen easier. */
#define JANET_SYS_MAX_OPERAND 0x7FFFFFFFU
@ -153,7 +196,7 @@ typedef struct {
uint32_t dest;
uint32_t callee;
uint32_t arg_count;
uint8_t has_dest;
uint8_t flags;
JanetSysCallingConvention calling_convention;
} call;
struct {
@ -193,6 +236,7 @@ typedef struct {
struct {
uint32_t dest_type;
uint32_t type;
// Include address space?
} pointer;
struct {
uint32_t dest_type;
@ -230,6 +274,14 @@ typedef struct {
JanetTable *type_name_lookup;
} JanetSysIRLinkage;
/* Keep source code information as well as
* typing information along with constants */
typedef struct {
uint32_t type;
Janet value;
// TODO - source and line
} JanetSysConstant;
/* IR representation for a single function.
* Allow for incremental compilation and linking. */
typedef struct {
@ -245,8 +297,7 @@ typedef struct {
uint32_t *types;
JanetSysInstruction *instructions;
JanetString *register_names;
Janet *constants;
JanetTable *constants_lookup;
JanetSysConstant *constants;
JanetTable *register_name_lookup;
JanetTable *labels;
} JanetSysIR;
@ -263,6 +314,8 @@ extern const char *prim_to_prim_name[];
/* Utilities */
uint32_t janet_sys_optype(JanetSysIR *ir, uint32_t op);
/* Get list of uint32_t instruction arguments from a call or other variable length instruction.
Needs to be free with janet_sfree (or you can leak it and the garbage collector will eventually clean
* it up). */

253
src/core/sysir_x86.c
View File

@ -57,15 +57,23 @@ static const char *register_names_8[] = {
"r8b", "r9b", "r10b", "rllb", "r12b", "r13b", "r14b", "r15b"
};
static const char *register_names_xmm[] = {
"xmm0", "xmm1", "xmm2", "xmm3", "xmm4", "xmm5", "xmm6", "xmm7",
"xmm8", "xmm9", "xmm10", "xmm11", "xmm12", "xmm13", "xmm14", "xmm15"
};
typedef enum {
JANET_SYSREG_STACK, // TODO - one of these is not like the others
JANET_SYSREG_8,
JANET_SYSREG_16,
JANET_SYSREG_32,
JANET_SYSREG_64,
JANET_SYSREG_2x64,
JANET_SYSREG_XMM
} x64RegKind;
typedef struct {
enum {
JANET_SYSREG_STACK,
JANET_SYSREG_8,
JANET_SYSREG_16,
JANET_SYSREG_32,
JANET_SYSREG_64,
JANET_SYSREG_XMM
} kind;
x64RegKind kind;
uint32_t index;
} x64Reg;
@ -80,6 +88,7 @@ typedef struct {
uint32_t restore_count;
uint32_t to_restore[128];
JanetSysCallingConvention calling_convention;
int32_t ir_index;
} JanetSysx64Context;
/* Get the layout for types */
@ -121,26 +130,64 @@ JanetSysTypeLayout get_x64layout(JanetSysTypeInfo info) {
return layout;
}
/* Get the register type that could store an operand o. Anything that will
* be forced to the stack will return a 64bit register. */
static x64RegKind get_slot_regkind(JanetSysx64Context *ctx, uint32_t o) {
JanetPrim prim;
if (o > JANET_SYS_MAX_OPERAND) {
prim = ctx->linkage->type_defs[ctx->ir->constants[o - JANET_SYS_CONSTANT_PREFIX].type].prim;
} else {
prim = ctx->linkage->type_defs[ctx->ir->types[o]].prim;
}
if (prim == JANET_PRIM_S8 || prim == JANET_PRIM_U8) {
return JANET_SYSREG_8;
} else if (prim == JANET_PRIM_S16 || prim == JANET_PRIM_U16) {
return JANET_SYSREG_16;
} else if (prim == JANET_PRIM_S32 || prim == JANET_PRIM_U32) {
return JANET_SYSREG_32;
} else if (prim == JANET_PRIM_F64 || prim == JANET_PRIM_F32) {
return JANET_SYSREG_XMM;
} else {
return JANET_SYSREG_64;
}
}
void assign_registers(JanetSysx64Context *ctx) {
/* simplest register assignment algorithm - first n variables
* get registers, rest get assigned temporary registers and spill on every use. */
/* TODO - linear scan or graph coloring. Require calculating live ranges */
/* TODO - avoid spills inside loops if possible */
/* TODO - avoid spills inside loops if possible i.e. not all spills are equal */
/* TODO - move into sysir.c and allow reuse for multiple targets */
/* Make trivial assigments */
uint32_t next_loc = 0;
ctx->regs = janet_smalloc(ctx->ir->register_count * sizeof(x64Reg));
uint32_t assigned = 0;
assigned |= 1 << RSP;
assigned |= 1 << RBP;
assigned |= 1 << 15; // keep a temp
for (uint32_t i = 0; i < ctx->ir->register_count; i++) {
if (i < 13) { /* skip r15 so we have some temporary registers if needed */
/* Assign to register */
uint32_t to = i + 1; /* skip rax */
if (i > 5) {
to += 2; /* skip rsp and rbp */
if (i < ctx->ir->parameter_count) {
/* Assign to rdi, rsi, etc. according to ABI */
ctx->regs[i].kind = get_slot_regkind(ctx, i);
if (i == 0) ctx->regs[i].index = RDI;
if (i == 1) ctx->regs[i].index = RSI;
if (i == 2) ctx->regs[i].index = RDX;
if (i == 3) ctx->regs[i].index = RCX;
if (i == 4) ctx->regs[i].index = 8;
if (i == 5) ctx->regs[i].index = 9;
if (i >= 6) {
janet_assert(0, "more than 6 parameters nyi");
}
ctx->regs[i].kind = JANET_SYSREG_64;
assigned |= 1 << ctx->regs[i].index;
} else if (assigned < 0xFFFF) { /* skip r15 so we have some temporary registers if needed */
/* Assign to register */
uint32_t to = 0;
while ((1 << to) & assigned) to++;
ctx->regs[i].kind = get_slot_regkind(ctx, i);
ctx->regs[i].index = to;
assigned |= 1 << ctx->regs[i].index;
} else { // TODO - also assign stack location if src of address IR instruction
/* Assign to stack location */
ctx->regs[i].kind = JANET_SYSREG_STACK;
@ -183,36 +230,57 @@ static int operand_isreg(JanetSysx64Context *ctx, uint32_t o, uint32_t regindex)
return reg.index == regindex;
}
static void sysemit_reg(JanetSysx64Context *ctx, x64Reg reg, const char *after) {
if (reg.kind == JANET_SYSREG_STACK) {
janet_formatb(ctx->buffer, "[rbp - %u]", reg.index);
} else if (reg.kind == JANET_SYSREG_64) {
janet_formatb(ctx->buffer, "%s", register_names[reg.index]);
} else if (reg.kind == JANET_SYSREG_32) {
janet_formatb(ctx->buffer, "%s", register_names_32[reg.index]);
} else if (reg.kind == JANET_SYSREG_16) {
janet_formatb(ctx->buffer, "%s", register_names_16[reg.index]);
} else if (reg.kind == JANET_SYSREG_8) {
janet_formatb(ctx->buffer, "%s", register_names_8[reg.index]);
} else {
janet_formatb(ctx->buffer, "%s", register_names_xmm[reg.index]);
}
if (after) janet_buffer_push_cstring(ctx->buffer, after);
}
static void sysemit_operand(JanetSysx64Context *ctx, uint32_t o, const char *after) {
if (o <= JANET_SYS_MAX_OPERAND) {
/* Virtual register */
x64Reg reg = ctx->regs[o];
if (reg.kind == JANET_SYSREG_STACK) {
janet_formatb(ctx->buffer, "[rbp - %u]", reg.index);
} else if (reg.kind == JANET_SYSREG_64) {
janet_formatb(ctx->buffer, "%s", register_names[reg.index]);
}
sysemit_reg(ctx, ctx->regs[o], NULL);
} else {
/* Constant */
uint32_t index = o - JANET_SYS_CONSTANT_PREFIX;
Janet c = ctx->ir->constants[index];
Janet c = ctx->ir->constants[index].value;
// TODO - do this properly
if (janet_checktype(c, JANET_STRING)) {
janet_formatb(ctx->buffer, "CONST%u", index);
janet_formatb(ctx->buffer, "CONST_%d_%u", ctx->ir_index, index);
} else {
// TODO - do this properly too.
// Also figure out how to load large constants to a temporary register
// In x64, only move to register is allowed to take a 64 bit immediate, so
// our methodology here changes based on what kind of operand we need.
janet_formatb(ctx->buffer, "%V", c);
}
}
janet_buffer_push_cstring(ctx->buffer, after);
if (after) janet_buffer_push_cstring(ctx->buffer, after);
}
/* A = A op B */
static void sysemit_binop(JanetSysx64Context *ctx, const char *op, uint32_t dest, uint32_t src) {
if (operand_isstack(ctx, dest) && operand_isstack(ctx, src)) {
/* Use a temporary register for src */
janet_formatb(ctx->buffer, "mov r15, ");
x64Reg tempreg;
tempreg.kind = get_slot_regkind(ctx, dest);
tempreg.index = 15;
janet_formatb(ctx->buffer, "mov ");
sysemit_reg(ctx, tempreg, ", ");
sysemit_operand(ctx, src, "\n");
janet_formatb(ctx->buffer, "%s ", op);
sysemit_operand(ctx, dest, ", r15\n");
sysemit_operand(ctx, dest, ", ");
sysemit_reg(ctx, tempreg, "\n");
} else {
janet_formatb(ctx->buffer, "%s ", op);
sysemit_operand(ctx, dest, ", ");
@ -227,7 +295,11 @@ static void sysemit_mov(JanetSysx64Context *ctx, uint32_t dest, uint32_t src) {
static void sysemit_movreg(JanetSysx64Context *ctx, uint32_t regdest, uint32_t src) {
if (operand_isreg(ctx, src, regdest)) return;
janet_formatb(ctx->buffer, "mov %s, ", register_names[regdest]);
x64Reg tempreg;
tempreg.kind = get_slot_regkind(ctx, src);
tempreg.index = regdest;
janet_formatb(ctx->buffer, "mov ");
sysemit_reg(ctx, tempreg, ", ");
sysemit_operand(ctx, src, "\n");
}
@ -235,7 +307,7 @@ static void sysemit_pushreg(JanetSysx64Context *ctx, uint32_t dest_reg) {
janet_formatb(ctx->buffer, "push %s\n", register_names[dest_reg]);
}
/* Move a value to a register, and save the contents of the old register on the stack */
/* Move a value to a register, and save the contents of the old register on fhe stack */
static void sysemit_mov_save(JanetSysx64Context *ctx, uint32_t dest_reg, uint32_t src) {
sysemit_pushreg(ctx, dest_reg);
sysemit_movreg(ctx, dest_reg, src);
@ -256,7 +328,7 @@ static void sysemit_three_inst(JanetSysx64Context *ctx, const char *op, JanetSys
static void sysemit_ret(JanetSysx64Context *ctx, uint32_t arg, int has_return) {
if (has_return) sysemit_movreg(ctx, RAX, arg);
janet_formatb(ctx->buffer, "add rsp, %u\n", ctx->frame_size);
/* TODO - depends on current calling convention */
for (uint32_t k = 0; k < ctx->restore_count; k++) {
/* Pop in reverse order */
janet_formatb(ctx->buffer, "pop %s\n", register_names[ctx->to_restore[ctx->restore_count - k - 1]]);
@ -279,7 +351,7 @@ static int sysemit_comp(JanetSysx64Context *ctx, uint32_t index,
nexti.branch.cond == instruction.three.dest) {
/* Combine compare and branch */
int invert = nexti.opcode == JANET_SYSOP_BRANCH_NOT;
janet_formatb(ctx->buffer, "%s label_%u\n", invert ? branch_invert : branch, nexti.branch.to);
janet_formatb(ctx->buffer, "%s label_%d_%u\n", invert ? branch_invert : branch, ctx->ir_index, nexti.branch.to);
/* Skip next branch IR instruction */
return 1;
} else {
@ -290,6 +362,25 @@ static int sysemit_comp(JanetSysx64Context *ctx, uint32_t index,
}
}
static void sysemit_cast(JanetSysx64Context *ctx, JanetSysInstruction instruction) {
uint32_t dest = instruction.two.dest;
uint32_t src = instruction.two.src;
uint32_t dest_type = janet_sys_optype(ctx->ir, dest);
uint32_t src_type = janet_sys_optype(ctx->ir, src);
JanetSysTypeInfo destinfo = ctx->linkage->type_defs[dest_type];
JanetSysTypeInfo srcinfo = ctx->linkage->type_defs[src_type];
/* For signed -> unsigned of same size, just move */
/* For casting larger integer to smaller, truncate by just using smaller register class w/ move */
/* For casting smaller integer to larger, depends.
* for 32 -> 64, zeros/sign-extends upper bits
* for other sizes, upper bits unchanged, need to be zeroed or oned before hand.
* for floating pointer conversions, todo
*/
(void) destinfo;
(void) srcinfo;
janet_formatb(ctx->buffer, "; cast nyi\n");
}
void janet_sys_ir_lower_to_x64(JanetSysIRLinkage *linkage, JanetBuffer *buffer) {
/* Partially setup context */
@ -303,17 +394,32 @@ void janet_sys_ir_lower_to_x64(JanetSysIRLinkage *linkage, JanetBuffer *buffer)
/* Emit prelude */
janet_formatb(buffer, "bits 64\ndefault rel\n\n");
JanetTable *seen = janet_table(0);
for (int32_t i = 0; i < linkage->ir_ordered->count; i++) {
JanetSysIR *ir = janet_unwrap_pointer(linkage->ir_ordered->data[i]);
if (ir->link_name != NULL) {
janet_table_put(seen, janet_csymbolv((const char *)ir->link_name), janet_wrap_true());
janet_formatb(buffer, "global %s\n", ir->link_name);
}
}
for (int32_t i = 0; i < linkage->ir_ordered->count; i++) {
JanetSysIR *ir = janet_unwrap_pointer(linkage->ir_ordered->data[i]);
for (uint32_t j = 0; j < ir->constant_count; j++) {
Janet c = ir->constants[j].value;
if (janet_checktype(janet_table_get(seen, c), JANET_NIL)) {
if (janet_checktype(c, JANET_SYMBOL)) {
janet_formatb(buffer, "extern %V\n", c);
janet_table_put(seen, c, janet_wrap_true());
}
}
}
}
janet_formatb(buffer, "section .text\n");
/* Do register allocation */
for (int32_t i = 0; i < linkage->ir_ordered->count; i++) {
JanetSysIR *ir = janet_unwrap_pointer(linkage->ir_ordered->data[i]);
ctx.ir_index = i;
if (ir->link_name == NULL) {
continue;
}
@ -326,38 +432,6 @@ void janet_sys_ir_lower_to_x64(JanetSysIRLinkage *linkage, JanetBuffer *buffer)
ctx.ir = ir;
assign_registers(&ctx);
/* Emit constant strings */
for (uint32_t j = 0; j < ir->constant_count; j++) {
if (janet_checktype(ir->constants[j], JANET_STRING)) {
JanetString str = janet_unwrap_string(ir->constants[j]);
janet_formatb(buffer, "\nCONST%u: db ", j);
/* Nasm syntax */
int in_string = 0;
for (int32_t ci = 0; ci < janet_string_length(str); ci++) {
int c = str[ci];
if (c < 32) {
if (in_string) {
janet_formatb(buffer, "\", %d", c);
} else {
janet_formatb(buffer, ci ? ", %d" : "%d", c);
}
in_string = 0;
} else {
if (!in_string) {
janet_buffer_push_cstring(buffer, ci ? ", \"" : "\"");
}
janet_buffer_push_u8(buffer, c);
in_string = 1;
}
}
if (!in_string) {
janet_buffer_push_cstring(buffer, "\n");
} else {
janet_buffer_push_cstring(buffer, "\"\n");
}
}
}
/* Emit prelude */
if (ir->link_name != NULL) {
janet_formatb(buffer, "\n%s:\n", ir->link_name);
@ -423,7 +497,7 @@ void janet_sys_ir_lower_to_x64(JanetSysIRLinkage *linkage, JanetBuffer *buffer)
sysemit_ret(&ctx, instruction.ret.value, instruction.ret.has_value);
break;
case JANET_SYSOP_LABEL:
janet_formatb(buffer, "label_%u:\n", instruction.label.id);
janet_formatb(buffer, "label_%d_%u:\n", i, instruction.label.id);
break;
case JANET_SYSOP_EQ:
j += sysemit_comp(&ctx, j, "je", "jne", "sete");
@ -443,14 +517,17 @@ void janet_sys_ir_lower_to_x64(JanetSysIRLinkage *linkage, JanetBuffer *buffer)
case JANET_SYSOP_GTE:
j += sysemit_comp(&ctx, j, "jge", "jl", "setge");
break;
case JANET_SYSOP_CAST:
sysemit_cast(&ctx, instruction);
break;
case JANET_SYSOP_BRANCH:
case JANET_SYSOP_BRANCH_NOT:
janet_formatb(buffer, instruction.opcode == JANET_SYSOP_BRANCH ? "jnz " : "jz ");
sysemit_operand(&ctx, instruction.branch.cond, " ");
janet_formatb(buffer, "label_%u\n", instruction.branch.to);
janet_formatb(buffer, "label_%d_%u\n", i, instruction.branch.to);
break;
case JANET_SYSOP_JUMP:
janet_formatb(buffer, "jmp label_%u\n", instruction.jump.to);
janet_formatb(buffer, "jmp label_%d_%u\n", i, instruction.jump.to);
break;
case JANET_SYSOP_SYSCALL:
case JANET_SYSOP_CALL:
@ -473,10 +550,14 @@ void janet_sys_ir_lower_to_x64(JanetSysIRLinkage *linkage, JanetBuffer *buffer)
sysemit_movreg(&ctx, RAX, instruction.call.callee);
janet_formatb(buffer, "syscall\n");
} else {
/* Save RAX to number of floating point args for varags - for now, always 0 :) */
sysemit_pushreg(&ctx, RAX);
janet_formatb(buffer, "mov rax, 0\n");
janet_formatb(buffer, "call ");
sysemit_operand(&ctx, instruction.call.callee, "\n");
}
if (instruction.call.has_dest) sysemit_movreg(&ctx, instruction.call.dest, RAX);
if (instruction.call.flags & JANET_SYS_CALLFLAG_HAS_DEST) sysemit_movreg(&ctx, instruction.call.dest, RAX);
if (instruction.opcode != JANET_SYSOP_SYSCALL) sysemit_popreg(&ctx, RAX);
if (argcount >= 6) sysemit_popreg(&ctx, 9);
if (argcount >= 5) sysemit_popreg(&ctx, 8);
if (argcount >= 4) sysemit_popreg(&ctx, RCX);
@ -488,6 +569,44 @@ void janet_sys_ir_lower_to_x64(JanetSysIRLinkage *linkage, JanetBuffer *buffer)
}
}
}
/* End section .text */
janet_formatb(buffer, "section .rodata\n\n");
for (int32_t i = 0; i < linkage->ir_ordered->count; i++) {
JanetSysIR *ir = janet_unwrap_pointer(linkage->ir_ordered->data[i]);
/* Emit constant strings */
for (uint32_t j = 0; j < ir->constant_count; j++) {
if (janet_checktype(ir->constants[j].value, JANET_STRING)) {
JanetString str = janet_unwrap_string(ir->constants[j].value);
janet_formatb(buffer, "\nCONST_%d_%u: db ", i, j);
/* Nasm syntax */
int in_string = 0;
for (int32_t ci = 0; ci < janet_string_length(str); ci++) {
int c = str[ci];
if (c < 32) {
if (in_string) {
janet_formatb(buffer, "\", %d", c);
} else {
janet_formatb(buffer, ci ? ", %d" : "%d", c);
}
in_string = 0;
} else {
if (!in_string) {
janet_buffer_push_cstring(buffer, ci ? ", \"" : "\"");
}
janet_buffer_push_u8(buffer, c);
in_string = 1;
}
}
if (!in_string) {
janet_buffer_push_cstring(buffer, ", 0\n");
} else {
janet_buffer_push_cstring(buffer, "\", 0\n");
}
}
}
}
}
#undef RAX