mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2025-06-27 23:53:06 +00:00
Code Issues 1 Releases Wiki Activity

More work compile-opt.

Browse Source
This commit is contained in:
Calvin Rose 2024-06-12 18:28:05 -05:00
parent c31d8b52ff
commit 232a8faa35
5 changed files with 147 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
examples/sysir/frontend.janet
View File

@ -126,14 +126,13 @@
result))) result)))
# Named bindings # Named bindings
# TODO - type inference
'def 'def
(do (do
(assert (= 2 (length args))) (assert (= 2 (length args)))
(def [full-name value] args) (def [full-name value] args)
(assert (symbol? full-name)) (assert (symbol? full-name))
(def [name tp] (type-extract full-name 'int)) (def [name tp] (type-extract full-name 'int))
(def result (visit1 value into)) (def result (visit1 value into false tp))
(def slot (get-slot name)) (def slot (get-slot name))
(when tp (when tp
(array/push into ~(bind ,slot ,tp))) (array/push into ~(bind ,slot ,tp)))
@ -147,7 +146,7 @@
(def [full-name value] args) (def [full-name value] args)
(assert (symbol? full-name)) (assert (symbol? full-name))
(def [name tp] (type-extract full-name 'int)) (def [name tp] (type-extract full-name 'int))
(def result (visit1 value into)) (def result (visit1 value into false tp))
(def slot (get-slot name)) (def slot (get-slot name))
(when tp (when tp
(array/push into ~(bind ,slot ,tp))) (array/push into ~(bind ,slot ,tp)))
@ -179,7 +178,7 @@
'do 'do
(do (do
(each form (slice args 0 -2) (visit1 form into true)) (each form (slice args 0 -2) (visit1 form into true))
(visit1 (last args) into)) (visit1 (last args) into false type-hint))
# While loop # While loop
'while 'while
@ -204,15 +203,16 @@
(def lab-end (keyword (gensym))) (def lab-end (keyword (gensym)))
(assert (< 2 (length args) 4)) (assert (< 2 (length args) 4))
(def [cnd tru fal] args) (def [cnd tru fal] args)
(def condition-slot (visit1 cnd into)) (def condition-slot (visit1 cnd into false 'boolean))
(def ret (get-slot)) (def ret (get-slot))
(array/push into ~(bind ,ret ,type-hint))
(array/push into ~(branch ,condition-slot ,lab)) (array/push into ~(branch ,condition-slot ,lab))
# false path # false path
(array/push into ~(move ,ret ,(visit1 tru into))) (array/push into ~(move ,ret ,(visit1 tru into false type-hint)))
(array/push into ~(jump ,lab-end)) (array/push into ~(jump ,lab-end))
(array/push into lab) (array/push into lab)
# true path # true path
(array/push into ~(move ,ret ,(visit1 fal into))) (array/push into ~(move ,ret ,(visit1 fal into false type-hint)))
(array/push into lab-end) (array/push into lab-end)
ret) ret)
@ -312,7 +312,7 @@
(array/push ir-asm ~(bind ,slot ,tp))) (array/push ir-asm ~(bind ,slot ,tp)))
(each part body (each part body
(visit1 part ir-asm true)) (visit1 part ir-asm true))
#(eprintf "%.99M" ir-asm) # (eprintf "%.99M" ir-asm)
(sysir/asm ctx ir-asm)) (sysir/asm ctx ir-asm))
(errorf "unknown form %v" form))) (errorf "unknown form %v" form)))

13
examples/sysir/samples.janet
View File

@ -6,16 +6,16 @@
(return (* x 2 x)))) (return (* x 2 x))))
(def myprog (def myprog
'(defn myprog [] '(defn myprog:int []
(def xyz:int (+ 1 2 3)) (def xyz:int (+ 1 2 3))
(def abc:int (* 4 5 6)) (def abc:int (* 4 5 6))
(def x:boolean (= 5 7)) (def x:boolean (= (the int 5) xyz))
(var i:int 0) (var i:int 0)
(while (< i 10) (while (< i (the int 10))
(set i (+ 1 i)) (set i (the int (+ 1 i)))
(printf "i = %d\n" i)) (printf "i = %d\n" i))
(printf "hello, world!\n%d\n" (the int (if x abc xyz))) (printf "hello, world!\n%d\n" (the int (if x abc xyz)))
(return (/ abc xyz)))) (return (* abc xyz))))
(def doloop (def doloop
'(defn doloop [x:int y:int] '(defn doloop [x:int y:int]
@ -23,6 +23,7 @@
(while (< i y) (while (< i y)
(set i (the int (+ 1 i))) (set i (the int (+ 1 i)))
(printf "i = %d\n" (the int i))) (printf "i = %d\n" (the int i)))
(myprog)
(return x))) (return x)))
(def main-fn (def main-fn
@ -34,7 +35,7 @@
#### ####
#(compile1 myprog) (compile1 myprog)
(compile1 doloop) (compile1 doloop)
(compile1 main-fn) (compile1 main-fn)
#(dump) #(dump)

86
src/core/sysir.c
View File

@ -317,7 +317,7 @@ static uint32_t instr_read_operand_or_const(Janet x, JanetSysIR *ir) {
if (ir->constants[i].type != jsc.type) continue; if (ir->constants[i].type != jsc.type) continue;
if (!janet_equals(ir->constants[i].value, c)) continue; if (!janet_equals(ir->constants[i].value, c)) continue;
/* Found a constant */ /* Found a constant */
return i; return JANET_SYS_CONSTANT_PREFIX + i;
} }
uint32_t index = (uint32_t) janet_v_count(ir->constants); uint32_t index = (uint32_t) janet_v_count(ir->constants);
janet_v_push(ir->constants, jsc); janet_v_push(ir->constants, jsc);
@ -638,8 +638,6 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction
janet_panicf("last instruction must be jump or return, got %p", x); janet_panicf("last instruction must be jump or return, got %p", x);
} }
/* Check for valid number of function parameters */ /* Check for valid number of function parameters */
if (out->parameter_count > out->register_count) { if (out->parameter_count > out->register_count) {
janet_panicf("too many parameters, only %u registers for %u parameters.", janet_panicf("too many parameters, only %u registers for %u parameters.",
@ -656,6 +654,9 @@ uint32_t janet_sys_optype(JanetSysIR *ir, uint32_t op) {
if (op <= JANET_SYS_MAX_OPERAND) { if (op <= JANET_SYS_MAX_OPERAND) {
return ir->types[op]; return ir->types[op];
} else { } else {
if (op - JANET_SYS_CONSTANT_PREFIX >= ir->constant_count) {
janet_panic("invalid constant");
}
return ir->constants[op - JANET_SYS_CONSTANT_PREFIX].type; return ir->constants[op - JANET_SYS_CONSTANT_PREFIX].type;
} }
} }
@ -696,7 +697,7 @@ static Janet tname(JanetSysIR *ir, uint32_t typeid) {
static void tcheck_redef(JanetSysIR *ir, uint32_t typeid) { static void tcheck_redef(JanetSysIR *ir, uint32_t typeid) {
JanetSysIRLinkage *linkage = ir->linkage; JanetSysIRLinkage *linkage = ir->linkage;
if (linkage->type_defs[typeid].prim != JANET_PRIM_UNKNOWN) { if (linkage->type_defs[typeid].prim != JANET_PRIM_UNKNOWN) {
janet_panicf("cannot redefine type %V", tname(ir, typeid)); janet_panicf("in %p, cannot redefine type %V", ir->error_ctx, tname(ir, typeid));
} }
} }
@ -798,7 +799,7 @@ static uint32_t tcheck_array_element(JanetSysIR *sysir, uint32_t t) {
static void tcheck_boolean(JanetSysIR *sysir, uint32_t t) { static void tcheck_boolean(JanetSysIR *sysir, uint32_t t) {
JanetSysIRLinkage *linkage = sysir->linkage; JanetSysIRLinkage *linkage = sysir->linkage;
if (linkage->type_defs[t].prim != JANET_PRIM_BOOLEAN) { if (linkage->type_defs[t].prim != JANET_PRIM_BOOLEAN) {
janet_panicf("type failure, expected boolean, got %p", tname(sysir, t)); janet_panicf("type failure in %p, expected boolean, got %p", sysir->error_ctx, tname(sysir, t));
} }
} }
@ -809,7 +810,7 @@ static void rcheck_boolean(JanetSysIR *sysir, uint32_t reg) {
static void tcheck_array(JanetSysIR *sysir, uint32_t t) { static void tcheck_array(JanetSysIR *sysir, uint32_t t) {
JanetSysIRLinkage *linkage = sysir->linkage; JanetSysIRLinkage *linkage = sysir->linkage;
if (linkage->type_defs[t].prim != JANET_PRIM_ARRAY) { if (linkage->type_defs[t].prim != JANET_PRIM_ARRAY) {
janet_panicf("type failure, expected array, got %p", tname(sysir, t)); janet_panicf("type failure in %p, expected array, got %p", sysir->error_ctx, tname(sysir, t));
} }
} }
@ -821,7 +822,7 @@ static void tcheck_number(JanetSysIR *sysir, uint32_t t) {
t1 == JANET_PRIM_UNION || t1 == JANET_PRIM_UNION ||
t1 == JANET_PRIM_STRUCT || t1 == JANET_PRIM_STRUCT ||
t1 == JANET_PRIM_ARRAY) { t1 == JANET_PRIM_ARRAY) {
janet_panicf("type failure, expected numeric type, got %p", tname(sysir, t1)); janet_panicf("type failure in %p, expected numeric type, got %p", sysir->error_ctx, tname(sysir, t1));
} }
} }
@ -832,7 +833,7 @@ static void tcheck_number_or_pointer(JanetSysIR *sysir, uint32_t t) {
t1 == JANET_PRIM_UNION || t1 == JANET_PRIM_UNION ||
t1 == JANET_PRIM_STRUCT || t1 == JANET_PRIM_STRUCT ||
t1 == JANET_PRIM_ARRAY) { t1 == JANET_PRIM_ARRAY) {
janet_panicf("type failure, expected pointer or numeric type, got %p", tname(sysir, t1)); janet_panicf("type failure in %p, expected pointer or numeric type, got %p", sysir->error_ctx, tname(sysir, t1));
} }
} }
@ -851,7 +852,7 @@ static void tcheck_integer(JanetSysIR *sysir, uint32_t t) {
t1 != JANET_PRIM_U64 && t1 != JANET_PRIM_U64 &&
t1 != JANET_PRIM_U16 && t1 != JANET_PRIM_U16 &&
t1 != JANET_PRIM_U8) { t1 != JANET_PRIM_U8) {
janet_panicf("type failure, expected integer type, got %p", tname(sysir, t1)); janet_panicf("type failure in %p, expected integer type, got %p", sysir->error_ctx, tname(sysir, t1));
} }
} }
@ -862,7 +863,7 @@ static void rcheck_integer(JanetSysIR *sysir, uint32_t reg) {
static void tcheck_pointer(JanetSysIR *sysir, uint32_t t) { static void tcheck_pointer(JanetSysIR *sysir, uint32_t t) {
JanetSysIRLinkage *linkage = sysir->linkage; JanetSysIRLinkage *linkage = sysir->linkage;
if (linkage->type_defs[t].prim != JANET_PRIM_POINTER) { if (linkage->type_defs[t].prim != JANET_PRIM_POINTER) {
janet_panicf("type failure, expected pointer, got %p", tname(sysir, t)); janet_panicf("type failure in %p, expected pointer, got %p", sysir->error_ctx, tname(sysir, t));
} }
} }
@ -874,12 +875,13 @@ static void rcheck_pointer_equals(JanetSysIR *sysir, uint32_t preg, uint32_t elr
JanetSysIRLinkage *linkage = sysir->linkage; JanetSysIRLinkage *linkage = sysir->linkage;
uint32_t t1 = janet_sys_optype(sysir, preg); uint32_t t1 = janet_sys_optype(sysir, preg);
if (linkage->type_defs[t1].prim != JANET_PRIM_POINTER) { if (linkage->type_defs[t1].prim != JANET_PRIM_POINTER) {
janet_panicf("type failure, expected pointer, got %p", tname(sysir, t1)); janet_panicf("type failure in %p, expected pointer for array, got %p", sysir->error_ctx, tname(sysir, t1));
} }
uint32_t tp = linkage->type_defs[t1].pointer.type; uint32_t tp = linkage->type_defs[t1].pointer.type;
uint32_t t2 = janet_sys_optype(sysir, elreg); uint32_t t2 = janet_sys_optype(sysir, elreg);
if (t2 != tp) { if (t2 != tp) {
janet_panicf("type failure, %V is not compatible with a pointer to %p", janet_panicf("type failure in %p, %p is not compatible with a pointer to %p",
sysir->error_ctx,
tname(sysir, t2), tname(sysir, t2),
tname(sysir, tp)); tname(sysir, tp));
} }
@ -889,7 +891,7 @@ static void tcheck_struct_or_union(JanetSysIR *sysir, uint32_t t) {
JanetSysIRLinkage *linkage = sysir->linkage; JanetSysIRLinkage *linkage = sysir->linkage;
JanetPrim prim = linkage->type_defs[t].prim; JanetPrim prim = linkage->type_defs[t].prim;
if (prim != JANET_PRIM_STRUCT && prim != JANET_PRIM_UNION) { if (prim != JANET_PRIM_STRUCT && prim != JANET_PRIM_UNION) {
janet_panicf("type failure, expected struct or union, got %p", tname(sysir, t)); janet_panicf("type failure in %p expected struct or union, got %p", sysir->error_ctx, tname(sysir, t));
} }
} }
@ -898,7 +900,8 @@ static void rcheck_equal(JanetSysIR *sysir, uint32_t reg1, uint32_t reg2) {
uint32_t t1 = janet_sys_optype(sysir, reg1); uint32_t t1 = janet_sys_optype(sysir, reg1);
uint32_t t2 = janet_sys_optype(sysir, reg2); uint32_t t2 = janet_sys_optype(sysir, reg2);
if (t1 != t2) { if (t1 != t2) {
janet_panicf("type failure, %p does not match %p", janet_panicf("type failure in %p, %p does not match %p",
sysir->error_ctx,
tname(sysir, t1), tname(sysir, t1),
tname(sysir, t2)); tname(sysir, t2));
} }
@ -954,7 +957,8 @@ static void rcheck_cast(JanetSysIR *sysir, uint32_t dest, uint32_t src) {
uint32_t ts = janet_sys_optype(sysir, src); uint32_t ts = janet_sys_optype(sysir, src);
int notok = tcheck_cast(sysir, td, ts); int notok = tcheck_cast(sysir, td, ts);
if (notok) { if (notok) {
janet_panicf("type failure, %p cannot be cast to %p", janet_panicf("type failure in %p, %p cannot be cast to %p",
sysir->error_ctx,
tname(sysir, ts), tname(sysir, ts),
tname(sysir, td)); tname(sysir, td));
} }
@ -971,7 +975,7 @@ static void rcheck_array_getp(JanetSysIR *sysir, uint32_t dest, uint32_t lhs, ui
uint32_t dtype = linkage->type_defs[tdest].pointer.type; uint32_t dtype = linkage->type_defs[tdest].pointer.type;
uint32_t eltype = linkage->type_defs[tlhs].array.type; uint32_t eltype = linkage->type_defs[tlhs].array.type;
if (dtype != eltype) { if (dtype != eltype) {
janet_panicf("type failure, %p does not match %p", tname(sysir, dtype), tname(sysir, eltype)); janet_panicf("type failure in %p, %p does not match %p", sysir->error_ctx, tname(sysir, dtype), tname(sysir, eltype));
} }
} }
@ -985,12 +989,12 @@ static void rcheck_array_pgetp(JanetSysIR *sysir, uint32_t dest, uint32_t lhs, u
JanetSysIRLinkage *linkage = sysir->linkage; JanetSysIRLinkage *linkage = sysir->linkage;
uint32_t aptype = linkage->type_defs[tlhs].pointer.type; uint32_t aptype = linkage->type_defs[tlhs].pointer.type;
if (linkage->type_defs[aptype].prim != JANET_PRIM_ARRAY) { if (linkage->type_defs[aptype].prim != JANET_PRIM_ARRAY) {
janet_panicf("type failure, expected array type but got %p", tname(sysir, aptype)); janet_panicf("type failure in %p, expected array type but got %p", sysir->error_ctx, tname(sysir, aptype));
} }
uint32_t dtype = linkage->type_defs[tdest].pointer.type; uint32_t dtype = linkage->type_defs[tdest].pointer.type;
uint32_t eltype = linkage->type_defs[aptype].array.type; uint32_t eltype = linkage->type_defs[aptype].array.type;
if (dtype != eltype) { if (dtype != eltype) {
janet_panicf("type failure, %p does not match %p", tname(sysir, dtype), tname(sysir, eltype)); janet_panicf("type failure in %p, %p does not match %p", sysir->error_ctx, tname(sysir, dtype), tname(sysir, eltype));
} }
} }
@ -1001,13 +1005,14 @@ static void rcheck_fgetp(JanetSysIR *sysir, uint32_t dest, uint32_t st, uint32_t
tcheck_struct_or_union(sysir, tst); tcheck_struct_or_union(sysir, tst);
JanetSysIRLinkage *linkage = sysir->linkage; JanetSysIRLinkage *linkage = sysir->linkage;
if (field >= linkage->type_defs[tst].st.field_count) { if (field >= linkage->type_defs[tst].st.field_count) {
janet_panicf("invalid field index %u", field); janet_panicf("in %p, invalid field index %u", sysir->error_ctx, field);
} }
uint32_t field_type = linkage->type_defs[tst].st.field_start + field; uint32_t field_type = linkage->type_defs[tst].st.field_start + field;
uint32_t tfield = linkage->field_defs[field_type].type; uint32_t tfield = linkage->field_defs[field_type].type;
uint32_t tpdest = linkage->type_defs[tdest].pointer.type; uint32_t tpdest = linkage->type_defs[tdest].pointer.type;
if (tfield != tpdest) { if (tfield != tpdest) {
janet_panicf("field of type %p does not match %p", janet_panicf("in %p, field of type %p does not match %p",
sysir->error_ctx,
tname(sysir, tfield), tname(sysir, tfield),
tname(sysir, tpdest)); tname(sysir, tpdest));
} }
@ -1038,14 +1043,16 @@ static void janet_sysir_type_check(JanetSysIR *sysir) {
for (uint32_t i = 0; i < sysir->register_count; i++) { for (uint32_t i = 0; i < sysir->register_count; i++) {
uint32_t type = sysir->types[i]; uint32_t type = sysir->types[i];
JanetSysTypeInfo tinfo = linkage->type_defs[type]; JanetSysTypeInfo tinfo = linkage->type_defs[type];
sysir->error_ctx = janet_wrap_number(i);
if (tinfo.prim == JANET_PRIM_UNKNOWN) { if (tinfo.prim == JANET_PRIM_UNKNOWN) {
janet_panicf("unable to infer type for %s", rname(sysir, i)); janet_panicf("in %p, unable to infer type for %s", sysir->error_ctx, rname(sysir, i));
} }
} }
int found_return = 0; int found_return = 0;
for (uint32_t i = 0; i < sysir->instruction_count; i++) { for (uint32_t i = 0; i < sysir->instruction_count; i++) {
JanetSysInstruction instruction = sysir->instructions[i]; JanetSysInstruction instruction = sysir->instructions[i];
sysir->error_ctx = janet_cstringv(janet_sysop_names[instruction.opcode]);
switch (instruction.opcode) { switch (instruction.opcode) {
case JANET_SYSOP_TYPE_PRIMITIVE: case JANET_SYSOP_TYPE_PRIMITIVE:
case JANET_SYSOP_TYPE_STRUCT: case JANET_SYSOP_TYPE_STRUCT:
@ -1066,13 +1073,14 @@ static void janet_sysir_type_check(JanetSysIR *sysir) {
} }
if (found_return) { if (found_return) {
if (instruction.ret.has_value && !sysir->has_return_type) { if (instruction.ret.has_value && !sysir->has_return_type) {
janet_panic("void return type not compatible with non-void return type"); janet_panicf("in %p, void return type not compatible with non-void return type", sysir->error_ctx);
} }
if ((!instruction.ret.has_value) && sysir->has_return_type) { if ((!instruction.ret.has_value) && sysir->has_return_type) {
janet_panic("void return type not compatible with non-void return type"); janet_panicf("in %p, void return type not compatible with non-void return type", sysir->error_ctx);
} }
if (sysir->has_return_type && sysir->return_type != ret_type) { if (sysir->has_return_type && sysir->return_type != ret_type) {
janet_panicf("multiple return types are not allowed: %p and %p", janet_panicf("in %p, multiple return types are not allowed: %p and %p",
sysir->error_ctx,
tname(sysir, ret_type), tname(sysir, ret_type),
tname(sysir, sysir->return_type)); tname(sysir, sysir->return_type));
} }
@ -1193,6 +1201,7 @@ static void janet_sys_ir_init(JanetSysIR *out, JanetView instructions, JanetSysI
ir.linkage = linkage; ir.linkage = linkage;
ir.parameter_count = 0; ir.parameter_count = 0;
ir.link_name = NULL; ir.link_name = NULL;
ir.error_ctx = janet_wrap_nil();
janet_sysir_init_instructions(&ir, instructions); janet_sysir_init_instructions(&ir, instructions);
@ -1234,7 +1243,7 @@ static void op_or_const(JanetSysIR *ir, JanetBuffer *buf, uint32_t reg) {
janet_formatb(buf, "_r%u", reg); janet_formatb(buf, "_r%u", reg);
} else { } else {
uint32_t constant_id = reg - JANET_SYS_CONSTANT_PREFIX; uint32_t constant_id = reg - JANET_SYS_CONSTANT_PREFIX;
janet_formatb(buf, "%v", ir->constants[constant_id]); janet_formatb(buf, "%v", ir->constants[constant_id].value);
} }
} }
@ -1526,13 +1535,21 @@ void janet_sys_ir_lower_to_c(JanetSysIRLinkage *linkage, JanetBuffer *buffer) {
/* Convert IR linkage back to Janet ASM */ /* Convert IR linkage back to Janet ASM */
static Janet janet_sys_get_desttype(JanetSysIRLinkage *linkage, uint32_t destt) {
if (linkage->type_names[destt] == NULL) {
return janet_wrap_number(destt);
} else {
return janet_wrap_symbol(linkage->type_names[destt]);
}
}
static Janet wrap_op(JanetSysIR *ir, uint32_t reg) { static Janet wrap_op(JanetSysIR *ir, uint32_t reg) {
if (reg <= JANET_SYS_MAX_OPERAND) { if (reg <= JANET_SYS_MAX_OPERAND) {
return janet_wrap_number(reg); return janet_wrap_number(reg);
} }
Janet *tuple = janet_tuple_begin(2); Janet *tuple = janet_tuple_begin(2);
JanetSysConstant jsc = ir->constants[reg - JANET_SYS_CONSTANT_PREFIX]; JanetSysConstant jsc = ir->constants[reg - JANET_SYS_CONSTANT_PREFIX];
tuple[0] = janet_wrap_number(jsc.type); tuple[0] = janet_sys_get_desttype(ir->linkage, jsc.type);
tuple[1] = jsc.value; tuple[1] = jsc.value;
janet_tuple_flag(tuple) |= JANET_TUPLE_FLAG_BRACKETCTOR; janet_tuple_flag(tuple) |= JANET_TUPLE_FLAG_BRACKETCTOR;
return janet_wrap_tuple(janet_tuple_end(tuple)); return janet_wrap_tuple(janet_tuple_end(tuple));
@ -1557,32 +1574,32 @@ void janet_sys_ir_lower_to_ir(JanetSysIRLinkage *linkage, JanetArray *into) {
case JANET_SYSOP_TYPE_PRIMITIVE: case JANET_SYSOP_TYPE_PRIMITIVE:
build_tuple = janet_tuple_begin(3); build_tuple = janet_tuple_begin(3);
build_tuple[0] = janet_csymbolv("type-prim"); build_tuple[0] = janet_csymbolv("type-prim");
build_tuple[1] = janet_wrap_number(instruction.type_prim.dest_type); build_tuple[1] = janet_sys_get_desttype(linkage, instruction.type_prim.dest_type);
build_tuple[2] = janet_csymbolv(prim_to_prim_name[instruction.type_prim.prim]); build_tuple[2] = janet_csymbolv(prim_to_prim_name[instruction.type_prim.prim]);
break; break;
case JANET_SYSOP_TYPE_STRUCT: case JANET_SYSOP_TYPE_STRUCT:
case JANET_SYSOP_TYPE_UNION: case JANET_SYSOP_TYPE_UNION:
build_tuple = janet_tuple_begin(2 + instruction.type_types.arg_count); build_tuple = janet_tuple_begin(2 + instruction.type_types.arg_count);
build_tuple[0] = janet_csymbolv(instruction.opcode == JANET_SYSOP_TYPE_STRUCT ? "type-struct" : "type-union"); build_tuple[0] = janet_csymbolv(instruction.opcode == JANET_SYSOP_TYPE_STRUCT ? "type-struct" : "type-union");
build_tuple[1] = janet_wrap_number(instruction.type_types.dest_type); build_tuple[1] = janet_sys_get_desttype(linkage, instruction.type_types.dest_type);
for (uint32_t j = 0; j < instruction.type_types.arg_count; j++) { for (uint32_t j = 0; j < instruction.type_types.arg_count; j++) {
uint32_t offset = j / 3 + 1; uint32_t offset = j / 3 + 1;
uint32_t index = j % 3; uint32_t index = j % 3;
JanetSysInstruction arg_instruction = ir->instructions[i + offset]; JanetSysInstruction arg_instruction = ir->instructions[i + offset];
build_tuple[j + 2] = janet_wrap_number(arg_instruction.arg.args[index]); build_tuple[j + 2] = janet_sys_get_desttype(linkage, arg_instruction.arg.args[index]);
} }
break; break;
case JANET_SYSOP_TYPE_POINTER: case JANET_SYSOP_TYPE_POINTER:
build_tuple = janet_tuple_begin(3); build_tuple = janet_tuple_begin(3);
build_tuple[0] = janet_csymbolv("type-pointer"); build_tuple[0] = janet_csymbolv("type-pointer");
build_tuple[1] = janet_wrap_number(instruction.pointer.dest_type); build_tuple[1] = janet_sys_get_desttype(linkage, instruction.pointer.dest_type);
build_tuple[2] = janet_wrap_number(instruction.pointer.type); build_tuple[2] = janet_sys_get_desttype(linkage, instruction.pointer.type);
break; break;
case JANET_SYSOP_TYPE_ARRAY: case JANET_SYSOP_TYPE_ARRAY:
build_tuple = janet_tuple_begin(4); build_tuple = janet_tuple_begin(4);
build_tuple[0] = janet_csymbolv("type-array"); build_tuple[0] = janet_csymbolv("type-array");
build_tuple[1] = janet_wrap_number(instruction.array.dest_type); build_tuple[1] = janet_sys_get_desttype(linkage, instruction.array.dest_type);
build_tuple[2] = janet_wrap_number(instruction.array.type); build_tuple[2] = janet_sys_get_desttype(linkage, instruction.array.type);
build_tuple[4] = janet_wrap_number(instruction.array.fixed_count); build_tuple[4] = janet_wrap_number(instruction.array.fixed_count);
break; break;
} }
@ -1623,7 +1640,7 @@ void janet_sys_ir_lower_to_ir(JanetSysIRLinkage *linkage, JanetArray *into) {
build_tuple = janet_tuple_begin(3); build_tuple = janet_tuple_begin(3);
build_tuple[0] = janet_csymbolv(janet_sysop_names[instruction.opcode]); build_tuple[0] = janet_csymbolv(janet_sysop_names[instruction.opcode]);
build_tuple[1] = janet_wrap_number(instruction.two.dest); build_tuple[1] = janet_wrap_number(instruction.two.dest);
build_tuple[2] = janet_wrap_number(instruction.two.src); build_tuple[2] = janet_sys_get_desttype(linkage, instruction.two.src);
/* TODO - use named types if possible */ /* TODO - use named types if possible */
break; break;
} }
@ -1764,6 +1781,7 @@ static int sysir_gcmark(void *p, size_t s) {
janet_mark(janet_wrap_table(ir->labels)); janet_mark(janet_wrap_table(ir->labels));
janet_mark(janet_wrap_table(ir->register_name_lookup)); janet_mark(janet_wrap_table(ir->register_name_lookup));
janet_mark(janet_wrap_abstract(ir->linkage)); janet_mark(janet_wrap_abstract(ir->linkage));
janet_mark(ir->error_ctx);
return 0; return 0;
} }

1
src/core/sysir.h
View File

@ -300,6 +300,7 @@ typedef struct {
JanetSysConstant *constants; JanetSysConstant *constants;
JanetTable *register_name_lookup; JanetTable *register_name_lookup;
JanetTable *labels; JanetTable *labels;
Janet error_ctx; /* Temporary for holding error messages */
} JanetSysIR; } JanetSysIR;
/* Delay alignment info for the most part to the lowering phase */ /* Delay alignment info for the most part to the lowering phase */

110
src/core/sysir_x86.c
View File

@ -44,17 +44,17 @@ static const char *register_names[] = {
static const char *register_names_32[] = { static const char *register_names_32[] = {
"eax", "ecx", "edx", "ebx", "esi", "edi", "esp", "ebp", "eax", "ecx", "edx", "ebx", "esi", "edi", "esp", "ebp",
"r8d", "r9d", "r10d", "rlld", "r12d", "r13d", "r14d", "r15d" "r8d", "r9d", "r10d", "r11d", "r12d", "r13d", "r14d", "r15d"
}; };
static const char *register_names_16[] = { static const char *register_names_16[] = {
"ax", "cx", "dx", "bx", "si", "di", "sp", "bp", "ax", "cx", "dx", "bx", "si", "di", "sp", "bp",
"r8w", "r9w", "r10w", "rllw", "r12w", "r13w", "r14w", "r15w" "r8w", "r9w", "r10w", "r11w", "r12w", "r13w", "r14w", "r15w"
}; };
static const char *register_names_8[] = { static const char *register_names_8[] = {
"al", "cl", "dl", "bl", "sil", "dil", "spl", "bpl", "al", "cl", "dl", "bl", "sil", "dil", "spl", "bpl",
"r8b", "r9b", "r10b", "rllb", "r12b", "r13b", "r14b", "r15b" "r8b", "r9b", "r10b", "r11b", "r12b", "r13b", "r14b", "r15b"
}; };
static const char *register_names_xmm[] = { static const char *register_names_xmm[] = {
@ -89,6 +89,7 @@ typedef struct {
uint32_t to_restore[128]; uint32_t to_restore[128];
JanetSysCallingConvention calling_convention; JanetSysCallingConvention calling_convention;
int32_t ir_index; int32_t ir_index;
uint32_t occupied_registers;
} JanetSysx64Context; } JanetSysx64Context;
/* Get the layout for types */ /* Get the layout for types */
@ -160,13 +161,23 @@ void assign_registers(JanetSysx64Context *ctx) {
/* TODO - avoid spills inside loops if possible i.e. not all spills are equal */ /* 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 */ /* TODO - move into sysir.c and allow reuse for multiple targets */
if (ctx->ir->register_count == 0) {
ctx->regs = NULL;
ctx->frame_size = 0;
ctx->occupied_registers = 0;
ctx->restore_count = 0;
return;
}
/* Make trivial assigments */ /* Make trivial assigments */
uint32_t next_loc = 0; uint32_t next_loc = 0;
ctx->regs = janet_smalloc(ctx->ir->register_count * sizeof(x64Reg)); ctx->regs = janet_smalloc(ctx->ir->register_count * sizeof(x64Reg));
uint32_t assigned = 0; uint32_t assigned = 0;
uint32_t occupied = 0;
assigned |= 1 << RSP; assigned |= 1 << RSP;
assigned |= 1 << RBP; assigned |= 1 << RBP;
assigned |= 1 << 15; // keep a temp assigned |= 1 << RAX; // return reg, div, etc.
for (uint32_t i = 0; i < ctx->ir->register_count; i++) { for (uint32_t i = 0; i < ctx->ir->register_count; i++) {
if (i < ctx->ir->parameter_count) { if (i < ctx->ir->parameter_count) {
/* Assign to rdi, rsi, etc. according to ABI */ /* Assign to rdi, rsi, etc. according to ABI */
@ -181,6 +192,7 @@ void assign_registers(JanetSysx64Context *ctx) {
janet_assert(0, "more than 6 parameters nyi"); janet_assert(0, "more than 6 parameters nyi");
} }
assigned |= 1 << ctx->regs[i].index; assigned |= 1 << ctx->regs[i].index;
occupied |= 1 << ctx->regs[i].index;
} else if (assigned < 0xFFFF) { /* skip r15 so we have some temporary registers if needed */ } else if (assigned < 0xFFFF) { /* skip r15 so we have some temporary registers if needed */
/* Assign to register */ /* Assign to register */
uint32_t to = 0; uint32_t to = 0;
@ -188,6 +200,7 @@ void assign_registers(JanetSysx64Context *ctx) {
ctx->regs[i].kind = get_slot_regkind(ctx, i); ctx->regs[i].kind = get_slot_regkind(ctx, i);
ctx->regs[i].index = to; ctx->regs[i].index = to;
assigned |= 1 << ctx->regs[i].index; assigned |= 1 << ctx->regs[i].index;
occupied |= 1 << ctx->regs[i].index;
} else { // TODO - also assign stack location if src of address IR instruction } else { // TODO - also assign stack location if src of address IR instruction
/* Assign to stack location */ /* Assign to stack location */
ctx->regs[i].kind = JANET_SYSREG_STACK; ctx->regs[i].kind = JANET_SYSREG_STACK;
@ -200,6 +213,7 @@ void assign_registers(JanetSysx64Context *ctx) {
next_loc = (next_loc + 15) / 16 * 16; next_loc = (next_loc + 15) / 16 * 16;
ctx->frame_size = next_loc + 16; ctx->frame_size = next_loc + 16;
ctx->occupied_registers = occupied;
/* Mark which registers need restoration before returning */ /* Mark which registers need restoration before returning */
ctx->restore_count = 0; ctx->restore_count = 0;
@ -274,7 +288,7 @@ static void sysemit_binop(JanetSysx64Context *ctx, const char *op, uint32_t dest
/* Use a temporary register for src */ /* Use a temporary register for src */
x64Reg tempreg; x64Reg tempreg;
tempreg.kind = get_slot_regkind(ctx, dest); tempreg.kind = get_slot_regkind(ctx, dest);
tempreg.index = 15; tempreg.index = RAX;
janet_formatb(ctx->buffer, "mov "); janet_formatb(ctx->buffer, "mov ");
sysemit_reg(ctx, tempreg, ", "); sysemit_reg(ctx, tempreg, ", ");
sysemit_operand(ctx, src, "\n"); sysemit_operand(ctx, src, "\n");
@ -339,9 +353,18 @@ static void sysemit_ret(JanetSysx64Context *ctx, uint32_t arg, int has_return) {
static int sysemit_comp(JanetSysx64Context *ctx, uint32_t index, static int sysemit_comp(JanetSysx64Context *ctx, uint32_t index,
const char *branch, const char *branch_invert, const char *branch, const char *branch_invert,
const char *set) { const char *set, const char *set_invert) {
JanetSysInstruction instruction = ctx->ir->instructions[index]; JanetSysInstruction instruction = ctx->ir->instructions[index];
sysemit_binop(ctx, "cmp", instruction.three.lhs, instruction.three.rhs); if (instruction.three.lhs > JANET_SYS_MAX_OPERAND) {
/* Constant cannot be first operand to cmp, switch */
set = set_invert;
const char *temp = branch;
branch = branch_invert;
branch_invert = temp;
sysemit_binop(ctx, "cmp", instruction.three.rhs, instruction.three.lhs);
} else {
sysemit_binop(ctx, "cmp", instruction.three.lhs, instruction.three.rhs);
}
int has_next = index < ctx->ir->instruction_count - 1; int has_next = index < ctx->ir->instruction_count - 1;
JanetSysInstruction nexti; JanetSysInstruction nexti;
if (has_next) nexti = ctx->ir->instructions[index + 1]; if (has_next) nexti = ctx->ir->instructions[index + 1];
@ -357,6 +380,7 @@ static int sysemit_comp(JanetSysx64Context *ctx, uint32_t index,
} else { } else {
/* Set register instead */ /* Set register instead */
janet_formatb(ctx->buffer, "%s ", set); janet_formatb(ctx->buffer, "%s ", set);
/* Set only byte register */
sysemit_operand(ctx, instruction.three.dest, "\n"); sysemit_operand(ctx, instruction.three.dest, "\n");
return 0; return 0;
} }
@ -430,6 +454,7 @@ void janet_sys_ir_lower_to_x64(JanetSysIRLinkage *linkage, JanetBuffer *buffer)
ctx.ir_layouts[i] = ctx.layouts[ir->types[i]]; ctx.ir_layouts[i] = ctx.layouts[ir->types[i]];
} }
ctx.ir = ir; ctx.ir = ir;
//janet_assert(ir->register_count, "non-zero register count");
assign_registers(&ctx); assign_registers(&ctx);
/* Emit prelude */ /* Emit prelude */
@ -470,10 +495,10 @@ void janet_sys_ir_lower_to_x64(JanetSysIRLinkage *linkage, JanetBuffer *buffer)
sysemit_three_inst(&ctx, "sub", instruction); sysemit_three_inst(&ctx, "sub", instruction);
break; break;
case JANET_SYSOP_MULTIPLY: case JANET_SYSOP_MULTIPLY:
sysemit_three_inst(&ctx, "mul", instruction); sysemit_three_inst(&ctx, "imul", instruction);
break; break;
case JANET_SYSOP_DIVIDE: case JANET_SYSOP_DIVIDE:
sysemit_three_inst(&ctx, "div", instruction); sysemit_three_inst(&ctx, "idiv", instruction);
break; break;
case JANET_SYSOP_BAND: case JANET_SYSOP_BAND:
sysemit_three_inst(&ctx, "and", instruction); sysemit_three_inst(&ctx, "and", instruction);
@ -500,31 +525,35 @@ void janet_sys_ir_lower_to_x64(JanetSysIRLinkage *linkage, JanetBuffer *buffer)
janet_formatb(buffer, "label_%d_%u:\n", i, instruction.label.id); janet_formatb(buffer, "label_%d_%u:\n", i, instruction.label.id);
break; break;
case JANET_SYSOP_EQ: case JANET_SYSOP_EQ:
j += sysemit_comp(&ctx, j, "je", "jne", "sete"); j += sysemit_comp(&ctx, j, "je", "jne", "sete", "setne");
break; break;
case JANET_SYSOP_NEQ: case JANET_SYSOP_NEQ:
j += sysemit_comp(&ctx, j, "jne", "je", "setne"); j += sysemit_comp(&ctx, j, "jne", "je", "setne", "sete");
break; break;
case JANET_SYSOP_LT: case JANET_SYSOP_LT:
j += sysemit_comp(&ctx, j, "jl", "jge", "setl"); j += sysemit_comp(&ctx, j, "jl", "jge", "setl", "setge");
break; break;
case JANET_SYSOP_LTE: case JANET_SYSOP_LTE:
j += sysemit_comp(&ctx, j, "jle", "jg", "setle"); j += sysemit_comp(&ctx, j, "jle", "jg", "setle", "setg");
break; break;
case JANET_SYSOP_GT: case JANET_SYSOP_GT:
j += sysemit_comp(&ctx, j, "jg", "jle", "setg"); j += sysemit_comp(&ctx, j, "jg", "jle", "setg", "setle");
break; break;
case JANET_SYSOP_GTE: case JANET_SYSOP_GTE:
j += sysemit_comp(&ctx, j, "jge", "jl", "setge"); j += sysemit_comp(&ctx, j, "jge", "jl", "setge", "setl");
break; break;
case JANET_SYSOP_CAST: case JANET_SYSOP_CAST:
sysemit_cast(&ctx, instruction); sysemit_cast(&ctx, instruction);
break; break;
case JANET_SYSOP_BRANCH: case JANET_SYSOP_BRANCH:
case JANET_SYSOP_BRANCH_NOT: case JANET_SYSOP_BRANCH_NOT:
janet_formatb(buffer, instruction.opcode == JANET_SYSOP_BRANCH ? "jnz " : "jz "); janet_formatb(buffer, "test ");
sysemit_operand(&ctx, instruction.branch.cond, " "); // TODO - ensure branch condition is not a const
janet_formatb(buffer, "label_%d_%u\n", i, instruction.branch.to); sysemit_operand(&ctx, instruction.branch.cond, ", 0\n");
janet_formatb(buffer,
"%s label_%d_%u\n",
instruction.opcode == JANET_SYSOP_BRANCH ? "jnz " : "jz ",
i, instruction.branch.to);
break; break;
case JANET_SYSOP_JUMP: case JANET_SYSOP_JUMP:
janet_formatb(buffer, "jmp label_%d_%u\n", i, instruction.jump.to); janet_formatb(buffer, "jmp label_%d_%u\n", i, instruction.jump.to);
@ -535,13 +564,30 @@ void janet_sys_ir_lower_to_x64(JanetSysIRLinkage *linkage, JanetBuffer *buffer)
/* Push first 6 arguments to particular registers */ /* Push first 6 arguments to particular registers */
uint32_t argcount = 0; uint32_t argcount = 0;
uint32_t *args = janet_sys_callargs(ir->instructions + j, &argcount); uint32_t *args = janet_sys_callargs(ir->instructions + j, &argcount);
if (argcount >= 1) sysemit_mov_save(&ctx, RDI, args[0]); int save_rdi = argcount >= 1 || (ctx.occupied_registers & (1 << RDI));
if (argcount >= 2) sysemit_mov_save(&ctx, RSI, args[1]); int save_rsi = argcount >= 2 || (ctx.occupied_registers & (1 << RSI));
if (argcount >= 3) sysemit_mov_save(&ctx, RDX, args[2]); int save_rdx = argcount >= 3 || (ctx.occupied_registers & (1 << RDX));
if (argcount >= 4) sysemit_mov_save(&ctx, RCX, args[3]); int save_rcx = argcount >= 4 || (ctx.occupied_registers & (1 << RCX));
if (argcount >= 5) sysemit_mov_save(&ctx, 8, args[4]); int save_r8 = argcount >= 5 || (ctx.occupied_registers & (1 << 8));
if (argcount >= 6) sysemit_mov_save(&ctx, 9, args[5]); int save_r9 = argcount >= 6 || (ctx.occupied_registers & (1 << 9));
int save_r10 = ctx.occupied_registers & (1 << 10);
int save_r11 = ctx.occupied_registers & (1 << 11);
if (save_rdi && argcount >= 1) sysemit_mov_save(&ctx, RDI, args[0]);
if (save_rdi && argcount < 1) sysemit_pushreg(&ctx, RDI);
if (save_rsi && argcount >= 2) sysemit_mov_save(&ctx, RSI, args[1]);
if (save_rsi && argcount < 2) sysemit_pushreg(&ctx, RSI);
if (save_rdx && argcount >= 3) sysemit_mov_save(&ctx, RDX, args[2]);
if (save_rdx && argcount < 3) sysemit_pushreg(&ctx, RDX);
if (save_rcx && argcount >= 4) sysemit_mov_save(&ctx, RCX, args[3]);
if (save_rcx && argcount < 4) sysemit_pushreg(&ctx, RCX);
if (save_r8 && argcount >= 5) sysemit_mov_save(&ctx, 8, args[4]);
if (save_r8 && argcount < 5) sysemit_pushreg(&ctx, 8);
if (save_r9 && argcount >= 6) sysemit_mov_save(&ctx, 9, args[5]);
if (save_r9 && argcount < 6) sysemit_pushreg(&ctx, 9);
if (save_r10) sysemit_pushreg(&ctx, 10);
if (save_r11) sysemit_pushreg(&ctx, 11);
for (int32_t argo = argcount - 1; argo >= 5; argo--) { for (int32_t argo = argcount - 1; argo >= 5; argo--) {
janet_panic("nyi");
janet_formatb(buffer, "push "); janet_formatb(buffer, "push ");
sysemit_operand(&ctx, args[argo], "\n"); sysemit_operand(&ctx, args[argo], "\n");
} }
@ -556,14 +602,16 @@ void janet_sys_ir_lower_to_x64(JanetSysIRLinkage *linkage, JanetBuffer *buffer)
janet_formatb(buffer, "call "); janet_formatb(buffer, "call ");
sysemit_operand(&ctx, instruction.call.callee, "\n"); sysemit_operand(&ctx, instruction.call.callee, "\n");
} }
if (instruction.call.flags & JANET_SYS_CALLFLAG_HAS_DEST) sysemit_movreg(&ctx, instruction.call.dest, RAX); if (instruction.call.flags & JANET_SYS_CALLFLAG_HAS_DEST) sysemit_movreg(&ctx, RAX, instruction.call.dest);
if (instruction.opcode != JANET_SYSOP_SYSCALL) sysemit_popreg(&ctx, RAX); if (instruction.opcode != JANET_SYSOP_SYSCALL) sysemit_popreg(&ctx, RAX);
if (argcount >= 6) sysemit_popreg(&ctx, 9); if (save_r11) sysemit_popreg(&ctx, 11);
if (argcount >= 5) sysemit_popreg(&ctx, 8); if (save_r10) sysemit_popreg(&ctx, 10);
if (argcount >= 4) sysemit_popreg(&ctx, RCX); if (save_r9) sysemit_popreg(&ctx, 9);
if (argcount >= 3) sysemit_popreg(&ctx, RDX); if (save_r8) sysemit_popreg(&ctx, 8);
if (argcount >= 2) sysemit_popreg(&ctx, RSI); if (save_rcx) sysemit_popreg(&ctx, RCX);
if (argcount >= 1) sysemit_popreg(&ctx, RDI); if (save_rdx) sysemit_popreg(&ctx, RDX);
if (save_rsi) sysemit_popreg(&ctx, RSI);
if (save_rdi) sysemit_popreg(&ctx, RDI);
break; break;
// On a comparison, if next instruction is branch that reads from dest, combine into a single op. // On a comparison, if next instruction is branch that reads from dest, combine into a single op.
} }