@@ -88,8 +88,6 @@ module Debug : sig
8888
8989 val create : include_cmis :bool -> bool -> t
9090
91- val fold : t -> (Code.Addr .t -> Instruct .debug_event -> 'a -> 'a ) -> 'a -> 'a
92-
9391 val paths : t -> units :StringSet .t -> StringSet .t
9492end = struct
9593 open Instruct
@@ -315,9 +313,6 @@ end = struct
315313 | [] , [] -> ()
316314 | _ -> assert false
317315
318- let fold t f acc =
319- Int_table. fold (fun k { event; _ } acc -> f k event acc) t.events_by_pc acc
320-
321316 let paths t ~units =
322317 let paths =
323318 Hashtbl. fold
@@ -333,66 +328,56 @@ end
333328module Blocks : sig
334329 type t
335330
336- val analyse : Debug .t -> bytecode -> t
337-
338- val add : t -> int -> t
339-
340- type u
341-
342- val finish_analysis : t -> u
331+ val analyse : bytecode -> t
343332
344- val next : u -> int -> int
333+ val next : t -> int -> int
345334
346- val is_empty : u -> bool
335+ val is_empty : t -> bool
347336end = struct
348- type t = Addr.Set .t
349-
350- type u = int array
337+ type t = int array
351338
352339 let add blocks pc = Addr.Set. add pc blocks
353340
354- let rec scan debug blocks code pc len =
341+ let rec scan blocks code pc len =
355342 if pc < len
356343 then
357344 match (get_instr_exn code pc).kind with
358- | KNullary -> scan debug blocks code (pc + 1 ) len
359- | KUnary -> scan debug blocks code (pc + 2 ) len
360- | KBinary -> scan debug blocks code (pc + 3 ) len
361- | KNullaryCall -> scan debug blocks code (pc + 1 ) len
362- | KUnaryCall -> scan debug blocks code (pc + 2 ) len
363- | KBinaryCall -> scan debug blocks code (pc + 3 ) len
345+ | KNullary -> scan blocks code (pc + 1 ) len
346+ | KUnary -> scan blocks code (pc + 2 ) len
347+ | KBinary -> scan blocks code (pc + 3 ) len
348+ | KNullaryCall -> scan blocks code (pc + 1 ) len
349+ | KUnaryCall -> scan blocks code (pc + 2 ) len
350+ | KBinaryCall -> scan blocks code (pc + 3 ) len
364351 | KJump ->
365352 let offset = gets code (pc + 1 ) in
366353 let blocks = Addr.Set. add (pc + offset + 1 ) blocks in
367- scan debug blocks code (pc + 2 ) len
354+ scan blocks code (pc + 2 ) len
368355 | KCond_jump ->
369356 let offset = gets code (pc + 1 ) in
370357 let blocks = Addr.Set. add (pc + offset + 1 ) blocks in
371- scan debug blocks code (pc + 2 ) len
358+ scan blocks code (pc + 2 ) len
372359 | KCmp_jump ->
373360 let offset = gets code (pc + 2 ) in
374361 let blocks = Addr.Set. add (pc + offset + 2 ) blocks in
375- scan debug blocks code (pc + 3 ) len
362+ scan blocks code (pc + 3 ) len
376363 | KSwitch ->
377364 let sz = getu code (pc + 1 ) in
378365 let blocks = ref blocks in
379366 for i = 0 to (sz land 0xffff ) + (sz lsr 16 ) - 1 do
380367 let offset = gets code (pc + 2 + i) in
381368 blocks := Addr.Set. add (pc + offset + 2 ) ! blocks
382369 done ;
383- scan debug ! blocks code (pc + 2 + (sz land 0xffff ) + (sz lsr 16 )) len
370+ scan ! blocks code (pc + 2 + (sz land 0xffff ) + (sz lsr 16 )) len
384371 | KClosurerec ->
385372 let nfuncs = getu code (pc + 1 ) in
386- scan debug blocks code (pc + nfuncs + 3 ) len
387- | KClosure -> scan debug blocks code (pc + 3 ) len
388- | KStop n -> scan debug blocks code (pc + n + 1 ) len
373+ scan blocks code (pc + nfuncs + 3 ) len
374+ | KClosure -> scan blocks code (pc + 3 ) len
375+ | KStop n -> scan blocks code (pc + n + 1 ) len
389376 | K_will_not_happen -> assert false
390377 else (
391378 assert (pc = len);
392379 blocks)
393380
394- let finish_analysis blocks = Array. of_list (Addr.Set. elements blocks)
395-
396381 (* invariant: a.(i) <= x < a.(j) *)
397382 let rec find a i j x =
398383 assert (i < j);
@@ -406,17 +391,13 @@ end = struct
406391
407392 let is_empty x = Array. length x < = 1
408393
409- let analyse debug_data code =
410- let debug_data =
411- if Debug. enabled debug_data
412- then debug_data
413- else Debug. create ~include_cmis: false false
414- in
394+ let analyse code =
415395 let blocks = Addr.Set. empty in
416396 let len = String. length code / 4 in
417397 let blocks = add blocks 0 in
418398 let blocks = add blocks len in
419- scan debug_data blocks code 0 len
399+ let blocks = scan blocks code 0 len in
400+ Array. of_list (Addr.Set. elements blocks)
420401end
421402
422403(* Parse constants *)
@@ -806,7 +787,7 @@ let method_cache_id = ref 1
806787let clo_offset_3 = if new_closure_repr then 3 else 2
807788
808789type compile_info =
809- { blocks : Blocks .u
790+ { blocks : Blocks .t
810791 ; code : string
811792 ; limit : int
812793 ; debug : Debug .t
@@ -2465,14 +2446,7 @@ type one =
24652446let parse_bytecode code globals debug_data =
24662447 let state = State. initial globals in
24672448 Code.Var. reset () ;
2468- let blocks = Blocks. analyse debug_data code in
2469- let blocks =
2470- (* Disabled. [pc] might not be an appropriate place to split blocks *)
2471- if false && Debug. enabled debug_data
2472- then Debug. fold debug_data (fun pc _ blocks -> Blocks. add blocks pc) blocks
2473- else blocks
2474- in
2475- let blocks' = Blocks. finish_analysis blocks in
2449+ let blocks' = Blocks. analyse code in
24762450 let p =
24772451 if not (Blocks. is_empty blocks')
24782452 then (
0 commit comments