INCLUDE "debug.ml"
INCLUDE "utils.ml"
+INCLUDE "trace.ml"
open Format
open Ata
type opcode =
- | CACHE of unit
- | RETURN of unit
+ | CACHE
+ | RETURN
| LEFT of Translist.t * jump
| RIGHT of Translist.t * jump
| BOTH of Translist.t * jump * jump
type t = opcode Cache.Lvl2.t
-let dummy = CACHE()
+
+let dummy = CACHE
let print_opcode fmt o = match o with
- | CACHE _ -> fprintf fmt "CACHE()"
- | RETURN _ -> fprintf fmt "RETURN ()"
+ | CACHE -> fprintf fmt "CACHE"
+ | RETURN -> fprintf fmt "RETURN"
| LEFT (tl, j) -> fprintf fmt "LEFT(\n[%a], %a)" Translist.print tl print_jump j
| RIGHT (tl, j) -> fprintf fmt "RIGHT(\n[%a], %a)" Translist.print tl print_jump j
| BOTH (tl, j1, j2) -> fprintf fmt "BOTH(\n[%a], %a, %a)" Translist.print tl print_jump j1 print_jump j2
-
+(*
let print_cache fmt d =
let c = Cache.Lvl2.to_array d in
Array.iteri begin fun tag a ->
fprintf fmt "---------------------------\n%!"
end
end c
-
-let create () = Cache.Lvl2.create 1024 dummy
-
+*)
+let create () = Cache.Lvl2.create 4096 dummy
+(*
let stats fmt c =
let d = Cache.Lvl2.to_array c in
let len = Array.fold_left (fun acc a -> Array.length a + acc) 0 d in
len lvl1 lvl2 (Ocaml.size_kb d);
fprintf fmt "%s" "L2JIT Content:\n";
print_cache fmt c
+*)
-let find t tag set = Cache.Lvl2.find t tag (Uid.to_int set.StateSet.Node.id)
+let find t tag set = Cache.Lvl2.find t (Uid.to_int set.StateSet.Node.id) tag
-let add t tag set v = Cache.Lvl2.add t tag (Uid.to_int set.StateSet.Node.id) v
+let add t tag set v = Cache.Lvl2.add t (Uid.to_int set.StateSet.Node.id) tag v
let collect_trans tag ((a_t, a_s1, a_s2) as acc) (labels, tr) =
if TagSet.mem tag labels
let labels = Ptset.Int.inter l_one t in
let c = Ptset.Int.cardinal labels in
if c == 0 then _nop
- else if Ptset.Int.for_all (fun lab -> not (Ptset.Int.mem lab l_many)) labels
- then translate_jump tree tag (JUMP_MANY(labels)) dir s
+ else if Ptset.Int.for_all (fun lab -> not (Ptset.Int.mem lab l_many)) labels then
+ translate_jump tree tag (JUMP_MANY(labels)) dir s
else if c == 1 then tagged_one s (Ptset.Int.choose labels)
else if c > 5 then if has_text labels then any s else any_notext s
else select_one s labels
| _ -> assert false
let compute_jump auto tree tag states dir =
- (*PROF_CFUN("L2JIT.compute_jump"); *)
if !Options.no_jump then
if dir == DIR_LEFT then FIRST_CHILD states
else NEXT_SIBLING states
else
let jkind = Ata.top_down_approx auto states tree in
let jump = translate_jump tree tag jkind dir states in
- D_TRACE_(eprintf "Computed jumps for %s %a %s: %a\n%!"
- (Tag.to_string tag)
- StateSet.print states
- (if dir == DIR_LEFT then "left" else "right")
- print_jump jump);
- jump
+ TRACE("level2-jit", 2,
+ __ "Computed jumps for %s %a %s: %a\n%!"
+ (Tag.to_string tag)
+ StateSet.print states
+ (if dir == DIR_LEFT then "left" else "right")
+ print_jump jump
+ );
+ jump
let compile cache2 auto tree tag states =
- (*PROF_CFUN("L2JIT.compile"); *)
let tr_list, states1, states2 =
StateSet.fold
(fun q acc ->
let op =
let empty_s1 = StateSet.is_empty states1 in
let empty_s2 = StateSet.is_empty states2 in
- if empty_s1 && empty_s2 then RETURN ()
+ if empty_s1 && empty_s2 then RETURN
else if empty_s1 then
RIGHT (tr_list,
compute_jump auto tree tag states2 DIR_RIGHT)
LEFT (tr_list,
compute_jump auto tree tag states1 DIR_LEFT)
else
- BOTH (tr_list,
- compute_jump auto tree tag states1 DIR_LEFT,
- compute_jump auto tree tag states2 DIR_RIGHT)
+ let j1 = compute_jump auto tree tag states1 DIR_LEFT in
+ let j2 = compute_jump auto tree tag states2 DIR_RIGHT in
+ BOTH (tr_list, j1, j2);
in
let op = match op with
(*BOTH(_, NOP _, NOP _) | LEFT(_, NOP _) | RIGHT(_, NOP _) -> RETURN() *)
op
let get_transitions = function
- | CACHE _ | RETURN _ -> failwith "get_transitions"
+ | CACHE | RETURN -> failwith "get_transitions"
| LEFT (tr, _)
| RIGHT (tr, _)
| BOTH (tr, _, _) -> tr