@@ -88,8 +88,6 @@ module Debug : sig
88
88
89
89
val create : include_cmis :bool -> bool -> t
90
90
91
- val fold : t -> (Code.Addr .t -> Instruct .debug_event -> 'a -> 'a ) -> 'a -> 'a
92
-
93
91
val paths : t -> units :StringSet .t -> StringSet .t
94
92
end = struct
95
93
open Instruct
@@ -315,9 +313,6 @@ end = struct
315
313
| [] , [] -> ()
316
314
| _ -> assert false
317
315
318
- let fold t f acc =
319
- Int_table. fold (fun k { event; _ } acc -> f k event acc) t.events_by_pc acc
320
-
321
316
let paths t ~units =
322
317
let paths =
323
318
Hashtbl. fold
@@ -333,66 +328,56 @@ end
333
328
module Blocks : sig
334
329
type t
335
330
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
343
332
344
- val next : u -> int -> int
333
+ val next : t -> int -> int
345
334
346
- val is_empty : u -> bool
335
+ val is_empty : t -> bool
347
336
end = struct
348
- type t = Addr.Set .t
349
-
350
- type u = int array
337
+ type t = int array
351
338
352
339
let add blocks pc = Addr.Set. add pc blocks
353
340
354
- let rec scan debug blocks code pc len =
341
+ let rec scan blocks code pc len =
355
342
if pc < len
356
343
then
357
344
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
364
351
| KJump ->
365
352
let offset = gets code (pc + 1 ) in
366
353
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
368
355
| KCond_jump ->
369
356
let offset = gets code (pc + 1 ) in
370
357
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
372
359
| KCmp_jump ->
373
360
let offset = gets code (pc + 2 ) in
374
361
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
376
363
| KSwitch ->
377
364
let sz = getu code (pc + 1 ) in
378
365
let blocks = ref blocks in
379
366
for i = 0 to (sz land 0xffff ) + (sz lsr 16 ) - 1 do
380
367
let offset = gets code (pc + 2 + i) in
381
368
blocks := Addr.Set. add (pc + offset + 2 ) ! blocks
382
369
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
384
371
| KClosurerec ->
385
372
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
389
376
| K_will_not_happen -> assert false
390
377
else (
391
378
assert (pc = len);
392
379
blocks)
393
380
394
- let finish_analysis blocks = Array. of_list (Addr.Set. elements blocks)
395
-
396
381
(* invariant: a.(i) <= x < a.(j) *)
397
382
let rec find a i j x =
398
383
assert (i < j);
@@ -406,17 +391,13 @@ end = struct
406
391
407
392
let is_empty x = Array. length x < = 1
408
393
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 =
415
395
let blocks = Addr.Set. empty in
416
396
let len = String. length code / 4 in
417
397
let blocks = add blocks 0 in
418
398
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)
420
401
end
421
402
422
403
(* Parse constants *)
@@ -806,7 +787,7 @@ let method_cache_id = ref 1
806
787
let clo_offset_3 = if new_closure_repr then 3 else 2
807
788
808
789
type compile_info =
809
- { blocks : Blocks .u
790
+ { blocks : Blocks .t
810
791
; code : string
811
792
; limit : int
812
793
; debug : Debug .t
@@ -2465,14 +2446,7 @@ type one =
2465
2446
let parse_bytecode code globals debug_data =
2466
2447
let state = State. initial globals in
2467
2448
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
2476
2450
let p =
2477
2451
if not (Blocks. is_empty blocks')
2478
2452
then (
0 commit comments