diff --git a/CHANGES.md b/CHANGES.md index cb0a415455..0e39ba7f9e 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -9,8 +9,6 @@ * Compiler: improved global dead code elimination (#2206) * Compiler: speedup json parsing, relying on Yojson.Raw (#1640) * Compiler: Decode sourcemap mappings only when necessary (#1664) -* Compiler: make indirect call using sequence instead of using the call method - [f.call(null, args)] becomes [(0,f)(args)] * Compiler: mark [TextEncoder] as reserved * Compiler: add support for the Wasm backend in parts of the pipeline, in prevision for the merge of wasm_of_ocaml diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml index dbf0577505..7784206d67 100644 --- a/compiler/lib/generate.ml +++ b/compiler/lib/generate.ml @@ -898,7 +898,8 @@ let apply_fun_raw ctx f params exact trampolined loc = (* Make sure we are performing a regular call, not a (slower) method call *) match f with - | J.EAccess _ | J.EDot _ -> J.call (J.ESeq (int 0, f)) params loc + | J.EAccess _ | J.EDot _ -> + J.call (J.dot f (Utf8_string.of_string_exn "call")) (s_var "null" :: params) loc | _ -> J.call f params loc in let apply = diff --git a/compiler/lib/parse_bytecode.ml b/compiler/lib/parse_bytecode.ml index b3fbc6c1b5..667f62c5c5 100644 --- a/compiler/lib/parse_bytecode.ml +++ b/compiler/lib/parse_bytecode.ml @@ -88,8 +88,6 @@ module Debug : sig val create : include_cmis:bool -> bool -> t - val fold : t -> (Code.Addr.t -> Instruct.debug_event -> 'a -> 'a) -> 'a -> 'a - val paths : t -> units:StringSet.t -> StringSet.t end = struct open Instruct @@ -315,9 +313,6 @@ end = struct | [], [] -> () | _ -> assert false - let fold t f acc = - Int_table.fold (fun k { event; _ } acc -> f k event acc) t.events_by_pc acc - let paths t ~units = let paths = Hashtbl.fold @@ -333,46 +328,38 @@ end module Blocks : sig type t - val analyse : Debug.t -> bytecode -> t - - val add : t -> int -> t - - type u - - val finish_analysis : t -> u + val analyse : bytecode -> t - val next : u -> int -> int + val next : t -> int -> int - val is_empty : u -> bool + val is_empty : t -> bool end = struct - type t = Addr.Set.t - - type u = int array + type t = int array let add blocks pc = Addr.Set.add pc blocks - let rec scan debug blocks code pc len = + let rec scan blocks code pc len = if pc < len then match (get_instr_exn code pc).kind with - | KNullary -> scan debug blocks code (pc + 1) len - | KUnary -> scan debug blocks code (pc + 2) len - | KBinary -> scan debug blocks code (pc + 3) len - | KNullaryCall -> scan debug blocks code (pc + 1) len - | KUnaryCall -> scan debug blocks code (pc + 2) len - | KBinaryCall -> scan debug blocks code (pc + 3) len + | KNullary -> scan blocks code (pc + 1) len + | KUnary -> scan blocks code (pc + 2) len + | KBinary -> scan blocks code (pc + 3) len + | KNullaryCall -> scan blocks code (pc + 1) len + | KUnaryCall -> scan blocks code (pc + 2) len + | KBinaryCall -> scan blocks code (pc + 3) len | KJump -> let offset = gets code (pc + 1) in let blocks = Addr.Set.add (pc + offset + 1) blocks in - scan debug blocks code (pc + 2) len + scan blocks code (pc + 2) len | KCond_jump -> let offset = gets code (pc + 1) in let blocks = Addr.Set.add (pc + offset + 1) blocks in - scan debug blocks code (pc + 2) len + scan blocks code (pc + 2) len | KCmp_jump -> let offset = gets code (pc + 2) in let blocks = Addr.Set.add (pc + offset + 2) blocks in - scan debug blocks code (pc + 3) len + scan blocks code (pc + 3) len | KSwitch -> let sz = getu code (pc + 1) in let blocks = ref blocks in @@ -380,19 +367,17 @@ end = struct let offset = gets code (pc + 2 + i) in blocks := Addr.Set.add (pc + offset + 2) !blocks done; - scan debug !blocks code (pc + 2 + (sz land 0xffff) + (sz lsr 16)) len + scan !blocks code (pc + 2 + (sz land 0xffff) + (sz lsr 16)) len | KClosurerec -> let nfuncs = getu code (pc + 1) in - scan debug blocks code (pc + nfuncs + 3) len - | KClosure -> scan debug blocks code (pc + 3) len - | KStop n -> scan debug blocks code (pc + n + 1) len + scan blocks code (pc + nfuncs + 3) len + | KClosure -> scan blocks code (pc + 3) len + | KStop n -> scan blocks code (pc + n + 1) len | K_will_not_happen -> assert false else ( assert (pc = len); blocks) - let finish_analysis blocks = Array.of_list (Addr.Set.elements blocks) - (* invariant: a.(i) <= x < a.(j) *) let rec find a i j x = assert (i < j); @@ -406,17 +391,13 @@ end = struct let is_empty x = Array.length x <= 1 - let analyse debug_data code = - let debug_data = - if Debug.enabled debug_data - then debug_data - else Debug.create ~include_cmis:false false - in + let analyse code = let blocks = Addr.Set.empty in let len = String.length code / 4 in let blocks = add blocks 0 in let blocks = add blocks len in - scan debug_data blocks code 0 len + let blocks = scan blocks code 0 len in + Array.of_list (Addr.Set.elements blocks) end (* Parse constants *) @@ -806,7 +787,7 @@ let method_cache_id = ref 1 let clo_offset_3 = if new_closure_repr then 3 else 2 type compile_info = - { blocks : Blocks.u + { blocks : Blocks.t ; code : string ; limit : int ; debug : Debug.t @@ -1865,7 +1846,7 @@ and compile infos pc state (instrs : instr list) = if debug_parser () then ( - Format.printf "%a = ccal \"%s\" (" Var.print x prim; + Format.printf "%a = ccall \"%s\" (" Var.print x prim; for i = 0 to nargs - 1 do if i > 0 then Format.printf ", "; Format.printf "%a" Var.print (List.nth args i) @@ -1885,7 +1866,7 @@ and compile infos pc state (instrs : instr list) = if debug_parser () then ( - Format.printf "%a = ccal \"%s\" (" Var.print x prim; + Format.printf "%a = ccall \"%s\" (" Var.print x prim; for i = 0 to nargs - 1 do if i > 0 then Format.printf ", "; Format.printf "%a" Var.print (List.nth args i) @@ -1905,7 +1886,7 @@ and compile infos pc state (instrs : instr list) = if debug_parser () then ( - Format.printf "%a = ccal \"%s\" (" Var.print x prim; + Format.printf "%a = ccall \"%s\" (" Var.print x prim; for i = 0 to nargs - 1 do if i > 0 then Format.printf ", "; Format.printf "%a" Var.print (List.nth args i) @@ -2465,14 +2446,7 @@ type one = let parse_bytecode code globals debug_data = let state = State.initial globals in Code.Var.reset (); - let blocks = Blocks.analyse debug_data code in - let blocks = - (* Disabled. [pc] might not be an appropriate place to split blocks *) - if false && Debug.enabled debug_data - then Debug.fold debug_data (fun pc _ blocks -> Blocks.add blocks pc) blocks - else blocks - in - let blocks' = Blocks.finish_analysis blocks in + let blocks' = Blocks.analyse code in let p = if not (Blocks.is_empty blocks') then ( diff --git a/compiler/tests-compiler/direct_calls.ml b/compiler/tests-compiler/direct_calls.ml index eac493b749..e458e83918 100644 --- a/compiler/tests-compiler/direct_calls.ml +++ b/compiler/tests-compiler/direct_calls.ml @@ -84,8 +84,8 @@ let%expect_test "direct calls without --enable effects" = //end function test3(x){ function F(symbol){function f(x){return x + 1 | 0;} return [0, f];} - var M1 = F([0]), M2 = F([0]), _b_ = (0, M2[1])(2); - return [0, (0, M1[1])(1), _b_]; + var M1 = F([0]), M2 = F([0]), _b_ = M2[1].call(null, 2); + return [0, M1[1].call(null, 1), _b_]; } //end function test4(x){ @@ -94,11 +94,10 @@ let%expect_test "direct calls without --enable effects" = return [0, f]; } var M1 = F([0]), M2 = F([0]); - (0, M1[1])(1); - return (0, M2[1])(2); + M1[1].call(null, 1); + return M2[1].call(null, 2); } - //end - |}] + //end |}] let%expect_test "direct calls with --enable effects" = let code = @@ -179,8 +178,8 @@ let%expect_test "direct calls with --enable effects" = //end function test3(x, cont){ function F(symbol){function f(x){return x + 1 | 0;} return [0, f];} - var M1 = F(), M2 = F(), _c_ = (0, M2[1])(2); - return cont([0, (0, M1[1])(1), _c_]); + var M1 = F(), M2 = F(), _c_ = M2[1].call(null, 2); + return cont([0, M1[1].call(null, 1), _c_]); } //end function test4(x, cont){