← Back to branch summary

~ubuntu-branches/debian/sid/ocaml/sid

« back to all changes in this revision

Viewing changes to bytecomp/switch.ml

  • Committer: Bazaar Package Importer
  • Author(s): Stéphane Glondu
  • Date: 2011-04-21 21:35:08 UTC
  • mfrom: (1.1.11 upstream) (12.1.14 sid)
  • Revision ID: james.westby@ubuntu.com-20110421213508-kg34453aqmb0moha
* Fixes related to -output-obj with g++ (in debian/patches):
  - add Declare-primitive-name-table-as-const-char
  - add Avoid-multiple-declarations-in-generated-.c-files-in
  - fix Embed-bytecode-in-C-object-when-using-custom: the closing
    brace for extern "C" { ... } was missing in some cases

Show diffs side-by-side

added added

removed removed

Lines of Context:
bytecomp/switch.ml
20
20
  let r_acts = ref [] in
21
21
  let store act =
22
22
    let rec store_rec i = function
23
 
      | [] -> i,[act] 
 
23
      | [] -> i,[act]
24
24
      | act0::rem ->
25
25
          if same act0 act then raise (Found i)
26
26
          else
256
256
  Array.sub cases i (j-i+1),
257
257
  case_append (Array.sub cases 0 i) (Array.sub cases (j+1) (lcases-(j+1)))
258
258
 
259
 
type kind = Kvalue of int | Kinter of int | Kempty 
 
259
type kind = Kvalue of int | Kinter of int | Kempty
260
260
 
261
261
let pkind chan = function
262
262
  | Kvalue i ->Printf.fprintf chan "V%d" i
281
281
        incr count ;
282
282
        r
283
283
    | (act0,index) :: rem ->
284
 
        if act0 = act then 
 
284
        if act0 = act then
285
285
          index
286
286
        else
287
287
          got_it act rem in
291
291
      Kvalue (got_it act !seen)
292
292
    else
293
293
      Kinter (got_it act !seen) in
294
 
  
 
294
 
295
295
  let rec make_rec i pl =
296
296
    if i < 0 then
297
297
      []
303
303
        Kempty::make_one l h act::make_rec (i-1) l in
304
304
 
305
305
  let l,h,act = cases.(Array.length cases-1) in
306
 
  make_one l h act::make_rec (Array.length cases-2) l 
307
 
                       
 
306
  make_one l h act::make_rec (Array.length cases-2) l
 
307
 
308
308
 
309
309
    let same_act t =
310
310
      let len = Array.length t in
330
330
 
331
331
   This condition is checked by zyva
332
332
*)
333
 
  
 
333
 
334
334
let inter_limit = 1 lsl 16
335
335
 
336
336
let ok_inter = ref false
356
356
              divide top cases in
357
357
      Hashtbl.add t key r ;
358
358
      r
359
 
        
 
359
 
360
360
and divide top cases =
361
361
  let lcases = Array.length cases in
362
362
  let m = lcases/2 in
372
372
  else
373
373
    add_test cm cml ;
374
374
  Sep m,(cm, ci)
375
 
    
 
375
 
376
376
and heuristic top cases =
377
377
  let lcases = Array.length cases in
378
 
  
 
378
 
379
379
  let sep,csep = divide false cases
380
 
      
 
380
 
381
381
  and inter,cinter =
382
382
    if !ok_inter then begin
383
383
      let _,_,act0 = cases.(0)
398
398
      end else
399
399
        Inter (-1,-1),(too_much, too_much)
400
400
    end else
401
 
      Inter (-1,-1),(too_much, too_much) in          
 
401
      Inter (-1,-1),(too_much, too_much) in
402
402
  if less2tests csep cinter then
403
403
    sep,csep
404
404
  else
405
405
    inter,cinter
406
 
      
407
 
      
 
406
 
 
407
 
408
408
and enum top cases =
409
409
  let lcases = Array.length cases in
410
410
  let lim, with_sep =
411
411
    let best = ref (-1) and best_cost = ref (too_much,too_much) in
412
 
    
 
412
 
413
413
    for i = 1 to lcases-(1) do
414
414
      let _,left,right = coupe cases i in
415
415
      let ci = {n=1 ; ni=0}
422
422
        add_test cm cmr
423
423
      else
424
424
        add_test cm cml ;
425
 
      
 
425
 
426
426
      if
427
427
        less2tests (cm,ci) !best_cost
428
428
      then begin
488
488
    r := Sep lim ; rc := with_sep
489
489
  end ;
490
490
  !r, !rc
491
 
    
 
491
 
492
492
    let make_if_test konst test arg i ifso ifnot =
493
493
      Arg.make_if
494
494
        (Arg.make_prim test [arg ; konst i])
495
495
        ifso ifnot
496
 
        
 
496
 
497
497
    let make_if_lt konst arg i  ifso ifnot = match i with
498
498
    | 1 ->
499
499
        make_if_test konst Arg.leint arg 0 ifso ifnot
500
500
    | _ ->
501
501
        make_if_test konst Arg.ltint arg i ifso ifnot
502
 
          
 
502
 
503
503
    and make_if_le konst arg i ifso ifnot = match i with
504
504
    | -1 ->
505
505
        make_if_test konst Arg.ltint arg 0 ifso ifnot
506
506
    | _ ->
507
507
        make_if_test konst Arg.leint arg i ifso ifnot
508
 
          
 
508
 
509
509
    and make_if_gt konst arg i  ifso ifnot = match i with
510
510
    | -1 ->
511
511
        make_if_test konst Arg.geint arg 0 ifso ifnot
512
512
    | _ ->
513
513
        make_if_test konst Arg.gtint arg i ifso ifnot
514
 
          
 
514
 
515
515
    and make_if_ge konst arg i  ifso ifnot = match i with
516
516
    | 1 ->
517
517
        make_if_test konst Arg.gtint arg 0 ifso ifnot
518
518
    | _ ->
519
519
        make_if_test konst Arg.geint arg i ifso ifnot
520
 
          
 
520
 
521
521
    and make_if_eq  konst arg i ifso ifnot =
522
522
      make_if_test konst Arg.eqint arg i ifso ifnot
523
 
        
 
523
 
524
524
    and make_if_ne  konst arg i ifso ifnot =
525
525
      make_if_test konst Arg.neint arg i ifso ifnot
526
 
        
 
526
 
527
527
    let do_make_if_out h arg ifso ifno =
528
528
      Arg.make_if (Arg.make_isout h arg) ifso ifno
529
 
        
 
529
 
530
530
    let make_if_out konst ctx l d mk_ifso mk_ifno = match l with
531
531
    | 0 ->
532
532
        do_make_if_out
538
538
            let ctx = {off= (-l+ctx.off) ; arg=arg} in
539
539
            do_make_if_out
540
540
              (konst d) arg (mk_ifso ctx) (mk_ifno ctx))
541
 
          
 
541
 
542
542
    let do_make_if_in h arg ifso ifno =
543
543
      Arg.make_if (Arg.make_isin h arg) ifso ifno
544
 
        
 
544
 
545
545
    let make_if_in konst ctx l d mk_ifso mk_ifno = match l with
546
546
    | 0 ->
547
547
        do_make_if_in
553
553
            let ctx = {off= (-l+ctx.off) ; arg=arg} in
554
554
            do_make_if_in
555
555
              (konst d) arg (mk_ifso ctx) (mk_ifno ctx))
556
 
          
557
 
          
 
556
 
 
557
 
558
558
    let rec c_test konst ctx ({cases=cases ; actions=actions} as s) =
559
559
      let lcases = Array.length cases in
560
560
      assert(lcases > 0) ;
561
561
      if lcases = 1 then
562
562
        actions.(get_act cases 0) ctx
563
563
      else begin
564
 
        
 
564
 
565
565
        let w,c = opt_count false cases in
566
566
(*
567
567
  Printf.fprintf stderr
624
624
          make_if_ge konst
625
625
             ctx.arg (lim+ctx.off)
626
626
            (c_test konst ctx right) (c_test konst ctx left)
627
 
        
 
627
 
628
628
  end
629
629
 
630
630
 
687
687
        get_min (j-1) + 1 < min_clusters.(i)
688
688
      then begin
689
689
        k.(i) <- j ;
690
 
        min_clusters.(i) <- get_min (j-1) + 1             
 
690
        min_clusters.(i) <- get_min (j-1) + 1
691
691
      end
692
692
    done ;
693
693
  done ;
766
766
      r.(ir) <- (l,h,add_index (make_switch s i j))
767
767
    end ;
768
768
    if i > 0 then zyva (i-1) (ir-1) in
769
 
  
 
769
 
770
770
  zyva (len-1) (n_clusters-1) ;
771
771
  let acts = Array.create !index (fun _ -> assert false) in
772
772
  Hashtbl.iter (fun _ (i,act) -> acts.(i) <- act) t ;
773
773
  {cases = r ; actions = acts}
774
774
;;
775
775
 
776
 
  
777
 
let zyva (low,high) konst arg cases actions = 
 
776
 
 
777
let zyva (low,high) konst arg cases actions =
778
778
  let old_ok = !ok_inter in
779
779
  ok_inter := (abs low <= inter_limit && abs high <= inter_limit) ;
780
780
  if !ok_inter <> old_ok then Hashtbl.clear t ;
793
793
 
794
794
 
795
795
and test_sequence konst arg cases actions =
796
 
  let old_ok = !ok_inter in  
 
796
  let old_ok = !ok_inter in
797
797
  ok_inter := false ;
798
798
  if !ok_inter <> old_ok then Hashtbl.clear t ;
799
799
  let s =