mirror of
				https://github.com/janet-lang/janet
				synced 2025-10-31 15:43:01 +00:00 
			
		
		
		
	More work compile-opt.
This commit is contained in:
		| @@ -126,14 +126,13 @@ | ||||
|               result))) | ||||
|  | ||||
|         # Named bindings | ||||
|         # TODO - type inference | ||||
|         'def | ||||
|         (do | ||||
|           (assert (= 2 (length args))) | ||||
|           (def [full-name value] args) | ||||
|           (assert (symbol? full-name)) | ||||
|           (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)) | ||||
|           (when tp | ||||
|             (array/push into ~(bind ,slot ,tp))) | ||||
| @@ -147,7 +146,7 @@ | ||||
|           (def [full-name value] args) | ||||
|           (assert (symbol? full-name)) | ||||
|           (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)) | ||||
|           (when tp | ||||
|             (array/push into ~(bind ,slot ,tp))) | ||||
| @@ -179,7 +178,7 @@ | ||||
|         'do | ||||
|         (do | ||||
|           (each form (slice args 0 -2) (visit1 form into true)) | ||||
|           (visit1 (last args) into)) | ||||
|           (visit1 (last args) into false type-hint)) | ||||
|  | ||||
|         # While loop | ||||
|         'while | ||||
| @@ -204,15 +203,16 @@ | ||||
|           (def lab-end (keyword (gensym))) | ||||
|           (assert (< 2 (length args) 4)) | ||||
|           (def [cnd tru fal] args) | ||||
|           (def condition-slot (visit1 cnd into)) | ||||
|           (def condition-slot (visit1 cnd into false 'boolean)) | ||||
|           (def ret (get-slot)) | ||||
|           (array/push into ~(bind ,ret ,type-hint)) | ||||
|           (array/push into ~(branch ,condition-slot ,lab)) | ||||
|           # 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 lab) | ||||
|           # 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) | ||||
|           ret) | ||||
|  | ||||
|   | ||||
| @@ -6,16 +6,16 @@ | ||||
|      (return (* x 2 x)))) | ||||
|  | ||||
| (def myprog | ||||
|   '(defn myprog [] | ||||
|   '(defn myprog:int [] | ||||
|      (def xyz:int (+ 1 2 3)) | ||||
|      (def abc:int (* 4 5 6)) | ||||
|      (def x:boolean (= 5 7)) | ||||
|      (def x:boolean (= (the int 5) xyz)) | ||||
|      (var i:int 0) | ||||
|      (while (< i 10) | ||||
|        (set i (+ 1 i)) | ||||
|      (while (< i (the int 10)) | ||||
|        (set i (the int (+ 1 i))) | ||||
|        (printf "i = %d\n" i)) | ||||
|      (printf "hello, world!\n%d\n" (the int (if x abc xyz))) | ||||
|      (return (/ abc xyz)))) | ||||
|      (return (* abc xyz)))) | ||||
|  | ||||
| (def doloop | ||||
|   '(defn doloop [x:int y:int] | ||||
| @@ -23,6 +23,7 @@ | ||||
|      (while (< i y) | ||||
|        (set i (the int (+ 1 i))) | ||||
|        (printf "i = %d\n" (the int i))) | ||||
|      (myprog) | ||||
|      (return x))) | ||||
|  | ||||
| (def main-fn | ||||
| @@ -34,7 +35,7 @@ | ||||
|  | ||||
| #### | ||||
|  | ||||
| #(compile1 myprog) | ||||
| (compile1 myprog) | ||||
| (compile1 doloop) | ||||
| (compile1 main-fn) | ||||
| #(dump) | ||||
|   | ||||
| @@ -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 (!janet_equals(ir->constants[i].value, c)) continue; | ||||
|             /* Found a constant */ | ||||
|             return i; | ||||
|             return JANET_SYS_CONSTANT_PREFIX + i; | ||||
|         } | ||||
|         uint32_t index = (uint32_t) janet_v_count(ir->constants); | ||||
|         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); | ||||
|     } | ||||
|  | ||||
|  | ||||
|  | ||||
|     /* Check for valid number of function parameters */ | ||||
|     if (out->parameter_count > out->register_count) { | ||||
|         janet_panicf("too many parameters, only %u registers for %u parameters.", | ||||
| @@ -656,6 +654,9 @@ uint32_t janet_sys_optype(JanetSysIR *ir, uint32_t op) { | ||||
|     if (op <= JANET_SYS_MAX_OPERAND) { | ||||
|         return ir->types[op]; | ||||
|     } else { | ||||
|         if (op - JANET_SYS_CONSTANT_PREFIX >= ir->constant_count) { | ||||
|             janet_panic("invalid constant"); | ||||
|         } | ||||
|         return ir->constants[op - JANET_SYS_CONSTANT_PREFIX].type; | ||||
|     } | ||||
| } | ||||
| @@ -696,7 +697,7 @@ static Janet tname(JanetSysIR *ir, uint32_t typeid) { | ||||
| static void tcheck_redef(JanetSysIR *ir, uint32_t typeid) { | ||||
|     JanetSysIRLinkage *linkage = ir->linkage; | ||||
|     if (linkage->type_defs[typeid].prim != JANET_PRIM_UNKNOWN) { | ||||
|         janet_panicf("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) { | ||||
|     JanetSysIRLinkage *linkage = sysir->linkage; | ||||
|     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) { | ||||
|     JanetSysIRLinkage *linkage = sysir->linkage; | ||||
|     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_STRUCT || | ||||
|             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_STRUCT || | ||||
|             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_U16 && | ||||
|             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) { | ||||
|     JanetSysIRLinkage *linkage = sysir->linkage; | ||||
|     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; | ||||
|     uint32_t t1 = janet_sys_optype(sysir, preg); | ||||
|     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 t2 = janet_sys_optype(sysir, elreg); | ||||
|     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, tp)); | ||||
|     } | ||||
| @@ -889,7 +891,7 @@ 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 %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 t2 = janet_sys_optype(sysir, reg2); | ||||
|     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, 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); | ||||
|     int notok = tcheck_cast(sysir, td, ts); | ||||
|     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, 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 eltype = linkage->type_defs[tlhs].array.type; | ||||
|     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; | ||||
|     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 %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 eltype = linkage->type_defs[aptype].array.type; | ||||
|     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); | ||||
|     JanetSysIRLinkage *linkage = sysir->linkage; | ||||
|     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 tfield = linkage->field_defs[field_type].type; | ||||
|     uint32_t tpdest = linkage->type_defs[tdest].pointer.type; | ||||
|     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, tpdest)); | ||||
|     } | ||||
| @@ -1038,14 +1043,16 @@ static void janet_sysir_type_check(JanetSysIR *sysir) { | ||||
|     for (uint32_t i = 0; i < sysir->register_count; i++) { | ||||
|         uint32_t type = sysir->types[i]; | ||||
|         JanetSysTypeInfo tinfo = linkage->type_defs[type]; | ||||
|         sysir->error_ctx = janet_wrap_number(i); | ||||
|         if (tinfo.prim == JANET_PRIM_UNKNOWN) { | ||||
|             janet_panicf("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; | ||||
|     for (uint32_t i = 0; i < sysir->instruction_count; i++) { | ||||
|         JanetSysInstruction instruction = sysir->instructions[i]; | ||||
|         sysir->error_ctx = janet_cstringv(janet_sysop_names[instruction.opcode]); | ||||
|         switch (instruction.opcode) { | ||||
|             case JANET_SYSOP_TYPE_PRIMITIVE: | ||||
|             case JANET_SYSOP_TYPE_STRUCT: | ||||
| @@ -1066,13 +1073,14 @@ static void janet_sysir_type_check(JanetSysIR *sysir) { | ||||
|                 } | ||||
|                 if (found_return) { | ||||
|                     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) { | ||||
|                         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) { | ||||
|                         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, sysir->return_type)); | ||||
|                     } | ||||
| @@ -1193,6 +1201,7 @@ static void janet_sys_ir_init(JanetSysIR *out, JanetView instructions, JanetSysI | ||||
|     ir.linkage = linkage; | ||||
|     ir.parameter_count = 0; | ||||
|     ir.link_name = NULL; | ||||
|     ir.error_ctx = janet_wrap_nil(); | ||||
|  | ||||
|     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); | ||||
|     } else { | ||||
|         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 */ | ||||
|  | ||||
| static Janet janet_sys_get_desttype(JanetSysIRLinkage *linkage, uint32_t destt) { | ||||
|     if (linkage->type_names[destt] == NULL) { | ||||
|         return janet_wrap_number(destt); | ||||
|     } else { | ||||
|         return janet_wrap_symbol(linkage->type_names[destt]); | ||||
|     } | ||||
| } | ||||
|  | ||||
| static Janet wrap_op(JanetSysIR *ir, uint32_t reg) { | ||||
|     if (reg <= JANET_SYS_MAX_OPERAND) { | ||||
|         return janet_wrap_number(reg); | ||||
|     } | ||||
|     Janet *tuple = janet_tuple_begin(2); | ||||
|     JanetSysConstant jsc = ir->constants[reg - JANET_SYS_CONSTANT_PREFIX]; | ||||
|     tuple[0] = janet_wrap_number(jsc.type); | ||||
|     tuple[0] = janet_sys_get_desttype(ir->linkage, jsc.type); | ||||
|     tuple[1] = jsc.value; | ||||
|     janet_tuple_flag(tuple) |= JANET_TUPLE_FLAG_BRACKETCTOR; | ||||
|     return janet_wrap_tuple(janet_tuple_end(tuple)); | ||||
| @@ -1557,32 +1574,32 @@ void janet_sys_ir_lower_to_ir(JanetSysIRLinkage *linkage, JanetArray *into) { | ||||
|                 case JANET_SYSOP_TYPE_PRIMITIVE: | ||||
|                     build_tuple = janet_tuple_begin(3); | ||||
|                     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]); | ||||
|                     break; | ||||
|                 case JANET_SYSOP_TYPE_STRUCT: | ||||
|                 case JANET_SYSOP_TYPE_UNION: | ||||
|                     build_tuple = janet_tuple_begin(2 + instruction.type_types.arg_count); | ||||
|                     build_tuple[0] = janet_csymbolv(instruction.opcode == JANET_SYSOP_TYPE_STRUCT ? "type-struct" : "type-union"); | ||||
|                     build_tuple[1] = janet_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++) { | ||||
|                         uint32_t offset = j / 3 + 1; | ||||
|                         uint32_t index = j % 3; | ||||
|                         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; | ||||
|                 case JANET_SYSOP_TYPE_POINTER: | ||||
|                     build_tuple = janet_tuple_begin(3); | ||||
|                     build_tuple[0] = janet_csymbolv("type-pointer"); | ||||
|                     build_tuple[1] = janet_wrap_number(instruction.pointer.dest_type); | ||||
|                     build_tuple[2] = janet_wrap_number(instruction.pointer.type); | ||||
|                     build_tuple[1] = janet_sys_get_desttype(linkage, instruction.pointer.dest_type); | ||||
|                     build_tuple[2] = janet_sys_get_desttype(linkage, instruction.pointer.type); | ||||
|                     break; | ||||
|                 case JANET_SYSOP_TYPE_ARRAY: | ||||
|                     build_tuple = janet_tuple_begin(4); | ||||
|                     build_tuple[0] = janet_csymbolv("type-array"); | ||||
|                     build_tuple[1] = janet_wrap_number(instruction.array.dest_type); | ||||
|                     build_tuple[2] = janet_wrap_number(instruction.array.type); | ||||
|                     build_tuple[1] = janet_sys_get_desttype(linkage, instruction.array.dest_type); | ||||
|                     build_tuple[2] = janet_sys_get_desttype(linkage, instruction.array.type); | ||||
|                     build_tuple[4] = janet_wrap_number(instruction.array.fixed_count); | ||||
|                     break; | ||||
|             } | ||||
| @@ -1623,7 +1640,7 @@ void janet_sys_ir_lower_to_ir(JanetSysIRLinkage *linkage, JanetArray *into) { | ||||
|                     build_tuple = janet_tuple_begin(3); | ||||
|                     build_tuple[0] = janet_csymbolv(janet_sysop_names[instruction.opcode]); | ||||
|                     build_tuple[1] = janet_wrap_number(instruction.two.dest); | ||||
|                     build_tuple[2] = janet_wrap_number(instruction.two.src); | ||||
|                     build_tuple[2] = janet_sys_get_desttype(linkage, instruction.two.src); | ||||
|                     /* TODO - use named types if possible */ | ||||
|                     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->register_name_lookup)); | ||||
|     janet_mark(janet_wrap_abstract(ir->linkage)); | ||||
|     janet_mark(ir->error_ctx); | ||||
|     return 0; | ||||
| } | ||||
|  | ||||
|   | ||||
| @@ -300,6 +300,7 @@ typedef struct { | ||||
|     JanetSysConstant *constants; | ||||
|     JanetTable *register_name_lookup; | ||||
|     JanetTable *labels; | ||||
|     Janet error_ctx; /* Temporary for holding error messages */ | ||||
| } JanetSysIR; | ||||
|  | ||||
| /* Delay alignment info for the most part to the lowering phase */ | ||||
|   | ||||
| @@ -44,17 +44,17 @@ static const char *register_names[] = { | ||||
|  | ||||
| static const char *register_names_32[] = { | ||||
|     "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[] = { | ||||
|     "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[] = { | ||||
|     "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[] = { | ||||
| @@ -89,6 +89,7 @@ typedef struct { | ||||
|     uint32_t to_restore[128]; | ||||
|     JanetSysCallingConvention calling_convention; | ||||
|     int32_t ir_index; | ||||
|     uint32_t occupied_registers; | ||||
| } JanetSysx64Context; | ||||
|  | ||||
| /* 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 - 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 */ | ||||
|     uint32_t next_loc = 0; | ||||
|     ctx->regs = janet_smalloc(ctx->ir->register_count * sizeof(x64Reg)); | ||||
|     uint32_t assigned = 0; | ||||
|     uint32_t occupied = 0; | ||||
|     assigned |= 1 << RSP; | ||||
|     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++) { | ||||
|         if (i < ctx->ir->parameter_count) { | ||||
|             /* 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"); | ||||
|             } | ||||
|             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 */ | ||||
|             /* Assign to register */ | ||||
|             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].index = to; | ||||
|             assigned |= 1 << ctx->regs[i].index; | ||||
|             occupied |= 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; | ||||
| @@ -200,6 +213,7 @@ void assign_registers(JanetSysx64Context *ctx) { | ||||
|  | ||||
|     next_loc = (next_loc + 15) / 16 * 16; | ||||
|     ctx->frame_size = next_loc + 16; | ||||
|     ctx->occupied_registers = occupied; | ||||
|  | ||||
|     /* Mark which registers need restoration before returning */ | ||||
|     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 */ | ||||
|         x64Reg tempreg; | ||||
|         tempreg.kind = get_slot_regkind(ctx, dest); | ||||
|         tempreg.index = 15; | ||||
|         tempreg.index = RAX; | ||||
|         janet_formatb(ctx->buffer, "mov "); | ||||
|         sysemit_reg(ctx, tempreg, ", "); | ||||
|         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, | ||||
|                         const char *branch, const char *branch_invert, | ||||
|                         const char *set) { | ||||
|                         const char *set, const char *set_invert) { | ||||
|     JanetSysInstruction instruction = ctx->ir->instructions[index]; | ||||
|     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; | ||||
|     JanetSysInstruction nexti; | ||||
|     if (has_next) nexti = ctx->ir->instructions[index + 1]; | ||||
| @@ -357,6 +380,7 @@ static int sysemit_comp(JanetSysx64Context *ctx, uint32_t index, | ||||
|     } else { | ||||
|         /* Set register instead */ | ||||
|         janet_formatb(ctx->buffer, "%s ", set); | ||||
|         /* Set only byte register */ | ||||
|         sysemit_operand(ctx, instruction.three.dest, "\n"); | ||||
|         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 = ir; | ||||
|         //janet_assert(ir->register_count, "non-zero register count"); | ||||
|         assign_registers(&ctx); | ||||
|  | ||||
|         /* Emit prelude */ | ||||
| @@ -470,10 +495,10 @@ void janet_sys_ir_lower_to_x64(JanetSysIRLinkage *linkage, JanetBuffer *buffer) | ||||
|                     sysemit_three_inst(&ctx, "sub", instruction); | ||||
|                     break; | ||||
|                 case JANET_SYSOP_MULTIPLY: | ||||
|                     sysemit_three_inst(&ctx, "mul", instruction); | ||||
|                     sysemit_three_inst(&ctx, "imul", instruction); | ||||
|                     break; | ||||
|                 case JANET_SYSOP_DIVIDE: | ||||
|                     sysemit_three_inst(&ctx, "div", instruction); | ||||
|                     sysemit_three_inst(&ctx, "idiv", instruction); | ||||
|                     break; | ||||
|                 case JANET_SYSOP_BAND: | ||||
|                     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); | ||||
|                     break; | ||||
|                 case JANET_SYSOP_EQ: | ||||
|                     j += sysemit_comp(&ctx, j, "je", "jne", "sete"); | ||||
|                     j += sysemit_comp(&ctx, j, "je", "jne", "sete", "setne"); | ||||
|                     break; | ||||
|                 case JANET_SYSOP_NEQ: | ||||
|                     j += sysemit_comp(&ctx, j, "jne", "je", "setne"); | ||||
|                     j += sysemit_comp(&ctx, j, "jne", "je", "setne", "sete"); | ||||
|                     break; | ||||
|                 case JANET_SYSOP_LT: | ||||
|                     j += sysemit_comp(&ctx, j, "jl", "jge", "setl"); | ||||
|                     j += sysemit_comp(&ctx, j, "jl", "jge", "setl", "setge"); | ||||
|                     break; | ||||
|                 case JANET_SYSOP_LTE: | ||||
|                     j += sysemit_comp(&ctx, j, "jle", "jg", "setle"); | ||||
|                     j += sysemit_comp(&ctx, j, "jle", "jg", "setle", "setg"); | ||||
|                     break; | ||||
|                 case JANET_SYSOP_GT: | ||||
|                     j += sysemit_comp(&ctx, j, "jg", "jle", "setg"); | ||||
|                     j += sysemit_comp(&ctx, j, "jg", "jle", "setg", "setle"); | ||||
|                     break; | ||||
|                 case JANET_SYSOP_GTE: | ||||
|                     j += sysemit_comp(&ctx, j, "jge", "jl", "setge"); | ||||
|                     j += sysemit_comp(&ctx, j, "jge", "jl", "setge", "setl"); | ||||
|                     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_%d_%u\n", i, instruction.branch.to); | ||||
|                     janet_formatb(buffer, "test "); | ||||
|                     // TODO - ensure branch condition is not a const | ||||
|                     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; | ||||
|                 case JANET_SYSOP_JUMP: | ||||
|                     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 */ | ||||
|                     uint32_t argcount = 0; | ||||
|                     uint32_t *args = janet_sys_callargs(ir->instructions + j, &argcount); | ||||
|                     if (argcount >= 1) sysemit_mov_save(&ctx, RDI, args[0]); | ||||
|                     if (argcount >= 2) sysemit_mov_save(&ctx, RSI, args[1]); | ||||
|                     if (argcount >= 3) sysemit_mov_save(&ctx, RDX, args[2]); | ||||
|                     if (argcount >= 4) sysemit_mov_save(&ctx, RCX, args[3]); | ||||
|                     if (argcount >= 5) sysemit_mov_save(&ctx, 8,   args[4]); | ||||
|                     if (argcount >= 6) sysemit_mov_save(&ctx, 9,   args[5]); | ||||
|                     int save_rdi = argcount >= 1 || (ctx.occupied_registers & (1 << RDI)); | ||||
|                     int save_rsi = argcount >= 2 || (ctx.occupied_registers & (1 << RSI)); | ||||
|                     int save_rdx = argcount >= 3 || (ctx.occupied_registers & (1 << RDX)); | ||||
|                     int save_rcx = argcount >= 4 || (ctx.occupied_registers & (1 << RCX)); | ||||
|                     int save_r8 = argcount >= 5 || (ctx.occupied_registers & (1 << 8)); | ||||
|                     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--) { | ||||
|                         janet_panic("nyi"); | ||||
|                         janet_formatb(buffer, "push "); | ||||
|                         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 "); | ||||
|                         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 (argcount >= 6) sysemit_popreg(&ctx, 9); | ||||
|                     if (argcount >= 5) sysemit_popreg(&ctx, 8); | ||||
|                     if (argcount >= 4) sysemit_popreg(&ctx, RCX); | ||||
|                     if (argcount >= 3) sysemit_popreg(&ctx, RDX); | ||||
|                     if (argcount >= 2) sysemit_popreg(&ctx, RSI); | ||||
|                     if (argcount >= 1) sysemit_popreg(&ctx, RDI); | ||||
|                     if (save_r11) sysemit_popreg(&ctx, 11); | ||||
|                     if (save_r10) sysemit_popreg(&ctx, 10); | ||||
|                     if (save_r9) sysemit_popreg(&ctx, 9); | ||||
|                     if (save_r8) sysemit_popreg(&ctx, 8); | ||||
|                     if (save_rcx) sysemit_popreg(&ctx, RCX); | ||||
|                     if (save_rdx) sysemit_popreg(&ctx, RDX); | ||||
|                     if (save_rsi) sysemit_popreg(&ctx, RSI); | ||||
|                     if (save_rdi) sysemit_popreg(&ctx, RDI); | ||||
|                     break; | ||||
|                     // On a comparison, if next instruction is branch that reads from dest, combine into a single op. | ||||
|             } | ||||
|   | ||||
		Reference in New Issue
	
	Block a user
	 Calvin Rose
					Calvin Rose