path: root/debugger/command_line_interpreter.ml

(***********************************************************************)
(*                                                                     *)
(*                           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)." }]