diff --git a/src/riscv_generate.ml b/src/riscv_generate.ml index 3d2fe16..3b89ac8 100644 --- a/src/riscv_generate.ml +++ b/src/riscv_generate.ml @@ -69,6 +69,14 @@ let nameof (x: Mtype.t) = match x with let remove_space = String.map (fun c -> if c = ' ' then '_' else c) +let revert_optimized_option_type = function +| Mtype.T_optimized_option { elem } -> + (match elem with + | Mtype.T_char | T_bool | T_unit | T_byte -> Mtype.T_int + | Mtype.T_int | T_uint -> Mtype.T_int64 + | _ -> failwith (Printf.sprintf "riscv_generate.ml: bad optimized_option type %s in revert" (Mtype.to_string elem))) +| otherwise -> otherwise + (** Push the correct sequence of instruction based on primitives. *) let deal_with_prim tac rd (prim: Primitive.prim) args = let die () = @@ -139,6 +147,7 @@ let deal_with_prim tac rd (prim: Primitive.prim) args = (* But convert is where we must take some action *) else let arg = List.hd args in + let arg = { arg with ty = revert_optimized_option_type arg.ty } in (match from, to_ with | I32, U8 | U32, U8 -> (* Discard higher bits by masking them away *) @@ -526,13 +535,18 @@ let deal_with_prim tac rd (prim: Primitive.prim) args = Vec.push tac (CallExtern { rd; fn = "puts"; args }) | Pnot -> Vec.push tac (Not { rd; rs1 = List.hd args }) + | Pstringequal -> + let cmp_res = new_temp Mtype.T_int in + let zero = new_temp Mtype.T_bytes in + Vec.push tac (CallExtern { rd = cmp_res; fn = "strcmp"; args }); + Vec.push tac (AssignInt64 { rd = zero; imm = 0L }); + Vec.push tac (Eq { rd; rs1 = cmp_res; rs2 = zero }); (* | Primitive.Pccall { func_name = "";_} -> _ | Primitive.Praise -> _ | Primitive.Punreachable -> _ | Primitive.Pcatch -> _ | Primitive.Psequand -> _ | Primitive.Psequor -> _ - | Primitive.Pstringequal -> _ | Primitive.Pclosure_to_extern_ref -> _ | Primitive.Pnull_string_extern -> _ | Primitive.Perror_to_string -> _ @@ -1156,7 +1170,7 @@ let rec do_convert tac (expr: Mcore.expr) = (* Choose which place to jump to *) let jtable = new_temp Mtype.T_bytes in let ptr_sz = new_temp Mtype.T_int in - let off = new_temp Mtype.T_bytes in + let off = new_temp Mtype.T_int in let altered = new_temp Mtype.T_bytes in let target = new_temp Mtype.T_bytes in @@ -1244,6 +1258,7 @@ let rec do_convert tac (expr: Mcore.expr) = let values = List.map (fun (t, _) -> match t with + | Constant.C_bool b -> Bool.to_int b | Constant.C_int { v } -> Int32.to_int v | Constant.C_char v -> Uchar.to_int v | _ -> failwith "TODO: unsupported switch constant type" @@ -1254,7 +1269,7 @@ let rec do_convert tac (expr: Mcore.expr) = let mn = List.fold_left (fun mn x -> min mn x) 2147483647 values in (* Sparse values, convert to if-else *) - if mx - mn >= 256 then ( + if mx - mn >= 256 || len < 16 then ( let ifexit = new_label "match_ifexit_" in List.iter2 (fun x (_, expr) -> let equal = new_temp Mtype.T_bool in diff --git a/src/riscv_opt_gather.ml b/src/riscv_opt_gather.ml index 066fe8e..6a32279 100644 --- a/src/riscv_opt_gather.ml +++ b/src/riscv_opt_gather.ml @@ -3,8 +3,7 @@ open Riscv_opt open Riscv_ssa let opt tac = - let out_noopt = Printf.sprintf "%s-no-opt.ssa" !Driver_config.Linkcore_Opt.output_file in - Basic_io.write out_noopt (String.concat "\n" (List.map Riscv_ssa.to_string tac)); + Riscv_ssa.write_to_file "-no-opt.ssa" tac; List.iter (fun top -> match top with | FnDecl { fn; args } -> Hashtbl.add params fn args @@ -12,14 +11,16 @@ let opt tac = iter_fn2 build_cfg tac; let ssa = Riscv_tac2ssa.ssa_of_tac tac in - + + Riscv_ssa.write_to_file "-opt0.ssa" ssa; + for i = 1 to 3 do + Riscv_ssa.write_to_file (Printf.sprintf "-opt%d.ssa" i) ssa; Riscv_opt_inline.inline ssa; Riscv_opt_peephole.peephole ssa; Riscv_opt_escape.lower_malloc ssa; done; let s = map_fn ssa_of_cfg ssa in - let out = Printf.sprintf "%s.ssa" !Driver_config.Linkcore_Opt.output_file in - Basic_io.write out (String.concat "\n" (List.map Riscv_ssa.to_string s)); + write_to_file ".ssa" s; s \ No newline at end of file diff --git a/src/riscv_ssa.ml b/src/riscv_ssa.ml index a972d0a..2757fff 100644 --- a/src/riscv_ssa.ml +++ b/src/riscv_ssa.ml @@ -253,7 +253,7 @@ let rec sizeof ty = (* Optimized option uses special values to indicate None for integer types *) (* So the size is equal to the underlying integer type *) - | Mtype.T_optimized_option { elem } -> sizeof elem + (* | Mtype.T_optimized_option { elem } -> sizeof elem *) (* Same size as the underlying type *) | Mtype.T_maybe_uninit x -> sizeof x @@ -266,15 +266,15 @@ let rec sizeof ty = (** Emits SSA form. We choose a less human-readable form to facilitate verifier. *) let to_string t = let rtype op ({ rd; rs1; rs2 }: r_type) = - Printf.sprintf "%s %s %s %s" op rd.name rs1.name rs2.name + Printf.sprintf "%s %s:%s %s:%s %s:%s" op rd.name (Mtype.to_string rd.ty) rs1.name (Mtype.to_string rs1.ty) rs2.name (Mtype.to_string rs2.ty) in let r2type op ({ rd; rs1; }: r2_type) = - Printf.sprintf "%s %s %s" op rd.name rs1.name + Printf.sprintf "%s %s:%s %s:%s" op rd.name (Mtype.to_string rd.ty) rs1.name (Mtype.to_string rs1.ty) in let itype op ({ rd; rs; imm } : i_type) = - Printf.sprintf "%s %s %s %d" op rd.name rs.name imm + Printf.sprintf "%s %s:%s %s:%s %d" op rd.name (Mtype.to_string rd.ty) rs.name (Mtype.to_string rs.ty) imm in (* Deals with signedness: signed or unsigned *) @@ -283,7 +283,7 @@ let to_string t = let width = (match rd.ty with | T_uint | T_uint64 -> "u" | _ -> "") in - Printf.sprintf "%s%s %s %s %s" op width rd.name rs1.name rs2.name + Printf.sprintf "%s%s %s:%s %s:%s %s:%s" op width rd.name (Mtype.to_string rd.ty) rs1.name (Mtype.to_string rs1.ty) rs2.name (Mtype.to_string rs2.ty) in (* Deals with width: 32 or 64 bit *) @@ -291,7 +291,7 @@ let to_string t = let width = (match rd.ty with | T_int | T_uint -> "w" | _ -> "") in - Printf.sprintf "%s%s %s %s %s" op width rd.name rs1.name rs2.name + Printf.sprintf "%s%s %s:%s %s:%s %s:%s" op width rd.name (Mtype.to_string rd.ty) rs1.name (Mtype.to_string rs1.ty) rs2.name (Mtype.to_string rs2.ty) in (* Deals with both width and signedness *) @@ -301,14 +301,14 @@ let to_string t = | T_uint -> "uw" | T_uint64 -> "u" | _ -> "") in - Printf.sprintf "%s%s %s %s %s" op width rd.name rs1.name rs2.name + Printf.sprintf "%s%s %s:%s %s:%s %s:%s" op width rd.name (Mtype.to_string rd.ty) rs1.name (Mtype.to_string rs1.ty) rs2.name (Mtype.to_string rs2.ty) in let itypew op ({ rd; rs; imm }: i_type) = let width = (match rd.ty with | T_int | T_uint -> "w" | _ -> "") in - Printf.sprintf "%s%s %s %s %d" op width rd.name rs.name imm + Printf.sprintf "%s%s %s:%s %s:%s %d" op width rd.name (Mtype.to_string rd.ty) rs.name (Mtype.to_string rs.ty) imm in (* Dedicated for slt *) @@ -319,7 +319,7 @@ let to_string t = | T_int -> "sltiw" | T_uint64 -> "sltiuw" | _ -> "") in - Printf.sprintf "%s %s %s %d" width rd.name rs.name imm + Printf.sprintf "%s %s:%s %s:%s %d" width rd.name (Mtype.to_string rd.ty) rs.name (Mtype.to_string rs.ty) imm in (* Similarly, `srl` and `sra` are instructions where `rs` matters rather than `rd` *) @@ -328,7 +328,7 @@ let to_string t = let width = (match rs.ty with | T_uint | T_int -> "w" | _ -> "") in - Printf.sprintf "%s%s %s %s %d" op width rd.name rs.name imm + Printf.sprintf "%s%s %s:%s %s:%s %d" op width rd.name (Mtype.to_string rd.ty) rs.name (Mtype.to_string rs.ty) imm in let die x = @@ -555,4 +555,8 @@ let new_temp ty = let new_label prefix = let name = prefix ^ Int.to_string !slot in slot := !slot + 1; - name \ No newline at end of file + name + +let write_to_file file_postfix ssa = + let out_noopt = Printf.sprintf "%s%s" !Driver_config.Linkcore_Opt.output_file file_postfix in + Basic_io.write out_noopt (String.concat "\n" (List.map to_string ssa)); \ No newline at end of file diff --git a/src/riscv_virtasm_generate.ml b/src/riscv_virtasm_generate.ml index c62cf66..9d39558 100644 --- a/src/riscv_virtasm_generate.ml +++ b/src/riscv_virtasm_generate.ml @@ -46,7 +46,7 @@ let slot_v v = (** Terminator and body are output arguments *) let convert_single name body terminator (inst: Riscv_ssa.t) = - let die msg = failwith (Printf.sprintf "riscv_virtasm_generate.ml: %s" msg) in + let die msg = failwith (Printf.sprintf "riscv_virtasm_generate.ml: %s. Complete SSA instruction: %s" msg (Riscv_ssa.to_string inst)) in let rslot ({ rd; rs1; rs2 }: Riscv_ssa.r_type) = ({ @@ -86,6 +86,13 @@ let convert_single name body terminator (inst: Riscv_ssa.t) = | T_uint -> Vec.push body (Inst.Subw r); Vec.push body (Zextw { rd = r.rd; rs = r.rd }) | _ -> Vec.push body (Inst.Sub r)) + | Neg ({rd ; rs1}) -> + let r = ({ rd = slot_v rd; rs1 = Slot.Reg Zero ; rs2 = slot_v rs1}: Slots.r_slot) in + (match rd.ty with + | T_int -> Vec.push body (Inst.Subw r); Vec.push body (Zextw { rd = r.rd; rs = r.rd }) + | T_int64 -> Vec.push body (Inst.Sub r) + | _ -> die (Printf.sprintf "neg: unexpected type %s" (Mtype.to_string rd.ty))) + | Mul ({ rd; rs1; rs2 } as x) -> let r = rslot x in (match rd.ty with @@ -153,8 +160,8 @@ let convert_single name body terminator (inst: Riscv_ssa.t) = | Srai ({ rd; rs; imm }) -> let r = ({ rd = slot_v rd; rs1 = slot_v rs; imm } : Slots.i_slot) in (match rs.ty with - | T_int -> Vec.push body (Inst.Sraiw r) - | T_int64 -> Vec.push body (Inst.Srai r) + | T_int | T_uint -> Vec.push body (Inst.Sraiw r) + | T_int64 | T_uint64 -> Vec.push body (Inst.Srai r) | _ -> die (Printf.sprintf "srai: unexpected type %s" (Mtype.to_string rs.ty))) | Srli ({ rd; rs; imm }) -> @@ -259,8 +266,8 @@ let convert_single name body terminator (inst: Riscv_ssa.t) = imm }: Slots.i_slot) in Vec.push body (match rs.ty with - | T_int -> Inst.Sltiw r - | T_int64 -> Inst.Slti r + | T_int | T_uint -> Inst.Sltiw r + | T_int64 | T_uint64 -> Inst.Slti r | _ -> die (Printf.sprintf "slti: unexpected type %s" (Mtype.to_string rs.ty))) | Not { rd; rs1 } -> @@ -366,7 +373,14 @@ let convert_single name body terminator (inst: Riscv_ssa.t) = | Jump label -> terminator := Term.J (label_of label) - (* | Neg -> _ + | JumpIndirect { rs; possibilities } -> (* TODO: Optimizations on possibilities *) + terminator := Term.Jalr { + rd = Slot.Reg Zero; + rs1 = slot_v rs; + offset = 0; + }; + (* Floating point instructions *) + (* | FAdd -> _ | FSub -> _ | FMul -> _ @@ -379,7 +393,6 @@ let convert_single name body terminator (inst: Riscv_ssa.t) = | FNeq -> _ | FNeg -> _ | AssignFP -> _ - | JumpIndirect -> _ | FnDecl -> _ | GlobalVarDecl -> _ | ExtArray _ -> _ *) diff --git a/test.py b/test.py index 9b43868..e5b8c0c 100755 --- a/test.py +++ b/test.py @@ -23,6 +23,7 @@ def __exit__(self, exc_type, exc_value, traceback): parser.add_argument("-v", "--verbose", action="store_true", help="on rebuild, makes interpreter output detailed values") parser.add_argument("-c", "--compile-only", action="store_true", help="compile without executing tests") parser.add_argument("-t", "--test", type=str, help="execute this test case only") +parser.add_argument("--gcc", action="store_true", help="use gcc instead of clang++") args = parser.parse_args() @@ -57,7 +58,10 @@ def try_remove(path): if args.build and not args.wasm: print("Building SSA interpreter...") os.makedirs("test/build", exist_ok=True) - os.system(f"clang++ -std=c++20 {verbose} test/interpreter.cpp -Wall -g -o test/build/interpreter") + if args.gcc: + os.system(f"g++ -std=c++20 {verbose} test/interpreter.cpp -Wall -g -o test/build/interpreter") + else: + os.system(f"clang++ -std=c++20 {verbose} test/interpreter.cpp -Wall -g -o test/build/interpreter") print("Done.") exit(0) @@ -102,6 +106,11 @@ def try_remove(path): if diff == 0: print("Passed.") else: + print("Failed.") + print("Expected output:") + os.system(f"cat src/{src}/{src}.ans") + print("Actual output:") + os.system(f"cat build/output.txt") success = False exit(not success) \ No newline at end of file diff --git a/test/interpreter.cpp b/test/interpreter.cpp index d909b18..43db751 100644 --- a/test/interpreter.cpp +++ b/test/interpreter.cpp @@ -308,6 +308,11 @@ int64_t interpret(std::string label) { continue; } + if (args[2] == "strcmp") { + VAL(1) = (int64_t) strcmp((char*) VAL(3), (char*) VAL(4)); + continue; + } + if (args[2] == "memset") { memset((void*) VAL(3), VAL(4), VAL(5)); VAL(1) = unit; diff --git a/test/src/string01/string01.ans b/test/src/string01/string01.ans new file mode 100644 index 0000000..7ed6ff8 --- /dev/null +++ b/test/src/string01/string01.ans @@ -0,0 +1 @@ +5 diff --git a/test/src/string01/string01.mbt b/test/src/string01/string01.mbt new file mode 100644 index 0000000..ac0ff84 --- /dev/null +++ b/test/src/string01/string01.mbt @@ -0,0 +1,4 @@ +fn main { + let x = "hello" + println(x.length()) +} \ No newline at end of file diff --git a/test/src/string02/string02.ans b/test/src/string02/string02.ans new file mode 100644 index 0000000..7565230 --- /dev/null +++ b/test/src/string02/string02.ans @@ -0,0 +1,4 @@ +false +true +false +true diff --git a/test/src/string02/string02.mbt b/test/src/string02/string02.mbt new file mode 100644 index 0000000..223d1f3 --- /dev/null +++ b/test/src/string02/string02.mbt @@ -0,0 +1,9 @@ +fn main { + let x = "hello" + let y = "world" + let z = "hello" + println(x == y) + println(x == z) + println(x == y) + println(x == x) +} \ No newline at end of file