From 7430f7b9712f9bb5ffc26ec228057b3cca8726c7 Mon Sep 17 00:00:00 2001 From: Claudio Russo Date: Sat, 17 Feb 2024 22:18:33 +0000 Subject: [PATCH 1/8] add flag to enable rtti --- src/codegen/compile.ml | 96 +++++++++++++++-------- src/mo_config/flags.ml | 1 + test/bench/ok/alloc.drun-run-opt.ok | 6 +- test/bench/ok/alloc.drun-run.ok | 6 +- test/bench/ok/bignum.drun-run-opt.ok | 4 +- test/bench/ok/bignum.drun-run.ok | 4 +- test/bench/ok/heap-32.drun-run-opt.ok | 4 +- test/bench/ok/heap-32.drun-run.ok | 4 +- test/bench/ok/nat16.drun-run-opt.ok | 2 +- test/bench/ok/nat16.drun-run.ok | 2 +- test/bench/ok/palindrome.drun-run-opt.ok | 12 +-- test/bench/ok/palindrome.drun-run.ok | 12 +-- test/bench/ok/region-mem.drun-run-opt.ok | 2 +- test/bench/ok/region-mem.drun-run.ok | 2 +- test/bench/ok/region0-mem.drun-run-opt.ok | 2 +- test/bench/ok/region0-mem.drun-run.ok | 2 +- test/bench/ok/stable-mem.drun-run-opt.ok | 2 +- test/bench/ok/stable-mem.drun-run.ok | 2 +- 18 files changed, 98 insertions(+), 67 deletions(-) diff --git a/src/codegen/compile.ml b/src/codegen/compile.ml index 5fac421f4d3..c07136dcd8b 100644 --- a/src/codegen/compile.ml +++ b/src/codegen/compile.ml @@ -92,34 +92,64 @@ module TaggingScheme = struct | _ -> TUnused let tag_of_typ pty = Type.( - match pty with - | Nat - | Int -> 0b10l - | Nat64 -> 0b0100l - | Int64 -> 0b1100l - | Nat32 -> 0b01000l - | Int32 -> 0b11000l - | Char -> 0b010_00000000l - | Nat16 -> 0b01000000_00000000l - | Int16 -> 0b11000000_00000000l - | Nat8 -> 0b01000000_00000000_00000000l - | Int8 -> 0b11000000_00000000_00000000l - | _ -> assert false) - - let unit_tag = (* all tag, no payload (none needed) *) - 0b01000000_00000000_00000000_00000000l + if !Flags.rtti then + match pty with + | Nat + | Int -> 0b10l + | Nat64 -> 0b0100l + | Int64 -> 0b1100l + | Nat32 -> 0b01000l + | Int32 -> 0b11000l + | Char -> 0b010_00000000l + | Nat16 -> 0b01000000_00000000l + | Int16 -> 0b11000000_00000000l + | Nat8 -> 0b01000000_00000000_00000000l + | Int8 -> 0b11000000_00000000_00000000l + | _ -> assert false + else + (* no tag *) + match pty with + | Nat + | Int + | Nat64 + | Int64 + | Nat32 + | Int32 + | Char + | Nat16 + | Int16 + | Nat8 + | Int8 -> 0l + | _ -> assert false) + + let unit_tag () = + if !Flags.rtti then + (* all tag, no payload (none needed) *) + 0b01000000_00000000_00000000_00000000l + else + (* no tag *) + 0l (* Number of payload bits in compact representation, including any sign *) let ubits_of pty = Type.( - match pty with - | Nat | Int -> 30 - | Nat64 | Int64 -> 28 - | Nat32 | Int32 -> 27 - | Char -> 21 (* suffices for 21-bit UTF8 codepoints *) - | Nat16 | Int16 -> 16 - | Nat8 | Int8 -> 8 - | _ -> assert false) - + if !Flags.rtti then + match pty with + | Nat | Int -> 30 + | Nat64 | Int64 -> 28 + | Nat32 | Int32 -> 27 + | Char -> 21 (* suffices for 21-bit UTF8 codepoints *) + | Nat16 | Int16 -> 16 + | Nat8 | Int8 -> 8 + | _ -> assert false + else + match pty with + | Nat | Int -> 31 + | Nat64 | Int64 -> 31 + | Nat32 | Int32 -> 31 + | Char -> 21 (* suffices for 21-bit UTF8 codepoints *) + | Nat16 | Int16 -> 16 + | Nat8 | Int8 -> 8 + | _ -> assert false) end (* @@ -4782,8 +4812,8 @@ module Tuple = struct (* We represent the boxed empty tuple as the unboxed scalar 0, i.e. simply as number (but really anything is fine, we never look at this) *) - let unit_vanilla_lit = TaggingScheme.unit_tag (* all tag, trivial payload *) - let compile_unit = compile_unboxed_const unit_vanilla_lit + let unit_vanilla_lit env = TaggingScheme.unit_tag () (* all tag, trivial payload *) + let compile_unit env = compile_unboxed_const (unit_vanilla_lit ()) (* Expects on the stack the pointer to the array. *) let load_n env n = @@ -4792,7 +4822,7 @@ module Tuple = struct (* Takes n elements of the stack and produces an argument tuple *) let from_stack env n = - if n = 0 then compile_unit + if n = 0 then compile_unit env else let name = Printf.sprintf "to_%i_tuple" n in let args = Lib.List.table n (fun i -> Printf.sprintf "arg%i" i, I32Type) in @@ -5283,7 +5313,7 @@ module IC = struct get_code ^^ compile_unboxed_const const ^^ G.i (Compare (Wasm.Values.I32 I32Op.Eq)) ^^ G.if1 I32Type - (Variant.inject env tag Tuple.compile_unit) + (Variant.inject env tag (Tuple.compile_unit env)) code) ["system_fatal", 1l; "system_transient", 2l; @@ -8700,7 +8730,7 @@ module StackRep = struct | Const.Obj fs -> let fs' = List.map (fun (n, c) -> (n, materialize_const_t env c)) fs in Object.vanilla_lit env fs' - | Const.Unit -> Tuple.unit_vanilla_lit + | Const.Unit -> Tuple.unit_vanilla_lit env | Const.Array cs -> let ptrs = List.map (materialize_const_t env) cs in Arr.vanilla_lit env ptrs @@ -9149,7 +9179,7 @@ module FuncDec = struct (* reply early for a oneway *) (if control = Type.Returns then - Tuple.compile_unit ^^ + Tuple.compile_unit env ^^ Serialization.serialize env [] ^^ IC.reply_with_data env else G.nop) ^^ @@ -9540,7 +9570,7 @@ module FuncDec = struct (* To avoid more failing allocation, don't deserialize args nor serialize reply, i.e. don't even try to do this: Serialization.deserialize env [] ^^ - Tuple.compile_unit ^^ + Tuple.compile_unit env ^^ Serialization.serialize env [] ^^ *) (* Instead, just ignore the argument and @@ -10999,7 +11029,7 @@ and compile_prim_invocation (env : E.t) ae p es at = begin match ts with | [] -> (* return some () *) - Opt.inject env Tuple.compile_unit + Opt.inject env (Tuple.compile_unit env) | [t] -> (* save to local, propagate error as null or return some value *) let (set_val, get_val) = new_local env "val" in diff --git a/src/mo_config/flags.ml b/src/mo_config/flags.ml index 075ed103d26..849dd30e7a0 100644 --- a/src/mo_config/flags.ml +++ b/src/mo_config/flags.ml @@ -46,6 +46,7 @@ let experimental_field_aliasing = ref false let ocaml_js = ref false let rts_stack_pages_default = 32 (* 2MB *) let rts_stack_pages : int ref = ref rts_stack_pages_default +let rtti = ref false let trap_on_call_error = ref false let use_stable_regions = ref false let share_code = ref false diff --git a/test/bench/ok/alloc.drun-run-opt.ok b/test/bench/ok/alloc.drun-run-opt.ok index 1a952ee1cf3..70256f58c01 100644 --- a/test/bench/ok/alloc.drun-run-opt.ok +++ b/test/bench/ok/alloc.drun-run-opt.ok @@ -1,8 +1,8 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: (+268_435_456, 3_373_867_377) +debug.print: (+268_435_456, 3_273_204_071) ingress Completed: Reply: 0x4449444c0000 -debug.print: (+268_435_456, 3_372_384_625) +debug.print: (+268_435_456, 3_271_721_319) ingress Completed: Reply: 0x4449444c0000 -debug.print: (+268_435_456, 3_372_384_625) +debug.print: (+268_435_456, 3_271_721_319) ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/alloc.drun-run.ok b/test/bench/ok/alloc.drun-run.ok index 501cf43980e..842473d57f7 100644 --- a/test/bench/ok/alloc.drun-run.ok +++ b/test/bench/ok/alloc.drun-run.ok @@ -1,8 +1,8 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: (+268_435_456, 3_441_090_958) +debug.print: (+268_435_456, 3_340_427_654) ingress Completed: Reply: 0x4449444c0000 -debug.print: (+268_435_456, 3_439_583_630) +debug.print: (+268_435_456, 3_338_920_326) ingress Completed: Reply: 0x4449444c0000 -debug.print: (+268_435_456, 3_439_583_630) +debug.print: (+268_435_456, 3_338_920_326) ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/bignum.drun-run-opt.ok b/test/bench/ok/bignum.drun-run-opt.ok index 1dc8351f721..08782b73098 100644 --- a/test/bench/ok/bignum.drun-run-opt.ok +++ b/test/bench/ok/bignum.drun-run-opt.ok @@ -1,6 +1,6 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: {cycles = 2_512_909; size = +59_652} +debug.print: {cycles = 2_512_869; size = +59_652} ingress Completed: Reply: 0x4449444c0000 -debug.print: {cycles = 107_695_087; size = +1_817_872} +debug.print: {cycles = 107_695_003; size = +1_817_872} ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/bignum.drun-run.ok b/test/bench/ok/bignum.drun-run.ok index 05e79735cfd..6f75d31bf6d 100644 --- a/test/bench/ok/bignum.drun-run.ok +++ b/test/bench/ok/bignum.drun-run.ok @@ -1,6 +1,6 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: {cycles = 2_620_042; size = +59_652} +debug.print: {cycles = 2_620_002; size = +59_652} ingress Completed: Reply: 0x4449444c0000 -debug.print: {cycles = 107_890_056; size = +1_817_872} +debug.print: {cycles = 107_890_014; size = +1_817_872} ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/heap-32.drun-run-opt.ok b/test/bench/ok/heap-32.drun-run-opt.ok index 8d32b39df9b..e35a3ea6193 100644 --- a/test/bench/ok/heap-32.drun-run-opt.ok +++ b/test/bench/ok/heap-32.drun-run-opt.ok @@ -1,5 +1,5 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: (50_227, +33_340_296, 763_038_144) -debug.print: (50_070, +34_703_580, 793_972_423) +debug.print: (50_227, +29_863_068, 708_978_584) +debug.print: (50_070, +32_592_772, 765_463_946) ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/heap-32.drun-run.ok b/test/bench/ok/heap-32.drun-run.ok index 27821c1cca2..7b450840b3e 100644 --- a/test/bench/ok/heap-32.drun-run.ok +++ b/test/bench/ok/heap-32.drun-run.ok @@ -1,5 +1,5 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: (50_227, +33_340_296, 826_535_101) -debug.print: (50_070, +34_703_580, 859_094_948) +debug.print: (50_227, +29_863_068, 769_803_717) +debug.print: (50_070, +32_592_772, 829_977_496) ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/nat16.drun-run-opt.ok b/test/bench/ok/nat16.drun-run-opt.ok index 93397fc3d8a..9a514a12f0c 100644 --- a/test/bench/ok/nat16.drun-run-opt.ok +++ b/test/bench/ok/nat16.drun-run-opt.ok @@ -1,4 +1,4 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: (0, 22_021_275) +debug.print: (0, 22_021_239) ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/nat16.drun-run.ok b/test/bench/ok/nat16.drun-run.ok index 89e4ba06f85..d1f79396beb 100644 --- a/test/bench/ok/nat16.drun-run.ok +++ b/test/bench/ok/nat16.drun-run.ok @@ -1,4 +1,4 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: (0, 55_575_384) +debug.print: (0, 55_575_348) ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/palindrome.drun-run-opt.ok b/test/bench/ok/palindrome.drun-run-opt.ok index b088d4e9e58..2c056139002 100644 --- a/test/bench/ok/palindrome.drun-run-opt.ok +++ b/test/bench/ok/palindrome.drun-run-opt.ok @@ -1,9 +1,9 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: (true, +1_188, 11_527) -debug.print: (false, +1_188, 10_562) -debug.print: (false, +1_188, 11_507) -debug.print: (true, +868, 11_723) -debug.print: (false, +868, 10_234) -debug.print: (false, +868, 11_674) +debug.print: (true, +1_188, 11_457) +debug.print: (false, +1_188, 10_492) +debug.print: (false, +1_188, 11_437) +debug.print: (true, +868, 11_653) +debug.print: (false, +868, 10_164) +debug.print: (false, +868, 11_604) ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/palindrome.drun-run.ok b/test/bench/ok/palindrome.drun-run.ok index 753cbae6d20..8f1f788e708 100644 --- a/test/bench/ok/palindrome.drun-run.ok +++ b/test/bench/ok/palindrome.drun-run.ok @@ -1,9 +1,9 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: (true, +1_188, 12_803) -debug.print: (false, +1_188, 11_792) -debug.print: (false, +1_188, 12_782) -debug.print: (true, +868, 12_911) -debug.print: (false, +868, 11_314) -debug.print: (false, +868, 12_859) +debug.print: (true, +1_188, 12_733) +debug.print: (false, +1_188, 11_722) +debug.print: (false, +1_188, 12_712) +debug.print: (true, +868, 12_841) +debug.print: (false, +868, 11_244) +debug.print: (false, +868, 12_789) ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/region-mem.drun-run-opt.ok b/test/bench/ok/region-mem.drun-run-opt.ok index 0a7a823e786..6e0ffe16c74 100644 --- a/test/bench/ok/region-mem.drun-run-opt.ok +++ b/test/bench/ok/region-mem.drun-run-opt.ok @@ -1,4 +1,4 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: {heap_diff = 0; instr_diff = 5_662_310_732} +debug.print: {heap_diff = 0; instr_diff = 5_662_310_728} ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/region-mem.drun-run.ok b/test/bench/ok/region-mem.drun-run.ok index e5217ee3b0b..dabe1697632 100644 --- a/test/bench/ok/region-mem.drun-run.ok +++ b/test/bench/ok/region-mem.drun-run.ok @@ -1,4 +1,4 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: {heap_diff = 0; instr_diff = 6_014_632_305} +debug.print: {heap_diff = 0; instr_diff = 6_014_632_301} ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/region0-mem.drun-run-opt.ok b/test/bench/ok/region0-mem.drun-run-opt.ok index 30fb7072685..d9ce7d7fb53 100644 --- a/test/bench/ok/region0-mem.drun-run-opt.ok +++ b/test/bench/ok/region0-mem.drun-run-opt.ok @@ -1,4 +1,4 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: {heap_diff = 0; instr_diff = 5_838_471_500} +debug.print: {heap_diff = 0; instr_diff = 5_838_471_496} ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/region0-mem.drun-run.ok b/test/bench/ok/region0-mem.drun-run.ok index c58279290cc..904627d7719 100644 --- a/test/bench/ok/region0-mem.drun-run.ok +++ b/test/bench/ok/region0-mem.drun-run.ok @@ -1,4 +1,4 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: {heap_diff = 0; instr_diff = 6_442_451_313} +debug.print: {heap_diff = 0; instr_diff = 6_442_451_309} ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/stable-mem.drun-run-opt.ok b/test/bench/ok/stable-mem.drun-run-opt.ok index c425cec9b4e..fc0bb453520 100644 --- a/test/bench/ok/stable-mem.drun-run-opt.ok +++ b/test/bench/ok/stable-mem.drun-run-opt.ok @@ -1,4 +1,4 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: {heap_diff = 0; instr_diff = 3_510_632_780} +debug.print: {heap_diff = 0; instr_diff = 3_510_632_776} ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/stable-mem.drun-run.ok b/test/bench/ok/stable-mem.drun-run.ok index b3f63bb7403..617c5cc11e0 100644 --- a/test/bench/ok/stable-mem.drun-run.ok +++ b/test/bench/ok/stable-mem.drun-run.ok @@ -1,4 +1,4 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: {heap_diff = 0; instr_diff = 3_925_868_913} +debug.print: {heap_diff = 0; instr_diff = 3_925_868_909} ingress Completed: Reply: 0x4449444c0000 From 51df94709ebf5dd0add0a41e82e66882624e9366 Mon Sep 17 00:00:00 2001 From: Claudio Russo Date: Sun, 18 Feb 2024 16:07:50 +0000 Subject: [PATCH 2/8] fix bugs in can_tag_i32/i64 tests and sanity checks --- src/codegen/compile.ml | 101 ++++++++++++++++++++++------------------- 1 file changed, 55 insertions(+), 46 deletions(-) diff --git a/src/codegen/compile.ml b/src/codegen/compile.ml index c07136dcd8b..a6b723f7b65 100644 --- a/src/codegen/compile.ml +++ b/src/codegen/compile.ml @@ -29,6 +29,9 @@ let page_size = Int32.of_int (64*1024) let page_size64 = Int64.of_int32 page_size let page_size_bits = 16 +(* Our code depends on OCaml int having at least 32 bits *) +let _ = assert (Sys.int_size >= 32) + (* Scalar Tagging Scheme *) (* Rationale: @@ -1763,28 +1766,31 @@ module BitTagged = struct if TaggingScheme.debug || !Flags.sanity then get_x ^^ Func.share_code2 Func.Always env (prim_fun_name pty "check_can_tag_i64") (("res", I32Type), ("x", I64Type)) [I32Type] - (fun env get_res get_x -> - let lower_bound, upper_bound = Type.( - match pty with - | Nat | Int | Int64 | Int32 -> - let sbits = sbits_of pty in - Int64.(neg (shift_left 1L sbits), shift_left 1L sbits) - | Nat64 | Nat32 -> - let ubits = ubits_of pty in - (0L, Int64.shift_left 1L ubits) - | _ -> assert false) - in - (* lower_bound <= x < upper_bound *) - compile_const_64 lower_bound ^^ - get_x ^^ - G.i (Compare (Wasm.Values.I64 I64Op.LeS)) ^^ - get_x ^^ compile_const_64 upper_bound ^^ - G.i (Compare (Wasm.Values.I64 I64Op.LtS)) ^^ - G.i (Binary (Wasm.Values.I32 I32Op.And)) ^^ - get_res ^^ - G.i (Compare (Wasm.Values.I32 I32Op.Eq)) ^^ - E.else_trap_with env (prim_fun_name pty "check_can_tag_i64") ^^ - get_res) + (fun env get_res get_x -> Type.( + match pty with + | Nat | Int | Int64 | Int32 -> + let sbits = sbits_of pty in + let lower_bound = Int64.(neg (shift_left 1L sbits)) in + let upper_bound = Int64.shift_left 1L sbits in + (* lower_bound <= x < upper_bound *) + compile_const_64 lower_bound ^^ + get_x ^^ + G.i (Compare (Wasm.Values.I64 I32Op.LeS)) ^^ + get_x ^^ compile_const_64 upper_bound ^^ + G.i (Compare (Wasm.Values.I64 I32Op.LtS)) ^^ + G.i (Binary (Wasm.Values.I32 I32Op.And)) + | Nat64 | Nat32 -> + let ubits = ubits_of pty in + let upper_bound = Int64.shift_left 1L ubits in + (* 0 <= x < upper_bound *) + get_x ^^ compile_const_64 upper_bound ^^ + G.i (Compare (Wasm.Values.I64 I32Op.LtU)) + | _ -> + assert false) ^^ + get_res ^^ + G.i (Compare (Wasm.Values.I32 I32Op.Eq)) ^^ + E.else_trap_with env (prim_fun_name pty "check_can_tag_i64") ^^ + get_res) else G.nop @@ -1795,7 +1801,7 @@ module BitTagged = struct (prim_fun_name pty "if_can_tag_i64") ("x", I64Type) [I32Type] (fun env get_x -> (* checks that all but the low sbits are either all 0 or all 1 *) get_x ^^ - get_x ^^ compile_shrS64_const (Int64.of_int ((64 - ubits_of pty) - 1)) ^^ + get_x ^^ compile_shrS64_const (Int64.of_int (64 - sbits_of pty)) ^^ G.i (Binary (Wasm.Values.I64 I32Op.Xor)) ^^ compile_shrU64_const (Int64.of_int (sbits_of pty)) ^^ G.i (Test (Wasm.Values.I64 I64Op.Eqz)) ^^ @@ -1865,28 +1871,31 @@ module BitTagged = struct if TaggingScheme.debug || !Flags.sanity then get_x ^^ Func.share_code2 Func.Always env (prim_fun_name pty "check_can_tag_i32") (("res", I32Type), ("x", I32Type)) [I32Type] - (fun env get_res get_x -> - let lower_bound, upper_bound = Type.( - match pty with - | Nat | Int | Int64 | Int32 -> - let sbits = sbits_of pty in - (Int32.(neg (shift_left 1l sbits)), Int32.shift_left 1l sbits) - | Nat64 | Nat32 -> - let ubits = ubits_of pty in - (0l, Int32.shift_left 1l ubits) - | _ -> assert false) - in - (* lower_bound <= x < upper_bound *) - compile_unboxed_const lower_bound ^^ - get_x ^^ - G.i (Compare (Wasm.Values.I32 I32Op.LeS)) ^^ - get_x ^^ compile_unboxed_const upper_bound ^^ - G.i (Compare (Wasm.Values.I32 I32Op.LtS)) ^^ - G.i (Binary (Wasm.Values.I32 I32Op.And)) ^^ - get_res ^^ - G.i (Compare (Wasm.Values.I32 I32Op.Eq)) ^^ - E.else_trap_with env (prim_fun_name pty "check_can_tag_i32") ^^ - get_res) + (fun env get_res get_x -> Type.( + match pty with + | Nat | Int | Int64 | Int32 -> + let sbits = sbits_of pty in + let lower_bound = Int32.(neg (shift_left 1l sbits)) in + let upper_bound = Int32.shift_left 1l sbits in + (* lower_bound <= x < upper_bound *) + compile_unboxed_const lower_bound ^^ + get_x ^^ + G.i (Compare (Wasm.Values.I32 I32Op.LeS)) ^^ + get_x ^^ compile_unboxed_const upper_bound ^^ + G.i (Compare (Wasm.Values.I32 I32Op.LtS)) ^^ + G.i (Binary (Wasm.Values.I32 I32Op.And)) + | Nat64 | Nat32 -> + let ubits = ubits_of pty in + let upper_bound = Int32.shift_left 1l ubits in + (* 0 <= x < upper_bound *) + get_x ^^ compile_unboxed_const upper_bound ^^ + G.i (Compare (Wasm.Values.I32 I32Op.LtU)) + | _ -> + assert false) ^^ + get_res ^^ + G.i (Compare (Wasm.Values.I32 I32Op.Eq)) ^^ + E.else_trap_with env (prim_fun_name pty "check_can_tag_i32") ^^ + get_res) else G.nop @@ -1896,7 +1905,7 @@ module BitTagged = struct (prim_fun_name pty "if_can_tag_i32") ("x", I32Type) [I32Type] (fun env get_x -> (* checks that all but the low sbits are both either 0 or 1 *) get_x ^^ - get_x ^^ compile_shrS_const (Int32.of_int ((32 - ubits_of pty) - 1)) ^^ + get_x ^^ compile_shrS_const (Int32.of_int (32 - sbits_of pty)) ^^ G.i (Binary (Wasm.Values.I32 I32Op.Xor)) ^^ compile_shrU_const (Int32.of_int (sbits_of pty)) ^^ G.i (Test (Wasm.Values.I32 I32Op.Eqz)) ^^ From bf55ff524beb887d6ac1dec98263c47446043ff3 Mon Sep 17 00:00:00 2001 From: Claudio Russo Date: Sun, 18 Feb 2024 16:09:04 +0000 Subject: [PATCH 3/8] adjust test assert on heap size --- test/run/idl-ops.mo | 1 + test/run/idl.mo | 6 ++++-- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/test/run/idl-ops.mo b/test/run/idl-ops.mo index bdff4c3417c..6c4bec438a4 100644 --- a/test/run/idl-ops.mo +++ b/test/run/idl-ops.mo @@ -51,6 +51,7 @@ assert(null == deserArrayNat (serArrayInt arrayInt)); assert((?arrayInt) == deserArrayInt (serArrayInt arrayInt)); let heapDifference = Prim.rts_heap_size() : Int - started_with; // Difference between incremental and non-incremental GC +Prim.debugPrint(debug_show heapDifference); assert(heapDifference <= +8_176); //SKIP run diff --git a/test/run/idl.mo b/test/run/idl.mo index 036509ffb4b..4b24c4963bc 100644 --- a/test/run/idl.mo +++ b/test/run/idl.mo @@ -44,10 +44,12 @@ assert(arrayNat == deserArrayNat (serArrayNat arrayNat)); assert(arrayNat == deserArrayInt (serArrayNat arrayNat)); assert(arrayNat == deserArrayInt (serArrayInt arrayNat)); assert(arrayInt == deserArrayInt (serArrayInt arrayInt)); - let heapDifference = Prim.rts_heap_size() : Int - started_with; // Difference between incremental and non-incremental GC -assert(heapDifference == +4_892 or heapDifference == +5_340); +assert(heapDifference == 4_488 or // no rtti + heapDifference == 4_888 or // no rtti and incremental GC + heapDifference == +4_892 or // rtti + heapDifference == +5_340); // rtti and incremental GC //SKIP run //SKIP run-ir From efc95a587ca25224a320eb8532deec53527dcf95 Mon Sep 17 00:00:00 2001 From: Claudio Russo Date: Sun, 18 Feb 2024 16:38:43 +0000 Subject: [PATCH 4/8] update perf numbers --- test/bench/alloc.mo | 2 +- test/bench/ok/bignum.drun-run-opt.ok | 2 +- test/bench/ok/bignum.drun-run.ok | 2 +- test/bench/ok/heap-32.drun-run-opt.ok | 2 +- test/bench/ok/heap-32.drun-run.ok | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/test/bench/alloc.mo b/test/bench/alloc.mo index 555de3f14ff..088cc0c5621 100644 --- a/test/bench/alloc.mo +++ b/test/bench/alloc.mo @@ -1,4 +1,4 @@ -//MOC-FLAG --force-gc +//MOC-FLAG import { performanceCounter; rts_heap_size; debugPrint } = "mo:⛔"; actor alloc { diff --git a/test/bench/ok/bignum.drun-run-opt.ok b/test/bench/ok/bignum.drun-run-opt.ok index 08782b73098..94a72d07b2d 100644 --- a/test/bench/ok/bignum.drun-run-opt.ok +++ b/test/bench/ok/bignum.drun-run-opt.ok @@ -2,5 +2,5 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a000000000000000001 ingress Completed: Reply: 0x4449444c0000 debug.print: {cycles = 2_512_869; size = +59_652} ingress Completed: Reply: 0x4449444c0000 -debug.print: {cycles = 107_695_003; size = +1_817_872} +debug.print: {cycles = 107_695_051; size = +1_817_872} ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/bignum.drun-run.ok b/test/bench/ok/bignum.drun-run.ok index 6f75d31bf6d..a47c25f4f30 100644 --- a/test/bench/ok/bignum.drun-run.ok +++ b/test/bench/ok/bignum.drun-run.ok @@ -2,5 +2,5 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a000000000000000001 ingress Completed: Reply: 0x4449444c0000 debug.print: {cycles = 2_620_002; size = +59_652} ingress Completed: Reply: 0x4449444c0000 -debug.print: {cycles = 107_890_014; size = +1_817_872} +debug.print: {cycles = 107_890_020; size = +1_817_872} ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/heap-32.drun-run-opt.ok b/test/bench/ok/heap-32.drun-run-opt.ok index e35a3ea6193..0f5b3c72293 100644 --- a/test/bench/ok/heap-32.drun-run-opt.ok +++ b/test/bench/ok/heap-32.drun-run-opt.ok @@ -1,5 +1,5 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 debug.print: (50_227, +29_863_068, 708_978_584) -debug.print: (50_070, +32_592_772, 765_463_946) +debug.print: (50_070, +32_992_212, 767_314_988) ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/heap-32.drun-run.ok b/test/bench/ok/heap-32.drun-run.ok index 7b450840b3e..8f5ced2203e 100644 --- a/test/bench/ok/heap-32.drun-run.ok +++ b/test/bench/ok/heap-32.drun-run.ok @@ -1,5 +1,5 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 debug.print: (50_227, +29_863_068, 769_803_717) -debug.print: (50_070, +32_592_772, 829_977_496) +debug.print: (50_070, +32_992_212, 831_128_684) ingress Completed: Reply: 0x4449444c0000 From 7b0b2408f839da7103d87102ce951f370c82a207 Mon Sep 17 00:00:00 2001 From: Claudio Russo Date: Sun, 18 Feb 2024 18:55:46 +0000 Subject: [PATCH 5/8] revert change --- test/bench/alloc.mo | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/bench/alloc.mo b/test/bench/alloc.mo index 088cc0c5621..555de3f14ff 100644 --- a/test/bench/alloc.mo +++ b/test/bench/alloc.mo @@ -1,4 +1,4 @@ -//MOC-FLAG +//MOC-FLAG --force-gc import { performanceCounter; rts_heap_size; debugPrint } = "mo:⛔"; actor alloc { From 53de330def705f330a492f195ab6d38fb9cce4e6 Mon Sep 17 00:00:00 2001 From: Claudio Russo Date: Sun, 18 Feb 2024 18:58:56 +0000 Subject: [PATCH 6/8] revert test --- test/run/idl-ops.mo | 1 - 1 file changed, 1 deletion(-) diff --git a/test/run/idl-ops.mo b/test/run/idl-ops.mo index 6c4bec438a4..bdff4c3417c 100644 --- a/test/run/idl-ops.mo +++ b/test/run/idl-ops.mo @@ -51,7 +51,6 @@ assert(null == deserArrayNat (serArrayInt arrayInt)); assert((?arrayInt) == deserArrayInt (serArrayInt arrayInt)); let heapDifference = Prim.rts_heap_size() : Int - started_with; // Difference between incremental and non-incremental GC -Prim.debugPrint(debug_show heapDifference); assert(heapDifference <= +8_176); //SKIP run From f55007109c2b55697e469ddd758644176dc0dda7 Mon Sep 17 00:00:00 2001 From: Claudio Russo Date: Sun, 18 Feb 2024 21:55:43 +0000 Subject: [PATCH 7/8] optimized clearing of all-zero tags --- src/codegen/compile.ml | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/src/codegen/compile.ml b/src/codegen/compile.ml index a6b723f7b65..0c271ed863b 100644 --- a/src/codegen/compile.ml +++ b/src/codegen/compile.ml @@ -1954,6 +1954,13 @@ module BitTagged = struct compile_shrU_const (Int32.sub 32l (Int32.of_int ubits)) | _ -> assert false) + let clear_tag env pty = + if TaggingScheme.tag_of_typ pty <> 0l then + let shift_amount = 32 - ubits_of pty in + let mask = Int32.(lognot (sub (shift_left one shift_amount) one)) in + compile_bitand_const mask + else G.nop + end (* BitTagged *) module Tagged = struct @@ -2952,7 +2959,7 @@ module TaggedSmallWord = struct (* check tag *) BitTagged.sanity_check_tag __LINE__ env pty ^^ (* clear tag *) - compile_bitand_const (mask_of_type pty) + BitTagged.clear_tag env pty | _ -> assert false end (* TaggedSmallWord *) @@ -3279,9 +3286,7 @@ module MakeCompact (Num : BigNumType) : BigNumType = struct (* examine the skewed pointer and determine if number fits into ubits *) let fits_in_vanilla env = Num.fits_signed_bits env (BitTagged.ubits_of Type.Int) - let clear_tag env = - let mask = Int32.(lognot (sub (shift_left 1l (32 - BitTagged.ubits_of Type.Int)) 1l)) in - compile_bitand_const mask + let clear_tag env = BitTagged.clear_tag env Type.Int (* Tagged scalar to right-0-padded signed i64 *) let extend64 env = From 16fa558f4143d08afb964bed09f7c347a10f3a7f Mon Sep 17 00:00:00 2001 From: Claudio Russo Date: Sun, 18 Feb 2024 21:59:26 +0000 Subject: [PATCH 8/8] update perf numbers --- test/bench/ok/alloc.drun-run-opt.ok | 6 +++--- test/bench/ok/alloc.drun-run.ok | 6 +++--- test/bench/ok/bignum.drun-run-opt.ok | 2 +- test/bench/ok/bignum.drun-run.ok | 2 +- test/bench/ok/heap-32.drun-run-opt.ok | 4 ++-- test/bench/ok/heap-32.drun-run.ok | 4 ++-- test/bench/ok/nat16.drun-run-opt.ok | 2 +- test/bench/ok/nat16.drun-run.ok | 2 +- test/bench/ok/palindrome.drun-run-opt.ok | 12 ++++++------ test/bench/ok/palindrome.drun-run.ok | 12 ++++++------ test/bench/ok/region-mem.drun-run.ok | 2 +- test/bench/ok/region0-mem.drun-run.ok | 2 +- test/bench/ok/stable-mem.drun-run.ok | 2 +- 13 files changed, 29 insertions(+), 29 deletions(-) diff --git a/test/bench/ok/alloc.drun-run-opt.ok b/test/bench/ok/alloc.drun-run-opt.ok index 70256f58c01..820c65ecd07 100644 --- a/test/bench/ok/alloc.drun-run-opt.ok +++ b/test/bench/ok/alloc.drun-run-opt.ok @@ -1,8 +1,8 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: (+268_435_456, 3_273_204_071) +debug.print: (+268_435_456, 3_004_768_603) ingress Completed: Reply: 0x4449444c0000 -debug.print: (+268_435_456, 3_271_721_319) +debug.print: (+268_435_456, 3_003_285_851) ingress Completed: Reply: 0x4449444c0000 -debug.print: (+268_435_456, 3_271_721_319) +debug.print: (+268_435_456, 3_003_285_851) ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/alloc.drun-run.ok b/test/bench/ok/alloc.drun-run.ok index 842473d57f7..2f9ee83b071 100644 --- a/test/bench/ok/alloc.drun-run.ok +++ b/test/bench/ok/alloc.drun-run.ok @@ -1,8 +1,8 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: (+268_435_456, 3_340_427_654) +debug.print: (+268_435_456, 3_071_992_186) ingress Completed: Reply: 0x4449444c0000 -debug.print: (+268_435_456, 3_338_920_326) +debug.print: (+268_435_456, 3_070_484_858) ingress Completed: Reply: 0x4449444c0000 -debug.print: (+268_435_456, 3_338_920_326) +debug.print: (+268_435_456, 3_070_484_858) ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/bignum.drun-run-opt.ok b/test/bench/ok/bignum.drun-run-opt.ok index 94a72d07b2d..007530eef47 100644 --- a/test/bench/ok/bignum.drun-run-opt.ok +++ b/test/bench/ok/bignum.drun-run-opt.ok @@ -1,6 +1,6 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: {cycles = 2_512_869; size = +59_652} +debug.print: {cycles = 2_512_723; size = +59_652} ingress Completed: Reply: 0x4449444c0000 debug.print: {cycles = 107_695_051; size = +1_817_872} ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/bignum.drun-run.ok b/test/bench/ok/bignum.drun-run.ok index a47c25f4f30..b037729f278 100644 --- a/test/bench/ok/bignum.drun-run.ok +++ b/test/bench/ok/bignum.drun-run.ok @@ -1,6 +1,6 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: {cycles = 2_620_002; size = +59_652} +debug.print: {cycles = 2_619_856; size = +59_652} ingress Completed: Reply: 0x4449444c0000 debug.print: {cycles = 107_890_020; size = +1_817_872} ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/heap-32.drun-run-opt.ok b/test/bench/ok/heap-32.drun-run-opt.ok index 0f5b3c72293..faf3bfb29da 100644 --- a/test/bench/ok/heap-32.drun-run-opt.ok +++ b/test/bench/ok/heap-32.drun-run-opt.ok @@ -1,5 +1,5 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: (50_227, +29_863_068, 708_978_584) -debug.print: (50_070, +32_992_212, 767_314_988) +debug.print: (50_227, +29_863_068, 708_174_952) +debug.print: (50_070, +32_992_212, 766_613_680) ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/heap-32.drun-run.ok b/test/bench/ok/heap-32.drun-run.ok index 8f5ced2203e..f51bd0ff0c3 100644 --- a/test/bench/ok/heap-32.drun-run.ok +++ b/test/bench/ok/heap-32.drun-run.ok @@ -1,5 +1,5 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: (50_227, +29_863_068, 769_803_717) -debug.print: (50_070, +32_992_212, 831_128_684) +debug.print: (50_227, +29_863_068, 769_000_085) +debug.print: (50_070, +32_992_212, 830_427_376) ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/nat16.drun-run-opt.ok b/test/bench/ok/nat16.drun-run-opt.ok index 9a514a12f0c..05bfd327066 100644 --- a/test/bench/ok/nat16.drun-run-opt.ok +++ b/test/bench/ok/nat16.drun-run-opt.ok @@ -1,4 +1,4 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: (0, 22_021_239) +debug.print: (0, 22_021_107) ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/nat16.drun-run.ok b/test/bench/ok/nat16.drun-run.ok index d1f79396beb..8febef52370 100644 --- a/test/bench/ok/nat16.drun-run.ok +++ b/test/bench/ok/nat16.drun-run.ok @@ -1,4 +1,4 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: (0, 55_575_348) +debug.print: (0, 51_380_880) ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/palindrome.drun-run-opt.ok b/test/bench/ok/palindrome.drun-run-opt.ok index 2c056139002..a1c6781e286 100644 --- a/test/bench/ok/palindrome.drun-run-opt.ok +++ b/test/bench/ok/palindrome.drun-run-opt.ok @@ -1,9 +1,9 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: (true, +1_188, 11_457) -debug.print: (false, +1_188, 10_492) -debug.print: (false, +1_188, 11_437) -debug.print: (true, +868, 11_653) -debug.print: (false, +868, 10_164) -debug.print: (false, +868, 11_604) +debug.print: (true, +1_188, 11_393) +debug.print: (false, +1_188, 10_488) +debug.print: (false, +1_188, 11_373) +debug.print: (true, +868, 11_589) +debug.print: (false, +868, 10_160) +debug.print: (false, +868, 11_540) ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/palindrome.drun-run.ok b/test/bench/ok/palindrome.drun-run.ok index 8f1f788e708..3bbcfef98a7 100644 --- a/test/bench/ok/palindrome.drun-run.ok +++ b/test/bench/ok/palindrome.drun-run.ok @@ -1,9 +1,9 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: (true, +1_188, 12_733) -debug.print: (false, +1_188, 11_722) -debug.print: (false, +1_188, 12_712) -debug.print: (true, +868, 12_841) -debug.print: (false, +868, 11_244) -debug.print: (false, +868, 12_789) +debug.print: (true, +1_188, 12_669) +debug.print: (false, +1_188, 11_718) +debug.print: (false, +1_188, 12_648) +debug.print: (true, +868, 12_777) +debug.print: (false, +868, 11_240) +debug.print: (false, +868, 12_725) ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/region-mem.drun-run.ok b/test/bench/ok/region-mem.drun-run.ok index dabe1697632..b99bc582edf 100644 --- a/test/bench/ok/region-mem.drun-run.ok +++ b/test/bench/ok/region-mem.drun-run.ok @@ -1,4 +1,4 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: {heap_diff = 0; instr_diff = 6_014_632_301} +debug.print: {heap_diff = 0; instr_diff = 5_964_300_649} ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/region0-mem.drun-run.ok b/test/bench/ok/region0-mem.drun-run.ok index 904627d7719..bf527929218 100644 --- a/test/bench/ok/region0-mem.drun-run.ok +++ b/test/bench/ok/region0-mem.drun-run.ok @@ -1,4 +1,4 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: {heap_diff = 0; instr_diff = 6_442_451_309} +debug.print: {heap_diff = 0; instr_diff = 6_392_119_657} ingress Completed: Reply: 0x4449444c0000 diff --git a/test/bench/ok/stable-mem.drun-run.ok b/test/bench/ok/stable-mem.drun-run.ok index 617c5cc11e0..5e3eeec3bce 100644 --- a/test/bench/ok/stable-mem.drun-run.ok +++ b/test/bench/ok/stable-mem.drun-run.ok @@ -1,4 +1,4 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101 ingress Completed: Reply: 0x4449444c0000 -debug.print: {heap_diff = 0; instr_diff = 3_925_868_909} +debug.print: {heap_diff = 0; instr_diff = 3_875_537_257} ingress Completed: Reply: 0x4449444c0000