diff options
Diffstat (limited to 'debugger/command_line.ml')
| -rw-r--r-- | debugger/command_line.ml | 1084 |
1 files changed, 0 insertions, 1084 deletions
diff --git a/debugger/command_line.ml b/debugger/command_line.ml deleted file mode 100644 index 7651b53f32..0000000000 --- a/debugger/command_line.ml +++ /dev/null @@ -1,1084 +0,0 @@ -(***********************************************************************) -(* *) -(* 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 *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id$ *) - -(************************ Reading and executing commands ***************) - -open Int64ops -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 Printval - -(** Instructions, variables and infos lists. **) -type dbg_instruction = - { instr_name: string; (* Name of command *) - instr_prio: bool; (* Has priority *) - instr_action: formatter -> 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) * (formatter -> unit); - (* Reading, writing 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 = - eprintf "%s@." 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 *) -(* XL 25-02-97 why? I find it very confusing. *) - -let matching_instructions instr = - let all = all_matching_instructions instr in - let prio = filter (fun i -> i.instr_prio) all in - if prio = [] 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 ppf lexbuf = - match identifier_or_eol Lexer.lexeme lexbuf with - | None -> alternative ppf - | Some ident -> - match matcher ident with - | [] -> error ("Unknown " ^ name ^ ".") - | [a] -> action a ppf lexbuf - | _ -> error ("Ambiguous " ^ name ^ ".") - -let find_variable action alternative ppf lexbuf = - find_ident "variable name" matching_variables action alternative ppf lexbuf - -let find_info action alternative ppf lexbuf = - find_ident "info command" matching_infos action alternative ppf lexbuf - -let add_breakpoint_at_pc pc = - try - new_breakpoint (any_event_at_pc pc) - with - | Not_found -> - eprintf "Can't add breakpoint at pc %i : no event there.@." pc; - raise Toplevel - -let add_breakpoint_after_pc pc = - let rec try_add n = - if n < 3 then begin - try - new_breakpoint (any_event_at_pc (pc + n * 4)) - with - | Not_found -> - try_add (n+1) - end else begin - error - "Can't add breakpoint at beginning of function: no event there" - end - in try_add 0 - -let convert_module mdle = - match mdle with - | Some m -> - (* Strip .ml extension if any, and capitalize *) - String.capitalize(if Filename.check_suffix m ".ml" - then Filename.chop_suffix m ".ml" - else m) - | None -> - try - let (x, _) = current_point () in x - with - | Not_found -> - error "Not in a module." - -(** Toplevel. **) -let current_line = ref "" - -let interprete_line ppf 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 ppf 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 ppf 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 ppf line then - previous_line := line - done - with - | Exit -> - stop_user_input () - | Sys_error s -> - error ("System error : " ^ s) - -(** Instructions. **) -let instr_cd ppf lexbuf = - let dir = argument_eol argument lexbuf in - if ask_kill_program () then - try - Sys.chdir (expand_path dir) - with - | Sys_error s -> - error s - -let instr_shell ppf lexbuf = - let cmdarg = argument_list_eol argument lexbuf in - let cmd = String.concat " " cmdarg in - (* perhaps we should use $SHELL -c ? *) - let err = Sys.command cmd in - if (err != 0) then - eprintf "Shell command %S failed with exit code %d\n%!" cmd err - -let instr_pwd ppf lexbuf = - eol lexbuf; - ignore(system "/bin/pwd") - -let instr_dir ppf 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); - let print_dirs ppf l = List.iter (function x -> fprintf ppf "@ %s" x) l in - fprintf ppf "@[<2>Directories :%a@]@." print_dirs !Config.load_path - -let instr_kill ppf lexbuf = - eol lexbuf; - if not !loaded then error "The program is not being run."; - if (yes_or_no "Kill the program being debugged") then begin - kill_program (); - show_no_point() - end - -let instr_run ppf lexbuf = - eol lexbuf; - ensure_loaded (); - reset_named_values (); - run (); - show_current_event ppf;; - -let instr_reverse ppf lexbuf = - eol lexbuf; - ensure_loaded (); - reset_named_values(); - back_run (); - show_current_event ppf - -let instr_step ppf lexbuf = - let step_count = - match opt_signed_int64_eol Lexer.lexeme lexbuf with - | None -> _1 - | Some x -> x - in - ensure_loaded (); - reset_named_values(); - step step_count; - show_current_event ppf - -let instr_back ppf lexbuf = - let step_count = - match opt_signed_int64_eol Lexer.lexeme lexbuf with - | None -> _1 - | Some x -> x - in - ensure_loaded (); - reset_named_values(); - step (_0 -- step_count); - show_current_event ppf - -let instr_finish ppf lexbuf = - eol lexbuf; - ensure_loaded (); - reset_named_values(); - finish (); - show_current_event ppf - -let instr_next ppf lexbuf = - let step_count = - match opt_integer_eol Lexer.lexeme lexbuf with - | None -> 1 - | Some x -> x - in - ensure_loaded (); - reset_named_values(); - next step_count; - show_current_event ppf - -let instr_start ppf lexbuf = - eol lexbuf; - ensure_loaded (); - reset_named_values(); - start (); - show_current_event ppf - -let instr_previous ppf lexbuf = - let step_count = - match opt_integer_eol Lexer.lexeme lexbuf with - | None -> 1 - | Some x -> x - in - ensure_loaded (); - reset_named_values(); - previous step_count; - show_current_event ppf - -let instr_goto ppf lexbuf = - let time = int64_eol Lexer.lexeme lexbuf in - ensure_loaded (); - reset_named_values(); - go_to time; - show_current_event ppf - -let instr_quit _ = - raise Exit - -let print_variable_list ppf = - let pr_vars ppf = List.iter (fun v -> fprintf ppf "%s@ " v.var_name) in - fprintf ppf "List of variables :%a@." pr_vars !variable_list - -let print_info_list ppf = - let pr_infos ppf = List.iter (fun i -> fprintf ppf "%s@ " i.info_name) in - fprintf ppf "List of info commands :%a@." pr_infos !info_list - -let instr_complete ppf lexbuf = - let ppf = Format.err_formatter in - let rec print_list l = - try - eol lexbuf; - List.iter (function i -> fprintf ppf "%s@." i) 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 ppf lexbuf = - let pr_instrs ppf = - List.iter (fun i -> fprintf ppf "%s@ " i.instr_name) in - match identifier_or_eol Lexer.lexeme lexbuf with - | Some x -> - let print_help nm hlp = - eol lexbuf; - fprintf ppf "%s : %s@." nm hlp in - begin match matching_instructions x with - | [] -> - eol lexbuf; - fprintf ppf "No matching command.@." - | [ {instr_name = "set"} ] -> - find_variable - (fun v _ _ -> - print_help ("set " ^ v.var_name) ("set " ^ v.var_help)) - (fun ppf -> - print_help "set" "set debugger variable."; - print_variable_list ppf) - ppf - lexbuf - | [ {instr_name = "show"} ] -> - find_variable - (fun v _ _ -> - print_help ("show " ^ v.var_name) ("show " ^ v.var_help)) - (fun v -> - print_help "show" "display debugger variable."; - print_variable_list ppf) - ppf - lexbuf - | [ {instr_name = "info"} ] -> - find_info - (fun i _ _ -> print_help ("info " ^ i.info_name) i.info_help) - (fun ppf -> - print_help "info" - "display infos about the program being debugged."; - print_info_list ppf) - ppf - lexbuf - | [i] -> - print_help i.instr_name i.instr_help - | l -> - eol lexbuf; - fprintf ppf "Ambiguous command \"%s\" : %a@." x pr_instrs l - end - | None -> - fprintf ppf "List of commands :%a@." pr_instrs !instruction_list - -(* Printing values *) - -let print_expr depth ev env ppf expr = - try - let (v, ty) = Eval.expression ev env expr in - print_named_value depth expr env v ppf ty - with - | Eval.Error msg -> - Eval.report_error ppf msg; - raise Toplevel - -let print_command depth ppf lexbuf = - let exprs = expression_list_eol Lexer.lexeme lexbuf in - ensure_loaded (); - let env = - try - Envaux.env_of_event !selected_event - with - | Envaux.Error msg -> - Envaux.report_error ppf msg; - raise Toplevel - in - List.iter (print_expr depth !selected_event env ppf) exprs - -let instr_print ppf lexbuf = print_command !max_printer_depth ppf lexbuf - -let instr_display ppf lexbuf = print_command 1 ppf lexbuf - -(* Loading of command files *) - -let extract_filename arg = - (* Allow enclosing filename in quotes *) - let l = String.length arg in - let pos1 = if l > 0 && arg.[0] = '"' then 1 else 0 in - let pos2 = if l > 0 && arg.[l-1] = '"' then l-1 else l in - String.sub arg pos1 (pos2 - pos1) - -let instr_source ppf lexbuf = - let file = extract_filename(argument_eol argument lexbuf) - and old_state = !interactif - and old_channel = !user_channel in - let io_chan = - try - io_channel_of_descr - (openfile (find_in_path !Config.load_path (expand_path file)) - [O_RDONLY] 0) - with - | Not_found -> error "Source file not found." - | (Unix_error _) as x -> Unix_tools.report_error x; raise Toplevel - in - try - interactif := false; - user_channel := io_chan; - line_loop ppf (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_set = - find_variable - (fun {var_action = (funct, _)} ppf lexbuf -> funct lexbuf) - (function ppf -> error "Argument required.") - -let instr_show = - find_variable - (fun {var_action = (_, funct)} ppf lexbuf -> eol lexbuf; funct ppf) - (function ppf -> - List.iter - (function {var_name = nm; var_action = (_, funct)} -> - fprintf ppf "%s : " nm; - funct ppf) - !variable_list) - -let instr_info = - find_info - (fun i ppf lexbuf -> i.info_action lexbuf) - (function ppf -> - error "\"info\" must be followed by the name of an info command.") - -let instr_break ppf lexbuf = - let argument = break_argument_eol Lexer.lexeme lexbuf in - ensure_loaded (); - match argument with - | BA_none -> (* break *) - (match !selected_event with - | Some ev -> - new_breakpoint ev - | None -> - error "Can't add breakpoint at this point.") - | BA_pc pc -> (* break PC *) - add_breakpoint_at_pc pc - | BA_function expr -> (* break FUNCTION *) - let env = - try - Envaux.env_of_event !selected_event - with - | Envaux.Error msg -> - Envaux.report_error ppf msg; - raise Toplevel - in - begin try - let (v, ty) = Eval.expression !selected_event env expr in - match (Ctype.repr ty).desc with - | Tarrow _ -> - add_breakpoint_after_pc (Remote_value.closure_code v) - | _ -> - eprintf "Not a function.@."; - raise Toplevel - with - | Eval.Error msg -> - Eval.report_error ppf msg; - raise Toplevel - end - | BA_pos1 (mdle, line, column) -> (* break @ [MODULE] LINE [COL] *) - let module_name = convert_module mdle in - new_breakpoint - (try - let buffer = - try get_buffer module_name with - | Not_found -> - eprintf "No source file for %s.@." module_name; - raise Toplevel - in - match column with - | None -> - event_at_pos module_name (fst (pos_of_line buffer line)) - | Some col -> - event_near_pos module_name (point_of_coord buffer line col) - with - | Not_found -> (* event_at_pos / event_near pos *) - eprintf "Can't find any event there.@."; - raise Toplevel - | Out_of_range -> (* pos_of_line / point_of_coord *) - eprintf "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 -> - eprintf "Can't find any event there.@." - -let instr_delete ppf 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 ppf 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 ppf true - with - | Not_found -> - error ("No frame number " ^ string_of_int frame_number ^ ".") - -let instr_backtrace ppf 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 -> - fprintf ppf - "(Encountered a function with no debugging information)@."; - false - | Some event -> - if !frame_counter >= first_frame then - show_one_frame !frame_counter ppf event; - incr frame_counter; - if !frame_counter >= last_frame then begin - fprintf ppf "(More frames follow)@." - 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 - fprintf ppf - "(Encountered a function with no debugging information)"; - print_newline() - end else - do_backtrace (print_frame (num_frames + number) max_int) - end - -let instr_up ppf 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 ppf true - with - | Not_found -> error "No such frame." - -let instr_down ppf 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 ppf true - with - | Not_found -> error "No such frame." - -let instr_last ppf lexbuf = - let count = - match opt_signed_int64_eol Lexer.lexeme lexbuf with - | None -> _1 - | Some x -> x - in - reset_named_values(); - go_to (History.previous_time count); - show_current_event ppf - -let instr_list ppf 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 when (mo <> None) || (point = -1) -> - 1 - | None -> - let buffer = - try get_buffer mdle with - | Not_found -> error ("No source file for " ^ mdle ^ ".") - in - begin try - max 1 ((snd (line_of_pos buffer point)) - 10) - with Out_of_range -> - 1 - end - | 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) || ask_kill_program () then name := argument), - function ppf -> fprintf ppf "%s@." !name - -let raw_line_variable kill name = - (function lexbuf -> - let argument = argument_eol line_argument lexbuf in - if (not kill) || ask_kill_program () then name := argument), - function ppf -> fprintf ppf "%s@." !name - -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) || ask_kill_program () then name := argument), - function ppf -> fprintf ppf "%i@." !name - -let int64_variable kill min msg name = - (function lexbuf -> - let argument = int64_eol Lexer.lexeme lexbuf in - if argument < min then print_endline msg - else if (not kill) || ask_kill_program () then name := argument), - function ppf -> fprintf ppf "%Li@." !name - -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) || ask_kill_program () then name := argument), - function ppf -> fprintf ppf "%s@." (if !name then "on" else "off") - -let path_variable kill name = - (function lexbuf -> - let argument = argument_eol argument lexbuf in - if (not kill) || ask_kill_program () then - name := make_absolute (expand_path argument)), - function ppf -> fprintf ppf "%s@." !name - -let loading_mode_variable ppf = - (find_ident - "loading mode" - (matching_elements (ref loading_modes) fst) - (fun (_, mode) ppf lexbuf -> - eol lexbuf; set_launching_function mode) - (function ppf -> error "Syntax error.") - ppf), - function ppf -> - let rec find = function - | [] -> () - | (name, funct) :: l -> - if funct == !launching_func then fprintf ppf "%s" name else find l - in - find loading_modes; - fprintf ppf "@." - -(** Infos. **) - -let pr_modules ppf mods = - let pr_mods ppf = List.iter (function x -> fprintf ppf "%s@ " x) in - fprintf ppf "Used modules :@.%a@?" pr_mods mods - -let info_modules ppf lexbuf = - eol lexbuf; - ensure_loaded (); - pr_modules ppf !modules -(******** - 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 ppf lexbuf = - eol lexbuf; - if !checkpoints = [] then fprintf ppf "No checkpoint.@." - 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 "%19Ld %5d %d\n" time pid version) - !checkpoints) - else - (print_endline " Time Pid"; - List.iter - (function - {c_time = time; c_pid = pid} -> - Printf.printf "%19Ld %5d\n" time pid) - !checkpoints)) - -let info_one_breakpoint ppf (num, ev) = - fprintf ppf "%3d %10d %s@." num ev.ev_pos (Pos.get_desc ev); -;; - -let info_breakpoints ppf lexbuf = - eol lexbuf; - if !breakpoints = [] then fprintf ppf "No breakpoints.@." - else begin - fprintf ppf "Num Address Where@."; - List.iter (info_one_breakpoint ppf) (List.rev !breakpoints); - end -;; - -let info_events ppf lexbuf = - ensure_loaded (); - let mdle = convert_module (opt_identifier_eol Lexer.lexeme lexbuf) in - print_endline ("Module : " ^ mdle); - print_endline " Address Character Kind Repr."; - List.iter - (function ev -> - Printf.printf - "%10d %10d %10s %10s\n" - ev.ev_pos - ev.ev_char.Lexing.pos_cnum - ((match ev.ev_kind with - Event_before -> "before" - | Event_after _ -> "after" - | Event_pseudo -> "pseudo") - ^ - (match ev.ev_info with - Event_function -> "/fun" - | Event_return _ -> "/ret" - | Event_other -> "")) - (match ev.ev_repr with - Event_none -> "" - | Event_parent _ -> "(repr)" - | Event_child repr -> string_of_int !repr)) - (events_in_module mdle) - -(** User-defined printers **) - -let instr_load_printer ppf lexbuf = - let filename = extract_filename(argument_eol argument lexbuf) in - try - Loadprinter.loadfile ppf filename - with Loadprinter.Error e -> - Loadprinter.report_error ppf e; raise Toplevel - -let instr_install_printer ppf lexbuf = - let lid = longident_eol Lexer.lexeme lexbuf in - try - Loadprinter.install_printer ppf lid - with Loadprinter.Error e -> - Loadprinter.report_error ppf e; raise Toplevel - -let instr_remove_printer ppf lexbuf = - let lid = longident_eol Lexer.lexeme lexbuf in - try - Loadprinter.remove_printer lid - with Loadprinter.Error e -> - Loadprinter.report_error ppf e; raise Toplevel - -(** Initialization. **) -let init ppf = - 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." }; - { instr_name = "shell"; instr_prio = false; - instr_action = instr_shell; instr_repeat = true; instr_help = -"Execute a given COMMAND thru the system shell." }; - (* 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 topmost 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 = "start"; instr_prio = false; - instr_action = instr_start; instr_repeat = true; instr_help = -"execute backward until the current function is exited." }; - { instr_name = "previous"; instr_prio = false; - instr_action = instr_previous; instr_repeat = true; instr_help = -"step program until it reaches the previous 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 expressions (deep printing)." }; - { instr_name = "display"; instr_prio = true; - instr_action = instr_display; instr_repeat = true; instr_help = -"print value of expressions (shallow printing)." }; - { instr_name = "source"; instr_prio = false; - instr_action = instr_source; instr_repeat = true; instr_help = -"read command from file FILE." }; - (* Breakpoints *) - { instr_name = "break"; instr_prio = false; - instr_action = instr_break; instr_repeat = false; instr_help = -"Set breakpoint at specified line or function.\n\ -Syntax: break function-name\n\ - break @ [module] linenum\n\ - break @ [module] # characternum" }; - { 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." }; - (* User-defined printers *) - { instr_name = "load_printer"; instr_prio = false; - instr_action = instr_load_printer; instr_repeat = false; instr_help = -"load in the debugger a .cmo or .cma file containing printing functions." }; - { instr_name = "install_printer"; instr_prio = false; - instr_action = instr_install_printer; instr_repeat = false; instr_help = -"use the given function for printing values of its input type.\n\ -The code for the function must have previously been loaded in the debugger\n\ -using \"load_printer\"." }; - { instr_name = "remove_printer"; instr_prio = false; - instr_action = instr_remove_printer; instr_repeat = false; instr_help = -"stop using the given function for printing values of its input type." } -]; - 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 ppf; - var_help = -"mode of loading.\n\ -It can be either : - direct : the program is directly called by the debugger.\n\ - runtime : the debugger execute `ocamlrun 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 = int64_variable false _1 "Must be >= 1." - checkpoint_big_step; - var_help = -"step between checkpoints during long displacements." }; - { var_name = "smallstep"; - var_action = int64_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" - 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" - max_printer_steps; - var_help = -"maximal number of value nodes printed." }]; - - info_list := - (* info name, function, help *) - [{ info_name = "modules"; - info_action = info_modules ppf; - info_help = "list opened modules." }; - { info_name = "checkpoints"; - info_action = info_checkpoints ppf; - info_help = "list checkpoints." }; - { info_name = "breakpoints"; - info_action = info_breakpoints ppf; - info_help = "list breakpoints." }; - { info_name = "events"; - info_action = info_events ppf; - info_help = "list events in MODULE (default is current module)." }] - -let _ = init std_formatter |