+breakpoints.cmi: ../bytecomp/instruct.cmi primitives.cmi

+checkpoints.cmi: debugcom.cmi primitives.cmi

+debugcom.cmi: primitives.cmi

+envaux.cmi: ../typing/env.cmi

+eval.cmi: debugcom.cmi ../bytecomp/instruct.cmi ../typing/path.cmi

+events.cmi: ../bytecomp/instruct.cmi

+frames.cmi: ../bytecomp/instruct.cmi primitives.cmi

+input_handling.cmi: primitives.cmi

+parser.cmi: parser_aux.cmi

+parser_aux.cmi: primitives.cmi

+pattern_matching.cmi: debugcom.cmi parser_aux.cmi ../typing/typedtree.cmi

+primitives.cmi: ../otherlibs/unix/unix.cmi

+printval.cmi: debugcom.cmi ../typing/env.cmi ../typing/types.cmi

+program_loading.cmi: primitives.cmi

+show_information.cmi: ../bytecomp/instruct.cmi

+symbols.cmi: ../bytecomp/instruct.cmi

+time_travel.cmi: primitives.cmi

+unix_tools.cmi: ../otherlibs/unix/unix.cmi

+breakpoints.cmo: checkpoints.cmi debugcom.cmi exec.cmi \

+ ../bytecomp/instruct.cmi primitives.cmi source.cmi breakpoints.cmi

+breakpoints.cmx: checkpoints.cmx debugcom.cmx exec.cmx \

+ ../bytecomp/instruct.cmx primitives.cmx source.cmx breakpoints.cmi

+checkpoints.cmo: debugcom.cmi primitives.cmi checkpoints.cmi

+checkpoints.cmx: debugcom.cmx primitives.cmx checkpoints.cmi

+command_line_interpreter.cmo: breakpoints.cmi checkpoints.cmi \

+ ../utils/config.cmi ../typing/ctype.cmi debugcom.cmi debugger_config.cmi \

+ ../typing/env.cmi envaux.cmi eval.cmi events.cmi frames.cmi history.cmi \

+ input_handling.cmi ../bytecomp/instruct.cmi ../parsing/lexer.cmi \

+ ../parsing/longident.cmi ../utils/misc.cmi parameters.cmi parser.cmi \

+ parser_aux.cmi primitives.cmi ../typing/printtyp.cmi printval.cmi \

+ program_loading.cmi program_management.cmi show_information.cmi \

+ show_source.cmi source.cmi symbols.cmi time_travel.cmi \

+ ../typing/types.cmi ../otherlibs/unix/unix.cmi unix_tools.cmi \

+ command_line_interpreter.cmi

+command_line_interpreter.cmx: breakpoints.cmx checkpoints.cmx \

+ ../utils/config.cmx ../typing/ctype.cmx debugcom.cmx debugger_config.cmx \

+ ../typing/env.cmx envaux.cmx eval.cmx events.cmx frames.cmx history.cmx \

+ input_handling.cmx ../bytecomp/instruct.cmx ../parsing/lexer.cmx \

+ ../parsing/longident.cmx ../utils/misc.cmx parameters.cmx parser.cmx \

+ parser_aux.cmi primitives.cmx ../typing/printtyp.cmx printval.cmx \

+ program_loading.cmx program_management.cmx show_information.cmx \

+ show_source.cmx source.cmx symbols.cmx time_travel.cmx \

+ ../typing/types.cmx ../otherlibs/unix/unix.cmx unix_tools.cmx \

+ command_line_interpreter.cmi

+debugcom.cmo: ../utils/misc.cmi primitives.cmi debugcom.cmi

+debugcom.cmx: ../utils/misc.cmx primitives.cmx debugcom.cmi

+debugger_config.cmo: debugger_config.cmi

+debugger_config.cmx: debugger_config.cmi

+envaux.cmo: ../typing/env.cmi ../utils/misc.cmi ../typing/mtype.cmi \

+ ../typing/types.cmi envaux.cmi

+envaux.cmx: ../typing/env.cmx ../utils/misc.cmx ../typing/mtype.cmx \

+ ../typing/types.cmx envaux.cmi

+eval.cmo: debugcom.cmi debugger_config.cmi ../typing/ident.cmi \

+ ../bytecomp/instruct.cmi ../utils/misc.cmi ../typing/path.cmi \

+ ../typing/printtyp.cmi ../bytecomp/symtable.cmi eval.cmi

+eval.cmx: debugcom.cmx debugger_config.cmx ../typing/ident.cmx \

+ ../bytecomp/instruct.cmx ../utils/misc.cmx ../typing/path.cmx \

+ ../typing/printtyp.cmx ../bytecomp/symtable.cmx eval.cmi

+events.cmo: checkpoints.cmi ../bytecomp/instruct.cmi primitives.cmi \

+ symbols.cmi events.cmi

+events.cmx: checkpoints.cmx ../bytecomp/instruct.cmx primitives.cmx \

+ symbols.cmx events.cmi

+exec.cmo: exec.cmi

+exec.cmx: exec.cmi

+frames.cmo: checkpoints.cmi debugcom.cmi events.cmi ../bytecomp/instruct.cmi \

+ ../utils/misc.cmi primitives.cmi symbols.cmi frames.cmi

+frames.cmx: checkpoints.cmx debugcom.cmx events.cmx ../bytecomp/instruct.cmx \

+ ../utils/misc.cmx primitives.cmx symbols.cmx frames.cmi

+history.cmo: checkpoints.cmi debugger_config.cmi ../utils/misc.cmi \

+ primitives.cmi history.cmi

+history.cmx: checkpoints.cmx debugger_config.cmx ../utils/misc.cmx \

+ primitives.cmx history.cmi

+input_handling.cmo: ../parsing/lexer.cmi primitives.cmi \

+ ../otherlibs/unix/unix.cmi input_handling.cmi

+input_handling.cmx: ../parsing/lexer.cmx primitives.cmx \

+ ../otherlibs/unix/unix.cmx input_handling.cmi

+lexer.cmo: parser.cmi primitives.cmi

+lexer.cmx: parser.cmx primitives.cmx

+main.cmo: checkpoints.cmi command_line_interpreter.cmi ../utils/config.cmi \

+ debugger_config.cmi exec.cmi frames.cmi input_handling.cmi \

+ ../utils/misc.cmi parameters.cmi primitives.cmi program_management.cmi \

+ show_information.cmi time_travel.cmi ../otherlibs/unix/unix.cmi

+main.cmx: checkpoints.cmx command_line_interpreter.cmx ../utils/config.cmx \

+ debugger_config.cmx exec.cmx frames.cmx input_handling.cmx \

+ ../utils/misc.cmx parameters.cmx primitives.cmx program_management.cmx \

+ show_information.cmx time_travel.cmx ../otherlibs/unix/unix.cmx

+parameters.cmo: ../utils/config.cmi envaux.cmi ../utils/misc.cmi \

+ primitives.cmi parameters.cmi

+parameters.cmx: ../utils/config.cmx envaux.cmx ../utils/misc.cmx \

+ primitives.cmx parameters.cmi

+parser.cmo: input_handling.cmi parser_aux.cmi primitives.cmi parser.cmi

+parser.cmx: input_handling.cmx parser_aux.cmi primitives.cmx parser.cmi

+pattern_matching.cmo: ../typing/ctype.cmi debugcom.cmi debugger_config.cmi \

+ ../utils/misc.cmi parser_aux.cmi ../typing/typedtree.cmi \

+ pattern_matching.cmi

+pattern_matching.cmx: ../typing/ctype.cmx debugcom.cmx debugger_config.cmx \

+ ../utils/misc.cmx parser_aux.cmi ../typing/typedtree.cmx \

+ pattern_matching.cmi

+primitives.cmo: ../otherlibs/unix/unix.cmi primitives.cmi

+primitives.cmx: ../otherlibs/unix/unix.cmx primitives.cmi

+printval.cmo: ../typing/ctype.cmi debugcom.cmi ../typing/env.cmi \

+ ../typing/ident.cmi ../parsing/longident.cmi ../utils/misc.cmi \

+ ../typing/path.cmi ../typing/predef.cmi ../typing/printtyp.cmi \

+ ../typing/types.cmi printval.cmi

+printval.cmx: ../typing/ctype.cmx debugcom.cmx ../typing/env.cmx \

+ ../typing/ident.cmx ../parsing/longident.cmx ../utils/misc.cmx \

+ ../typing/path.cmx ../typing/predef.cmx ../typing/printtyp.cmx \

+ ../typing/types.cmx printval.cmi

+program_loading.cmo: debugger_config.cmi input_handling.cmi ../utils/misc.cmi \

+ parameters.cmi primitives.cmi ../otherlibs/unix/unix.cmi unix_tools.cmi \

+ program_loading.cmi

+program_loading.cmx: debugger_config.cmx input_handling.cmx ../utils/misc.cmx \

+ parameters.cmx primitives.cmx ../otherlibs/unix/unix.cmx unix_tools.cmx \

+ program_loading.cmi

+program_management.cmo: debugcom.cmi debugger_config.cmi history.cmi \

+ input_handling.cmi ../bytecomp/instruct.cmi ../utils/misc.cmi \

+ parameters.cmi primitives.cmi program_loading.cmi symbols.cmi \

+ time_travel.cmi ../otherlibs/unix/unix.cmi unix_tools.cmi \

+ program_management.cmi

+program_management.cmx: debugcom.cmx debugger_config.cmx history.cmx \

+ input_handling.cmx ../bytecomp/instruct.cmx ../utils/misc.cmx \

+ parameters.cmx primitives.cmx program_loading.cmx symbols.cmx \

+ time_travel.cmx ../otherlibs/unix/unix.cmx unix_tools.cmx \

+ program_management.cmi

+show_information.cmo: breakpoints.cmi checkpoints.cmi debugcom.cmi events.cmi \

+ frames.cmi ../bytecomp/instruct.cmi ../utils/misc.cmi primitives.cmi \

+ show_source.cmi symbols.cmi show_information.cmi

+show_information.cmx: breakpoints.cmx checkpoints.cmx debugcom.cmx events.cmx \

+ frames.cmx ../bytecomp/instruct.cmx ../utils/misc.cmx primitives.cmx \

+ show_source.cmx symbols.cmx show_information.cmi

+show_source.cmo: debugger_config.cmi ../utils/misc.cmi parameters.cmi \

+ primitives.cmi source.cmi show_source.cmi

+show_source.cmx: debugger_config.cmx ../utils/misc.cmx parameters.cmx \

+ primitives.cmx source.cmx show_source.cmi

+source.cmo: ../utils/config.cmi ../utils/misc.cmi primitives.cmi source.cmi

+source.cmx: ../utils/config.cmx ../utils/misc.cmx primitives.cmx source.cmi

+symbols.cmo: ../utils/config.cmi debugcom.cmi debugger_config.cmi \

+ ../bytecomp/instruct.cmi ../bytecomp/symtable.cmi symbols.cmi

+symbols.cmx: ../utils/config.cmx debugcom.cmx debugger_config.cmx \

+ ../bytecomp/instruct.cmx ../bytecomp/symtable.cmx symbols.cmi

+test3.cmo: ../otherlibs/unix/unix.cmi

+test3.cmx: ../otherlibs/unix/unix.cmx

+test9.cmo: ../otherlibs/unix/unix.cmi

+test9.cmx: ../otherlibs/unix/unix.cmx

+time_travel.cmo: breakpoints.cmi checkpoints.cmi debugcom.cmi \

+ debugger_config.cmi events.cmi exec.cmi input_handling.cmi \

+ ../bytecomp/instruct.cmi primitives.cmi program_loading.cmi \

+ trap_barrier.cmi time_travel.cmi

+time_travel.cmx: breakpoints.cmx checkpoints.cmx debugcom.cmx \

+ debugger_config.cmx events.cmx exec.cmx input_handling.cmx \

+ ../bytecomp/instruct.cmx primitives.cmx program_loading.cmx \

+ trap_barrier.cmx time_travel.cmi

+trap_barrier.cmo: checkpoints.cmi debugcom.cmi exec.cmi trap_barrier.cmi

+trap_barrier.cmx: checkpoints.cmx debugcom.cmx exec.cmx trap_barrier.cmi

+unix_tools.cmo: ../utils/misc.cmi primitives.cmi ../otherlibs/unix/unix.cmi \

+ unix_tools.cmi

+unix_tools.cmx: ../utils/misc.cmx primitives.cmx ../otherlibs/unix/unix.cmx \

+ unix_tools.cmi

+CAMLC=../boot/ocamlrun ../boot/ocamlc -I ../boot

+COMPFLAGS=$(INCLUDES)

+LINKFLAGS=-custom

+CAMLYACC=../boot/ocamlyacc

+YACCFLAGS=

+CAMLLEX=../boot/ocamlrun ../boot/ocamllex

+CAMLDEP=../boot/ocamlrun ../tools/ocamldep

+DEPFLAGS=$(INCLUDES)

+

+INCLUDES=-I ../otherlibs/unix -I ../utils -I ../parsing -I ../typing -I ../bytecomp

+

+OTHEROBJS=\

+ ../otherlibs/unix/unix.cma \

+ ../utils/misc.cmo ../utils/config.cmo \

+ ../utils/tbl.cmo ../utils/clflags.cmo \

+ ../parsing/longident.cmo \

+ ../typing/ident.cmo ../typing/path.cmo ../typing/types.cmo \

+ ../typing/primitive.cmo ../typing/typedtree.cmo \

+ ../typing/subst.cmo ../typing/predef.cmo \

+ ../typing/datarepr.cmo ../typing/env.cmo \

+ ../typing/ctype.cmo ../typing/printtyp.cmo ../typing/mtype.cmo \

+ ../bytecomp/runtimedef.cmo ../bytecomp/symtable.cmo

+

+OBJS=\

+ primitives.cmo \

+ unix_tools.cmo \

+ debugger_config.cmo \

+ envaux.cmo \

+ parameters.cmo \

+ lexer.cmo \

+ debugcom.cmo \

+ exec.cmo \

+ input_handling.cmo \

+ source.cmo \

+ checkpoints.cmo \

+ symbols.cmo \

+ events.cmo \

+ breakpoints.cmo \

+ trap_barrier.cmo \

+ history.cmo \

+ program_loading.cmo \

+ eval.cmo \

+ printval.cmo \

+ show_source.cmo \

+ time_travel.cmo \

+ program_management.cmo \

+ frames.cmo \

+ show_information.cmo \

+ parser.cmo \

+ command_line_interpreter.cmo \

+ main.cmo

+# debugger.cmo

+

+xOBJS=\

+ debugcom.cmo \

+ symbols.cmo \

+ envaux.cmo \

+ eval.cmo \

+ printval.cmo \

+ source.cmo \

+ show_source.cmo \

+ debugger.cmo

+

+all: ocamldebug

+

+ocamldebug: $(OBJS)

+ $(CAMLC) $(LINKFLAGS) -o ocamldebug $(OTHEROBJS) $(OBJS) ../otherlibs/unix/libunix.a

+

+clean::

+ rm -f ocamldebug

+ rm -f *.cmo *.cmi

+ rm -f lexer.ml parser.ml parser.mli

+

+.SUFFIXES:

+.SUFFIXES: .ml .cmo .mli .cmi

+

+.ml.cmo:

+ $(CAMLC) -c $(COMPFLAGS) $<

+

+.mli.cmi:

+ $(CAMLC) -c $(COMPFLAGS) $<

+

+depend: lexer.ml parser.ml parser.mli

+ $(CAMLDEP) $(DEPFLAGS) *.mli *.ml > .depend

+

+lexer.ml: lexer.mll

+ $(CAMLLEX) lexer.mll

+

+parser.ml parser.mli: parser.mly

+ $(CAMLYACC) parser.mly

+

+sharfile: Makefile *.ml *.mli *.mll *.mly

+ shar -o $@ $^

+

+include .depend

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(******************************* Breakpoints ***************************)

+

+open Instruct

+open Primitives

+open Debugcom

+open Checkpoints

+open Source

+

+(*** Debugging. ***)

+let debug_breakpoints = ref true

+

+(*** Data. ***)

+

+(* Number of the last added breakpoint. *)

+let breakpoint_number = ref 0

+

+(* Breakpoint number -> event. *)

+let breakpoints = ref ([] : (int * debug_event) list)

+

+(* Program counter -> breakpoint count. *)

+let positions = ref ([] : (int * int ref) list)

+

+(* Versions of the breakpoint list. *)

+let current_version = ref 0

+let max_version = ref 0

+

+(*** Miscellaneous. ***)

+

+(* Mark breakpoints as installed in current checkpoint. *)

+let copy_breakpoints () =

+ !current_checkpoint.c_breakpoints <- !positions;

+ !current_checkpoint.c_breakpoint_version <- !current_version

+

+(* Announce a new version of the breakpoint list. *)

+let new_version () =

+ incr max_version;

+ current_version := !max_version;

+ copy_breakpoints ()

+

+(*** Information about breakpoints. ***)

+

+let breakpoints_count () =

+ List.length !breakpoints

+

+(* Is there a breakpoint at `pc' ? *)

+let breakpoint_at_pc pc =

+ List.mem_assoc pc !positions

+

+(* List of breakpoints at `pc'. *)

+let breakpoints_at_pc pc =

+ List.map fst (filter (function (_, {ev_pos = pos}) -> pos = pc) !breakpoints)

+

+(*** Set and remove breakpoints ***)

+

+(* Remove all breakpoints. *)

+let remove_breakpoints pos =

+ if !debug_breakpoints then

+ (print_string "Removing breakpoints..."; print_newline ());

+ List.iter

+ (function (pos, _) ->

+ if !debug_breakpoints then begin

+ print_int pos;

+ print_newline()

+ end;

+ reset_instr pos)

+ pos

+

+(* Set all breakpoints. *)

+let set_breakpoints pos =

+ if !debug_breakpoints then

+ (print_string "Setting breakpoints..."; print_newline ());

+ List.iter

+ (function (pos, _) ->

+ if !debug_breakpoints then begin

+ print_int pos;

+ print_newline()

+ end;

+ set_breakpoint pos)

+ pos

+

+(* Ensure the current version in installed in current checkpoint. *)

+let update_breakpoints () =

+ if !current_checkpoint.c_breakpoint_version <> !current_version then

+ Exec.protected

+ (function () ->

+ remove_breakpoints !current_checkpoint.c_breakpoints;

+ set_breakpoints !positions;

+ copy_breakpoints ())

+

+let change_version version pos =

+ Exec.protected

+ (function () ->

+ current_version := version;

+ positions := pos)

+

+(* Execute given function with no breakpoint in current checkpoint. *)

+(* --- `goto' runs faster this way (does not stop on each breakpoint). *)

+let execute_without_breakpoints f =

+ let version = !current_version

+ and pos = !positions

+ in

+ change_version 0 [];

+ try

+ f ();

+ change_version version pos

+ with

+ x ->

+ change_version version pos

+

+(* Add a position in the position list. *)

+(* Change version if necessary. *)

+let insert_position pos =

+ try

+ incr (List.assoc pos !positions)

+ with

+ Not_found ->

+ set_breakpoint pos;

+ positions := (pos, ref 1) :: !positions;

+ new_version ()

+

+(* Remove a position in the position list. *)

+(* Change version if necessary. *)

+let remove_position pos =

+ let count = List.assoc pos !positions in

+ decr count;

+ if !count = 0 then begin

+ positions := assoc_remove !positions pos;

+ new_version ();

+ reset_instr pos;

+ ()

+ end

+

+(* Insert a new breakpoint in lists. *)

+let new_breakpoint event =

+ Exec.protected

+ (function () ->

+ incr breakpoint_number;

+ insert_position event.ev_pos;

+ breakpoints := (!breakpoint_number, event) :: !breakpoints);

+ print_string "Breakpoint ";

+ print_int !breakpoint_number;

+ print_string " at ";

+ print_int event.ev_pos;

+ print_string " : file ";

+ print_string event.ev_file;

+ print_string ".ml, line ";

+ (let (start, line) = line_of_pos (get_buffer event.ev_file) event.ev_char in

+ print_int line;

+ print_string " column ";

+ print_int (event.ev_char - start + 1));

+ print_newline ()

+

+(* Remove a breakpoint from lists. *)

+let remove_breakpoint number =

+ try

+ let pos = (List.assoc number !breakpoints).ev_pos in

+ Exec.protected

+ (function () ->

+ breakpoints := assoc_remove !breakpoints number;

+ remove_position pos)

+ with

+ Not_found ->

+ prerr_endline ("No breakpoint number " ^ (string_of_int number) ^ ".");

+ raise Not_found

+

+let remove_all_breakpoints () =

+ List.iter (function (number, _) -> remove_breakpoint number) !breakpoints

+

+(*** Temporary breakpoints. ***)

+

+(* Temporary breakpoint position. *)

+let temporary_breakpoint_position = ref (None : int option)

+

+(* Execute `funct' with a breakpoint added at `pc'. *)

+(* --- Used by `finish'. *)

+let exec_with_temporary_breakpoint pc funct =

+ let previous_version = !current_version in

+ let remove () =

+ temporary_breakpoint_position := None;

+ current_version := previous_version;

+ let count = List.assoc pc !positions in

+ decr count;

+ if !count = 0 then begin

+ positions := assoc_remove !positions pc;

+ reset_instr pc;

+ ()

+ end

+

+ in

+ Exec.protected (function () -> insert_position pc);

+ temporary_breakpoint_position := Some pc;

+ try

+ funct ();

+ Exec.protected remove

+ with

+ x ->

+ Exec.protected remove;

+ raise x

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(******************************* Breakpoints ***************************)

+

+open Primitives

+open Instruct

+

+(*** Debugging. ***)

+val debug_breakpoints : bool ref

+

+(*** Information about breakpoints. ***)

+

+val breakpoints_count : unit -> int

+

+(* Breakpoint number -> debug_event_kind. *)

+val breakpoints : (int * debug_event) list ref

+

+(* Is there a breakpoint at `pc' ? *)

+val breakpoint_at_pc : int -> bool

+

+(* List of breakpoints at `pc'. *)

+val breakpoints_at_pc : int -> int list

+

+(*** Set and remove breakpoints ***)

+

+(* Ensure the current version in installed in current checkpoint. *)

+val update_breakpoints : unit -> unit

+

+(* Execute given function with no breakpoint in current checkpoint. *)

+(* --- `goto' run faster so (does not stop on each breakpoint). *)

+val execute_without_breakpoints : (unit -> unit) -> unit

+

+(* Insert a new breakpoint in lists. *)

+val new_breakpoint : debug_event -> unit

+

+(* Remove a breakpoint from lists. *)

+val remove_breakpoint : int -> unit

+

+val remove_all_breakpoints : unit -> unit

+

+(*** Temporary breakpoints. ***)

+

+(* Temporary breakpoint position. *)

+val temporary_breakpoint_position : int option ref

+

+(* Execute `funct' with a breakpoint added at `pc'. *)

+(* --- Used by `finish'. *)

+val exec_with_temporary_breakpoint : int -> (unit -> unit) -> unit

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(*************************** Checkpoints *******************************)

+

+open Debugcom

+open Primitives

+

+(*** A type for checkpoints. ***)

+

+type checkpoint_state =

+ C_stopped

+ | C_running of int

+

+(* `c_valid' is true if and only if the corresponding

+ * process is connected to the debugger.

+ * `c_parent' is the checkpoint whose process is parent

+ * of the checkpoint one (`root' if no parent).

+ * c_pid = -2 for root pseudo-checkpoint.

+ * c_pid = 0 for ghost checkpoints.

+ * c_pid = -1 for kill checkpoints.

+ *)

+type checkpoint = {

+ mutable c_time : int;

+ mutable c_pid : int;

+ mutable c_fd : io_channel;

+ mutable c_valid : bool;

+ mutable c_report : report option;

+ mutable c_state : checkpoint_state;

+ mutable c_parent : checkpoint;

+ mutable c_breakpoint_version : int;

+ mutable c_breakpoints : (int * int ref) list;

+ mutable c_trap_barrier : int

+ }

+

+(*** Pseudo-checkpoint `root'. ***)

+(* --- Parents of all checkpoints which have no parent. *)

+let rec root = {

+ c_time = 0;

+ c_pid = -2;

+ c_fd = std_io;

+ c_valid = false;

+ c_report = None;

+ c_state = C_stopped;

+ c_parent = root;

+ c_breakpoint_version = 0;

+ c_breakpoints = [];

+ c_trap_barrier = 0

+ }

+

+(*** Current state ***)

+let checkpoints =

+ ref ([] : checkpoint list)

+

+let current_checkpoint =

+ ref root

+

+let current_time () =

+ !current_checkpoint.c_time

+

+let current_report () =

+ !current_checkpoint.c_report

+

+let current_pc () =

+ match current_report () with

+ None | Some {rep_type = Exited | Uncaught_exc} -> None

+ | Some {rep_program_pointer = pc } -> Some pc

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(***************************** Checkpoints *****************************)

+

+open Primitives

+open Debugcom

+

+(*** A type for checkpoints. ***)

+

+type checkpoint_state =

+ C_stopped

+ | C_running of int

+

+(* `c_valid' is true if and only if the corresponding

+ * process is connected to the debugger.

+ * `c_parent' is the checkpoint whose process is parent

+ * of the checkpoint one (`root' if no parent).

+ * c_pid = 2 for root pseudo-checkpoint.

+ * c_pid = 0 for ghost checkpoints.

+ * c_pid = -1 for kill checkpoints.

+ *)

+type checkpoint =

+ {mutable c_time : int;

+ mutable c_pid : int;

+ mutable c_fd : io_channel;

+ mutable c_valid : bool;

+ mutable c_report : report option;

+ mutable c_state : checkpoint_state;

+ mutable c_parent : checkpoint;

+ mutable c_breakpoint_version : int;

+ mutable c_breakpoints : (int * int ref) list;

+ mutable c_trap_barrier : int}

+

+(*** Pseudo-checkpoint `root'. ***)

+(* --- Parents of all checkpoints which have no parent. *)

+val root : checkpoint

+

+(*** Current state ***)

+val checkpoints : checkpoint list ref

+val current_checkpoint : checkpoint ref

+

+val current_time : unit -> int

+val current_report : unit -> report option

+val current_pc : unit -> int option

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(************************ Reading and executing commands ***************)

+

+open Format

+open Misc

+open Instruct

+open Unix

+open Debugger_config

+open Types

+open Primitives

+open Unix_tools

+open Parser

+open Parser_aux

+open Lexer

+open Input_handling

+open Debugcom

+open Program_loading

+open Program_management

+open Lexing

+open Parameters

+open Show_source

+open Show_information

+open Time_travel

+open Events

+open Symbols

+open Source

+open Breakpoints

+open Checkpoints

+open Frames

+(*open Pattern_matching*)

+

+(** Instructions, variables and infos lists. **)

+type dbg_instruction =

+ { instr_name: string; (* Name of command *)

+ instr_prio: bool; (* Has priority *)

+ instr_action: lexbuf -> unit; (* What to do *)

+ instr_repeat: bool; (* Can be repeated *)

+ instr_help: string } (* Help message *)

+

+let instruction_list = ref ([] : dbg_instruction list)

+

+type dbg_variable =

+ { var_name: string; (* Name of variable *)

+ var_action: (lexbuf -> unit) * (unit -> unit); (* Writing, reading fns *)

+ var_help: string } (* Help message *)

+

+let variable_list = ref ([] : dbg_variable list)

+

+type dbg_info =

+ { info_name: string; (* Name of info *)

+ info_action: lexbuf -> unit; (* What to do *)

+ info_help: string } (* Help message *)

+

+let info_list = ref ([] : dbg_info list)

+

+(** Utilities. **)

+let error text =

+ prerr_endline text;

+ raise Toplevel

+

+let eol =

+ end_of_line Lexer.lexeme

+

+let matching_elements list name instr =

+ filter (function a -> isprefix instr (name a)) !list

+

+let all_matching_instructions =

+ matching_elements instruction_list (fun i -> i.instr_name)

+

+(* itz 04-21-96 don't do priority completion in emacs mode *)

+let matching_instructions instr =

+ let all = all_matching_instructions instr in

+ let prio = filter (fun i -> i.instr_prio) all in

+ if prio = [] || !emacs then all else prio

+

+let matching_variables =

+ matching_elements variable_list (fun v -> v.var_name)

+

+let matching_infos =

+ matching_elements info_list (fun i -> i.info_name)

+

+let find_ident name matcher action alternative lexbuf =

+ match identifier_or_eol Lexer.lexeme lexbuf with

+ None ->

+ alternative ()

+ | Some ident ->

+ match matcher ident with

+ [] ->

+ error ("Unknown " ^ name ^ ".")

+ | [a] ->

+ action a lexbuf

+ | _ ->

+ error ("Ambiguous " ^ name ^ ".")

+

+let find_variable action alternative lexbuf =

+ find_ident "variable name" matching_variables action alternative lexbuf

+

+let find_info action alternative lexbuf =

+ find_ident "info command" matching_infos action alternative lexbuf

+

+let add_breakpoint_at_pc pc =

+ try

+ new_breakpoint (event_at_pc pc)

+ with

+ Not_found ->

+ prerr_string "Can't add breakpoint at pc ";

+ prerr_int pc;

+ prerr_endline " : no event there.";

+ raise Toplevel

+

+let convert_module mdle =

+ match mdle with

+ Some x ->

+ x

+ | None ->

+ try

+ let (x, _) = current_point () in x

+ with Not_found ->

+ prerr_endline "Not in a module.";

+ raise Toplevel

+

+(** Toplevel. **)

+let current_line = ref ""

+

+let interprete_line line =

+ current_line := line;

+ let lexbuf = Lexing.from_string line in

+ try

+ match identifier_or_eol Lexer.lexeme lexbuf with

+ Some x ->

+ begin match matching_instructions x with

+ [] ->

+ error "Unknown command."

+ | [i] ->

+ i.instr_action lexbuf;

+ resume_user_input ();

+ i.instr_repeat

+ | l ->

+ error "Ambiguous command."

+ end

+ | None ->

+ resume_user_input ();

+ false

+ with

+ Parsing.Parse_error ->

+ error "Syntax error."

+

+let line_loop line_buffer =

+ resume_user_input ();

+ let previous_line = ref "" in

+ try

+ while true do

+ if !loaded then

+ History.add_current_time ();

+ let new_line = string_trim (line line_buffer) in

+ let line =

+ if new_line <> "" then

+ new_line

+ else

+ !previous_line

+ in

+ previous_line := "";

+ if interprete_line line then

+ previous_line := line

+ done

+ with

+ Exit ->

+ stop_user_input ()

+ | Sys_error s ->

+ prerr_endline ("System error : " ^ s);

+ raise Toplevel

+

+

+(** Instructions. **)

+let instr_cd lexbuf =

+ let dir = argument_eol argument lexbuf in

+ if ask_kill_program () then

+ try

+ Sys.chdir (expand_path dir)

+ with

+ Sys_error s ->

+ prerr_endline s;

+ raise Toplevel

+

+let instr_pwd lexbuf =

+ eol lexbuf;

+ system "/bin/pwd";

+ ()

+

+let instr_dir lexbuf =

+ let new_directory = argument_list_eol argument lexbuf in

+ if new_directory = [] then begin

+ if yes_or_no "Reinitialize directory list" then begin

+ Config.load_path := !default_load_path;

+ Envaux.reset_cache ();

+ flush_buffer_list ()

+ end

+ end

+ else

+ List.iter (function x -> add_path (expand_path x)) (List.rev new_directory);

+ print_string "Directories :";

+ List.iter (function x -> print_space(); print_string x) !Config.load_path;

+ print_newline ()

+

+let instr_kill lexbuf =

+ eol lexbuf;

+ if not !loaded then

+ (prerr_endline "The program is not being run."; raise Toplevel);

+ if (yes_or_no "Kill the program being debugged") then begin

+ kill_program ();

+ show_no_point()

+ end

+

+let instr_run lexbuf =

+ eol lexbuf;

+ ensure_loaded ();

+ run ();

+ show_current_event ()

+

+let instr_reverse lexbuf =

+ eol lexbuf;

+ ensure_loaded ();

+ back_run ();

+ show_current_event ()

+

+let instr_step lexbuf =

+ let step_count =

+ match opt_signed_integer_eol Lexer.lexeme lexbuf with

+ None -> 1

+ | Some x -> x

+ in

+ ensure_loaded ();

+ step step_count;

+ show_current_event ()

+

+let instr_back lexbuf =

+ let step_count =

+ match opt_signed_integer_eol Lexer.lexeme lexbuf with

+ None -> 1

+ | Some x -> x

+ in

+ ensure_loaded ();

+ step (-step_count);

+ show_current_event ()

+

+let instr_finish lexbuf =

+ eol lexbuf;

+ ensure_loaded ();

+ finish ();

+ show_current_event ()

+

+let instr_next lexbuf =

+ let step_count =

+ match opt_integer_eol Lexer.lexeme lexbuf with

+ None -> 1

+ | Some x -> x

+ in

+ ensure_loaded ();

+ next step_count;

+ show_current_event ()

+

+let instr_goto lexbuf =

+ let time = integer_eol Lexer.lexeme lexbuf in

+ ensure_loaded ();

+ go_to time;

+ show_current_event ()

+

+let instr_quit _ =

+ raise Exit

+

+let print_variable_list () =

+ print_endline "List of variables :";

+ List.iter (fun v -> print_string v.var_name; print_space()) !variable_list;

+ print_newline ()

+

+let print_info_list () =

+ print_endline "List of info commands :";

+ List.iter (fun i -> print_string i.info_name; print_space()) !info_list;

+ print_newline ()

+

+let instr_complete lexbuf =

+ let rec print_list l =

+ try

+ eol lexbuf;

+ List.iter (function i -> print_string i; print_newline ()) l

+ with _ ->

+ remove_file !user_channel

+ and match_list lexbuf =

+ match identifier_or_eol Lexer.lexeme lexbuf with

+ None ->

+ List.map (fun i -> i.instr_name) !instruction_list

+ | Some x ->

+ match matching_instructions x with

+ [ {instr_name = ("set" | "show" as i_full)} ] ->

+ if x = i_full then begin

+ match identifier_or_eol Lexer.lexeme lexbuf with

+ Some ident ->

+ begin match matching_variables ident with

+ [v] -> if v.var_name = ident then [] else [v.var_name]

+ | l -> List.map (fun v -> v.var_name) l

+ end

+ | None ->

+ List.map (fun v -> v.var_name) !variable_list

+ end

+ else [i_full]

+ | [ {instr_name = "info"} ] ->

+ if x = "info" then begin

+ match identifier_or_eol Lexer.lexeme lexbuf with

+ Some ident ->

+ begin match matching_infos ident with

+ [i] -> if i.info_name = ident then [] else [i.info_name]

+ | l -> List.map (fun i -> i.info_name) l

+ end

+ | None ->

+ List.map (fun i -> i.info_name) !info_list

+ end

+ else ["info"]

+ | [ {instr_name = "help"} ] ->

+ if x = "help" then match_list lexbuf else ["help"]

+ | [ i ] ->

+ if x = i.instr_name then [] else [i.instr_name]

+ | l ->

+ List.map (fun i -> i.instr_name) l

+ in

+ print_list(match_list lexbuf)

+

+let instr_help lexbuf =

+ match identifier_or_eol Lexer.lexeme lexbuf with

+ Some x ->

+ let print_help nm hlp =

+ eol lexbuf;

+ print_string nm;

+ print_string " : ";

+ print_string hlp;

+ print_newline ()

+ in

+ begin match matching_instructions x with

+ [] ->

+ eol lexbuf;

+ print_string "No matching command.";

+ print_newline ()

+ | [ {instr_name = "set"} ] ->

+ find_variable

+ (fun v _ ->

+ print_help ("set " ^ v.var_name) ("set " ^ v.var_help))

+ (fun () ->

+ print_help "set" "set debugger variable.";

+ print_variable_list ())

+ lexbuf

+ | [ {instr_name = "show"} ] ->

+ find_variable

+ (fun v _ ->

+ print_help ("show " ^ v.var_name) ("show " ^ v.var_help))

+ (fun () ->

+ print_help "show" "display debugger variable.";

+ print_variable_list ())

+ lexbuf

+ | [ {instr_name = "info"} ] ->

+ find_info

+ (fun i _ -> print_help ("info " ^ i.info_name) i.info_help)

+ (fun () ->

+ print_help "info" "display infos about the program being debugged.";

+ print_info_list ())

+ lexbuf

+ | [i] ->

+ print_help i.instr_name i.instr_help

+ | l ->

+ eol lexbuf;

+ print_string ("Ambiguous command \"" ^ x ^ "\" : ");

+ List.iter

+ (fun i -> print_string i.instr_name; print_space())

+ l;

+ print_newline ()

+ end

+ | None ->

+ print_endline "List of commands :";

+ List.iter

+ (fun i -> print_string i.instr_name; print_space())

+ !instruction_list;

+ print_newline ()

+

+let longident idlist =

+ let rec longid = function

+ [] -> fatal_error "Debugger.longident"

+ | [s] -> Longident.Lident s

+ | f::l -> Longident.Ldot(longid l, f) in

+ longid (List.rev idlist)

+

+let print_val valu var typ env =

+ (* prints the classic "var : typ = val" message *)

+ print_string var;

+ print_string " : ";

+ Printtyp.type_scheme typ;

+ print_string " = ";

+ Printval.print_value valu typ env;

+ Format.print_newline()

+

+let instr_print lexbuf =

+ let e = match !selected_event with

+ None -> raise Toplevel

+ | Some x -> x in

+ let variables = variable_list_eol Lexer.lexeme lexbuf in

+ ensure_loaded ();

+ List.iter

+ (function vari ->

+ open_hovbox 0;

+ let lid = longident(split_string '.' vari) in

+ let env = Envaux.env_from_summary e.ev_typenv in

+ begin try

+ let (path, valdesc) = Env.lookup_value lid env in

+ let exp_type = (Ctype.instance valdesc.Types.val_type)

+ and valu = Eval.path e.ev_compenv e.ev_stacksize path in

+ print_val valu vari exp_type env

+ with Not_found ->

+ print_string "Unbound identifier "; print_string vari

+ end;

+ close_box();

+ print_newline ())

+ variables

+

+let instr_match lexbuf =

+ ()

+(***

+ let (var, pattern) = match_arguments_eol Lexer.lexeme lexbuf in

+ ensure_loaded ();

+ let (valu, typ) = variable var in

+ List.iter

+ (function

+ (name, valu, typ) ->

+ open_hovbox 0;

+ print_string name;

+ print_string " :"; print_space();

+ print_one_type typ;

+ print_string " ="; print_space();

+ print_value valu typ;

+ close_box();

+ print_newline ())

+ (pattern_matching pattern valu typ)

+***)

+

+let instr_source lexbuf =

+ let file = argument_eol argument lexbuf

+ and old_state = !interactif

+ and old_channel = !user_channel in

+ let io_chan =

+ try

+ io_channel_of_descr (openfile (expand_path file) [O_RDONLY] 0)

+ with

+ (Unix_error _) as x -> Unix_tools.report_error x; raise Toplevel

+ in

+ try

+ interactif := false;

+ user_channel := io_chan;

+ line_loop (Lexing.from_function read_user_input);

+ close_io io_chan;

+ interactif := old_state;

+ user_channel := old_channel

+ with

+ x ->

+ stop_user_input ();

+ close_io io_chan;

+ interactif := old_state;

+ user_channel := old_channel;

+ raise x

+

+let instr_open lexbuf = ()

+(***

+ let mdles = argument_list_eol argument lexbuf in

+ List.iter open_module mdles ***)

+

+let instr_close lexbuf = ()

+(***

+ let mdles = argument_list_eol argument lexbuf in

+ List.iter close_module mdles ***)

+

+let instr_set =

+ find_variable

+ (function {var_action = (funct, _)} -> funct)

+ (function () -> prerr_endline "Argument required."; raise Toplevel)

+

+let instr_show =

+ find_variable

+ (fun {var_action = (_, funct)} lexbuf -> eol lexbuf; funct ())

+ (function () ->

+ List.iter

+ (function {var_name = nm; var_action = (_, funct)} ->

+ print_string (nm ^ " : ");

+ funct ())

+ !variable_list)

+

+let instr_info =

+ find_info

+ (fun i lexbuf -> i.info_action lexbuf)

+ (function () ->

+ prerr_endline

+ "\"info\" must be followed by the name of an info command.";

+ raise Toplevel)

+

+let instr_break lexbuf =

+ let argument = break_argument_eol Lexer.lexeme lexbuf in

+ ensure_loaded ();

+ match argument with

+ BA_none -> (* break *)

+ (match current_pc () with

+ Some pc ->

+ add_breakpoint_at_pc pc

+ | None ->

+ prerr_endline "Can't add breakpoint at this point.";

+ raise Toplevel)

+ | BA_pc pc -> (* break PC *)

+ add_breakpoint_at_pc pc

+ | BA_function vari -> (* break FUNCTION *)

+ let e = match !current_event with

+ None -> raise Toplevel

+ | Some x -> x in

+ let lid = longident(split_string '.' vari) in

+ let env = Envaux.env_from_summary e.ev_typenv in

+ (try

+ let (path, valdesc) = Env.lookup_value lid env in

+ let typ = (Ctype.instance valdesc.Types.val_type)

+ and valu = Eval.path e.ev_compenv e.ev_stacksize path in

+ match (Ctype.repr typ).desc with

+ Tarrow (_, _) ->

+ prerr_endline "Not Yet Implemented"

+ | _ ->

+ prerr_endline "Not a function.";

+ raise Toplevel

+ with Not_found ->

+ print_string "Unbound identifier"; print_newline())

+ | BA_pos1 (mdle, line, column) -> (* break @ [MODULE] LINE [COL] *)

+ let module_name = convert_module mdle in

+ new_breakpoint

+ (try

+ match column with

+ None ->

+ event_after_pos

+ module_name

+ (fst (pos_of_line (get_buffer module_name) line))

+ | Some col ->

+ event_near_pos

+ module_name

+ (point_of_coord (get_buffer module_name) line col)

+ with

+ Not_found ->

+ prerr_endline "Can't find any event there.";

+ raise Toplevel

+ | Out_of_range ->

+ prerr_endline "Position out of range.";

+ raise Toplevel)

+ | BA_pos2 (mdle, position) -> (* break @ [MODULE] # POSITION *)

+ try

+ new_breakpoint (event_near_pos (convert_module mdle) position)

+ with

+ Not_found ->

+ prerr_endline "Can't find any event there."

+

+let instr_delete lexbuf =

+ match integer_list_eol Lexer.lexeme lexbuf with

+ [] ->

+ if (breakpoints_count () <> 0) & (yes_or_no "Delete all breakpoints")

+ then remove_all_breakpoints ()

+ | breakpoints ->

+ List.iter

+ (function x ->

+ try

+ remove_breakpoint x

+ with

+ Not_found ->

+ ())

+ breakpoints

+

+let instr_frame lexbuf =

+ let frame_number =

+ match opt_integer_eol Lexer.lexeme lexbuf with

+ None -> !current_frame

+ | Some x -> x

+ in

+ ensure_loaded ();

+ try

+ select_frame frame_number;

+ show_current_frame true

+ with

+ Not_found ->

+ prerr_endline ("No frame number " ^ (string_of_int frame_number) ^ ".");

+ raise Toplevel

+

+let instr_backtrace lexbuf =

+ let number =

+ match opt_signed_integer_eol Lexer.lexeme lexbuf with

+ None -> 0

+ | Some x -> x in

+ ensure_loaded ();

+ match current_report() with

+ None | Some {rep_type = Exited | Uncaught_exc} -> ()

+ | Some _ ->

+ let frame_counter = ref 0 in

+ let print_frame first_frame last_frame = function

+ None ->

+ print_string "(Encountered a function with no debugging information)";

+ print_newline();

+ false

+ | Some event ->

+ if !frame_counter >= first_frame then

+ show_one_frame !frame_counter event;

+ incr frame_counter;

+ if !frame_counter >= last_frame then begin

+ print_string "(More frames follow)"; print_newline()

+ end;

+ !frame_counter < last_frame in

+ if number = 0 then

+ do_backtrace (print_frame 0 max_int)

+ else if number > 0 then

+ do_backtrace (print_frame 0 number)

+ else begin

+ let num_frames = stack_depth() in

+ if num_frames < 0 then begin

+ print_string "(Encountered a function with no debugging information)";

+ print_newline()

+ end else

+ do_backtrace (print_frame (num_frames + number) max_int)

+ end

+

+let do_up rep =

+ let stack_pointer = rep.rep_stack_pointer in

+ let pc = rep.rep_program_pointer in

+ let ev = ref (event_at_pc pc) in

+ print_string !ev.ev_file; print_string " char "; print_int !ev.ev_char;

+ print_newline();

+ let (stackpos, pc) = Debugcom.up_frame !ev.ev_stacksize in

+ if stackpos = -1 then raise Exit;

+ current_event := Some (event_at_pc pc)

+

+let instr_up lexbuf =

+ let offset =

+ match opt_signed_integer_eol Lexer.lexeme lexbuf with

+ None -> 1

+ | Some x -> x

+ in

+ ensure_loaded ();

+ try

+ select_frame (!current_frame + offset);

+ show_current_frame true

+ with

+ Not_found ->

+ prerr_endline "No such frame.";

+ raise Toplevel

+

+let instr_down lexbuf =

+ let offset =

+ match opt_signed_integer_eol Lexer.lexeme lexbuf with

+ None -> 1

+ | Some x -> x

+ in

+ ensure_loaded ();

+ try

+ select_frame (!current_frame - offset);

+ show_current_frame true

+ with

+ Not_found ->

+ prerr_endline "No such frame.";

+ raise Toplevel

+

+let instr_last lexbuf =

+ let count =

+ match opt_signed_integer_eol Lexer.lexeme lexbuf with

+ None -> 1

+ | Some x -> x

+ in

+ go_to (History.previous_time count);

+ show_current_event ()

+

+let instr_list lexbuf =

+ let (mo, beg, e) = list_arguments_eol Lexer.lexeme lexbuf in

+ let (curr_mod, point) =

+ try

+ selected_point ()

+ with

+ Not_found ->

+ ("", -1)

+ in

+ let mdle = convert_module mo in

+ let beginning =

+ match beg with

+ None ->

+ if point = -1 then

+ (prerr_endline "No current point."; raise Toplevel);

+ (max 1 ((snd (line_of_pos (get_buffer mdle) point)) - 10))

+ | Some x -> x

+ in

+ let en =

+ match e with

+ None -> beginning + 20

+ | Some x -> x

+ in

+ if mdle = curr_mod then

+ show_listing mdle beginning en point

+ (current_event_is_before ())

+ else

+ show_listing mdle beginning en (-1) true

+

+(** Variables. **)

+let raw_variable kill name =

+ (function

+ lexbuf ->

+ let argument = argument_eol argument lexbuf in

+ if (not kill) or (ask_kill_program ()) then

+ name := argument),

+ function

+ () ->

+ print_string !name;

+ print_newline ()

+

+let raw_line_variable kill name =

+ (function

+ lexbuf ->

+ let argument = argument_eol line_argument lexbuf in

+ if (not kill) or (ask_kill_program ()) then

+ name := argument),

+ function

+ () ->

+ print_string !name;

+ print_newline ()

+

+let integer_variable kill min msg name =

+ (function

+ lexbuf ->

+ let argument = integer_eol Lexer.lexeme lexbuf in

+ if argument < min then

+ print_endline msg

+ else

+ if (not kill) or (ask_kill_program ()) then

+ name := argument),

+ function

+ () ->

+ print_int !name;

+ print_newline ()

+

+let boolean_variable kill name =

+ (function

+ lexbuf ->

+ let argument =

+ match identifier_eol Lexer.lexeme lexbuf with

+ "on" -> true

+ | "of" | "off" -> false

+ | _ -> error "Syntax error."

+ in

+ if (not kill) or (ask_kill_program ()) then

+ name := argument),

+ function

+ () ->

+ print_string (if !name then "on" else "off");

+ print_newline ()

+

+let path_variable kill name =

+ (function

+ lexbuf ->

+ let argument = argument_eol argument lexbuf in

+ if (not kill) or (ask_kill_program ()) then

+ name := (expand_path argument)),

+ function

+ () ->

+ print_string !name;

+ print_newline ()

+

+let loading_mode_variable =

+ (find_ident

+ "loading mode"

+ (matching_elements (ref loading_modes) fst)

+ (fun (_, mode) lexbuf ->

+ eol lexbuf; set_launching_function mode)

+ (function () -> error "Syntax error.")),

+ function

+ () ->

+ let rec find =

+ function

+ [] -> ()

+ | (name, funct)::l ->

+ if funct == !launching_func then

+ print_string name

+ else

+ find l

+ in

+ find loading_modes;

+ print_newline ()

+

+(** Infos. **)

+

+let info_modules lexbuf =

+ eol lexbuf

+(********

+ print_endline "Used modules :";

+ List.iter (function x -> print_string x; print_space()) !modules;

+ print_newline ();

+ print_endline "Opened modules :";

+ if !opened_modules_names = [] then

+ print_endline "(no module opened)."

+ else

+ (List.iter (function x -> print_string x; print_space) !opened_modules_names;

+ print_newline ())

+*********)

+

+let info_checkpoints lexbuf =

+ eol lexbuf;

+ if !checkpoints = [] then

+ (print_string "No checkpoint."; print_newline ())

+ else

+ (if !debug_breakpoints then

+ (prerr_endline " Time Pid Version";

+ List.iter

+ (function

+ {c_time = time; c_pid = pid; c_breakpoint_version = version} ->

+ Printf.printf "%10d %5d %d\n" time pid version)

+ !checkpoints)

+ else

+ (print_endline " Time Pid";

+ List.iter

+ (function

+ {c_time = time; c_pid = pid} ->

+ Printf.printf "%10d %5d\n" time pid)

+ !checkpoints))

+

+let info_breakpoints lexbuf =

+ eol lexbuf;

+ if !breakpoints = [] then

+ (print_string "No breakpoint."; print_newline ())

+ else

+ (print_endline "Num Address Where";

+ List.iter

+ (function (num, {ev_pos = pc; ev_file = file; ev_char = char}) ->

+ Printf.printf "%3d %10d in %s.ml, character %d\n" num pc file char)

+ (List.rev !breakpoints))

+

+let info_events lexbuf =

+ if not !loaded then

+ (prerr_endline "Not in a module."; raise Toplevel);

+ let mdle =

+ match opt_identifier_eol Lexer.lexeme lexbuf with

+ Some x -> x

+ | None ->

+ match !current_event with

+ None ->

+ prerr_endline "Not in a module."; raise Toplevel

+ | Some {ev_file = f} -> f

+ in

+ print_endline ("Module : " ^ mdle);

+ print_endline " Address Character Kind";

+ List.iter

+ (function {ev_pos = pc; ev_char = char; ev_kind = kind} ->

+ Printf.printf

+ "%10d %10d %s\n"

+ pc

+ char

+ (match kind with

+ Event_before -> "before"

+ | Event_after _ -> "after"))

+ (events_in_module mdle)

+

+(** Initialization. **)

+let _ =

+ instruction_list := [

+ { instr_name = "cd"; instr_prio = false;

+ instr_action = instr_cd; instr_repeat = true; instr_help =

+"set working directory to DIR for debugger and program being debugged." };

+ { instr_name = "complete"; instr_prio = false;

+ instr_action = instr_complete; instr_repeat = false; instr_help =

+"complete word at cursor according to context. Useful for Emacs." };

+ { instr_name = "pwd"; instr_prio = false;

+ instr_action = instr_pwd; instr_repeat = true; instr_help =

+"print working directory." };

+ { instr_name = "directory"; instr_prio = false;

+ instr_action = instr_dir; instr_repeat = false; instr_help =

+"add directory DIR to beginning of search path for source and\n\

+interface files.\n\

+Forget cached info on source file locations and line positions.\n\

+With no argument, reset the search path." };

+ { instr_name = "kill"; instr_prio = false;

+ instr_action = instr_kill; instr_repeat = true; instr_help =

+"kill the program being debugged." };

+ { instr_name = "help"; instr_prio = false;

+ instr_action = instr_help; instr_repeat = true; instr_help =

+"print list of commands." };

+ { instr_name = "quit"; instr_prio = false;

+ instr_action = instr_quit; instr_repeat = false; instr_help =

+"exit the debugger." };

+ (* Displacements *)

+ { instr_name = "run"; instr_prio = true;

+ instr_action = instr_run; instr_repeat = true; instr_help =

+"run the program from current position." };

+ { instr_name = "reverse"; instr_prio = false;

+ instr_action = instr_reverse; instr_repeat = true; instr_help =

+"run the program backward from current position." };

+ { instr_name = "step"; instr_prio = true;

+ instr_action = instr_step; instr_repeat = true; instr_help =

+"step program until it reaches the next event.\n\

+Argument N means do this N times (or till program stops for another reason)." };

+ { instr_name = "backstep"; instr_prio = true;

+ instr_action = instr_back; instr_repeat = true; instr_help =

+"step program backward until it reaches the previous event.\n\

+Argument N means do this N times (or till program stops for another reason)." };

+ { instr_name = "goto"; instr_prio = false;

+ instr_action = instr_goto; instr_repeat = true; instr_help =

+"go to the given time." };

+ { instr_name = "finish"; instr_prio = true;

+ instr_action = instr_finish; instr_repeat = true; instr_help =

+"execute until selected stack frame returns." };

+ { instr_name = "next"; instr_prio = true;

+ instr_action = instr_next; instr_repeat = true; instr_help =

+"step program until it reaches the next event.\n\

+Skip over function calls.\n\

+Argument N means do this N times (or till program stops for another reason)." };

+ { instr_name = "print"; instr_prio = true;

+ instr_action = instr_print; instr_repeat = true; instr_help =

+"print value of variables (`*' stand for the accumulator)." };

+ { instr_name = "match"; instr_prio = false;

+ instr_action = instr_match; instr_repeat = true; instr_help =

+"match the value of a variable against a pattern." };

+ { instr_name = "source"; instr_prio = false;

+ instr_action = instr_source; instr_repeat = true; instr_help =

+"read command from file FILE." };

+ { instr_name = "open"; instr_prio = false;

+ instr_action = instr_open; instr_repeat = false; instr_help =

+"open modules." };

+ { instr_name = "close"; instr_prio = false;

+ instr_action = instr_close; instr_repeat = false; instr_help =

+"close modules." };

+ (* Breakpoints *)

+ { instr_name = "break"; instr_prio = false;

+ instr_action = instr_break; instr_repeat = false; instr_help =

+"Set breakpoint at specified line or function." };

+ { instr_name = "delete"; instr_prio = false;

+ instr_action = instr_delete; instr_repeat = false; instr_help =

+"delete some breakpoints.\n\

+Arguments are breakpoint numbers with spaces in between.\n\

+To delete all breakpoints, give no argument." };

+ { instr_name = "set"; instr_prio = false;

+ instr_action = instr_set; instr_repeat = false; instr_help =

+"--unused--" };

+ { instr_name = "show"; instr_prio = false;

+ instr_action = instr_show; instr_repeat = true; instr_help =

+"--unused--" };

+ { instr_name = "info"; instr_prio = false;

+ instr_action = instr_info; instr_repeat = true; instr_help =

+"--unused--" };

+ (* Frames *)

+ { instr_name = "frame"; instr_prio = false;

+ instr_action = instr_frame; instr_repeat = true; instr_help =

+"Select and print a stack frame.\n\

+With no argument, print the selected stack frame.\n\

+An argument specifies the frame to select." };

+ { instr_name = "backtrace"; instr_prio = false;

+ instr_action = instr_backtrace; instr_repeat = true; instr_help =

+"print backtrace of all stack frames, or innermost COUNT frames.\n\

+With a negative argument, print outermost -COUNT frames." };

+ { instr_name = "bt"; instr_prio = false;

+ instr_action = instr_backtrace; instr_repeat = true; instr_help =

+"print backtrace of all stack frames, or innermost COUNT frames.\n\

+With a negative argument, print outermost -COUNT frames." };

+ { instr_name = "up"; instr_prio = false;

+ instr_action = instr_up; instr_repeat = true; instr_help =

+"select and print stack frame that called this one.\n\

+An argument says how many frames up to go." };

+ { instr_name = "down"; instr_prio = false;

+ instr_action = instr_down; instr_repeat = true; instr_help =

+"select and print stack frame called by this one.\n\

+An argument says how many frames down to go." };

+ { instr_name = "last"; instr_prio = true;

+ instr_action = instr_last; instr_repeat = true; instr_help =

+"go back to previous time." };

+ { instr_name = "list"; instr_prio = false;

+ instr_action = instr_list; instr_repeat = true; instr_help =

+"list the source code." }

+];

+ variable_list := [

+ (* variable name, (writing, reading), help reading, help writing *)

+ { var_name = "arguments";

+ var_action = raw_line_variable true arguments;

+ var_help =

+"arguments to give program being debugged when it is started." };

+ { var_name = "program";

+ var_action = path_variable true program_name;

+ var_help =

+"name of program to be debugged." };

+ { var_name = "loadingmode";

+ var_action = loading_mode_variable;

+ var_help =

+"mode of loading.\n\

+It can be either :

+ direct : the program is directly called by the debugger.\n\

+ runtime : the debugger execute `camlrun -D socket programname arguments'.\n\

+ manual : the program is not launched by the debugger,\n\

+ but manually by the user." };

+ { var_name = "processcount";

+ var_action = integer_variable false 1 "Must be > 1."

+ checkpoint_max_count;

+ var_help =

+"maximum number of process to keep." };

+ { var_name = "checkpoints";

+ var_action = boolean_variable false make_checkpoints;

+ var_help =

+"whether to make checkpoints or not." };

+ { var_name = "bigstep";

+ var_action = integer_variable false 1 "Must be > 1."

+ checkpoint_big_step;

+ var_help =

+"step between checkpoints during long displacements." };

+ { var_name = "smallstep";

+ var_action = integer_variable false 1 "Must be > 1."

+ checkpoint_small_step;

+ var_help =

+"step between checkpoints during small displacements." };

+ { var_name = "socket";

+ var_action = raw_variable true socket_name;

+ var_help =

+"name of the socket used by communications debugger-runtime." };

+ { var_name = "history";

+ var_action = integer_variable false 0 "" history_size;

+ var_help =

+"history size." };

+ { var_name = "print_depth";

+ var_action = integer_variable false 1 "Must be at least 1"

+ Printval.max_printer_depth;

+ var_help =

+"maximal depth for printing of values." };

+ { var_name = "print_length";

+ var_action = integer_variable false 1 "Must be at least 1"

+ Printval.max_printer_steps;

+ var_help =

+"maximal number of value nodes printed." }];

+

+ info_list :=

+ (* info name, function, help *)

+ [{ info_name = "modules"; info_action = info_modules; info_help =

+"list opened modules." };

+ { info_name = "checkpoints"; info_action = info_checkpoints; info_help =

+"list checkpoints." };

+ { info_name = "breakpoints"; info_action = info_breakpoints; info_help =

+"list breakpoints." };

+ { info_name = "events"; info_action = info_events; info_help =

+"list events in MODULE (default is current module)." }]

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(************************ Reading and executing commands ***************)

+

+open Lexing;;

+

+val interprete_line : string -> bool;;

+val line_loop : lexbuf -> unit;;

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(* Low-level communication with the debuggee *)

+

+open Primitives

+

+(* The current connection with the debuggee *)

+

+let conn = ref Primitives.std_io

+

+let set_current_connection io_chan =

+ conn := io_chan

+

+(* Modify the program code *)

+

+let set_event pos =

+ output_char !conn.io_out 'e';

+ output_binary_int !conn.io_out pos;

+ flush !conn.io_out

+

+let set_breakpoint pos =

+ output_char !conn.io_out 'B';

+ output_binary_int !conn.io_out pos;

+ flush !conn.io_out

+

+let reset_instr pos =

+ output_char !conn.io_out 'i';

+ output_binary_int !conn.io_out pos;

+ flush !conn.io_out

+

+(* Basic commands for flow control *)

+

+type execution_summary =

+ Event

+ | Breakpoint

+ | Exited

+ | Trap_barrier

+ | Uncaught_exc

+

+type report = {

+ rep_type : execution_summary;

+ rep_event_count : int;

+ rep_stack_pointer : int;

+ rep_program_pointer : int

+}

+

+type checkpoint_report =

+ Checkpoint_done of int

+ | Checkpoint_failed

+

+(* Run the debuggee for N events *)

+

+let do_go n =

+ output_char !conn.io_out 'g';

+ output_binary_int !conn.io_out n;

+ flush !conn.io_out;

+ let summary =

+ match input_char !conn.io_in with

+ 'e' -> Event

+ | 'b' -> Breakpoint

+ | 'x' -> Exited

+ | 's' -> Trap_barrier

+ | 'u' -> Uncaught_exc

+ | _ -> Misc.fatal_error "Debugcom.do_go" in

+ let event_counter = input_binary_int !conn.io_in in

+ let stack_pos = input_binary_int !conn.io_in in

+ let pc = input_binary_int !conn.io_in in

+ { rep_type = summary;

+ rep_event_count = event_counter;

+ rep_stack_pointer = stack_pos;

+ rep_program_pointer = pc }

+

+(* Perform a checkpoint *)

+

+let do_checkpoint () =

+ output_char !conn.io_out 'c';

+ flush !conn.io_out;

+ let pid = input_binary_int !conn.io_in in

+ if pid = -1 then Checkpoint_failed else Checkpoint_done pid

+

+(* Kill the given process. *)

+let stop chan =

+ try

+ try

+ output_char chan.io_out 's';

+ flush chan.io_out

+ with

+ Sys_error _ -> ()

+ with

+ End_of_file -> ()

+

+(* Ask a process to wait for its child which has been killed. *)

+(* (so as to eliminate zombies). *)

+let wait_child chan =

+ try

+ try

+ output_char chan.io_out 'w';

+ flush chan.io_out

+ with

+ Sys_error _ -> ()

+ with

+ End_of_file -> ()

+

+(* Move to initial frame (that of current function). *)

+(* Return stack position and current pc *)

+

+let initial_frame () =

+ output_char !conn.io_out '0';

+ flush !conn.io_out;

+ let stack_pos = input_binary_int !conn.io_in in

+ let pc = input_binary_int !conn.io_in in

+ (stack_pos, pc)

+

+(* Move up one frame *)

+(* Return stack position and current pc.

+ If there's no frame above, return (-1, 0). *)

+

+let up_frame stacksize =

+ output_char !conn.io_out 'U';

+ output_binary_int !conn.io_out stacksize;

+ flush !conn.io_out;

+ let stack_pos = input_binary_int !conn.io_in in

+ let pc = if stack_pos = -1 then 0 else input_binary_int !conn.io_in in

+ (stack_pos, pc)

+

+(* Get and set the current frame position *)

+

+let get_frame () =

+ output_char !conn.io_out 'f';

+ flush !conn.io_out;

+ let stack_pos = input_binary_int !conn.io_in in

+ let pc = input_binary_int !conn.io_in in

+ (stack_pos, pc)

+

+let set_frame stack_pos =

+ output_char !conn.io_out 'S';

+ output_binary_int !conn.io_out stack_pos;

+ flush !conn.io_out

+

+(* Set the trap barrier to given stack position. *)

+

+let set_trap_barrier pos =

+ output_char !conn.io_out 'b';

+ output_binary_int !conn.io_out pos;

+ flush !conn.io_out

+

+(* Handling of remote values *)

+

+type remote_value = string

+

+let value_size = if 1 lsl 31 = 0 then 4 else 8

+let big_endian =

+ let s = (Obj.magic [|0|] : string) in

+ String.unsafe_get s 0 = '\000'

+let lsb_pos = if big_endian then value_size - 1 else 0

+

+let input_remote_value ic =

+ let v = String.create value_size in

+ really_input ic v 0 value_size; v

+

+let output_remote_value ic v =

+ output ic v 0 value_size

+

+let remote_value_is_int v =

+ not(Obj.is_block(Array.unsafe_get (Obj.magic v : Obj.t array) 0))

+

+let int_value v =

+ Array.unsafe_get (Obj.magic v : int array) 0

+

+let get_local pos =

+ output_char !conn.io_out 'L';

+ output_binary_int !conn.io_out pos;

+ flush !conn.io_out;

+ input_remote_value !conn.io_in

+

+let get_environment pos =

+ output_char !conn.io_out 'E';

+ output_binary_int !conn.io_out pos;

+ flush !conn.io_out;

+ input_remote_value !conn.io_in

+

+let get_global pos =

+ output_char !conn.io_out 'G';

+ output_binary_int !conn.io_out pos;

+ flush !conn.io_out;

+ input_remote_value !conn.io_in

+

+let get_accu () =

+ output_char !conn.io_out 'A';

+ flush !conn.io_out;

+ input_remote_value !conn.io_in

+

+let get_obj v =

+ output_char !conn.io_out 'O';

+ output_remote_value !conn.io_out v;

+ flush !conn.io_out;

+ let header = input_binary_int !conn.io_in in

+ let size = header lsr 10 in

+ let fields = Array.create size "" in

+ for i = 0 to size - 1 do fields.(i) <- input_remote_value !conn.io_in done;

+ (header land 0xFF, fields)

+

+let get_header v =

+ output_char !conn.io_out 'H';

+ output_remote_value !conn.io_out v;

+ flush !conn.io_out;

+ let header = input_binary_int !conn.io_in in

+ (header land 0xFF, header lsr 10)

+

+let get_field v n =

+ output_char !conn.io_out 'F';

+ output_remote_value !conn.io_out v;

+ output_binary_int !conn.io_out n;

+ flush !conn.io_out;

+ input_remote_value !conn.io_in

+

+let marshal_obj v =

+ output_char !conn.io_out 'M';

+ output_remote_value !conn.io_out v;

+ flush !conn.io_out;

+ input_value !conn.io_in

+

+let get_closure_code v =

+ output_char !conn.io_out 'C';

+ output_remote_value !conn.io_out v;

+ flush !conn.io_out;

+ input_binary_int !conn.io_in

+

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(* Low-level communication with the debuggee *)

+

+type execution_summary =

+ Event

+ | Breakpoint

+ | Exited

+ | Trap_barrier

+ | Uncaught_exc

+

+type report =

+ { rep_type : execution_summary;

+ rep_event_count : int;

+ rep_stack_pointer : int;

+ rep_program_pointer : int }

+

+type checkpoint_report =

+ Checkpoint_done of int

+ | Checkpoint_failed

+

+(* Set the current connection with the debuggee *)

+val set_current_connection : Primitives.io_channel -> unit

+

+(* Put an event at given pc *)

+val set_event : int -> unit

+

+(* Put a breakpoint at given pc *)

+val set_breakpoint : int -> unit

+

+(* Remove breakpoint or event at given pc *)

+val reset_instr : int -> unit

+

+(* Create a new checkpoint (the current process forks). *)

+val do_checkpoint : unit -> checkpoint_report

+

+(* Step N events. *)

+val do_go : int -> report

+

+(* Tell given process to terminate *)

+val stop : Primitives.io_channel -> unit

+

+(* Tell given process to wait for its children *)

+val wait_child : Primitives.io_channel -> unit

+

+(* Move to initial frame (that of current function). *)

+(* Return stack position and current pc *)

+val initial_frame : unit -> int * int

+

+(* Get the current frame position *)

+(* Return stack position and current pc *)

+val get_frame : unit -> int * int

+

+(* Set the current frame *)

+val set_frame : int -> unit

+

+(* Move up one frame *)

+(* Return stack position and current pc.

+ If there's no frame above, return (-1, 0). *)

+val up_frame : int -> int * int

+

+(* Set the trap barrier to given stack position. *)

+val set_trap_barrier : int -> unit

+

+(* Handling of remote values *)

+type remote_value

+val remote_value_is_int : remote_value -> bool

+val int_value : remote_value -> int

+val get_local : int -> remote_value

+val get_environment : int -> remote_value

+val get_global : int -> remote_value

+val get_accu : unit -> remote_value

+val get_obj : remote_value -> int * remote_value array

+val get_header : remote_value -> int * int

+val get_field : remote_value -> int -> remote_value

+val marshal_obj : remote_value -> 'a

+val get_closure_code : remote_value -> int

+

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(**************************** Configuration file ***********************)

+

+exception Toplevel

+

+(*** Miscellaneous parameters. ***)

+

+(*ISO 6429 color sequences

+00 to restore default color

+01 for brighter colors

+04 for underlined text

+05 for flashing text

+30 for black foreground

+31 for red foreground

+32 for green foreground

+33 for yellow (or brown) foreground

+34 for blue foreground

+35 for purple foreground

+36 for cyan foreground

+37 for white (or gray) foreground

+40 for black background

+41 for red background

+42 for green background

+43 for yellow (or brown) background

+44 for blue background

+45 for purple background

+46 for cyan background

+47 for white (or gray) background

+let debugger_prompt = "\027[1;04m(ocd)\027[0m "

+and event_mark_before = "\027[1;31m$\027[0m"

+and event_mark_after = "\027[1;34m$\027[0m"

+*)

+let debugger_prompt = "(ocd) "

+let event_mark_before = "<|b|>"

+let event_mark_after = "<|a|>"

+

+(* Name of shell used to launch the debuggee *)

+let shell = "/bin/sh"

+

+(* Name of the Objective Caml runtime. *)

+(* let runtime_program = "ocamlrun" *)

+let runtime_program = "/home/mouton/xleroy/csl-debugger/byterun/ocamlrun"

+

+(* Time history size (for `last') *)

+let history_size = ref 30

+

+(*** Time travel parameters. ***)

+

+(* Step between checkpoints for long displacements.*)

+let checkpoint_big_step = ref 10000

+

+(* Idem for small ones. *)

+let checkpoint_small_step = ref 1000

+

+(* Maximum number of checkpoints. *)

+let checkpoint_max_count = ref 15

+

+(* Whether to keep checkpoints or not. *)

+let make_checkpoints = ref true

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(********************** Configuration file *****************************)

+

+exception Toplevel

+

+(*** Miscellaneous parameters. ***)

+

+val debugger_prompt : string

+val event_mark_before : string

+val event_mark_after : string

+val shell : string

+val runtime_program : string

+val history_size : int ref

+

+(*** Time travel paramaters. ***)

+

+val checkpoint_big_step : int ref

+val checkpoint_small_step : int ref

+val checkpoint_max_count : int ref

+val make_checkpoints : bool ref

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+open Misc

+open Types

+open Env

+

+let env_cache =

+ (Hashtbl.create 59 : (Env.summary, Env.t) Hashtbl.t)

+

+let reset_cache () =

+ Hashtbl.clear env_cache;

+ Env.reset_cache()

+

+let extract_sig env mty =

+ match Mtype.scrape env mty with

+ Tmty_signature sg -> sg

+ | _ -> fatal_error "Envaux.extract_sig"

+

+let rec env_from_summary sum =

+ try

+ Hashtbl.find env_cache sum

+ with Not_found ->

+ let env =

+ match sum with

+ Env_empty ->

+ Env.empty

+ | Env_value(s, id, desc) ->

+ Env.add_value id desc (env_from_summary s)

+ | Env_type(s, id, desc) ->

+ Env.add_type id desc (env_from_summary s)

+ | Env_exception(s, id, desc) ->

+ Env.add_exception id desc (env_from_summary s)

+ | Env_module(s, id, desc) ->

+ Env.add_module id desc (env_from_summary s)

+ | Env_modtype(s, id, desc) ->

+ Env.add_modtype id desc (env_from_summary s)

+ | Env_class(s, id, desc) ->

+ Env.add_class id desc (env_from_summary s)

+ | Env_open(s, path) ->

+ let env = env_from_summary s in

+ let mty =

+ try

+ Env.find_module path env

+ with Not_found ->

+ fatal_error "Envaux.env_from_summary"

+ in

+ Env.open_signature path (extract_sig env mty) env

+ in

+ Hashtbl.add env_cache sum env;

+ env

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(* Convert environment summaries to environments *)

+

+val env_from_summary: Env.summary -> Env.t

+

+(* Empty the environment caches. To be called when load_path changes. *)

+

+val reset_cache: unit -> unit

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+open Debugger_config

+open Misc

+open Path

+open Instruct

+

+let rec path env sz = function

+ Pident id ->

+ if Ident.global id then

+ Debugcom.get_global (Symtable.get_global_position id)

+ else begin

+ try

+ let pos = Ident.find_same id env.ce_stack in

+ Debugcom.get_local (sz - pos)

+ with Not_found ->

+ try

+ let pos = Ident.find_same id env.ce_heap in

+ Debugcom.get_environment pos

+ with Not_found ->

+ Format.print_string "Cannot evaluate ";

+ Printtyp.ident id;

+ Format.print_newline();

+ raise Toplevel

+ end

+ | Pdot(root, fieldname, pos) ->

+ let v = path env sz root in

+ if Debugcom.remote_value_is_int v then begin

+ Printtyp.path root;

+ Format.print_string " has not yet been initialized";

+ Format.print_newline();

+ raise Toplevel

+ end;

+ Debugcom.get_field v pos

+ | Papply(p1, p2) ->

+ fatal_error "Eval.path: Papply"

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+val path : Instruct.compilation_env -> int -> Path.t -> Debugcom.remote_value

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(********************************* Events ******************************)

+

+open Instruct

+open Primitives

+open Checkpoints

+

+(* Previous `pc'. *)

+(* Save time if `update_current_event' is called *)

+(* several times at the same point. *)

+let old_pc = ref (None : int option)

+

+(*** Current events. ***)

+

+(* Event at current position *)

+let current_event =

+ ref (None : debug_event option)

+

+(* Recompute the current event *)

+let update_current_event () =

+ match current_pc () with

+ None ->

+ current_event := None;

+ old_pc := None

+ | (Some pc) as opt_pc ->

+ if opt_pc <> !old_pc then begin

+ current_event := Some (Symbols.event_at_pc pc);

+ old_pc := opt_pc

+ end

+

+(* Current position in source. *)

+(* Raise `Not_found' if not on an event (beginning or end of program). *)

+let current_point () =

+ match !current_event with

+ None ->

+ raise Not_found

+ | Some {ev_char = point; ev_file = mdle} ->

+ (mdle, point)

+

+let current_event_is_before () =

+ match !current_event with

+ None ->

+ raise Not_found

+ | Some {ev_kind = Event_before} ->

+ true

+ | _ ->

+ false

+

+(*** Finding events. ***)

+

+(* List the events in `module'. *)

+let events_in_module mdle =

+ let filename = String.uncapitalize mdle ^ ".ml" in

+ filter

+ (function {ev_file = f} -> f = filename)

+ !Symbols.events

+

+(* First event after the given position. *)

+(* Raise `Not_found' if no such event. *)

+let event_after_pos mdle position =

+ match

+ List.fold_right

+ (function

+ ({ev_char = pos1} as ev) ->

+ if pos1 < position then

+ function x -> x

+ else

+ function

+ None ->

+ Some ev

+ | (Some {ev_char = pos2} as old) ->

+ if pos1 < pos2 then

+ Some ev

+ else

+ old)

+ (events_in_module mdle)

+ None

+ with

+ None ->

+ raise Not_found

+ | Some x ->

+ x

+

+(* Nearest event from given position. *)

+(* Raise `Not_found' if no such event. *)

+let event_near_pos mdle position =

+ match events_in_module mdle with

+ [] ->

+ raise Not_found

+ | [event] ->

+ event

+ | a::l ->

+ List.fold_right

+ (fun ({ev_char = pos1} as ev) ({ev_char = pos2} as old) ->

+ if abs (position - pos1) < abs (position - pos2) then

+ ev

+ else

+ old)

+ l

+ a

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+open Instruct

+

+(** Current events. **)

+

+(* The event at current position. *)

+val current_event : debug_event option ref

+

+(* Recompute the current event *)

+val update_current_event : unit -> unit

+

+(* Current position in source. *)

+(* Raise `Not_found' if not on an event (beginning or end of program). *)

+val current_point : unit -> string * int

+

+val current_event_is_before : unit -> bool

+

+(** Finding events. **)

+

+(* List the events in `module'. *)

+(* ### module -> event_list *)

+val events_in_module : string -> debug_event list

+

+(* First event after the given position. *)

+(* --- Raise `Not_found' if no such event. *)

+val event_after_pos : string -> int -> debug_event

+

+(* Nearest event from given position. *)

+(* --- Raise `Not_found' if no such event. *)

+val event_near_pos : string -> int -> debug_event

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(* Handling of keyboard interrupts *)

+

+let interrupted = ref false

+

+let protect = ref false

+

+let break signum =

+ if !protect

+ then interrupted := true

+ else raise Sys.Break

+

+let _ =

+ Sys.signal Sys.sigint (Sys.Signal_handle break);

+ Sys.signal Sys.sigpipe (Sys.Signal_handle (fun _ -> raise End_of_file))

+

+let protected f =

+ if !protect then

+ f ()

+ else begin

+ protect := true;

+ if not !interrupted then

+ f ();

+ protect := false;

+ if !interrupted then begin interrupted := false; raise Sys.Break end

+ end

+

+let unprotected f =

+ if not !protect then

+ f ()

+ else begin

+ protect := false;

+ if !interrupted then begin interrupted := false; raise Sys.Break end;

+ f ();

+ protect := true

+ end

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(* Handling of keyboard interrupts *)

+

+val protected : (unit -> unit) -> unit

+val unprotected : (unit -> unit) -> unit

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(***************************** Frames **********************************)

+

+open Instruct

+open Primitives

+open Debugcom

+open Checkpoints

+open Events

+open Symbols

+

+(* Current frame number *)

+let current_frame = ref 0

+

+(* Event at selected position *)

+let selected_event = ref (None : debug_event option)

+

+(* Selected position in source. *)

+(* Raise `Not_found' if not on an event. *)

+let selected_point () =

+ match !selected_event with

+ None ->

+ raise Not_found

+ | Some {ev_char = point; ev_file = mdle} ->

+ (mdle, point)

+

+let selected_event_is_before () =

+ match !selected_event with

+ None ->

+ raise Not_found

+ | Some {ev_kind = Event_before} ->

+ true

+ | _ ->

+ false

+

+(* Move up `frame_count' frames, assuming current frame pointer

+ corresponds to event `event'. Return event of final frame. *)

+

+let rec move_up frame_count event =

+ if frame_count <= 0 then event else begin

+ let (sp, pc) = up_frame event.ev_stacksize in

+ if sp < 0 then raise Not_found;

+ move_up (frame_count - 1) (event_at_pc pc)

+ end

+

+(* Select a frame. *)

+(* Raise `Not_found' if no such frame. *)

+(* --- Assume the current events have already been updated. *)

+let select_frame frame_number =

+ let (initial_sp, _) = get_frame() in

+ try

+ match !current_event with

+ None ->

+ raise Not_found

+ | Some curr_event ->

+ match !selected_event with

+ Some sel_event when frame_number >= !current_frame ->

+ selected_event :=

+ Some(move_up (frame_number - !current_frame) sel_event);

+ current_frame := frame_number

+ | _ ->

+ initial_frame();

+ selected_event := Some(move_up frame_number curr_event);

+ current_frame := frame_number

+ with Not_found ->

+ set_frame initial_sp;

+ raise Not_found

+

+(* Select a frame. *)

+(* Same as `select_frame' but raise no exception if the frame is not found. *)

+(* --- Assume the currents events have already been updated. *)

+let try_select_frame frame_number =

+ try

+ select_frame frame_number

+ with

+ Not_found ->

+ ()

+

+(* Return to default frame (frame 0). *)

+let reset_frame () =

+ initial_frame();

+ selected_event := !current_event;

+ current_frame := 0

+

+(* Perform a stack backtrace.

+ Call the given function with the events for each stack frame,

+ or None if we've encountered a stack frame with no debugging info

+ attached. Stop when the function returns false, or frame with no

+ debugging info reached, or top of stack reached. *)

+

+let do_backtrace action =

+ match !current_event with

+ None -> Misc.fatal_error "Frames.do_backtrace"

+ | Some curr_ev ->

+ let (initial_sp, _) = get_frame() in

+ initial_frame();

+ let event = ref curr_ev in

+ begin try

+ while action (Some !event) do

+ let (sp, pc) = up_frame !event.ev_stacksize in

+ if sp < 0 then raise Exit;

+ event := event_at_pc pc

+ done

+ with Exit -> ()

+ | Not_found -> action None; ()

+ end;

+ set_frame initial_sp

+

+(* Return the number of frames in the stack *)

+

+let stack_depth () =

+ let num_frames = ref 0 in

+ do_backtrace (function Some ev -> incr num_frames; true

+ | None -> num_frames := -1; false);

+ !num_frames

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(****************************** Frames *********************************)

+

+open Instruct

+open Primitives

+

+(* Current frame number *)

+val current_frame : int ref

+

+(* Event at selected position. *)

+val selected_event : debug_event option ref

+

+(* Selected position in source. *)

+(* Raise `Not_found' if not on an event. *)

+val selected_point : unit -> string * int

+

+val selected_event_is_before : unit -> bool

+

+(* Select a frame. *)

+(* Raise `Not_found' if no such frame. *)

+(* --- Assume the currents events have already been updated. *)

+val select_frame : int -> unit

+

+(* Select a frame. *)

+(* Same as `select_frame' but raise no exception if the frame is not found. *)

+(* --- Assume the currents events have already been updated. *)

+val try_select_frame : int -> unit

+

+(* Return to default frame (frame 0). *)

+val reset_frame : unit -> unit

+

+(* Perform a stack backtrace.

+ Call the given function with the events for each stack frame,

+ or None if we've encountered a stack frame with no debugging info

+ attached. Stop when the function returns false, or frame with no

+ debugging info reached, or top of stack reached. *)

+val do_backtrace : (debug_event option -> bool) -> unit

+

+(* Return the number of frames in the stack, or (-1) if it can't be

+ determined because some frames have no debugging info. *)

+val stack_depth : unit -> int

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+open Checkpoints

+open Misc

+open Primitives

+open Debugger_config

+

+let history = ref ([] : int list)

+

+let empty_history () =

+ history := []

+

+let add_current_time () =

+ let time = current_time () in

+ if history = ref [] then

+ history := [time]

+ else if time <> List.hd !history then

+ history := list_truncate !history_size (time::!history)

+

+let previous_time_1 () =

+ match !history with

+ _::((time::_) as hist) ->

+ history := hist; time

+ | _ ->

+ prerr_endline "No more information."; raise Toplevel

+

+let rec previous_time n =

+ if n = 1

+ then previous_time_1()

+ else begin previous_time_1(); previous_time(n-1) end

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+val empty_history : unit -> unit

+

+val add_current_time : unit -> unit

+

+val previous_time : int -> int

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(**************************** Input control ****************************)

+

+open Unix

+open Primitives

+

+(*** Actives files. ***)

+

+(* List of the actives files. *)

+let active_files =

+ ref ([] : (file_descr * ((io_channel -> unit) * io_channel)) list)

+

+(* Add a file to the list of actives files. *)

+let add_file file controller =

+ active_files := (file.io_fd, (controller, file))::!active_files

+

+(* Remove a file from the list of actives files. *)

+let remove_file file =

+ active_files := assoc_remove !active_files file.io_fd

+

+(* Change the controller for the given file. *)

+let change_controller file controller =

+ remove_file file; add_file file controller

+

+(* Return the controller currently attached to the given file. *)

+let current_controller file =

+ fst (List.assoc file.io_fd !active_files)

+

+(* Execute a function with `controller' attached to `file'. *)

+(* ### controller file funct *)

+let execute_with_other_controller controller file funct =

+ let old_controller = current_controller file in

+ change_controller file controller;

+ try

+ let result = funct () in

+ change_controller file old_controller;

+ result

+ with

+ x ->

+ change_controller file old_controller;

+ raise x

+

+(*** The "Main Loop" ***)

+

+let continue_main_loop =

+ ref true

+

+let exit_main_loop _ =

+ continue_main_loop := false

+

+(* Handle active files until `continue_main_loop' is false. *)

+let main_loop () =

+ let old_state = !continue_main_loop in

+ try

+ continue_main_loop := true;

+ while !continue_main_loop do

+ try

+ let (input, _, _) = select (List.map fst !active_files) [] [] (-1.) in

+ List.iter

+ (function fd ->

+ let (funct, iochan) = (List.assoc fd !active_files) in

+ funct iochan)

+ input

+ with

+ Unix_error (EINTR, _, _) -> prerr_endline "EINTR";()

+ done;

+ continue_main_loop := old_state

+ with

+ x ->

+ continue_main_loop := old_state;

+ raise x

+

+(*** Managing user inputs ***)

+

+(* Are we in interactive mode ? *)

+let interactif = ref true

+

+let current_prompt = ref ""

+

+(* Where the user input come from. *)

+let user_channel = ref std_io

+

+let read_user_input buffer length =

+ main_loop ();

+ input !user_channel.io_in buffer 0 length

+

+(* Stop reading user input. *)

+let stop_user_input () =

+ remove_file !user_channel

+

+(* Resume reading user input. *)

+let resume_user_input () =

+ if not (List.mem_assoc !user_channel.io_fd !active_files) then begin

+ if !interactif then begin

+ print_string !current_prompt;

+ flush Pervasives.stdout

+ end;

+ add_file !user_channel exit_main_loop

+ end

+

+(* Ask user a yes or no question. *)

+let yes_or_no message =

+ if !interactif then

+ let old_prompt = !current_prompt in

+ try

+ current_prompt := message ^ " ? (y or n) ";

+ let answer =

+ let rec ask () =

+ resume_user_input ();

+ let line =

+ string_trim (Lexer.line (Lexing.from_function read_user_input))

+ in

+ stop_user_input ();

+ match (if String.length line > 0 then line.[0] else ' ') with

+ 'y' -> true

+ | 'n' -> false

+ | _ ->

+ print_string "Please answer y or n.";

+ print_newline ();

+ ask ()

+ in

+ ask ()

+ in

+ current_prompt := old_prompt;

+ answer

+ with

+ x ->

+ current_prompt := old_prompt;

+ stop_user_input ();

+ raise x

+ else

+ false

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(***************************** Input control ***************************)

+

+open Primitives

+

+(*** Actives files. ***)

+

+(* Add a file to the list of active files. *)

+val add_file : io_channel -> (io_channel -> unit) -> unit

+

+(* Remove a file from the list of actives files. *)

+val remove_file : io_channel -> unit

+

+(* Return the controller currently attached to the given file. *)

+val current_controller : io_channel -> (io_channel -> unit)

+

+(* Execute a function with `controller' attached to `file'. *)

+(* ### controller file funct *)

+val execute_with_other_controller :

+ (io_channel -> unit) -> io_channel -> (unit -> 'a) -> 'a

+

+(*** The "Main Loop" ***)

+

+(* Call this function for exiting the main loop. *)

+val exit_main_loop : 'a -> unit

+

+(* Handle active files until `continue_main_loop' is false. *)

+val main_loop : unit -> unit

+

+(*** Managing user inputs ***)

+

+(* Are we in interactive mode ? *)

+val interactif : bool ref

+

+val current_prompt : string ref

+

+(* Where the user input come from. *)

+val user_channel : io_channel ref

+

+val read_user_input : string -> int -> int

+

+(* Stop reading user input. *)

+val stop_user_input : unit -> unit

+

+(* Resume reading user input. *)

+val resume_user_input : unit -> unit

+

+(* Ask user a yes or no question. *)

+val yes_or_no : string -> bool

+

+

+open Primitives

+open Parser

+

+let lex_tables = {

+ Lexing.lex_base =

+ "\000\000\002\000\001\000\035\000\232\255\231\255\000\000\194\000\

+ \100\000\247\255\242\255\241\255\231\000\244\255\012\001\029\001\

+ \053\000\053\000\236\255\083\001\120\001\157\001\219\001\240\255\

+ \239\255\017\000\171\002\238\255\237\255\123\003\075\004\027\005\

+ \235\005\187\006\139\007\091\008\248\255\058\009\245\255\065\000\

+ \075\000\087\000\038\002\246\002\100\000\084\000\228\000\252\255\

+ \229\000\254\255\003\000\253\255\233\000\234\000\238\000\251\000\

+ \004\000\255\255";

+ Lexing.lex_backtrk =

+ "\001\000\255\255\000\000\255\255\255\255\255\255\000\000\022\000\

+ \024\000\255\255\255\255\255\255\005\000\255\255\006\000\004\000\

+ \004\000\024\000\255\255\020\000\021\000\009\000\002\000\255\255\

+ \255\255\012\000\002\000\255\255\255\255\002\000\255\255\002\000\

+ \002\000\002\000\002\000\001\000\255\255\022\000\255\255\004\000\

+ \255\255\255\255\255\255\004\000\004\000\004\000\255\255\255\255\

+ \000\000\255\255\000\000\255\255\000\000\001\000\001\000\000\000\

+ \001\000\255\255";

+ Lexing.lex_default =

+ "\056\000\052\000\050\000\022\000\000\000\000\000\255\255\255\255\

+ \046\000\000\000\000\000\000\000\255\255\000\000\255\255\255\255\

+ \255\255\255\255\000\000\255\255\255\255\255\255\255\255\000\000\

+ \000\000\255\255\255\255\000\000\000\000\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\000\000\255\255\000\000\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\046\000\000\000\

+ \255\255\000\000\050\000\000\000\055\000\255\255\255\255\055\000\

+ \056\000\000\000";

+ Lexing.lex_trans =

+ "\051\000\049\000\051\000\255\255\255\255\000\000\000\000\000\000\

+ \000\000\048\000\057\000\053\000\000\000\000\000\057\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \048\000\000\000\053\000\004\000\005\000\005\000\005\000\005\000\

+ \005\000\005\000\005\000\005\000\006\000\005\000\005\000\005\000\

+ \005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\

+ \005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\

+ \005\000\005\000\005\000\006\000\007\000\008\000\009\000\005\000\

+ \007\000\007\000\005\000\010\000\011\000\012\000\007\000\013\000\

+ \014\000\005\000\007\000\015\000\016\000\016\000\016\000\016\000\

+ \016\000\016\000\016\000\016\000\016\000\017\000\018\000\007\000\

+ \019\000\020\000\007\000\021\000\255\255\039\000\039\000\039\000\

+ \039\000\039\000\039\000\039\000\039\000\039\000\039\000\038\000\

+ \036\000\039\000\039\000\039\000\039\000\039\000\039\000\039\000\

+ \039\000\039\000\039\000\045\000\045\000\000\000\023\000\005\000\

+ \024\000\007\000\025\000\005\000\045\000\045\000\047\000\044\000\

+ \044\000\044\000\044\000\044\000\044\000\044\000\044\000\000\000\

+ \000\000\000\000\000\000\026\000\044\000\044\000\044\000\044\000\

+ \044\000\044\000\044\000\044\000\000\000\000\000\027\000\007\000\

+ \028\000\007\000\005\000\005\000\005\000\005\000\005\000\005\000\

+ \005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\

+ \005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\

+ \005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\

+ \005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\

+ \005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\

+ \005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\

+ \005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\

+ \005\000\005\000\005\000\037\000\255\255\000\000\037\000\037\000\

+ \037\000\255\255\000\000\000\000\037\000\037\000\048\000\037\000\

+ \037\000\037\000\255\255\054\000\000\000\000\000\000\000\054\000\

+ \000\000\000\000\005\000\255\255\037\000\037\000\037\000\037\000\

+ \037\000\037\000\037\000\000\000\255\255\048\000\047\000\000\000\

+ \037\000\255\255\054\000\037\000\037\000\037\000\054\000\000\000\

+ \000\000\037\000\037\000\000\000\037\000\037\000\037\000\000\000\

+ \000\000\000\000\005\000\255\255\000\000\000\000\000\000\000\000\

+ \037\000\037\000\037\000\037\000\037\000\037\000\037\000\037\000\

+ \000\000\000\000\000\000\000\000\000\000\037\000\000\000\000\000\

+ \037\000\037\000\037\000\000\000\000\000\000\000\037\000\037\000\

+ \000\000\037\000\037\000\037\000\000\000\000\000\037\000\000\000\

+ \037\000\000\000\000\000\000\000\000\000\037\000\037\000\037\000\

+ \037\000\037\000\037\000\037\000\037\000\039\000\039\000\039\000\

+ \039\000\039\000\039\000\039\000\039\000\039\000\039\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\040\000\

+ \000\000\000\000\000\000\037\000\000\000\037\000\000\000\000\000\

+ \000\000\000\000\037\000\000\000\041\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\037\000\042\000\000\000\037\000\

+ \037\000\037\000\000\000\000\000\000\000\037\000\037\000\040\000\

+ \037\000\037\000\037\000\000\000\000\000\000\000\000\000\000\000\

+ \037\000\000\000\037\000\000\000\041\000\037\000\037\000\037\000\

+ \037\000\037\000\037\000\037\000\000\000\042\000\000\000\000\000\

+ \000\000\037\000\000\000\000\000\037\000\037\000\037\000\000\000\

+ \000\000\000\000\037\000\037\000\000\000\037\000\037\000\037\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\037\000\037\000\037\000\037\000\037\000\037\000\037\000\

+ \037\000\000\000\000\000\000\000\000\000\000\000\037\000\000\000\

+ \000\000\037\000\037\000\037\000\000\000\000\000\000\000\037\000\

+ \037\000\000\000\037\000\037\000\037\000\000\000\000\000\037\000\

+ \000\000\037\000\000\000\000\000\000\000\000\000\037\000\037\000\

+ \037\000\037\000\037\000\037\000\037\000\037\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\037\000\000\000\037\000\000\000\

+ \000\000\000\000\000\000\037\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\029\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\000\000\000\000\000\000\

+ \000\000\037\000\000\000\037\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\000\000\000\000\

+ \000\000\000\000\030\000\000\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\043\000\043\000\

+ \043\000\043\000\043\000\043\000\043\000\043\000\043\000\043\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\043\000\

+ \043\000\043\000\043\000\043\000\043\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\043\000\

+ \043\000\043\000\043\000\043\000\043\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\000\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\000\000\000\000\

+ \000\000\000\000\030\000\000\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\031\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\043\000\043\000\

+ \043\000\043\000\043\000\043\000\043\000\043\000\043\000\043\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\043\000\

+ \043\000\043\000\043\000\043\000\043\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\043\000\

+ \043\000\043\000\043\000\043\000\043\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\000\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\000\000\000\000\

+ \000\000\000\000\030\000\000\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\000\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\000\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\000\000\000\000\

+ \000\000\000\000\030\000\000\000\029\000\029\000\029\000\029\000\

+ \032\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\000\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\000\000\000\000\

+ \000\000\000\000\030\000\000\000\029\000\029\000\029\000\029\000\

+ \029\000\033\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\000\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\000\000\000\000\

+ \000\000\000\000\030\000\000\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\034\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\000\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\000\000\000\000\

+ \000\000\000\000\030\000\000\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\035\000\029\000\029\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\000\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\000\000\000\000\

+ \000\000\000\000\030\000\000\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\000\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\000\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\037\000\000\000\000\000\037\000\037\000\

+ \037\000\000\000\000\000\000\000\037\000\037\000\000\000\037\000\

+ \037\000\037\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\037\000\037\000\037\000\037\000\

+ \037\000\037\000\037\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \037\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\037\000\000\000\

+ \037\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+ \000\000\000\000";

+ Lexing.lex_check =

+ "\000\000\002\000\001\000\050\000\056\000\255\255\255\255\255\255\

+ \255\255\006\000\000\000\001\000\255\255\255\255\056\000\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \006\000\255\255\001\000\003\000\003\000\003\000\003\000\003\000\

+ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\

+ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\

+ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\

+ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\

+ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\

+ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\

+ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\

+ \003\000\003\000\003\000\003\000\008\000\016\000\016\000\016\000\

+ \016\000\016\000\016\000\016\000\016\000\016\000\016\000\017\000\

+ \025\000\039\000\039\000\039\000\039\000\039\000\039\000\039\000\

+ \039\000\039\000\039\000\040\000\040\000\255\255\003\000\003\000\

+ \003\000\003\000\003\000\003\000\045\000\045\000\008\000\041\000\

+ \041\000\041\000\041\000\041\000\041\000\041\000\041\000\255\255\

+ \255\255\255\255\255\255\003\000\044\000\044\000\044\000\044\000\

+ \044\000\044\000\044\000\044\000\255\255\255\255\003\000\003\000\

+ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\

+ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\

+ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\

+ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\

+ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\

+ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\

+ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\

+ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\

+ \003\000\003\000\003\000\007\000\046\000\255\255\007\000\007\000\

+ \007\000\052\000\255\255\255\255\007\000\007\000\048\000\007\000\

+ \007\000\007\000\052\000\053\000\255\255\255\255\255\255\054\000\

+ \255\255\255\255\003\000\055\000\007\000\007\000\007\000\007\000\

+ \007\000\007\000\007\000\255\255\055\000\048\000\046\000\255\255\

+ \012\000\052\000\053\000\012\000\012\000\012\000\054\000\255\255\

+ \255\255\012\000\012\000\255\255\012\000\012\000\012\000\255\255\

+ \255\255\255\255\003\000\055\000\255\255\255\255\255\255\255\255\

+ \007\000\012\000\012\000\012\000\012\000\012\000\012\000\012\000\

+ \255\255\255\255\255\255\255\255\255\255\014\000\255\255\255\255\

+ \014\000\014\000\014\000\255\255\255\255\255\255\014\000\014\000\

+ \255\255\014\000\014\000\014\000\255\255\255\255\007\000\255\255\

+ \007\000\255\255\255\255\255\255\255\255\012\000\014\000\014\000\

+ \014\000\014\000\014\000\014\000\014\000\015\000\015\000\015\000\

+ \015\000\015\000\015\000\015\000\015\000\015\000\015\000\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\015\000\

+ \255\255\255\255\255\255\012\000\255\255\012\000\255\255\255\255\

+ \255\255\255\255\014\000\255\255\015\000\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\019\000\015\000\255\255\019\000\

+ \019\000\019\000\255\255\255\255\255\255\019\000\019\000\015\000\

+ \019\000\019\000\019\000\255\255\255\255\255\255\255\255\255\255\

+ \014\000\255\255\014\000\255\255\015\000\019\000\019\000\019\000\

+ \019\000\019\000\019\000\019\000\255\255\015\000\255\255\255\255\

+ \255\255\020\000\255\255\255\255\020\000\020\000\020\000\255\255\

+ \255\255\255\255\020\000\020\000\255\255\020\000\020\000\020\000\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\019\000\020\000\020\000\020\000\020\000\020\000\020\000\

+ \020\000\255\255\255\255\255\255\255\255\255\255\021\000\255\255\

+ \255\255\021\000\021\000\021\000\255\255\255\255\255\255\021\000\

+ \021\000\255\255\021\000\021\000\021\000\255\255\255\255\019\000\

+ \255\255\019\000\255\255\255\255\255\255\255\255\020\000\021\000\

+ \021\000\021\000\021\000\021\000\021\000\021\000\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\020\000\255\255\020\000\255\255\

+ \255\255\255\255\255\255\021\000\255\255\255\255\255\255\255\255\

+ \255\255\255\255\022\000\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\022\000\022\000\022\000\022\000\022\000\

+ \022\000\022\000\022\000\022\000\022\000\255\255\255\255\255\255\

+ \255\255\021\000\255\255\021\000\022\000\022\000\022\000\022\000\

+ \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\

+ \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\

+ \022\000\022\000\022\000\022\000\022\000\022\000\255\255\255\255\

+ \255\255\255\255\022\000\255\255\022\000\022\000\022\000\022\000\

+ \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\

+ \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\

+ \022\000\022\000\022\000\022\000\022\000\022\000\042\000\042\000\

+ \042\000\042\000\042\000\042\000\042\000\042\000\042\000\042\000\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\042\000\

+ \042\000\042\000\042\000\042\000\042\000\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\042\000\

+ \042\000\042\000\042\000\042\000\042\000\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\022\000\022\000\022\000\022\000\022\000\

+ \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\

+ \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\

+ \022\000\022\000\255\255\022\000\022\000\022\000\022\000\022\000\

+ \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\

+ \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\

+ \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\

+ \022\000\022\000\026\000\022\000\022\000\022\000\022\000\022\000\

+ \022\000\022\000\022\000\026\000\026\000\026\000\026\000\026\000\

+ \026\000\026\000\026\000\026\000\026\000\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\026\000\026\000\026\000\026\000\

+ \026\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\

+ \026\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\

+ \026\000\026\000\026\000\026\000\026\000\026\000\255\255\255\255\

+ \255\255\255\255\026\000\255\255\026\000\026\000\026\000\026\000\

+ \026\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\

+ \026\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\

+ \026\000\026\000\026\000\026\000\026\000\026\000\043\000\043\000\

+ \043\000\043\000\043\000\043\000\043\000\043\000\043\000\043\000\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\043\000\

+ \043\000\043\000\043\000\043\000\043\000\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\043\000\

+ \043\000\043\000\043\000\043\000\043\000\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\026\000\026\000\026\000\026\000\026\000\

+ \026\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\

+ \026\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\

+ \026\000\026\000\255\255\026\000\026\000\026\000\026\000\026\000\

+ \026\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\

+ \026\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\

+ \026\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\

+ \026\000\026\000\029\000\026\000\026\000\026\000\026\000\026\000\

+ \026\000\026\000\026\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\255\255\255\255\

+ \255\255\255\255\029\000\255\255\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\255\255\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\030\000\029\000\029\000\029\000\029\000\029\000\

+ \029\000\029\000\029\000\030\000\030\000\030\000\030\000\030\000\

+ \030\000\030\000\030\000\030\000\030\000\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\030\000\030\000\030\000\030\000\

+ \030\000\030\000\030\000\030\000\030\000\030\000\030\000\030\000\

+ \030\000\030\000\030\000\030\000\030\000\030\000\030\000\030\000\

+ \030\000\030\000\030\000\030\000\030\000\030\000\255\255\255\255\

+ \255\255\255\255\255\255\255\255\030\000\030\000\030\000\030\000\

+ \030\000\030\000\030\000\030\000\030\000\030\000\030\000\030\000\

+ \030\000\030\000\030\000\030\000\030\000\030\000\030\000\030\000\

+ \030\000\030\000\030\000\030\000\030\000\030\000\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\030\000\030\000\030\000\030\000\030\000\

+ \030\000\030\000\030\000\030\000\030\000\030\000\030\000\030\000\

+ \030\000\030\000\030\000\030\000\030\000\030\000\030\000\030\000\

+ \030\000\030\000\255\255\030\000\030\000\030\000\030\000\030\000\

+ \030\000\030\000\030\000\030\000\030\000\030\000\030\000\030\000\

+ \030\000\030\000\030\000\030\000\030\000\030\000\030\000\030\000\

+ \030\000\030\000\030\000\030\000\030\000\030\000\030\000\030\000\

+ \030\000\030\000\031\000\030\000\030\000\030\000\030\000\030\000\

+ \030\000\030\000\030\000\031\000\031\000\031\000\031\000\031\000\

+ \031\000\031\000\031\000\031\000\031\000\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\031\000\031\000\031\000\031\000\

+ \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\

+ \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\

+ \031\000\031\000\031\000\031\000\031\000\031\000\255\255\255\255\

+ \255\255\255\255\031\000\255\255\031\000\031\000\031\000\031\000\

+ \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\

+ \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\

+ \031\000\031\000\031\000\031\000\031\000\031\000\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\031\000\031\000\031\000\031\000\031\000\

+ \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\

+ \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\

+ \031\000\031\000\255\255\031\000\031\000\031\000\031\000\031\000\

+ \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\

+ \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\

+ \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\

+ \031\000\031\000\032\000\031\000\031\000\031\000\031\000\031\000\

+ \031\000\031\000\031\000\032\000\032\000\032\000\032\000\032\000\

+ \032\000\032\000\032\000\032\000\032\000\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\032\000\032\000\032\000\032\000\

+ \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\

+ \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\

+ \032\000\032\000\032\000\032\000\032\000\032\000\255\255\255\255\

+ \255\255\255\255\032\000\255\255\032\000\032\000\032\000\032\000\

+ \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\

+ \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\

+ \032\000\032\000\032\000\032\000\032\000\032\000\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\032\000\032\000\032\000\032\000\032\000\

+ \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\

+ \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\

+ \032\000\032\000\255\255\032\000\032\000\032\000\032\000\032\000\

+ \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\

+ \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\

+ \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\

+ \032\000\032\000\033\000\032\000\032\000\032\000\032\000\032\000\

+ \032\000\032\000\032\000\033\000\033\000\033\000\033\000\033\000\

+ \033\000\033\000\033\000\033\000\033\000\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\033\000\033\000\033\000\033\000\

+ \033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\

+ \033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\

+ \033\000\033\000\033\000\033\000\033\000\033\000\255\255\255\255\

+ \255\255\255\255\033\000\255\255\033\000\033\000\033\000\033\000\

+ \033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\

+ \033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\

+ \033\000\033\000\033\000\033\000\033\000\033\000\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\033\000\033\000\033\000\033\000\033\000\

+ \033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\

+ \033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\

+ \033\000\033\000\255\255\033\000\033\000\033\000\033\000\033\000\

+ \033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\

+ \033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\

+ \033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\

+ \033\000\033\000\034\000\033\000\033\000\033\000\033\000\033\000\

+ \033\000\033\000\033\000\034\000\034\000\034\000\034\000\034\000\

+ \034\000\034\000\034\000\034\000\034\000\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\034\000\034\000\034\000\034\000\

+ \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\

+ \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\

+ \034\000\034\000\034\000\034\000\034\000\034\000\255\255\255\255\

+ \255\255\255\255\034\000\255\255\034\000\034\000\034\000\034\000\

+ \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\

+ \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\

+ \034\000\034\000\034\000\034\000\034\000\034\000\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\034\000\034\000\034\000\034\000\034\000\

+ \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\

+ \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\

+ \034\000\034\000\255\255\034\000\034\000\034\000\034\000\034\000\

+ \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\

+ \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\

+ \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\

+ \034\000\034\000\035\000\034\000\034\000\034\000\034\000\034\000\

+ \034\000\034\000\034\000\035\000\035\000\035\000\035\000\035\000\

+ \035\000\035\000\035\000\035\000\035\000\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\035\000\035\000\035\000\035\000\

+ \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\

+ \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\

+ \035\000\035\000\035\000\035\000\035\000\035\000\255\255\255\255\

+ \255\255\255\255\035\000\255\255\035\000\035\000\035\000\035\000\

+ \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\

+ \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\

+ \035\000\035\000\035\000\035\000\035\000\035\000\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\035\000\035\000\035\000\035\000\035\000\

+ \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\

+ \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\

+ \035\000\035\000\255\255\035\000\035\000\035\000\035\000\035\000\

+ \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\

+ \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\

+ \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\

+ \035\000\035\000\255\255\035\000\035\000\035\000\035\000\035\000\

+ \035\000\035\000\035\000\037\000\255\255\255\255\037\000\037\000\

+ \037\000\255\255\255\255\255\255\037\000\037\000\255\255\037\000\

+ \037\000\037\000\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\037\000\037\000\037\000\037\000\

+ \037\000\037\000\037\000\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \037\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\037\000\255\255\

+ \037\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\

+ \255\255\255\255"

+}

+

+let rec line lexbuf =

+ match Lexing.engine lex_tables 0 lexbuf with

+ 0 -> ( let line =

+ Lexing.lexeme lexbuf

+ in

+ String.sub line 0 (String.length line - 1) )

+ | 1 -> ( Lexing.lexeme lexbuf )

+ | 2 -> ( raise Exit )

+ | _ -> lexbuf.Lexing.refill_buff lexbuf; line lexbuf

+

+and argument lexbuf =

+ match Lexing.engine lex_tables 1 lexbuf with

+ 0 -> ( ARGUMENT (Lexing.lexeme lexbuf) )

+ | 1 -> ( argument lexbuf )

+ | 2 -> ( EOL )

+ | 3 -> ( raise Parsing.Parse_error )

+ | _ -> lexbuf.Lexing.refill_buff lexbuf; argument lexbuf

+

+and line_argument lexbuf =

+ match Lexing.engine lex_tables 2 lexbuf with

+ 0 -> ( ARGUMENT (Lexing.lexeme lexbuf) )

+ | 1 -> ( EOL )

+ | _ -> lexbuf.Lexing.refill_buff lexbuf; line_argument lexbuf

+

+and lexeme lexbuf =

+ match Lexing.engine lex_tables 3 lexbuf with

+ 0 -> ( lexeme lexbuf )

+ | 1 -> ( PREFIX )

+ | 2 -> ( IDENTIFIER (Lexing.lexeme lexbuf) )

+ | 3 -> ( let s = Lexing.lexeme lexbuf in

+ IDENTIFIER (String.sub s 1 (String.length s - 2)) )

+ | 4 -> ( INTEGER (int_of_string (Lexing.lexeme lexbuf)) )

+ | 5 -> ( STAR )

+ | 6 -> ( MINUS )

+ | 7 -> ( UNDERUNDER )

+ | 8 -> ( SHARP )

+ | 9 -> ( AT )

+ | 10 -> ( COLONCOLON )

+ | 11 -> ( COMMA )

+ | 12 -> ( UNDERSCORE )

+ | 13 -> ( LPAREN )

+ | 14 -> ( RPAREN )

+ | 15 -> ( LBRACKET )

+ | 16 -> ( RBRACKET )

+ | 17 -> ( LBRACE )

+ | 18 -> ( RBRACE )

+ | 19 -> ( SEMI )

+ | 20 -> ( EQUAL )

+ | 21 -> ( SUPERIOR )

+ | 22 -> ( OPERATOR (Lexing.lexeme lexbuf) )

+ | 23 -> ( EOL )

+ | 24 -> ( raise Parsing.Parse_error )

+ | _ -> lexbuf.Lexing.refill_buff lexbuf; lexeme lexbuf

+

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+open Primitives

+open Misc

+open Input_handling

+open Command_line_interpreter

+open Debugger_config

+open Checkpoints

+open Time_travel

+open Parameters

+open Program_management

+open Frames

+open Show_information

+

+let toplevel_loop () =

+ let line_buffer = Lexing.from_function read_user_input in

+ let rec loop () =

+ try

+ let rec loop2 () =

+ (try

+ line_loop line_buffer

+ with

+ End_of_file ->

+ forget_process

+ !current_checkpoint.c_fd

+ !current_checkpoint.c_pid;

+ flush stdout;

+ stop_user_input ();

+ loop2 ());

+ if !loaded & (not (yes_or_no "The program is running. Quit anyway")) then

+ loop2 ()

+ in

+ loop2 ()

+ with

+ Toplevel ->

+ flush stdout;

+ stop_user_input ();

+ loop ()

+ | Sys.Break ->

+ (try

+ print_endline "Interrupted.";

+ Exec.protected

+ (function () ->

+ flush stdout;

+ stop_user_input ();

+ if !loaded then

+ ((try select_frame 0 with Not_found -> ());

+ show_current_event ()))

+ with Sys.Break -> ());

+ loop ()

+ | Current_checkpoint_lost ->

+ (try

+ print_endline "Trying to recover...";

+ flush stdout;

+ stop_user_input ();

+ recover ();

+ (try select_frame 0 with Not_found -> ());

+ show_current_event ()

+ with

+ x ->

+ if x = Sys.Break then

+ print_endline "Interrupted";

+ print_endline "Can't recover; killing program...";

+ flush stdout;

+ kill_program ());

+ loop ()

+ | Not_found ->

+ print_endline "Cannot find file ";

+ flush stdout;

+ stop_user_input ();

+ loop ()

+ | x ->

+ kill_program ();

+ raise x

+ in

+ loop ()

+

+let anonymous s =

+ if !program_name = ""

+ then program_name := s

+ else arguments := Printf.sprintf "%s '%s'" !arguments s

+let add_include d =

+ default_load_path := d :: !default_load_path

+let set_socket s =

+ socket_name := s

+let set_checkpoints n =

+ checkpoint_max_count := n

+let set_directory dir =

+ Sys.chdir dir

+let set_emacs () =

+ emacs := true

+

+let main () =

+ try

+ socket_name := "/tmp/camldebug" ^ (string_of_int (Unix.getpid ()));

+ Arg.parse

+ ["-I", Arg.String add_include,

+ "<dir> Add <dir> to the list of include directories";

+ "-s", Arg.String set_socket,

+ "<filename> Set the name of the communication socket";

+ "-c", Arg.Int set_checkpoints,

+ "<count> Set max number of checkpoints kept";

+ "-cd", Arg.String set_directory,

+ "<dir> Change working directory";

+ "-emacs", Arg.Unit set_emacs,

+ "For running the debugger under emacs"]

+ anonymous

+ "";

+ current_prompt := debugger_prompt;

+ print_string "\tObjective Caml Debugger version ";

+ print_string Config.version;

+ print_newline(); print_newline();

+ Config.load_path := !default_load_path;

+ toplevel_loop (); (* Toplevel. *)

+ kill_program ();

+ exit 0

+ with Toplevel ->

+ exit 2

+

+let _ =

+ Printexc.catch (Unix.handle_unix_error main) ()

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(* Miscellaneous parameters *)

+

+open Primitives

+open Config

+open Misc

+

+let program_loaded = ref false

+let program_name = ref ""

+let socket_name = ref ""

+let arguments = ref ""

+

+let default_load_path = ref [ "."; Config.standard_library ]

+

+let add_path dir =

+ load_path := dir :: except dir !load_path;

+ Envaux.reset_cache()

+

+(* Used by emacs ? *)

+let emacs = ref false

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(* Miscellaneous parameters *)

+

+val program_name : string ref

+val socket_name : string ref

+val arguments : string ref

+val default_load_path : string list ref

+

+val add_path : string -> unit

+

+(* Used by emacs ? *)

+val emacs : bool ref

+type token =

+ ARGUMENT of (string)

+ | IDENTIFIER of (string)

+ | INTEGER of (int)

+ | STAR

+ | MINUS

+ | UNDERUNDER

+ | SHARP

+ | AT

+ | COLONCOLON

+ | COMMA

+ | UNDERSCORE

+ | LPAREN

+ | RPAREN

+ | LBRACKET

+ | RBRACKET

+ | LBRACE

+ | RBRACE

+ | SEMI

+ | EQUAL

+ | SUPERIOR

+ | PREFIX

+ | OPERATOR of (string)

+ | EOL

+

+open Parsing

+

+open Primitives

+open Input_handling

+open Parser_aux

+

+(* Line 8, file parser.ml *)

+let yytransl_const = [|

+ 260 (* STAR *);

+ 261 (* MINUS *);

+ 262 (* UNDERUNDER *);

+ 263 (* SHARP *);

+ 264 (* AT *);

+ 265 (* COLONCOLON *);

+ 266 (* COMMA *);

+ 267 (* UNDERSCORE *);

+ 268 (* LPAREN *);

+ 269 (* RPAREN *);

+ 270 (* LBRACKET *);

+ 271 (* RBRACKET *);

+ 272 (* LBRACE *);

+ 273 (* RBRACE *);

+ 274 (* SEMI *);

+ 275 (* EQUAL *);

+ 276 (* SUPERIOR *);

+ 277 (* PREFIX *);

+ 279 (* EOL *);

+ 0|]

+

+let yytransl_block = [|

+ 257 (* ARGUMENT *);

+ 258 (* IDENTIFIER *);

+ 259 (* INTEGER *);

+ 278 (* OPERATOR *);

+ 0|]

+

+let yylhs = "\255\255\

+\001\000\001\000\002\000\003\000\003\000\004\000\005\000\006\000\

+\006\000\007\000\007\000\008\000\009\000\010\000\010\000\017\000\

+\017\000\011\000\011\000\012\000\012\000\019\000\020\000\020\000\

+\020\000\020\000\020\000\020\000\020\000\018\000\018\000\018\000\

+\013\000\013\000\013\000\013\000\013\000\015\000\015\000\014\000\

+\022\000\022\000\023\000\023\000\024\000\025\000\025\000\021\000\

+\021\000\021\000\021\000\021\000\026\000\026\000\026\000\026\000\

+\026\000\026\000\026\000\016\000\000\000\000\000\000\000\000\000\

+\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+\000\000\000\000\000\000\000\000"

+

+let yylen = "\002\000\

+\002\000\001\000\002\000\002\000\001\000\002\000\001\000\002\000\

+\001\000\002\000\001\000\001\000\002\000\001\000\001\000\001\000\

+\000\000\002\000\001\000\002\000\001\000\002\000\001\000\002\000\

+\002\000\002\000\002\000\002\000\002\000\001\000\003\000\001\000\

+\001\000\001\000\001\000\004\000\004\000\003\000\001\000\003\000\

+\003\000\001\000\003\000\001\000\003\000\003\000\003\000\001\000\

+\003\000\001\000\002\000\002\000\001\000\001\000\002\000\003\000\

+\003\000\003\000\003\000\001\000\002\000\002\000\002\000\002\000\

+\002\000\002\000\002\000\002\000\002\000\002\000\002\000\002\000\

+\002\000\002\000\002\000\002\000"

+

+let yydefred = "\000\000\

+\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+\000\000\000\000\060\000\061\000\002\000\000\000\062\000\000\000\

+\063\000\005\000\000\000\064\000\007\000\065\000\000\000\066\000\

+\009\000\000\000\011\000\067\000\012\000\068\000\000\000\069\000\

+\014\000\070\000\015\000\000\000\071\000\019\000\000\000\032\000\

+\000\000\072\000\021\000\000\000\030\000\000\000\034\000\073\000\

+\033\000\000\000\035\000\074\000\000\000\000\000\039\000\075\000\

+\000\000\076\000\001\000\003\000\004\000\006\000\008\000\010\000\

+\013\000\018\000\000\000\024\000\025\000\026\000\027\000\028\000\

+\029\000\020\000\016\000\000\000\022\000\000\000\000\000\053\000\

+\000\000\000\000\000\000\000\000\054\000\000\000\000\000\000\000\

+\048\000\000\000\023\000\031\000\000\000\000\000\000\000\000\000\

+\055\000\000\000\000\000\000\000\000\000\000\000\052\000\051\000\

+\000\000\000\000\040\000\000\000\038\000\036\000\037\000\000\000\

+\058\000\000\000\056\000\000\000\057\000\000\000\000\000\000\000\

+\000\000\041\000\000\000\043\000"

+

+let yydgoto = "\017\000\

+\020\000\023\000\025\000\028\000\030\000\032\000\036\000\093\000\

+\040\000\042\000\045\000\050\000\056\000\060\000\064\000\033\000\

+\065\000\094\000\059\000\053\000\106\000\107\000\109\000\110\000\

+\096\000\097\000"

+

+let yysindex = "\159\000\

+\007\255\026\255\022\255\006\255\041\255\047\255\016\255\021\255\

+\051\255\008\255\009\255\045\255\034\255\070\255\020\255\033\255\

+\000\000\007\255\000\000\000\000\000\000\033\255\000\000\022\255\

+\000\000\000\000\033\255\000\000\000\000\000\000\033\255\000\000\

+\000\000\006\255\000\000\000\000\000\000\000\000\033\255\000\000\

+\000\000\000\000\000\000\033\255\000\000\000\000\061\255\000\000\

+\137\255\000\000\000\000\045\255\000\000\074\255\000\000\000\000\

+\000\000\033\255\000\000\000\000\132\255\033\255\000\000\000\000\

+\041\255\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+\000\000\000\000\014\255\000\000\000\000\000\000\000\000\000\000\

+\000\000\000\000\000\000\119\255\000\000\061\255\087\255\000\000\

+\132\255\117\255\070\255\174\255\000\000\174\255\042\255\090\255\

+\000\000\047\255\000\000\000\000\047\255\006\255\132\255\093\255\

+\000\000\053\255\092\255\086\255\095\255\107\255\000\000\000\000\

+\132\255\132\255\000\000\132\255\000\000\000\000\000\000\101\255\

+\000\000\132\255\000\000\132\255\000\000\070\255\101\255\083\255\

+\083\255\000\000\083\255\000\000"

+

+let yyrindex = "\000\000\

+\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+\000\000\000\000\000\000\000\000\000\000\000\000\112\255\000\000\

+\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+\000\000\000\000\000\000\000\000\000\000\000\000\097\255\000\000\

+\000\000\000\000\000\000\000\000\000\000\120\255\000\000\000\000\

+\000\000\000\000\000\000\000\000\000\000\127\255\000\000\000\000\

+\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+\000\000\000\000\000\000\000\000\000\000\071\255\000\000\000\000\

+\000\000\000\000\000\000\000\000\000\000\000\000\000\000\178\255\

+\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\

+\000\000\125\255\000\000\000\000\000\000\118\255\000\000\000\000\

+\000\000\000\000\000\000\000\000\000\000\000\000\000\000\187\255\

+\000\000\000\000\000\000\000\000\000\000\000\000\196\255\203\255\

+\210\255\000\000\133\255\000\000"

+

+let yygindex = "\000\000\

+\129\000\000\000\125\000\250\255\089\000\253\255\000\000\147\000\

+\000\000\000\000\143\000\126\000\000\000\000\000\000\000\002\000\

+\123\000\244\255\000\000\104\000\201\255\058\000\056\000\000\000\

+\000\000\239\255"

+

+let yytablesize = 233

+let yytable = "\052\000\

+\058\000\061\000\021\000\035\000\026\000\095\000\055\000\018\000\

+\027\000\041\000\044\000\043\000\046\000\051\000\057\000\099\000\

+\046\000\066\000\031\000\021\000\034\000\062\000\037\000\068\000\

+\024\000\026\000\022\000\072\000\070\000\019\000\019\000\019\000\

+\071\000\104\000\049\000\047\000\027\000\048\000\019\000\052\000\

+\073\000\054\000\019\000\029\000\019\000\074\000\047\000\120\000\

+\048\000\031\000\113\000\114\000\039\000\051\000\049\000\019\000\

+\019\000\127\000\128\000\085\000\129\000\113\000\114\000\074\000\

+\019\000\049\000\075\000\019\000\131\000\019\000\122\000\047\000\

+\023\000\048\000\111\000\083\000\112\000\023\000\108\000\012\000\

+\012\000\023\000\023\000\012\000\023\000\012\000\023\000\012\000\

+\012\000\103\000\049\000\113\000\114\000\012\000\117\000\119\000\

+\115\000\118\000\023\000\116\000\023\000\113\000\114\000\023\000\

+\124\000\121\000\123\000\023\000\023\000\113\000\023\000\125\000\

+\023\000\108\000\017\000\023\000\023\000\023\000\086\000\023\000\

+\048\000\101\000\017\000\087\000\126\000\102\000\017\000\088\000\

+\089\000\016\000\090\000\105\000\091\000\086\000\044\000\048\000\

+\092\000\049\000\087\000\042\000\076\000\077\000\088\000\089\000\

+\078\000\090\000\067\000\091\000\069\000\045\000\045\000\092\000\

+\049\000\098\000\038\000\079\000\080\000\063\000\081\000\001\000\

+\002\000\003\000\004\000\005\000\006\000\007\000\008\000\009\000\

+\010\000\011\000\012\000\013\000\014\000\015\000\016\000\037\000\

+\084\000\082\000\100\000\130\000\087\000\132\000\000\000\000\000\

+\088\000\089\000\050\000\090\000\000\000\091\000\050\000\000\000\

+\050\000\000\000\050\000\050\000\059\000\000\000\000\000\059\000\

+\050\000\059\000\000\000\059\000\059\000\049\000\000\000\000\000\

+\049\000\059\000\049\000\000\000\049\000\049\000\000\000\047\000\

+\000\000\047\000\049\000\047\000\047\000\000\000\046\000\000\000\

+\046\000\047\000\046\000\046\000\000\000\000\000\000\000\000\000\

+\046\000"

+

+let yycheck = "\012\000\

+\013\000\014\000\001\000\007\000\003\000\061\000\013\000\001\001\

+\003\001\002\001\002\001\010\000\011\000\012\000\013\000\002\001\

+\015\000\016\000\003\001\018\000\005\001\002\001\002\001\022\000\

+\003\001\024\000\001\001\034\000\027\000\023\001\023\001\023\001\

+\031\000\089\000\021\001\002\001\003\001\004\001\023\001\052\000\

+\039\000\008\001\023\001\003\001\023\001\044\000\002\001\103\000\

+\004\001\003\001\009\001\010\001\002\001\052\000\021\001\023\001\

+\023\001\113\000\114\000\058\000\116\000\009\001\010\001\062\000\

+\023\001\021\001\006\001\023\001\124\000\023\001\018\001\002\001\

+\002\001\004\001\092\000\002\001\094\000\007\001\091\000\009\001\

+\010\001\011\001\012\001\013\001\014\001\015\001\016\001\017\001\

+\018\001\003\001\021\001\009\001\010\001\023\001\098\000\102\000\

+\095\000\101\000\002\001\010\001\004\001\009\001\010\001\007\001\

+\019\001\013\001\015\001\011\001\012\001\009\001\014\001\017\001\

+\016\001\126\000\003\001\019\001\020\001\021\001\002\001\023\001\

+\004\001\003\001\003\001\007\001\018\001\007\001\007\001\011\001\

+\012\001\003\001\014\001\015\001\016\001\002\001\017\001\004\001\

+\020\001\021\001\007\001\015\001\004\001\005\001\011\001\012\001\

+\008\001\014\001\018\000\016\001\024\000\017\001\018\001\020\001\

+\021\001\065\000\008\000\019\001\020\001\015\000\022\001\001\000\

+\002\000\003\000\004\000\005\000\006\000\007\000\008\000\009\000\

+\010\000\011\000\012\000\013\000\014\000\015\000\016\000\002\001\

+\054\000\052\000\075\000\122\000\007\001\126\000\255\255\255\255\

+\011\001\012\001\009\001\014\001\255\255\016\001\013\001\255\255\

+\015\001\255\255\017\001\018\001\010\001\255\255\255\255\013\001\

+\023\001\015\001\255\255\017\001\018\001\010\001\255\255\255\255\

+\013\001\023\001\015\001\255\255\017\001\018\001\255\255\013\001\

+\255\255\015\001\023\001\017\001\018\001\255\255\013\001\255\255\

+\015\001\023\001\017\001\018\001\255\255\255\255\255\255\255\255\

+\023\001"

+

+let yyact = [|

+ (fun _ -> failwith "parser")

+(* Rule 1, file parser.mly, line 105 *)

+; (fun parser_env -> Obj.repr(( (peek_val parser_env 1 : string)::(peek_val parser_env 0 : string list) ) : string list))

+(* Rule 2, file parser.mly, line 107 *)

+; (fun parser_env -> Obj.repr(( [] ) : string list))

+(* Rule 3, file parser.mly, line 111 *)

+; (fun parser_env -> Obj.repr(( (peek_val parser_env 1 : string) ) : string))

+(* Rule 4, file parser.mly, line 117 *)

+; (fun parser_env -> Obj.repr(( (peek_val parser_env 1 : int)::(peek_val parser_env 0 : int list) ) : int list))

+(* Rule 5, file parser.mly, line 119 *)

+; (fun parser_env -> Obj.repr(( [] ) : int list))

+(* Rule 6, file parser.mly, line 123 *)

+; (fun parser_env -> Obj.repr(( (peek_val parser_env 1 : int) ) : int))

+(* Rule 7, file parser.mly, line 127 *)

+; (fun parser_env -> Obj.repr(( (peek_val parser_env 0 : int) ) : int))

+(* Rule 8, file parser.mly, line 131 *)

+; (fun parser_env -> Obj.repr(( Some (peek_val parser_env 1 : int) ) : int option))

+(* Rule 9, file parser.mly, line 133 *)

+; (fun parser_env -> Obj.repr(( None ) : int option))

+(* Rule 10, file parser.mly, line 137 *)

+; (fun parser_env -> Obj.repr(( Some (- (peek_val parser_env 0 : int)) ) : int option))

+(* Rule 11, file parser.mly, line 139 *)

+; (fun parser_env -> Obj.repr(( (peek_val parser_env 0 : int option) ) : int option))

+(* Rule 12, file parser.mly, line 145 *)

+; (fun parser_env -> Obj.repr(( (peek_val parser_env 0 : string) ) : string))

+(* Rule 13, file parser.mly, line 149 *)

+; (fun parser_env -> Obj.repr(( (peek_val parser_env 1 : string) ) : string))

+(* Rule 14, file parser.mly, line 153 *)

+; (fun parser_env -> Obj.repr(( Some (peek_val parser_env 0 : string) ) : string option))

+(* Rule 15, file parser.mly, line 155 *)

+; (fun parser_env -> Obj.repr(( None ) : string option))

+(* Rule 16, file parser.mly, line 159 *)

+; (fun parser_env -> Obj.repr(( Some (peek_val parser_env 0 : string) ) : 'opt_identifier))

+(* Rule 17, file parser.mly, line 161 *)

+; (fun parser_env -> Obj.repr(( None ) : 'opt_identifier))

+(* Rule 18, file parser.mly, line 165 *)

+; (fun parser_env -> Obj.repr(( Some (peek_val parser_env 1 : string) ) : string option))

+(* Rule 19, file parser.mly, line 167 *)

+; (fun parser_env -> Obj.repr(( None ) : string option))

+(* Rule 20, file parser.mly, line 173 *)

+; (fun parser_env -> Obj.repr(( (peek_val parser_env 1 : 'variable)::(peek_val parser_env 0 : string list) ) : string list))

+(* Rule 21, file parser.mly, line 175 *)

+; (fun parser_env -> Obj.repr(( [] ) : string list))

+(* Rule 22, file parser.mly, line 179 *)

+; (fun parser_env -> Obj.repr(( (peek_val parser_env 1 : 'variable) ) : 'variable_eol))

+(* Rule 23, file parser.mly, line 183 *)

+; (fun parser_env -> Obj.repr(( (peek_val parser_env 0 : string) ) : 'local_name))

+(* Rule 24, file parser.mly, line 185 *)

+; (fun parser_env -> Obj.repr(( "*" ) : 'local_name))

+(* Rule 25, file parser.mly, line 187 *)

+; (fun parser_env -> Obj.repr(( "-" ) : 'local_name))

+(* Rule 26, file parser.mly, line 189 *)

+; (fun parser_env -> Obj.repr(( "@" ) : 'local_name))

+(* Rule 27, file parser.mly, line 191 *)

+; (fun parser_env -> Obj.repr(( "=" ) : 'local_name))

+(* Rule 28, file parser.mly, line 193 *)

+; (fun parser_env -> Obj.repr(( ">" ) : 'local_name))

+(* Rule 29, file parser.mly, line 195 *)

+; (fun parser_env -> Obj.repr(( (peek_val parser_env 0 : string) ) : 'local_name))

+(* Rule 30, file parser.mly, line 199 *)

+; (fun parser_env -> Obj.repr(( (peek_val parser_env 0 : 'local_name) ) : 'variable))

+(* Rule 31, file parser.mly, line 201 *)

+; (fun parser_env -> Obj.repr(( (peek_val parser_env 2 : string) ^ "." ^ (peek_val parser_env 0 : 'local_name) ) : 'variable))

+(* Rule 32, file parser.mly, line 203 *)

+; (fun parser_env -> Obj.repr(( "" ) : 'variable))

+(* Rule 33, file parser.mly, line 210 *)

+; (fun parser_env -> Obj.repr(( BA_none ) : Parser_aux.break_arg))

+(* Rule 34, file parser.mly, line 212 *)

+; (fun parser_env -> Obj.repr(( BA_pc (peek_val parser_env 0 : int) ) : Parser_aux.break_arg))

+(* Rule 35, file parser.mly, line 214 *)

+; (fun parser_env -> Obj.repr(( BA_function (peek_val parser_env 0 : 'variable_eol) ) : Parser_aux.break_arg))

+(* Rule 36, file parser.mly, line 216 *)

+; (fun parser_env -> Obj.repr(( BA_pos1 ((peek_val parser_env 2 : 'opt_identifier), (peek_val parser_env 1 : int), (peek_val parser_env 0 : int option)) ) : Parser_aux.break_arg))

+(* Rule 37, file parser.mly, line 218 *)

+; (fun parser_env -> Obj.repr(( BA_pos2 ((peek_val parser_env 2 : 'opt_identifier), (peek_val parser_env 0 : int)) ) : Parser_aux.break_arg))

+(* Rule 38, file parser.mly, line 224 *)

+; (fun parser_env -> Obj.repr(( ((peek_val parser_env 2 : 'opt_identifier), Some (peek_val parser_env 1 : int), (peek_val parser_env 0 : int option)) ) : string option * int option * int option))

+(* Rule 39, file parser.mly, line 226 *)

+; (fun parser_env -> Obj.repr(( ((peek_val parser_env 0 : string option), None, None) ) : string option * int option * int option))

+(* Rule 40, file parser.mly, line 232 *)

+; (fun parser_env -> Obj.repr(( ((peek_val parser_env 2 : 'variable), (peek_val parser_env 1 : 'pattern)) ) : string * Parser_aux.pattern))

+(* Rule 41, file parser.mly, line 236 *)

+; (fun parser_env -> Obj.repr(( (peek_val parser_env 2 : 'pattern)::(peek_val parser_env 0 : 'pattern_sm_list) ) : 'pattern_sm_list))

+(* Rule 42, file parser.mly, line 238 *)

+; (fun parser_env -> Obj.repr(( [(peek_val parser_env 0 : 'pattern)] ) : 'pattern_sm_list))

+(* Rule 43, file parser.mly, line 243 *)

+; (fun parser_env -> Obj.repr(( (peek_val parser_env 2 : 'pattern_label)::(peek_val parser_env 0 : 'pattern_label_list) ) : 'pattern_label_list))

+(* Rule 44, file parser.mly, line 245 *)

+; (fun parser_env -> Obj.repr(( [(peek_val parser_env 0 : 'pattern_label)] ) : 'pattern_label_list))

+(* Rule 45, file parser.mly, line 250 *)

+; (fun parser_env -> Obj.repr(( ((peek_val parser_env 2 : 'variable), (peek_val parser_env 0 : 'pattern)) ) : 'pattern_label))

+(* Rule 46, file parser.mly, line 255 *)

+; (fun parser_env -> Obj.repr(( (peek_val parser_env 0 : 'pattern) :: (peek_val parser_env 2 : 'pattern_comma_list) ) : 'pattern_comma_list))

+(* Rule 47, file parser.mly, line 257 *)

+; (fun parser_env -> Obj.repr(( [(peek_val parser_env 0 : 'pattern); (peek_val parser_env 2 : 'pattern)] ) : 'pattern_comma_list))

+(* Rule 48, file parser.mly, line 262 *)

+; (fun parser_env -> Obj.repr(( (peek_val parser_env 0 : 'simple_pattern) ) : 'pattern))

+(* Rule 49, file parser.mly, line 264 *)

+; (fun parser_env -> Obj.repr(( P_concat ((peek_val parser_env 2 : 'pattern), (peek_val parser_env 0 : 'pattern)) ) : 'pattern))

+(* Rule 50, file parser.mly, line 266 *)

+; (fun parser_env -> Obj.repr(( P_tuple (List.rev (peek_val parser_env 0 : 'pattern_comma_list)) ) : 'pattern))

+(* Rule 51, file parser.mly, line 268 *)

+; (fun parser_env -> Obj.repr(( P_constr ((peek_val parser_env 1 : 'variable), (peek_val parser_env 0 : 'simple_pattern)) ) : 'pattern))

+(* Rule 52, file parser.mly, line 270 *)

+; (fun parser_env -> Obj.repr(( P_constr ("", (peek_val parser_env 0 : 'simple_pattern)) ) : 'pattern))

+(* Rule 53, file parser.mly, line 275 *)

+; (fun parser_env -> Obj.repr(( P_dummy ) : 'simple_pattern))

+(* Rule 54, file parser.mly, line 277 *)

+; (fun parser_env -> Obj.repr(( P_variable (peek_val parser_env 0 : string) ) : 'simple_pattern))

+(* Rule 55, file parser.mly, line 279 *)

+; (fun parser_env -> Obj.repr(( P_list [] ) : 'simple_pattern))

+(* Rule 56, file parser.mly, line 281 *)

+; (fun parser_env -> Obj.repr(( P_list (peek_val parser_env 1 : 'pattern_sm_list) ) : 'simple_pattern))

+(* Rule 57, file parser.mly, line 283 *)

+; (fun parser_env -> Obj.repr(( P_record (peek_val parser_env 1 : 'pattern_label_list) ) : 'simple_pattern))

+(* Rule 58, file parser.mly, line 285 *)

+; (fun parser_env -> Obj.repr(( (peek_val parser_env 1 : 'pattern) ) : 'simple_pattern))

+(* Rule 59, file parser.mly, line 287 *)

+; (fun parser_env -> Obj.repr(( P_nth ((peek_val parser_env 1 : int), (peek_val parser_env 0 : 'pattern)) ) : 'simple_pattern))

+(* Rule 60, file parser.mly, line 294 *)

+; (fun parser_env -> Obj.repr(( stop_user_input () ) : unit))

+(* Entry argument_list_eol *)

+; (fun parser_env -> raise (YYexit (peek_val parser_env 0)))

+(* Entry argument_eol *)

+; (fun parser_env -> raise (YYexit (peek_val parser_env 0)))

+(* Entry integer_list_eol *)

+; (fun parser_env -> raise (YYexit (peek_val parser_env 0)))

+(* Entry integer_eol *)

+; (fun parser_env -> raise (YYexit (peek_val parser_env 0)))

+(* Entry integer *)

+; (fun parser_env -> raise (YYexit (peek_val parser_env 0)))

+(* Entry opt_integer_eol *)

+; (fun parser_env -> raise (YYexit (peek_val parser_env 0)))

+(* Entry opt_signed_integer_eol *)

+; (fun parser_env -> raise (YYexit (peek_val parser_env 0)))

+(* Entry identifier *)

+; (fun parser_env -> raise (YYexit (peek_val parser_env 0)))

+(* Entry identifier_eol *)

+; (fun parser_env -> raise (YYexit (peek_val parser_env 0)))

+(* Entry identifier_or_eol *)

+; (fun parser_env -> raise (YYexit (peek_val parser_env 0)))

+(* Entry opt_identifier_eol *)

+; (fun parser_env -> raise (YYexit (peek_val parser_env 0)))

+(* Entry variable_list_eol *)

+; (fun parser_env -> raise (YYexit (peek_val parser_env 0)))

+(* Entry break_argument_eol *)

+; (fun parser_env -> raise (YYexit (peek_val parser_env 0)))

+(* Entry match_arguments_eol *)

+; (fun parser_env -> raise (YYexit (peek_val parser_env 0)))

+(* Entry list_arguments_eol *)

+; (fun parser_env -> raise (YYexit (peek_val parser_env 0)))

+(* Entry end_of_line *)

+; (fun parser_env -> raise (YYexit (peek_val parser_env 0)))

+|]

+let yytables =

+ { actions=yyact;

+ transl_const=yytransl_const;

+ transl_block=yytransl_block;

+ lhs=yylhs;

+ len=yylen;

+ defred=yydefred;

+ dgoto=yydgoto;

+ sindex=yysindex;

+ rindex=yyrindex;

+ gindex=yygindex;

+ tablesize=yytablesize;

+ table=yytable;

+ check=yycheck;

+ error_function=parse_error }

+let argument_list_eol lexfun lexbuf = yyparse yytables 1 lexfun lexbuf

+let argument_eol lexfun lexbuf = yyparse yytables 2 lexfun lexbuf

+let integer_list_eol lexfun lexbuf = yyparse yytables 3 lexfun lexbuf

+let integer_eol lexfun lexbuf = yyparse yytables 4 lexfun lexbuf

+let integer lexfun lexbuf = yyparse yytables 5 lexfun lexbuf

+let opt_integer_eol lexfun lexbuf = yyparse yytables 6 lexfun lexbuf

+let opt_signed_integer_eol lexfun lexbuf = yyparse yytables 7 lexfun lexbuf

+let identifier lexfun lexbuf = yyparse yytables 8 lexfun lexbuf

+let identifier_eol lexfun lexbuf = yyparse yytables 9 lexfun lexbuf

+let identifier_or_eol lexfun lexbuf = yyparse yytables 10 lexfun lexbuf

+let opt_identifier_eol lexfun lexbuf = yyparse yytables 11 lexfun lexbuf

+let variable_list_eol lexfun lexbuf = yyparse yytables 12 lexfun lexbuf

+let break_argument_eol lexfun lexbuf = yyparse yytables 13 lexfun lexbuf

+let match_arguments_eol lexfun lexbuf = yyparse yytables 14 lexfun lexbuf

+let list_arguments_eol lexfun lexbuf = yyparse yytables 15 lexfun lexbuf

+let end_of_line lexfun lexbuf = yyparse yytables 16 lexfun lexbuf

+type token =

+ ARGUMENT of (string)

+ | IDENTIFIER of (string)

+ | INTEGER of (int)

+ | STAR

+ | MINUS

+ | UNDERUNDER

+ | SHARP

+ | AT

+ | COLONCOLON

+ | COMMA

+ | UNDERSCORE

+ | LPAREN

+ | RPAREN

+ | LBRACKET

+ | RBRACKET

+ | LBRACE

+ | RBRACE

+ | SEMI

+ | EQUAL

+ | SUPERIOR

+ | PREFIX

+ | OPERATOR of (string)

+ | EOL

+

+val argument_list_eol :

+ (Lexing.lexbuf -> token) -> Lexing.lexbuf -> string list

+val argument_eol :

+ (Lexing.lexbuf -> token) -> Lexing.lexbuf -> string

+val integer_list_eol :

+ (Lexing.lexbuf -> token) -> Lexing.lexbuf -> int list

+val integer_eol :

+ (Lexing.lexbuf -> token) -> Lexing.lexbuf -> int

+val integer :

+ (Lexing.lexbuf -> token) -> Lexing.lexbuf -> int

+val opt_integer_eol :

+ (Lexing.lexbuf -> token) -> Lexing.lexbuf -> int option

+val opt_signed_integer_eol :

+ (Lexing.lexbuf -> token) -> Lexing.lexbuf -> int option

+val identifier :

+ (Lexing.lexbuf -> token) -> Lexing.lexbuf -> string

+val identifier_eol :

+ (Lexing.lexbuf -> token) -> Lexing.lexbuf -> string

+val identifier_or_eol :

+ (Lexing.lexbuf -> token) -> Lexing.lexbuf -> string option

+val opt_identifier_eol :

+ (Lexing.lexbuf -> token) -> Lexing.lexbuf -> string option

+val variable_list_eol :

+ (Lexing.lexbuf -> token) -> Lexing.lexbuf -> string list

+val break_argument_eol :

+ (Lexing.lexbuf -> token) -> Lexing.lexbuf -> Parser_aux.break_arg

+val match_arguments_eol :

+ (Lexing.lexbuf -> token) -> Lexing.lexbuf -> string * Parser_aux.pattern

+val list_arguments_eol :

+ (Lexing.lexbuf -> token) -> Lexing.lexbuf -> string option * int option * int option

+val end_of_line :

+ (Lexing.lexbuf -> token) -> Lexing.lexbuf -> unit

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(*open Globals*)

+type global_reference = string

+open Primitives

+

+type break_arg =

+ BA_none (* break *)

+ | BA_pc of int (* break PC *)

+ | BA_function of global_reference (* break FUNCTION *)

+ | BA_pos1 of string option * int * int option

+ (* break @ [MODULE] LINE [POS] *)

+ | BA_pos2 of string option * int (* break @ [MODULE] # OFFSET *)

+

+type pattern =

+ P_dummy (* _ *)

+ | P_variable of string (* x *)

+ | P_record of (* {A = x; ...; D = z} *)

+ (global_reference * pattern) list

+ | P_list of pattern list (* [a;,,,;d] *)

+ | P_nth of int * pattern (* # 10 l *)

+ | P_concat of pattern * pattern (* a::l *)

+ | P_tuple of pattern list (* a,...,d *)

+ | P_constr of (* A p *)

+ global_reference * pattern (* > p *)

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(************************ Simple pattern matching **********************)

+

+open Debugger_config

+(*open Primitives*)

+open Misc

+(*open Const*)

+(*open Globals*)

+(*open Builtins*)

+open Typedtree

+(*open Modules*)

+(*open Symtable*)

+(*open Value*)

+open Parser_aux

+

+(*

+let rec find_constr tag = function

+ [] ->

+ fatal_error "find_constr: unknown constructor for this type"

+ | constr::rest ->

+ match constr.info.cs_tag with

+ ConstrRegular(t, _) ->

+ if t == tag then constr else find_constr tag rest

+ | ConstrExtensible _ ->

+ fatal_error "find_constr: extensible"

+

+let find_exception tag =

+ let (qualid, stamp) = get_exn_of_num tag in

+ let rec select_exn = function

+ [] ->

+ raise Not_found

+ | constr :: rest ->

+ match constr.info.cs_tag with

+ ConstrExtensible(_,st) ->

+ if st == stamp then constr else select_exn rest

+ | ConstrRegular(_,_) ->

+ fatal_error "find_exception: regular" in

+ select_exn(hashtbl__find_all (find_module qualid.qual).mod_constrs qualid.id)

+*)

+

+let error_matching () =

+ prerr_endline "Pattern matching failed";

+ raise Toplevel

+

+(*

+let same_name {qualid = name1} =

+ function

+ GRname name2 ->

+ (name2 = "") or (name1.id = name2)

+ | GRmodname name2 ->

+ name1 = name2

+

+let check_same_constr constr constr2 =

+ try

+ if not (same_name constr constr2) then

+ error_matching ()

+ with

+ Desc_not_found ->

+ prerr_endline "Undefined constructor.";

+ raise Toplevel

+*)

+

+let rec pattern_matching pattern obj ty =

+ match pattern with

+ P_dummy ->

+ []

+ | P_variable var ->

+ [var, obj, ty]

+ | _ ->

+ match (Ctype.repr ty).desc with

+ Tvar | Tarrow _ ->

+ error_matching ()

+ | Ttuple(ty_list) ->

+ (match pattern with

+ P_tuple pattern_list ->

+ pattern_matching_list pattern_list obj ty_list

+ | P_nth (n, patt) ->

+ if n >= List.length ty_list then

+ (prerr_endline "Out of range."; raise Toplevel);

+ pattern_matching patt (Debugcom.get_field obj n) (List.nth ty_list n)

+ | _ ->

+ error_matching ())

+ | Tconstr(cstr, [ty_arg],_) when same_type_constr cstr constr_type_list ->

+ (match pattern with

+ P_list pattern_list ->

+ let (last, list) =

+ it_list

+ (fun (current, list) pattern ->

+ if value_tag current = 0 then error_matching ();

+ (Debugcom.get_field current 1,

+ (pattern, Debugcom.get_field current 0)::list))

+ (obj, [])

+ pattern_list

+ in

+ if value_tag last <> 0 then error_matching ();

+ flat_map

+ (function (x, y) -> pattern_matching x y ty_arg)

+ (rev list)

+ | P_nth (n, patt) ->

+ let rec find k current =

+ if value_tag current = 0 then

+ (prerr_endline "Out of range."; raise Toplevel);

+ if k = 0 then

+ pattern_matching patt (Debugcom.get_field current 0) ty_arg

+ else

+ find (k - 1) (Debugcom.get_field current 1)

+ in

+ find n obj

+ | P_concat (pattern1, pattern2) ->

+ if value_tag obj == 0 then error_matching ();

+ (pattern_matching pattern1 (Debugcom.get_field obj 0) ty_arg)

+ @ (pattern_matching pattern2 (Debugcom.get_field obj 1) ty)

+ | _ ->

+ error_matching ())

+ | Tconstr(cstr, [ty_arg]) when same_type_constr cstr constr_type_vect ->

+ (match pattern with

+ P_nth (n, patt) ->

+ if n >= value_size obj then

+ (prerr_endline "Out of range."; raise Toplevel);

+ pattern_matching patt (Debugcom.get_field obj n) ty_arg

+ | _ ->

+ error_matching ())

+ | Tconstr(cstr, ty_list) ->

+ (match cstr.info.ty_abbr with

+ Tabbrev(params, body) ->

+ pattern_matching pattern obj (expand_abbrev params body ty_list)

+ | _ ->

+ match_concrete_type pattern obj cstr ty ty_list)

+

+and match_concrete_type pattern obj cstr ty ty_list =

+ let typ_descr =

+ type_descr_of_type_constr cstr in

+ match typ_descr.info.ty_desc with

+ Abstract_type ->

+ error_matching ()

+ | Variant_type constr_list ->

+ let tag = value_tag obj in

+ (try

+ let constr =

+ if same_type_constr cstr constr_type_exn then

+ find_exception tag

+ else

+ find_constr tag constr_list

+ in

+ let (ty_res, ty_arg) =

+ type_pair_instance (constr.info.cs_res, constr.info.cs_arg)

+ in

+ filter (ty_res, ty);

+ match constr.info.cs_kind with

+ Constr_constant ->

+ error_matching ()

+ | Constr_regular ->

+ (match pattern with

+ P_constr (constr2, patt) ->

+ check_same_constr constr constr2;

+ pattern_matching patt (Debugcom.get_field obj 0) ty_arg

+ | _ ->

+ error_matching ())

+ | Constr_superfluous n ->

+ (match pattern with

+ P_constr (constr2, patt) ->

+ check_same_constr constr constr2;

+ (match patt with

+ P_tuple pattern_list ->

+ pattern_matching_list

+ pattern_list

+ obj

+ (filter_product n ty_arg)

+ | P_nth (n2, patt) ->

+ let ty_list = filter_product n ty_arg in

+ if n2 >= n then

+ (prerr_endline "Out of range.";

+ raise Toplevel);

+ pattern_matching

+ patt

+ (Debugcom.get_field obj n2)

+ (List.nth ty_list n2)

+ | P_variable var ->

+ [var,

+ obj,

+ {typ_desc = Tproduct (filter_product n ty_arg);

+ typ_level = generic}]

+ | P_dummy ->

+ []

+ | _ ->

+ error_matching ())

+ | _ ->

+ error_matching ())

+ with

+ Not_found ->

+ error_matching ()

+ | Unify ->

+ fatal_error "pattern_matching: types should match")

+ | Record_type label_list ->

+ let match_field (label, patt) =

+ let lbl =

+ try

+ primitives__find

+ (function l -> same_name l label)

+ label_list

+ with Not_found ->

+ prerr_endline "Label not found.";

+ raise Toplevel

+ in

+ let (ty_res, ty_arg) =

+ type_pair_instance (lbl.info.lbl_res, lbl.info.lbl_arg)

+ in

+ (try

+ filter (ty_res, ty)

+ with Unify ->

+ fatal_error "pattern_matching: types should match");

+ pattern_matching patt (Debugcom.get_field obj lbl.info.lbl_pos) ty_arg

+ in

+ (match pattern with

+ P_record pattern_label_list ->

+ flat_map match_field pattern_label_list

+ | _ ->

+ error_matching ())

+ | Abbrev_type(_,_) ->

+ fatal_error "pattern_matching: abbrev type"

+

+and pattern_matching_list pattern_list obj ty_list =

+ let val_list =

+ try

+ pair__combine (pattern_list, ty_list)

+ with

+ Invalid_argument _ -> error_matching ()

+ in

+ flat_map

+ (function (x, y, z) -> pattern_matching x y z)

+ (rev

+ (snd

+ (it_list

+ (fun (num, list) (pattern, typ) ->

+ (num + 1, (pattern, Debugcom.get_field obj num, typ)::list))

+ (0, [])

+ val_list)))

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(************************ Simple pattern matching **********************)

+

+open Parser_aux

+

+val pattern_matching :

+ pattern -> Debugcom.remote_value -> Typedtree.type_expr -> (string * Debugcom.remote_value * Typedtree.type_expr) list;;

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(*********************** Basic functions and types *********************)

+

+(*** Miscellaneous ***)

+exception Out_of_range

+

+let nothing _ = ()

+

+(*** Operations on lists. ***)

+

+(* Remove an element from a list *)

+let except e l =

+ let rec except_e = function

+ [] -> []

+ | elem::l -> if e = elem then l else elem::except_e l

+ in except_e l

+

+(* Position of an element in a list. Head of list has position 0. *)

+let index a l =

+ let rec index_rec i = function

+ [] -> raise Not_found

+ | b::l -> if a = b then i else index_rec (i + 1) l

+ in index_rec 0 l

+

+(* Remove an element from an association list *)

+let assoc_remove lst elem =

+ let rec remove =

+ function

+ [] -> []

+ | ((a, _) as c::t) ->

+ if a = elem then t

+ else c::(remove t)

+ in remove lst

+

+(* Nth element of a list. *)

+let rec list_nth p0 p1 =

+ match (p0,p1) with

+ ([], _) ->

+ invalid_arg "list_nth"

+ | ((a::_), 0) ->

+ a

+ | ((_::l), n) ->

+ list_nth l (n - 1)

+

+(* Return the `n' first elements of `l' *)

+(* ### n l -> l' *)

+let rec list_truncate =

+ fun

+ p0 p1 -> match (p0,p1) with (0, _) -> []

+ | (_, []) -> []

+ | (n, (a::l)) -> a::(list_truncate (n - 1) l)

+

+(* Separe the `n' first elements of `l' and the others *)

+(* ### n list -> (first, last) *)

+let rec list_truncate2 =

+ fun

+ p0 p1 -> match (p0,p1) with (0, l) ->

+ ([], l)

+ | (_, []) ->

+ ([], [])

+ | (n, (a::l)) ->

+ let (first, last) = (list_truncate2 (n - 1) l) in

+ (a::first, last)

+

+(* Replace x by y in list l *)

+(* ### x y l -> l' *)

+let list_replace x y =

+ let rec repl =

+ function

+ [] -> []

+ | a::l ->

+ if a == x then y::l

+ else a::(repl l)

+ in repl

+

+(* Filter `list' according to `predicate'. *)

+(* ### predicate list -> list' *)

+let filter p =

+ let rec filter2 =

+ function

+ [] ->

+ []

+ | a::l ->

+ if p a then

+ a::(filter2 l)

+ else

+ filter2 l

+ in filter2

+

+(* Find the first element `element' of `list' *)

+(* so that `predicate element' holds. *)

+(* ### predicate list -> element *)

+let find p =

+ let rec find2 =

+ function

+ [] ->

+ raise Not_found

+ | a::l ->

+ if p a then a

+ else find2 l

+ in find2

+

+(*** Operations on strings. ***)

+

+(* Return the position of the first occurence of char `c' in string `s' *)

+(* Raise `Not_found' if `s' does not contain `c'. *)

+(* ### c s -> pos *)

+let string_pos s c =

+ let i = ref 0 and l = String.length s in

+ while (!i < l) & (String.get s !i != c) do i := !i + 1 done;

+ if !i = l then raise Not_found;

+ !i

+

+(* Remove blanks (spaces and tabs) at beginning and end of a string. *)

+let string_trim s =

+ let l = String.length s and i = ref 0 in

+ while

+ (!i < l) & (match String.get s !i with ' ' | '\t' -> true | _ -> false)

+ do

+ incr i

+ done;

+ let j = ref (l - 1) in

+ while

+ (!j >= !i) & (match String.get s !j with ' ' | '\t' -> true | _ -> false)

+ do

+ decr j

+ done;

+ String.sub s !i (!j - !i + 1)

+

+(* isprefix s1 s2 returns true if s1 is a prefix of s2. *)

+

+let isprefix s1 s2 =

+ let l1 = String.length s1 and l2 = String.length s2 in

+ (l1 = l2 && s1 = s2) || (l1 < l2 && s1 = String.sub s2 0 l1)

+

+(* Split a string at the given delimiter char *)

+

+let split_string sep str =

+ let rec split i j =

+ if j >= String.length str then

+ if i >= j then [] else [String.sub str i (j-i)]

+ else if str.[j] = sep then

+ if i >= j

+ then skip_sep (j+1)

+ else String.sub str i (j-i) :: skip_sep (j+1)

+ else

+ split i (j+1)

+ and skip_sep j =

+ if j < String.length str && str.[j] = sep

+ then skip_sep (j+1)

+ else split j j

+ in split 0 0

+

+(*** I/O channels ***)

+

+type io_channel = {

+ io_in : in_channel;

+ io_out : out_channel;

+ io_fd : Unix.file_descr

+ }

+

+let io_channel_of_descr fd = {

+ io_in = Unix.in_channel_of_descr fd;

+ io_out = Unix.out_channel_of_descr fd;

+ io_fd = fd

+ }

+

+let close_io io_channel =

+ (try

+ (try

+ close_out io_channel.io_out

+ with

+ Sys_error _ -> ())

+ with End_of_file -> ()); (* SIGPIPE during flush. *)

+ close_in io_channel.io_in

+

+let std_io = {

+ io_in = stdin;

+ io_out = stdout;

+ io_fd = Unix.stdin

+ }

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(********************* Basic functions and types ***********************)

+

+(*** Miscellaneous ***)

+val nothing : 'a -> unit

+

+(*** Types and exceptions. ***)

+exception Out_of_range

+

+(*** Operations on lists. ***)

+

+(* Remove an element from a list *)

+val except : 'a -> 'a list -> 'a list

+

+(* Position of an element in a list. Head of list has position 0. *)

+val index : 'a -> 'a list -> int

+

+(* Remove on element from an association list. *)

+val assoc_remove : ('a * 'b) list -> 'a -> ('a * 'b) list

+

+(* Nth element of a list. *)

+val list_nth : 'a list -> int -> 'a

+

+(* Return the `n' first elements of `l'. *)

+(* ### n l -> l' *)

+val list_truncate : int -> 'a list -> 'a list

+

+(* Separe the `n' first elements of `l' and the others. *)

+(* ### n list -> (first, last) *)

+val list_truncate2 : int -> 'a list -> 'a list * 'a list

+

+(* Replace x by y in list l *)

+(* ### x y l -> l' *)

+val list_replace : 'a -> 'a -> 'a list -> 'a list

+

+(* Filter `list' according to `predicate'. *)

+(* ### predicate list -> list' *)

+val filter : ('a -> bool) -> 'a list -> 'a list

+

+(* Find the first element `element' of `list' *)

+(* so that `predicate element' holds. *)

+(* Raise `Not_found' if no such element. *)

+(* ### predicate list -> element *)

+val find : ('a -> bool) -> 'a list -> 'a

+

+(*** Operations on strings. ***)

+

+(* Return the position of the first occurence of char `c' in string `s' *)

+(* Raise `Not_found' if `s' does not contain `c'. *)

+(* ### c s -> pos *)

+val string_pos : string -> char -> int

+

+(* Remove blanks (spaces and tabs) at beginning and end of a string. *)

+val string_trim : string -> string

+

+(* isprefix s1 s2 returns true if s1 is a prefix of s2. *)

+val isprefix : string -> string -> bool

+

+(* Split a string at the given delimiter char *)

+val split_string : char -> string -> string list

+

+(*** I/O channels ***)

+

+type io_channel = {

+ io_in : in_channel;

+ io_out : out_channel;

+ io_fd : Unix.file_descr

+ }

+

+val io_channel_of_descr : Unix.file_descr -> io_channel

+val close_io : io_channel -> unit

+val std_io : io_channel

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(* To print values *)

+

+open Misc

+open Obj

+open Format

+open Longident

+open Path

+open Types

+

+(* Given an exception value, we cannot recover its type,

+ hence we cannot print its arguments in general.

+ Here, we do a feeble attempt to print

+ integer, string and float arguments... *)

+

+let print_exception obj =

+ print_string

+ (Debugcom.marshal_obj(Debugcom.get_field (Debugcom.get_field obj 0) 0));

+ let (tag, field) = Debugcom.get_obj obj in

+ if Array.length field > 1 then begin

+ open_hovbox 1;

+ print_string "(";

+ for i = 1 to Array.length field - 1 do

+ if i > 1 then begin print_string ","; print_space() end;

+ let arg = field.(i) in

+ if Debugcom.remote_value_is_int arg then

+ print_int(Debugcom.int_value arg) (* Note: this could be a char! *)

+ else begin

+ let (tag, sz) = Debugcom.get_header arg in

+ if tag = 252 then begin

+ print_string "\"";

+ print_string (String.escaped (Debugcom.marshal_obj arg : string));

+ print_string "\""

+ end else if tag = 253 then

+ print_float (Debugcom.marshal_obj arg : float)

+ else

+ print_string "_"

+ end

+ done;

+ print_string ")";

+ close_box()

+ end

+

+(* Recover a constructor by its tag *)

+

+exception Constr_not_found

+

+let rec find_constr tag num_const num_nonconst = function

+ [] ->

+ raise Constr_not_found

+ | (name, [] as cstr) :: rem ->

+ if tag = Cstr_constant num_const

+ then cstr

+ else find_constr tag (num_const + 1) num_nonconst rem

+ | (name, _ as cstr) :: rem ->

+ if tag = Cstr_block num_nonconst

+ then cstr

+ else find_constr tag num_const (num_nonconst + 1) rem

+

+(* The user-defined printers. Also used for some builtin types. *)

+

+let printers = ref ([

+ Pident(Ident.create "print_int"), Predef.type_int,

+ (fun x -> print_int (Debugcom.int_value x));

+ Pident(Ident.create "print_float"), Predef.type_float,

+ (fun x -> print_float(Debugcom.marshal_obj x : float));

+ Pident(Ident.create "print_char"), Predef.type_char,

+ (fun x -> print_string "'";

+ print_string (Char.escaped(Char.chr(Debugcom.int_value x)));

+ print_string "'");

+ Pident(Ident.create "print_string"), Predef.type_string,

+ (fun x -> print_string "\"";

+ print_string (String.escaped(Debugcom.marshal_obj x : string));

+ print_string "\"")

+] : (Path.t * type_expr * (Debugcom.remote_value -> unit)) list)

+

+let find_printer env ty =

+ let rec find = function

+ [] -> raise Not_found

+ | (name, sch, printer) :: remainder ->

+ if Ctype.moregeneral env sch ty

+ then printer

+ else find remainder

+ in find !printers

+

+(* Print a constructor or label, giving it the same prefix as the type

+ it comes from. Attempt to omit the prefix if the type comes from

+ a module that has been opened. *)

+

+let print_qualified lookup_fun env ty_path name =

+ match ty_path with

+ Pident id ->

+ print_string name

+ | Pdot(p, s, pos) ->

+ if try

+ match (lookup_fun (Lident name) env).desc with

+ Tconstr(ty_path', _, _) -> Path.same ty_path ty_path'

+ | _ -> false

+ with Not_found -> false

+ then print_string name

+ else (Printtyp.path p; print_string "."; print_string name)

+ | Papply(p1, p2) ->

+ Printtyp.path ty_path

+

+let print_constr =

+ print_qualified (fun lid env -> (Env.lookup_constructor lid env).cstr_res)

+and print_label =

+ print_qualified (fun lid env -> (Env.lookup_label lid env).lbl_res)

+

+(* The main printing function *)

+

+let max_printer_depth = ref 100

+let max_printer_steps = ref 300

+exception Ellipsis

+

+let cautious f arg =

+ try f arg with Ellipsis -> print_string "..."

+

+let print_value obj ty env =

+

+ let printer_steps = ref !max_printer_steps in

+

+ let rec print_val prio depth obj ty =

+ decr printer_steps;

+ if !printer_steps < 0 or depth < 0 then raise Ellipsis;

+ try

+ find_printer env ty obj; ()

+ with Not_found ->

+ match (Ctype.repr ty).desc with

+ Tvar ->

+ print_string "<poly>"

+ | Tarrow(ty1, ty2) ->

+ print_string "<fun>"

+ | Ttuple(ty_list) ->

+ if prio > 0

+ then begin open_hovbox 1; print_string "(" end

+ else open_hovbox 0;

+ print_val_list 1 depth obj ty_list;

+ if prio > 0 then print_string ")";

+ close_box()

+ | Tconstr(path, [], _) when Path.same path Predef.path_exn ->

+ if prio > 1

+ then begin open_hovbox 2; print_string "(" end

+ else open_hovbox 1;

+ print_exception obj;

+ if prio > 1 then print_string ")";

+ close_box()

+ | Tconstr(path, [ty_arg], _) when Path.same path Predef.path_list ->

+ let rec print_conses depth cons =

+ if not (Debugcom.remote_value_is_int cons) then begin

+ print_val 0 (depth - 1) (Debugcom.get_field cons 0) ty_arg;

+ let next_obj = Debugcom.get_field cons 1 in

+ if not (Debugcom.remote_value_is_int next_obj) then begin

+ print_string ";"; print_space();

+ print_conses (depth - 1) next_obj

+ end

+ end in

+ open_hovbox 1;

+ print_string "[";

+ cautious (print_conses depth) obj;

+ print_string "]";

+ close_box()

+ | Tconstr(path, [ty_arg], _) when Path.same path Predef.path_array ->

+ let (tag, fields) = Debugcom.get_obj obj in

+ let rec print_items depth i =

+ if i < Array.length fields then begin

+ if i > 0 then begin print_string ";"; print_space() end;

+ print_val 0 (depth - 1) fields.(i) ty_arg;

+ print_items (depth - 1) (i + 1)

+ end in

+ open_hovbox 2;

+ print_string "[|";

+ cautious (print_items depth) 0;

+ print_string "|]";

+ close_box()

+ | Tconstr(path, ty_list, _) ->

+ begin try

+ let decl = Env.find_type path env in

+ match decl with

+ {type_kind = Type_abstract; type_manifest = None} ->

+ print_string "<abstr>"

+ | {type_kind = Type_abstract; type_manifest = Some body} ->

+ print_val prio depth obj

+ (Ctype.substitute [] decl.type_params ty_list body)

+ | {type_kind = Type_variant constr_list} ->

+ let tag =

+ if Debugcom.remote_value_is_int obj then

+ Cstr_constant(Debugcom.int_value obj)

+ else

+ let (tag, sz) = Debugcom.get_header obj in

+ Cstr_block tag in

+ let (constr_name, constr_args) =

+ find_constr tag 0 0 constr_list in

+ let ty_args =

+ List.map (Ctype.substitute [] decl.type_params ty_list)

+ constr_args in

+ begin match ty_args with

+ [] ->

+ print_constr env path constr_name

+ | [ty1] ->

+ if prio > 1

+ then begin open_hovbox 2; print_string "(" end

+ else open_hovbox 1;

+ print_constr env path constr_name;

+ print_space();

+ cautious

+ (print_val 2 (depth - 1) (Debugcom.get_field obj 0))

+ ty1;

+ if prio > 1 then print_string ")";

+ close_box()

+ | tyl ->

+ if prio > 1

+ then begin open_hovbox 2; print_string "(" end

+ else open_hovbox 1;

+ print_constr env path constr_name;

+ print_space();

+ open_hovbox 1;

+ print_string "(";

+ print_val_list 1 depth obj tyl;

+ print_string ")";

+ close_box();

+ if prio > 1 then print_string ")";

+ close_box()

+ end

+ | {type_kind = Type_record lbl_list} ->

+ let rec print_fields depth pos = function

+ [] -> ()

+ | (lbl_name, _, lbl_arg) :: remainder ->

+ if pos > 0 then begin print_string ";"; print_space() end;

+ open_hovbox 1;

+ print_label env path lbl_name;

+ print_string "="; print_cut();

+ let ty_arg =

+ Ctype.substitute [] decl.type_params ty_list lbl_arg in

+ cautious

+ (print_val 0 (depth - 1) (Debugcom.get_field obj pos))

+ ty_arg;

+ close_box();

+ print_fields (depth - 1) (pos + 1) remainder in

+ open_hovbox 1;

+ print_string "{";

+ cautious (print_fields depth 0) lbl_list;

+ print_string "}";

+ close_box()

+ with

+ Not_found -> (* raised by Env.find_type *)

+ print_string "<abstr>"

+ | Constr_not_found -> (* raised by find_constr *)

+ print_string "<unknown constructor>"

+ end

+ | Tobject (_, _) ->

+ print_string "<obj>"

+ | Tfield(_, _, _) | Tnil | Tlink _ ->

+ fatal_error "Printval.print_value"

+

+ and print_val_list prio depth obj ty_list =

+ let rec print_list depth i = function

+ [] -> ()

+ | ty :: ty_list ->

+ if i > 0 then begin print_string ","; print_space() end;

+ print_val prio (depth - 1) (Debugcom.get_field obj i) ty;

+ print_list (depth - 1) (i + 1) ty_list in

+ cautious (print_list depth 0) ty_list

+

+in print_val 0 !max_printer_depth obj ty

+

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+val max_printer_depth : int ref

+val max_printer_steps : int ref

+

+val print_value : Debugcom.remote_value -> Types.type_expr -> Env.t -> unit

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(* Program loading *)

+

+open Unix

+open Misc

+open Debugger_config

+open Parameters

+open Input_handling

+

+(*** Debugging. ***)

+

+let debug_loading = ref true

+

+(*** Load a program. ***)

+

+(* Function used for launching the program. *)

+let launching_func = ref (function () -> ())

+

+let load_program () =

+ !launching_func ();

+ main_loop ()

+

+(*** Launching functions. ***)

+

+(* A generic function for launching the program *)

+let generic_exec cmdline = function () ->

+ if !debug_loading then

+ prerr_endline "Launching program...";

+ let child =

+ try

+ fork ()

+ with x ->

+ Unix_tools.report_error x;

+ raise Toplevel in

+ match child with

+ 0 ->

+ begin try

+ match fork () with

+ 0 -> (* setsid(); *)

+ execv shell [| shell; "-c"; cmdline() |]

+ | _ -> exit 0

+ with x ->

+ Unix_tools.report_error x;

+ exit 1

+ end

+ | _ ->

+ match wait () with

+ (_, WEXITED 0) -> ()

+ | _ -> raise Toplevel

+

+(* Execute the program by calling the runtime explicitely *)

+let exec_with_runtime =

+ generic_exec

+ (function () ->

+ Printf.sprintf "CAML_DEBUG_SOCKET=%s %s %s %s"

+ !socket_name

+ runtime_program

+ !program_name

+ !arguments)

+

+(* Excute the program directly *)

+let exec_direct =

+ generic_exec

+ (function () ->

+ Printf.sprintf "CAML_DEBUG_SOCKET=%s %s %s"

+ !socket_name

+ !program_name

+ !arguments)

+

+(* Ask the user. *)

+let exec_manual =

+ function () ->

+ print_newline ();

+ print_string "Waiting for connection...";

+ print_string ("(the socket is " ^ !socket_name ^ ")");

+ print_newline ()

+

+(*** Selection of the launching function. ***)

+

+type launching_function = (unit -> unit)

+

+let loading_modes =

+ ["direct", exec_direct;

+ "runtime", exec_with_runtime;

+ "manual", exec_manual]

+

+let set_launching_function func =

+ launching_func := func

+

+(* Initialization *)

+

+let _ =

+ set_launching_function exec_direct

+

+(*** Connection. ***)

+

+let connection = ref Primitives.std_io

+let connection_opened = ref false

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(*** Debugging. ***)

+

+val debug_loading : bool ref

+

+(*** Load program ***)

+

+(* Function used for launching the program. *)

+val launching_func : (unit -> unit) ref

+

+val load_program : unit -> unit

+

+type launching_function = (unit -> unit)

+

+val loading_modes : (string * launching_function) list

+val set_launching_function : launching_function -> unit

+

+(** Connection **)

+val connection : Primitives.io_channel ref

+val connection_opened : bool ref

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(* Manage the loading of the program *)

+

+open Unix

+open Unix_tools

+open Debugger_config

+open Misc

+open Instruct

+open Primitives

+open Parameters

+open Input_handling

+open Debugcom

+open Program_loading

+open Time_travel

+

+(*** Connection opening and control. ***)

+

+(* Name of the file if the socket is in the unix domain.*)

+let file_name = ref (None : string option)

+

+(* Default connection handler. *)

+let buffer = String.create 1024

+let control_connection pid fd =

+ if (read fd.io_fd buffer 0 1024) = 0 then

+ forget_process fd pid

+ else begin

+ prerr_string "Garbage data from process ";

+ prerr_int pid;

+ prerr_endline ""

+ end

+

+(* Accept a connection from another process. *)

+let loaded = ref false

+

+let accept_connection continue fd =

+ let (sock, _) = accept fd.io_fd in

+ let io_chan = io_channel_of_descr sock in

+ let pid = input_binary_int io_chan.io_in in

+ if not !loaded then begin

+ (*loaded := true;*)

+ new_checkpoint pid io_chan;

+ Input_handling.add_file io_chan (control_connection pid);

+ continue ()

+ end

+ else begin

+ if set_file_descriptor pid io_chan then

+ Input_handling.add_file io_chan (control_connection pid)

+ end

+

+(* Initialize the socket. *)

+let open_connection address continue =

+ try

+ let (sock_domain, sock_address) = convert_address address in

+ file_name :=

+ (match sock_address with

+ ADDR_UNIX file ->

+ Some file

+ | _ ->

+ None);

+ let sock = socket sock_domain SOCK_STREAM 0 in

+ (try

+ bind sock sock_address;

+ listen sock 3;

+ connection := io_channel_of_descr sock;

+ Input_handling.add_file !connection (accept_connection continue);

+ connection_opened := true

+ with x -> close sock; raise x)

+ with

+ Failure _ -> raise Toplevel

+ | (Unix_error _) as err -> report_error err; raise Toplevel

+

+(* Close the socket. *)

+let close_connection () =

+ if !connection_opened then begin

+ connection_opened := false;

+ Input_handling.remove_file !connection;

+ close_io !connection;

+ match !file_name with

+ Some file ->

+ unlink file

+ | None ->

+ ()

+ end

+

+(*** Kill program. ***)

+let kill_program () =

+ loaded := false;

+ close_connection ();

+ kill_all_checkpoints ();

+ History.empty_history ()

+

+let ask_kill_program () =

+ if not !loaded then

+ true

+ else

+ let answer = yes_or_no "A program is being debugged already. Kill it" in

+ if answer then

+ kill_program ();

+ answer

+

+(*** Program loading and initializations. ***)

+

+let initialize_loading () =

+ if !debug_loading then

+ prerr_endline "Loading debugging informations...";

+ Symbols.read_symbols

+ (try search_in_path !program_name with

+ Not_found ->

+ prerr_endline "Program not found.";

+ raise Toplevel);

+ if !debug_loading then

+ prerr_endline "Opening a socket...";

+ open_connection !socket_name

+ (function () ->

+ go_to 0;

+ Symbols.set_all_events();

+ exit_main_loop ())

+

+(* Ensure the program is already loaded. *)

+let ensure_loaded () =

+ if not !loaded then begin

+ print_string "Loading program...";

+ flush Pervasives.stdout;

+ if !program_name = "" then begin

+ prerr_endline "No program specified.";

+ raise Toplevel

+ end;

+ try

+ initialize_loading();

+ !launching_func ();

+ if !debug_loading then

+ prerr_endline "Waiting for connection...";

+ main_loop ();

+ loaded := true;

+ if !debug_loading then

+ prerr_endline "done."

+ with

+ x ->

+ kill_program();

+ raise x

+ end

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(*** Program loading and initializations. ***)

+

+val loaded : bool ref

+val ensure_loaded : unit -> unit

+

+(*** Kill program. ***)

+val kill_program : unit -> unit

+

+(* Ask wether to kill the program or not. *)

+(* If yes, kill it. *)

+(* Return true iff the program has been killed. *)

+val ask_kill_program : unit -> bool

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+open Instruct

+open Format

+open Primitives

+open Debugcom

+open Checkpoints

+open Events

+open Symbols

+open Frames

+open Show_source

+open Breakpoints

+

+(* Display information about the current event. *)

+let show_current_event () =

+ print_string "Time : "; print_int (current_time ());

+ (match current_pc () with

+ Some pc ->

+ print_string " - pc : "; print_int pc

+ | _ -> ());

+ update_current_event ();

+ reset_frame ();

+ match current_report () with

+ None ->

+ print_newline ();

+ print_string "Beginning of program."; print_newline ();

+ show_no_point ()

+ | Some {rep_type = (Event | Breakpoint); rep_program_pointer = pc} ->

+ let (mdle, point) = current_point () in

+ print_string (" - module " ^ mdle);

+ print_newline ();

+ (match breakpoints_at_pc pc with

+ [] ->

+ ()

+ | [breakpoint] ->

+ print_string "Breakpoint : "; print_int breakpoint;

+ print_newline ()

+ | breakpoints ->

+ print_string "Breakpoints : ";

+ List.iter (function x -> print_int x; print_string " ") breakpoints;

+ print_newline ());

+ show_point mdle point (current_event_is_before ()) true

+ | Some {rep_type = Exited} ->

+ print_newline (); print_string "Program exit."; print_newline ();

+ show_no_point ()

+ | Some {rep_type = Uncaught_exc} ->

+ print_newline ();

+ print_string "Program end.";

+ print_newline ();

+ open_hovbox 0;

+ print_string "Uncaught exception:"; print_space();

+ (*print_value (get_accu ()) type_exn;*)

+ close_box();

+ print_newline();

+ show_no_point ()

+ | Some {rep_type = Trap_barrier} ->

+ (* Trap_barrier not visible outside *)

+ (* of module `time_travel'. *)

+ Misc.fatal_error "Show_information.show_current_event"

+

+(* Display short information about one frame. *)

+

+let show_one_frame framenum event =

+ print_string "#";

+ print_int framenum;

+ print_string " Pc : ";

+ print_int event.ev_pos;

+ print_string " ";

+ print_string event.ev_file;

+ print_string " char ";

+ print_int event.ev_char;

+ print_newline ()

+

+(* Display information about the current frame. *)

+(* --- `select frame' must have succeded before calling this function. *)

+let show_current_frame selected =

+ match !selected_event with

+ None ->

+ print_newline ();

+ print_string "No frame selected.";

+ print_newline ()

+ | Some sel_ev ->

+ show_one_frame !current_frame sel_ev;

+ begin match breakpoints_at_pc sel_ev.ev_pos with

+ [] ->

+ ()

+ | [breakpoint] ->

+ print_string "Breakpoint : "; print_int breakpoint; print_newline ()

+ | breakpoints ->

+ print_string "Breakpoints : ";

+ List.iter (function x -> print_int x; print_string " ") breakpoints;

+ print_newline ()

+ end;

+ show_point sel_ev.ev_file sel_ev.ev_char

+ (selected_event_is_before ()) selected

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(* Display information about the current event. *)

+val show_current_event : unit -> unit;;

+

+(* Display information about the current frame. *)

+(* --- `select frame' must have succeded before calling this function. *)

+val show_current_frame : bool -> unit;;

+

+(* Display short information about one frame. *)

+val show_one_frame : int -> Instruct.debug_event -> unit

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+open Debugger_config

+open Parameters

+open Misc

+open Primitives

+open Source

+

+(* Print a line; return the beginning of the next line *)

+let print_line buffer line_number start point before =

+ let next = next_linefeed buffer start

+ and content = buffer_content buffer

+ in

+ print_int line_number;

+ print_string " ";

+ if (point <= next) & (point >= start) then

+ (print_string (String.sub content start (point - start));

+ print_string (if before then event_mark_before else event_mark_after);

+ print_string (String.sub content point (next - point)))

+ else

+ print_string (String.sub content start (next - start));

+ print_newline ();

+ next

+

+(* Tell Emacs we are nowhere in the source. *)

+let show_no_point () =

+ if !emacs then begin

+ print_string "\026\026H";

+ print_newline ()

+ end

+

+(* Print the line containing the point *)

+let show_point mdle point before selected =

+ if !emacs & selected then begin

+ let source = source_of_module mdle in

+ print_string "\026\026M";

+ print_string source;

+ print_string ":";

+ print_int point;

+ print_string (if before then ":before" else ":after");

+ print_newline ()

+ end

+ else begin

+ try

+ let buffer = get_buffer mdle in

+ let (start, line_number) = line_of_pos buffer point in

+ print_line buffer line_number start point before; ()

+ with

+ Out_of_range ->

+ prerr_endline "Position out of range."

+ | Not_found ->

+ prerr_endline ("Cannot find " ^ mdle ^ ".")

+ end

+

+(* Display part of the source. *)

+let show_listing mdle start stop point before =

+ let buffer = get_buffer mdle in

+ try

+ let rec aff (line_start, line_number) =

+ if line_number <= stop then

+ aff (print_line buffer line_number line_start point before + 1, line_number + 1)

+ in

+ aff (pos_of_line buffer start)

+ with

+ Out_of_range ->

+ prerr_endline "Position out of range."

+ | Not_found ->

+ prerr_endline ("Cannot find " ^ mdle ^ ".")

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(* Print the line containing the point *)

+val show_point : string -> int -> bool -> bool -> unit;;

+

+(* Tell Emacs we are nowhere in the source. *)

+val show_no_point : unit -> unit;;

+

+(* Display part of the source. *)

+val show_listing : string -> int -> int -> int -> bool -> unit;;

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(************************ Source management ****************************)

+

+open Misc

+open Primitives

+

+(*** Conversion function. ***)

+

+let source_of_module mdle =

+ find_in_path !Config.load_path mdle

+

+(*** Buffer cache ***)

+

+(* Buffer and cache (to associate lines and positions in the buffer). *)

+type buffer = string * (int * int) list ref

+

+let buffer_max_count = ref 10

+

+let cache_size = 30

+

+let buffer_list =

+ ref ([] : (string * buffer) list)

+

+let flush_buffer_list () =

+ buffer_list := []

+

+let get_buffer mdle =

+ try List.assoc mdle !buffer_list with

+ Not_found ->

+ let inchan = open_in (source_of_module mdle) in

+ let (content, _) as buffer =

+ (String.create (in_channel_length inchan), ref [])

+ in

+ unsafe_really_input inchan content 0 (in_channel_length inchan);

+ buffer_list :=

+ (list_truncate !buffer_max_count ((mdle, buffer)::!buffer_list));

+ buffer

+

+let buffer_content =

+ (fst : buffer -> string)

+

+let buffer_length x =

+ String.length (buffer_content x)

+

+(*** Position conversions. ***)

+

+type position = int * int

+

+(* Insert a new pair (position, line) in the cache of the given buffer. *)

+let insert_pos buffer ((position, line) as pair) =

+ let rec new_list =

+ function

+ [] ->

+ [(position, line)]

+ | ((pos, lin) as a::l) as l' ->

+ if lin < line then

+ pair::l'

+ else if lin = line then

+ l'

+ else

+ a::(new_list l)

+ in

+ let buffer_cache = snd buffer in

+ buffer_cache := new_list !buffer_cache

+

+(* Position of the next linefeed after `pos'. *)

+(* Position just after the buffer end if no linefeed found. *)

+(* Raise `Out_of_range' if already there. *)

+let next_linefeed (buffer, _) pos =

+ let len = String.length buffer in

+ if pos >= len then

+ raise Out_of_range

+ else

+ let rec search p =

+ if (p = len) or (String.get buffer p = '\n') then

+ p

+ else

+ search (succ p)

+ in

+ search pos

+

+(* Go to next line. *)

+let next_line buffer (pos, line) =

+ (next_linefeed buffer pos + 1, line + 1)

+

+(* Convert a position in the buffer to a line number. *)

+let line_of_pos buffer position =

+ let rec find =

+ function

+ [] ->

+ if position < 0 then

+ raise Out_of_range

+ else

+ (0, 1)

+ | ((pos, line) as pair)::l ->

+ if pos > position then

+ find l

+ else

+ pair

+ and find_line previous =

+ let (pos, line) as next = next_line buffer previous in

+ if pos <= position then

+ find_line next

+ else

+ previous

+ in

+ let result = find_line (find !(snd buffer)) in

+ insert_pos buffer result;

+ result

+

+(* Convert a line number to a position. *)

+let pos_of_line buffer line =

+ let rec find =

+ function

+ [] ->

+ if line <= 0 then

+ raise Out_of_range

+ else

+ (0, 1)

+ | ((pos, lin) as pair)::l ->

+ if lin > line then

+ find l

+ else

+ pair

+ and find_pos previous =

+ let (_, lin) as next = next_line buffer previous in

+ if lin <= line then

+ find_pos next

+ else

+ previous

+ in

+ let result = find_pos (find !(snd buffer)) in

+ insert_pos buffer result;

+ result

+

+(* Convert a coordinate (line / column) into a position. *)

+(* --- The first line and column are line 1 and column 1. *)

+let point_of_coord buffer line column =

+ fst (pos_of_line buffer line) + (pred column)

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(************************ Source management ****************************)

+

+(*** Conversion function. ***)

+

+val source_of_module: string -> string

+

+(*** buffer cache ***)

+

+type buffer

+

+val buffer_max_count : int ref

+

+val flush_buffer_list : unit -> unit

+

+val get_buffer : string -> buffer

+

+val buffer_content : buffer -> string

+val buffer_length : buffer -> int

+

+(*** Position conversions. ***)

+

+(* Pair (position, line) where `position' is the position in character of *)

+(* the beginning of the line (first character is 0) and `line' is its *)

+(* number (first line number is 1). *)

+type position = int * int

+

+(* Position of the next linefeed after `pos'. *)

+(* Position just after the buffer end if no linefeed found. *)

+(* Raise `Out_of_range' if already there. *)

+val next_linefeed : buffer -> int -> int

+

+(* Go to next line. *)

+val next_line : buffer -> position -> position

+

+(* Convert a position in the buffer to a line number. *)

+val line_of_pos : buffer -> int -> position

+

+(* Convert a line number to a position. *)

+val pos_of_line : buffer -> int -> position

+

+(* Convert a coordinate (line / column) into a position. *)

+(* --- The first line and column are line 1 and column 1. *)

+val point_of_coord : buffer -> int -> int -> int

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(* Handling of symbol tables (globals and events) *)

+

+open Instruct

+open Debugger_config (* Toplevel *)

+

+let verbose = ref true

+

+let modules =

+ ref ([] : string list)

+

+let events =

+ ref ([] : debug_event list)

+let events_by_pc =

+ (Hashtbl.create 257 : (int, debug_event) Hashtbl.t)

+let events_by_file =

+ (Hashtbl.create 17 : (string, debug_event array) Hashtbl.t)

+

+let read_symbols' bytecode_file =

+ let ic = open_in_bin bytecode_file in

+ let pos_trailer =

+ in_channel_length ic - 16 - String.length Config.exec_magic_number in

+ seek_in ic pos_trailer;

+ let code_size = input_binary_int ic in

+ let data_size = input_binary_int ic in

+ let symbol_size = input_binary_int ic in

+ let debug_size = input_binary_int ic in

+ let magic = String.create (String.length Config.exec_magic_number) in

+ really_input ic magic 0 (String.length Config.exec_magic_number);

+ if magic <> Config.exec_magic_number then begin

+ prerr_string bytecode_file; prerr_endline " is not a bytecode file.";

+ exit 2

+ end;

+ if debug_size = 0 then begin

+ prerr_string bytecode_file; prerr_endline " has no debugging info.";

+ exit 2

+ end;

+ seek_in ic (pos_trailer - debug_size - symbol_size);

+ Symtable.restore_state (input_value ic);

+ let all_events = (input_value ic : debug_event list list) in

+ close_in ic;

+ all_events

+

+let read_symbols bytecode_file =

+ let all_events = read_symbols' bytecode_file in

+ List.iter

+ (fun evl ->

+ List.iter

+ (fun ev ->

+ events := ev :: !events;

+ Hashtbl.add events_by_pc ev.ev_pos ev)

+ evl)

+ all_events;

+

+ List.iter

+ (function

+ [] -> ()

+ | ev :: _ as evl ->

+ let file = ev.ev_file

+ and sorted_evl = Sort.list (fun ev1 ev2 -> ev1.ev_char <= ev2.ev_char) evl in

+ modules := file :: !modules;

+ Hashtbl.add events_by_file file (Array.of_list sorted_evl))

+ all_events

+

+let event_at_pc pc =

+ Hashtbl.find events_by_pc pc

+(*

+ try

+ Hashtbl.find events_by_pc pc

+ with Not_found ->

+ prerr_string "No event at pc="; prerr_int pc; prerr_endline ".";

+ (*exit 2*)

+ raise Toplevel

+*)

+

+(* Return the list of events at `pc' *)

+let events_at_pc =

+ Hashtbl.find_all events_by_pc

+

+let event_at_pos file char =

+ let ev = Hashtbl.find events_by_file file in

+ (* Binary search of event at or just after char *)

+ let rec bsearch lo hi =

+ if lo >= hi then

+ if hi + 1 < Array.length ev then ev.(hi+1) else ev.(hi)

+ else begin

+ let pivot = (lo + hi) / 2 in

+ let e = ev.(pivot) in

+ if char = e.ev_char then e else

+ if char < e.ev_char then bsearch lo (pivot - 1)

+ else bsearch (pivot + 1) hi

+ end in

+ bsearch 0 (Array.length ev - 1)

+

+let set_all_events () =

+ Hashtbl.iter

+ (fun pc ev -> Debugcom.set_event ev.ev_pos)

+ events_by_pc

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(* Modules used by the program. *)

+val modules : string list ref

+

+(* Events used by the program *)

+val events : Instruct.debug_event list ref

+val events_by_pc : (int, Instruct.debug_event) Hashtbl.t

+val events_by_file : (string, Instruct.debug_event array) Hashtbl.t

+

+val read_symbols : string -> unit

+val event_at_pc : int -> Instruct.debug_event

+val event_at_pos : string -> int -> Instruct.debug_event

+val set_all_events : unit -> unit

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(**************************** Time travel ******************************)

+

+open Instruct

+open Events

+open Debugcom

+open Primitives

+open Checkpoints

+open Breakpoints

+open Trap_barrier

+open Input_handling

+open Debugger_config

+open Program_loading

+

+exception Current_checkpoint_lost

+

+let remove_1st key list =

+ let rec remove =

+ function

+ [] -> []

+ | a::l -> if a == key then l else a::(remove l)

+ in

+ remove list

+

+(*** Debugging. ***)

+

+let debug_time_travel = ref false

+

+(*** Internal utilities. ***)

+

+(* Select a checkpoint at current. *)

+let set_current_checkpoint checkpoint =

+ current_checkpoint := checkpoint;

+ set_current_connection checkpoint.c_fd

+

+(* Insert a checkpoint in the checkpoint list.

+ * Raise `Exit' if there is already a checkpoint at the same time.

+ *)

+let insert_checkpoint ({c_time = time} as checkpoint) =

+ let rec traverse =

+ function

+ [] -> [checkpoint]

+ | (({c_time = t} as a)::l) as l' ->

+ if t > time then

+ a::(traverse l)

+ else if t = time then

+ raise Exit

+ else

+ checkpoint::l'

+ in

+ checkpoints := traverse !checkpoints

+

+(* Remove a checkpoint from the checkpoint list.

+ * --- No error if not found.

+ *)

+let remove_checkpoint checkpoint =

+ checkpoints := remove_1st checkpoint !checkpoints

+

+(* Wait for the process used by `checkpoint' to connect.

+ * --- Usually not called (the process is already connected).

+ *)

+let wait_for_connection checkpoint =

+ try

+ Exec.unprotected

+ (function () ->

+ let old_controller = Input_handling.current_controller !connection in

+ execute_with_other_controller

+ (function

+ fd ->

+ old_controller fd;

+ if checkpoint.c_valid = true then

+ exit_main_loop ())

+ !connection

+ main_loop)

+ with

+ Sys.Break ->

+ checkpoint.c_parent = root;

+ remove_checkpoint checkpoint;

+ checkpoint.c_pid <- -1;

+ raise Sys.Break

+

+(* Kill `checkpoint'. *)

+let kill_checkpoint checkpoint =

+ if !debug_time_travel then

+ prerr_endline ("Kill : " ^ (string_of_int checkpoint.c_pid));

+ if checkpoint.c_pid > 0 then (* Ghosts don't have to be killed ! *)

+ (if not checkpoint.c_valid then

+ wait_for_connection checkpoint;

+ stop checkpoint.c_fd;

+ if checkpoint.c_parent.c_pid > 0 then

+ wait_child checkpoint.c_parent.c_fd;

+ checkpoint.c_parent = root;

+ close_io checkpoint.c_fd;

+ remove_file checkpoint.c_fd;

+ remove_checkpoint checkpoint);

+ checkpoint.c_pid <- -1 (* Don't exist anymore *)

+

+(*** Cleaning the checkpoint list. ***)

+

+(* Separe checkpoints before (<=) and after (>) `t'. *)

+(* ### t checkpoints -> (after, before) *)

+let cut t =

+ let rec cut_t =

+ function

+ [] -> ([], [])

+ | ({c_time = t'} as a::l) as l' ->

+ if t' <= t then

+ ([], l')

+ else

+ let (b, e) = cut_t l in

+ (a::b, e)

+ in

+ cut_t

+

+(* Partition the checkpoints list. *)

+let cut2 t0 t l =

+ let rec cut2_t0 t =

+ function

+ [] -> []

+ | l ->

+ let (after, before) = cut (t0 - t - 1) l in

+ let l = cut2_t0 (2 * t) before in

+ after::l

+ in

+ let (after, before) = cut (t0 - 1) l in

+ after::(cut2_t0 t before)

+

+(* Separe first elements and last element of a list of checkpoint. *)

+let chk_merge2 cont =

+ let rec chk_merge2_cont =

+ function

+ [] -> cont

+ | [a] ->

+ let (accepted, rejected) = cont in

+ (a::accepted, rejected)

+ | a::l ->

+ let (accepted, rejected) = chk_merge2_cont l in

+ (accepted, a::rejected)

+ in chk_merge2_cont

+

+(* Separe the checkpoint list. *)

+(* ### list -> accepted * rejected *)

+let rec chk_merge =

+ function

+ [] -> ([], [])

+ | l::tail ->

+ chk_merge2 (chk_merge tail) l

+

+let new_checkpoint_list checkpoint_count accepted rejected =

+ if List.length accepted >= checkpoint_count then

+ let (k, l) = list_truncate2 checkpoint_count accepted in

+ (k, l @ rejected)

+ else

+ let (k, l) =

+ list_truncate2 (checkpoint_count - List.length accepted) rejected

+ in

+ (Sort.merge (fun {c_time = t1} {c_time = t2} -> t1 > t2) accepted k,

+ l)

+

+(* Clean the checkpoint list. *)

+(* Reference time is `time'. *)

+let clean_checkpoints time checkpoint_count =

+ let (after, before) = cut time !checkpoints in

+ let (accepted, rejected) =

+ chk_merge (cut2 time !checkpoint_small_step before)

+ in

+ let (kept, lost) =

+ new_checkpoint_list checkpoint_count accepted after

+ in

+ List.map kill_checkpoint (lost @ rejected);

+ checkpoints := kept

+

+(*** Internal functions for moving. ***)

+

+(* Find the first checkpoint before (or at) `time'.

+ * Ask for reloading the program if necessary.

+ *)

+let find_checkpoint_before time =

+ let rec find =

+ function

+ [] ->

+ print_string "Can't go that far in the past !"; print_newline ();

+ if yes_or_no "Reload program" then begin

+ load_program ();

+ find !checkpoints

+ end

+ else

+ raise Toplevel

+ | { c_time = t } as a::l ->

+ if t > time then

+ find l

+ else

+ a

+ in find !checkpoints

+

+(* Make a copy of the current checkpoint and clean the checkpoint list. *)

+(* --- The new checkpoint in not put in the list. *)

+let duplicate_current_checkpoint () =

+ let checkpoint = !current_checkpoint in

+ if not checkpoint.c_valid then

+ wait_for_connection checkpoint;

+ let new_checkpoint = (* Ghost *)

+ {c_time = checkpoint.c_time;

+ c_pid = 0;

+ c_fd = checkpoint.c_fd;

+ c_valid = false;

+ c_report = checkpoint.c_report;

+ c_state = C_stopped;

+ c_parent = checkpoint;

+ c_breakpoint_version = checkpoint.c_breakpoint_version;

+ c_breakpoints = checkpoint.c_breakpoints;

+ c_trap_barrier = checkpoint.c_trap_barrier}

+ in

+ checkpoints := list_replace checkpoint new_checkpoint !checkpoints;

+ set_current_checkpoint checkpoint;

+ clean_checkpoints (checkpoint.c_time + 1) (!checkpoint_max_count - 1);

+ if new_checkpoint.c_pid = 0 then (* The ghost has not been killed *)

+ (match do_checkpoint () with (* Duplicate checkpoint *)

+ Checkpoint_done pid ->

+ (new_checkpoint.c_pid <- pid;

+ if !debug_time_travel then

+ prerr_endline ("Waiting for connection : " ^ (string_of_int pid)))

+ | Checkpoint_failed ->

+ prerr_endline

+ "A fork failed. Reducing maximum number of checkpoints.";

+ checkpoint_max_count := List.length !checkpoints - 1;

+ remove_checkpoint new_checkpoint)

+

+(* Ensure we stop on an event. *)

+let rec stop_on_event report =

+ let find_event () =

+ if !debug_time_travel then

+ (print_string "Searching next event..."; print_newline ());

+ let report = do_go 1 in

+ !current_checkpoint.c_report <- Some report;

+ stop_on_event report

+ in

+ match report with

+ {rep_type = Breakpoint; rep_program_pointer = pc} ->

+ if Some pc = !temporary_breakpoint_position then begin

+ (* Others breakpoints are on events. *)

+ try (* Check if we are on an event. *)

+ update_current_event ()

+ with

+ Not_found -> find_event ()

+ end

+ | {rep_type = Trap_barrier; rep_stack_pointer = trap_frame} ->

+ (* No event at current position. *)

+ find_event ()

+ | _ ->

+ ()

+

+(* Was the movement interrupted ? *)

+(* --- An exception could have been used instead, *)

+(* --- but it is not clear where it should be caught. *)

+(* --- For instance, we can't caught it should not be caught in `step' *)

+(* --- (as `step' is used in `next_1'). *)

+(* --- On the other side, other modules does not need to know *)

+(* --- about this exception. *)

+let interrupted = ref false

+

+(* Internal function for running debugged program.

+ * Requires `duration > 0'.

+ *)

+let internal_step duration =

+ match current_report () with

+ Some {rep_type = Exited | Uncaught_exc} -> ()

+ | _ ->

+ Exec.protected

+ (function () ->

+ if !make_checkpoints then

+ duplicate_current_checkpoint ()

+ else

+ remove_checkpoint !current_checkpoint;

+ update_breakpoints ();

+ update_trap_barrier ();

+ !current_checkpoint.c_state <- C_running duration;

+ let report = do_go duration in

+ !current_checkpoint.c_report <- Some report;

+ !current_checkpoint.c_state <- C_stopped;

+ if report.rep_type = Event then begin

+ !current_checkpoint.c_time <-

+ !current_checkpoint.c_time + duration;

+ interrupted := false

+ end

+ else begin

+ !current_checkpoint.c_time <-

+ !current_checkpoint.c_time + duration

+ - report.rep_event_count + 1;

+ interrupted := true;

+ stop_on_event report

+ end;

+ (try

+ insert_checkpoint !current_checkpoint

+ with

+ Exit ->

+ kill_checkpoint !current_checkpoint;

+ set_current_checkpoint

+ (find_checkpoint_before (current_time ()))));

+ if !debug_time_travel then begin

+ print_string "Checkpoints : pid(time)"; print_newline ();

+ List.map

+ (function {c_time = time; c_pid = pid; c_valid = valid} ->

+ print_int pid;

+ print_string "("; print_int time; print_string ")";

+ if not valid then print_string "(invalid)";

+ print_string " ")

+ !checkpoints;

+ print_newline ()

+ end

+

+(*** Miscellaneous functions (exported). ***)

+

+(* Create a checkpoint at time 0 (new program). *)

+let new_checkpoint pid fd =

+ let new_checkpoint =

+ {c_time = 0;

+ c_pid = pid;

+ c_fd = fd;

+ c_valid = true;

+ c_report = None;

+ c_state = C_stopped;

+ c_parent = root;

+ c_breakpoint_version = 0;

+ c_breakpoints = [];

+ c_trap_barrier = 0}

+ in

+ insert_checkpoint new_checkpoint

+

+(* Set the file descriptor of a checkpoint *)

+(* (a new process has connected with the debugger). *)

+(* --- Return `true' on success (close the connection otherwise). *)

+let set_file_descriptor pid fd =

+ let rec find =

+ function

+ [] ->

+ prerr_endline "Unexpected connection";

+ close_io fd;

+ false

+ | ({c_pid = pid'} as checkpoint)::l ->

+ if pid <> pid' then

+ find l

+ else

+ (checkpoint.c_fd <- fd;

+ checkpoint.c_valid <- true;

+ true)

+ in

+ if !debug_time_travel then

+ prerr_endline ("Nouvelle connection : " ^(string_of_int pid));

+ find (!current_checkpoint::!checkpoints)

+

+(* Kill all the checkpoints. *)

+let kill_all_checkpoints () =

+ List.iter kill_checkpoint (!current_checkpoint::!checkpoints)

+

+(* Kill a checkpoint without killing the process. *)

+(* (used when connection with the process is lost). *)

+(* --- Assume that the checkpoint is valid. *)

+let forget_process fd pid =

+ let checkpoint =

+ find (function c -> c.c_pid = pid) (!current_checkpoint::!checkpoints)

+ in

+ prerr_string "Lost connection with process ";

+ prerr_int pid;

+ if checkpoint = !current_checkpoint then begin

+ prerr_endline " (active process)";

+ match !current_checkpoint.c_state with

+ C_stopped ->

+ prerr_string "at time ";

+ prerr_int !current_checkpoint.c_time

+ | C_running duration ->

+ prerr_string "between time ";

+ prerr_int !current_checkpoint.c_time;

+ prerr_string " and time ";

+ prerr_int (!current_checkpoint.c_time + duration)

+ end;

+ prerr_endline "";

+ Input_handling.remove_file fd;

+ close_io checkpoint.c_fd;

+ remove_file checkpoint.c_fd;

+ remove_checkpoint checkpoint;

+ checkpoint.c_pid <- -1; (* Don't exist anymore *)

+ if checkpoint.c_parent.c_pid > 0 then

+ wait_child checkpoint.c_parent.c_fd;

+ if checkpoint = !current_checkpoint then

+ raise Current_checkpoint_lost

+

+(* Try to recover when the current checkpoint is lost. *)

+let recover () =

+ set_current_checkpoint

+ (find_checkpoint_before (current_time ()))

+

+(*** Simple movements. ***)

+

+(* Forward stepping. Requires `duration >= 0'. *)

+let rec step_forward duration =

+ if duration > !checkpoint_small_step then begin

+ let first_step =

+ if duration > !checkpoint_big_step then

+ !checkpoint_big_step

+ else

+ !checkpoint_small_step

+ in

+ internal_step first_step;

+ if not !interrupted then

+ step_forward (duration - first_step)

+ end

+ else if duration != 0 then

+ internal_step duration

+

+(* Go to time `time' from current checkpoint (internal). *)

+let internal_go_to time =

+ let duration = time - current_time () in

+ if duration > 0 then

+ step_forward duration

+

+(* Move to a given time. *)

+let go_to time =

+ let checkpoint = find_checkpoint_before time in

+ set_current_checkpoint checkpoint;

+ internal_go_to time

+

+(* Return the time of the last breakpoint *)

+(* between current time and `max_time'. *)

+let rec find_last_breakpoint max_time =

+ let on_breakpoint () =

+ match current_report () with

+ Some {rep_program_pointer = pc} ->

+ breakpoint_at_pc pc

+ | _ ->

+ false

+ in

+ let rec find break =

+ let time = current_time () in

+ step_forward (max_time - time);

+ if ((on_breakpoint ()) & (current_time () < max_time)) then

+ find true

+ else

+ (time, break)

+ in

+ find (on_breakpoint ())

+

+(* Run from `time_max' back to `time'. *)

+(* --- Assume 0 <= time < time_max *)

+let rec back_to time time_max =

+ let

+ {c_time = t} as checkpoint = find_checkpoint_before (time_max - 1)

+ in

+ go_to (max time t);

+ let (new_time, break) = find_last_breakpoint time_max in

+ if break or (new_time <= time) then

+ go_to new_time

+ else

+ back_to time new_time

+

+(* Backward stepping. *)

+(* --- Assume duration > 1 *)

+let step_backward duration =

+ let time = current_time () in

+ if time > 0 then

+ back_to (max 0 (time - duration)) time

+

+(* Run the program from current time. *)

+(* Stop at the first breakpoint, or at the end of the program. *)

+let rec run () =

+ internal_step !checkpoint_big_step;

+ if not !interrupted then

+ run ()

+

+(* Run backward the program form current time. *)

+(* Stop at the first breakpoint, or at the beginning of the program. *)

+let back_run () =

+ if current_time () > 0 then

+ back_to 0 (current_time ())

+

+(* Step in any direction. *)

+(* Stop at the first brakpoint, or after `duration' steps. *)

+let step duration =

+ if duration >= 0 then

+ step_forward duration

+ else

+ step_backward (-duration)

+

+(*** Next, finish. ***)

+

+(* Finish current fucntion. *)

+let finish () =

+ match !current_event with

+ None ->

+ prerr_endline "Program is currently not running."; raise Toplevel

+ | Some curr_event ->

+ initial_frame();

+ let (frame, pc) = up_frame curr_event.ev_stacksize in

+ if frame < 0 then begin

+ prerr_endline "`finish' not meaningful in outermost frame.";

+ raise Toplevel

+ end;

+ exec_with_trap_barrier

+ frame

+ (fun () ->

+ exec_with_temporary_breakpoint

+ pc

+ (fun () ->

+ while

+ run ();

+ match current_report () with

+ Some {rep_type = Breakpoint;

+ rep_stack_pointer = sp;

+ rep_program_pointer = pc2} ->

+ (pc = pc2) && (frame <> sp)

+ | _ ->

+ false

+ do

+ ()

+ done))

+

+let next_1 () =

+ match !current_event with

+ None -> (* Beginning of the program. *)

+ step 1

+ | Some event1 ->

+ let (frame1, pc1) = initial_frame() in

+ step 1;

+ match !current_event with

+ None -> ()

+ | Some event2 ->

+ let (frame2, pc2) = initial_frame() in

+ (* Call `finish' if we've entered a function. *)

+ if frame1 >= 0 && frame2 >= 0 &&

+ frame2 + event2.ev_stacksize < frame1 + event1.ev_stacksize

+ then finish()

+

+(* Same as `step' (forward) but skip over function calls. *)

+let rec next =

+ function

+ 0 -> ()

+ | n ->

+ next_1 ();

+ if not !interrupted then

+ next (n - 1)

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(**************************** Time travel ******************************)

+

+open Primitives

+

+exception Current_checkpoint_lost

+

+val new_checkpoint : int -> io_channel -> unit

+val set_file_descriptor : int -> io_channel -> bool

+val kill_all_checkpoints : unit -> unit

+val forget_process : io_channel -> int -> unit

+val recover : unit -> unit

+

+val go_to : int -> unit

+

+val run : unit -> unit

+val back_run : unit -> unit

+val step : int -> unit

+val finish : unit -> unit

+val next : int -> unit

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(************************** Trap barrier *******************************)

+

+open Debugcom

+open Checkpoints

+

+let current_trap_barrier = ref 0

+

+let install_trap_barrier pos =

+ current_trap_barrier := pos

+

+let remove_trap_barrier () =

+ current_trap_barrier := 0

+

+(* Ensure the trap barrier state is up to date in current checkpoint. *)

+let update_trap_barrier () =

+ if !current_checkpoint.c_trap_barrier <> !current_trap_barrier then

+ Exec.protected

+ (function () ->

+ set_trap_barrier !current_trap_barrier;

+ !current_checkpoint.c_trap_barrier <- !current_trap_barrier)

+

+(* Execute `funct' with a trap barrier. *)

+(* --- Used by `finish'. *)

+let exec_with_trap_barrier trap_barrier funct =

+ try

+ install_trap_barrier trap_barrier;

+ funct ();

+ remove_trap_barrier ()

+ with

+ x ->

+ remove_trap_barrier ();

+ raise x

+(***********************************************************************)

+(* *)

+(* Objective Caml *)

+(* *)

+(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)

+(* Objective Caml port by John Malecki and Xavier Leroy *)

+(* *)

+(* Copyright 1996 Institut National de Recherche en Informatique et *)

+(* Automatique. Distributed only by permission. *)

+(* *)

+(***********************************************************************)

+

+(* $Id$ *)

+

+(************************* Trap barrier ********************************)

+

+val install_trap_barrier : int -> unit

+

+val remove_trap_barrier : unit -> unit

+

+(* Ensure the trap barrier state is up to date in current checkpoint. *)

+val update_trap_barrier : unit -> unit

+

+(* Execute `funct' with a trap barrier. *)

+(* --- Used by `finish'. *)

+val exec_with_trap_barrier : int -> (unit -> unit) -> unit