Edit file

File name : sldbcore.sl

Content :% Copyright (C) 2012-2017,2018 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for % more information. %--------------------------------------------------------------------------- % % This file implements the core a simple debugger. It needs to be wrapped % by routines that implement the Debugger_Methods. % % Public functions: % sldb_methods() % sldb_stop (); % sldb_start (); % sldb_set_breakpoint (); % % % Notes: % % If a file was not compiled with bos/eos hooks, then debugging of % it may be limited due to the lack of line number information. % % require ("print"); private variable Debugger_Methods = struct { list, % list (file, linemin, linemax) vmessage, % vmessage (fmt, args...) read_input, % input = read_input (prompt, default) pprint, % pprint(obj) % pprint the value of an object quit, % quit (and kill) the program exit % exit the debugger but not the program }; private define output () { variable args = __pop_args (_NARGS); (@Debugger_Methods.vmessage)(__push_args(args)); } private define quit_method () { output ("Program exiting\n"); exit (0); } Debugger_Methods.quit = &quit_method; private define exit_method () { output ("Leaving the debugger\n"); } Debugger_Methods.exit = &exit_method; define sldb_methods () { return Debugger_Methods; } define sldb_initialize (); % This should be overridden define sldb_stop(); private variable Depth = 0; private variable Stop_Depth = 0; private variable Debugger_Step = 0; private variable STEP_NEXT = 1; private variable STEP_STEP = 2; private variable STEP_FINISH = 3; private variable STEP_EXIT = 4; private variable Breakpoints = NULL; private variable Breakpoint_Number = 1; private variable Current_Frame; private variable Max_Current_Frame; private variable Last_List_Line = 0; private variable Last_Cmd_Line = NULL; private variable Last_Cmd = NULL; private variable Prompt = "(SLdb) "; private variable Startup_PID = NULL; private define new_breakpoints () { Breakpoints = Assoc_Type[Int_Type, 0]; Breakpoint_Number = 1; } private define check_breakpoints () { if (Breakpoints == NULL) new_breakpoints (); } define sldb_set_breakpoint (pos) { variable bp; check_breakpoints (); bp = Breakpoint_Number; Breakpoints[pos] = bp; Breakpoint_Number++; output ("breakpoint #%d set at %s\n", bp, pos); return bp; } private define make_breakpoint_name (file, line) { return sprintf ("%S:%d", file, line); } private define eval_in_frame (frame, expr, num_on_stack, print_fun) { variable boseos = _boseos_info; variable bofeof = _bofeof_info; expr = sprintf ("_boseos_info=0; _bofeof_info=0; _use_frame_namespace(%d); %s; _bofeof_info=%d; _boseos_info=%d;", frame, expr, bofeof, boseos); variable depth = _stkdepth () - num_on_stack; eval (expr); variable n = _stkdepth () - depth; if (print_fun == NULL) return n; loop (n) { variable val = (); (@print_fun) (val); } return n; } private define break_cmd (cmd, args, file, line) { variable bp; if (strlen (args) == 0) bp = make_breakpoint_name (file, line); else if (_slang_guess_type (args) == Int_Type) bp = make_breakpoint_name (file, integer (args)); else { bp = args; if (0 == is_substr (args, ":")) { } } () = sldb_set_breakpoint (bp); return 0; } private define display_file_and_line (file, linemin, linemax) { if (file == "***string***") return; if (linemin < 1) linemin = 1; if (linemax < linemin) linemax = linemin; (@Debugger_Methods.list)(file, linemin, linemax); } private define finish_cmd (cmd, args, file, line) { %variable fun = _get_frame_info (Max_Current_Frame).function; variable fun = _get_frame_info (Current_Frame).function; if (fun == NULL) fun = "<top-level>"; output ("Run until exit from %s\n", fun); Debugger_Step = STEP_FINISH; Stop_Depth = Depth-1; return 1; } private define next_cmd (cmd, args, file, line) { Debugger_Step = STEP_NEXT; Stop_Depth = Depth; return 1; } private define step_cmd (cmd, args, file, line) { Debugger_Step = STEP_STEP; Stop_Depth = Depth + 1; return 1; } private define delete_cmd (cmd, args, file, line) { variable bp = make_breakpoint_name (file, line); variable n = Breakpoints[bp]; if (n) { Breakpoints[bp] = 0; output ("Deleted breakpoint #%d\n", n); return 0; } if (args == "") { new_breakpoints (); output ("Deleted all breakpoints\n"); return 0; } variable keys = assoc_get_keys (Breakpoints); variable vals = assoc_get_values (Breakpoints); foreach (eval (sprintf ("[%s]", args))) { bp = (); variable i = wherefirst (vals == bp); if (i == NULL) continue; assoc_delete_key (Breakpoints, keys[i]); output ("Deleted breakpoint %d\n", bp); } return 0; } private define continue_cmd (cmd, args, file, line) { Debugger_Step = 0; return 1; } private define watch_cmd (cmd, args, file, line) { output ("%s is not implemented\n", cmd); return 0; } private define exit_cmd (cmd, args, file, line) { sldb_stop (); (@Debugger_Methods.exit) (); return 1; } private define quit_cmd (cmd, args, file, line) { variable prompt = "Are you sure you want to quit (and kill) the program? (y/n) "; variable y = (@Debugger_Methods.read_input)(prompt, NULL); y = strup (y); !if (strlen (y)) return 0; if (y[0] != 'Y') { output ("Try using 'exit' to leave the debugger"); return 0; } sldb_stop (); (@Debugger_Methods.quit)(); return 1; } private define simple_print (v) { if (length (v) <= 1) print (v, &v); output ("%S\n", v); } private define pretty_print (v) { variable p = Debugger_Methods.pprint; if (p == NULL) { simple_print (v); return; } (@p)(v); } private define print_expr (print_fun, expr) { variable info = _get_frame_info (Current_Frame); variable localvars = info.locals; if (localvars == NULL) { () = eval_in_frame (Current_Frame, expr, 0, print_fun); return; } % Create a dummy function and call it with the values of the local-vars % The idea is that variables that are initialized will be arguments, and % others will just be locals variable a = Assoc_Type[]; foreach (localvars) { variable lvar = (); try { a[lvar] = _get_frame_variable (Current_Frame, lvar); } catch VariableUninitializedError; } variable inited_vars = assoc_get_keys (a); variable uninited_vars = String_Type[0]; foreach (localvars) { lvar = (); if (assoc_key_exists (a, lvar)) continue; uninited_vars = [uninited_vars, lvar]; } if (length (uninited_vars)) uninited_vars = strcat ("variable ", strjoin (uninited_vars, ","), ";"); else uninited_vars = ""; variable fmt = "private define %s (%s) { %s %s; }"; variable dummy = "__debugger_print_function"; variable fun = sprintf (fmt, dummy, strjoin (inited_vars, ","), uninited_vars, expr); () = eval_in_frame (Current_Frame, fun, 0, print_fun); % push values to the stack and call the dummy function foreach lvar (inited_vars) { a[lvar]; } () = eval_in_frame (Current_Frame, dummy, length (inited_vars), print_fun); } private define print_cmd (cmd, args, file, line) { print_expr (&simple_print, args); return 0; } private define pprint_cmd (cmd, args, file, line) { print_expr (&pretty_print, args); return 0; } private define list_cmd (cmd, args, file, line) { variable dline = 5; line = int (line); if (Last_Cmd == cmd) line = Last_List_Line + 1 + dline; variable line_min = line - dline; variable line_max = line + dline; if (strlen (args)) { line_min = integer (args); line_max = line_min + 10; } display_file_and_line (file, line_min, line_max); Last_List_Line = line_max; return 0; } private define print_frame_info (f, print_line) { variable info = _get_frame_info (f); variable file = info.file; variable function = info.function; variable line = info.line; if (function == NULL) function = "<top-level frame>"; output("#%d %S:%d:%s\n", Max_Current_Frame-f, file, line, function); if (print_line) display_file_and_line (file, line, line); } private define up_cmd (cmd, args, file, line) { if (Current_Frame == 1) { output ("Can't go up\n"); return 0; } Current_Frame--; print_frame_info (Current_Frame, 1); return 0; } private define down_cmd (cmd, args, file, line) { if (Current_Frame == Max_Current_Frame) { output ("At inner-most frame\n"); return 0; } Current_Frame++; print_frame_info (Current_Frame, 1); return 0; } private define where_cmd (cmd, args, file, line) { variable i = Current_Frame; while (i > 0) { print_frame_info (i, 0); i--; } return 0; } #ifexists fpu_clear_except_bits private variable WatchFPU_Flags = 0; #endif private define watchfpu_cmd (cmd, args, file, line) { #ifexists fpu_clear_except_bits fpu_clear_except_bits (); if (args == "") { WatchFPU_Flags = FE_ALL_EXCEPT; output ("Watching all FPU exceptions:\n"); output (" FE_DIVBYZERO | FE_INEXACT | FE_INVALID | FE_OVERFLOW | FE_UNDERFLOW\n"); return 0; } WatchFPU_Flags = eval (args); if (WatchFPU_Flags == 0) { output ("Watching FPU exceptions disabled\n"); } return 0; #else output ("watchfpu is not supported on this OS\n"); return 0; #endif } private variable Cmd_Table = Assoc_Type [Ref_Type]; Cmd_Table["finish"] = &finish_cmd; Cmd_Table["next"] = &next_cmd; Cmd_Table["step"] = &step_cmd; Cmd_Table["break"] = &break_cmd; Cmd_Table["delete"] = &delete_cmd; Cmd_Table["cont"] = &continue_cmd; Cmd_Table["continue"] = &continue_cmd; Cmd_Table["watch"] = &watch_cmd; Cmd_Table["list"] = &list_cmd; Cmd_Table["pprint"] = &pprint_cmd; Cmd_Table["print"] = &print_cmd; Cmd_Table["exit"] = &exit_cmd; Cmd_Table["quit"] = &quit_cmd; Cmd_Table["up"] = &up_cmd; Cmd_Table["down"] = &down_cmd; Cmd_Table["where"] = &where_cmd; Cmd_Table["watchfpu"] = &watchfpu_cmd; % Aliases define sldb_add_alias (alias, cmd) { if (0 == assoc_key_exists (Cmd_Table, cmd)) return; Cmd_Table[alias] = Cmd_Table[cmd]; } sldb_add_alias ("b", "break"); sldb_add_alias ("c", "continue"); sldb_add_alias ("d", "delete"); sldb_add_alias ("h", "help"); sldb_add_alias ("l", "list"); sldb_add_alias ("n", "next"); sldb_add_alias ("p", "print"); sldb_add_alias ("pp", "pprint"); sldb_add_alias ("q", "quit"); sldb_add_alias ("s", "step"); private define help_cmd (cmd, args, file, line) { output ("Commands:\n"); variable cmds = assoc_get_keys (Cmd_Table); cmds = cmds[array_sort(cmds)]; foreach cmd (cmds) output (" %s\n", cmd); return 0; } Cmd_Table["help"] = &help_cmd; private define sigint_handler (sig) { Debugger_Step = STEP_STEP; Stop_Depth = INT_MAX; if (Depth == 0) throw UserBreakError; } private variable Old_Sigint_Handler; private define deinit_sigint_handler () { #ifexists SIGINT signal (SIGINT, Old_Sigint_Handler); #endif } private define init_sigint_handler () { #ifexists SIGINT variable old; signal (SIGINT, &sigint_handler, &old); ifnot (_eqs(old, &sigint_handler)) Old_Sigint_Handler = old; #endif } private variable Last_Frame = -1; private variable Last_Function = NULL; private define debugger_input_loop () { variable max_frame = Max_Current_Frame; %Last_Cmd_Line = NULL; %Last_Cmd = NULL; forever { variable e; try (e) { %deinit_sigint_handler (); init_sigint_handler (); Debugger_Step = 0; if (Current_Frame > max_frame) { Max_Current_Frame = max_frame; Current_Frame = max_frame; } variable info = _get_frame_info (Current_Frame); variable file = info.file; variable line = info.line; variable cmdline, cmd, cmd_parm; forever { variable prompt = Prompt; #iffalse prompt = "Depth=${Depth},Stop_Depth=${Stop_Depth} $prompt"$; #endif cmdline = (@Debugger_Methods.read_input)(prompt, Last_Cmd_Line); if (cmdline == NULL) throw ReadError, "NULL input returned"; cmdline = strtrim (cmdline); variable tokens = strtok (cmdline, " \t"); if (length (tokens)) { cmd = tokens[0]; break; } } cmd_parm = substr (cmdline, 1+strlen(cmd), -1); cmd_parm = strtrim (cmd_parm, "\t "); if (0 == assoc_key_exists (Cmd_Table, cmd)) { output("%s is unknown. Try help.\n", cmd); Last_Cmd_Line = NULL; Last_Cmd = NULL; continue; } variable ret = (@Cmd_Table[cmd])(cmd, cmd_parm, file, line); Last_Cmd_Line = cmdline; Last_Cmd = cmd; if (ret) return; } catch IOError: { sldb_stop (); vmessage ("Caught IOError exception -- stopping the debugger: %S",e.message); return; } catch AnyError: { output("Caught exception:%S:%S:%S:%S\n", e.file, e.line, e.function, e.message); } } } private define do_debug (file, line, bp_num) { %output ("do_debug: file=%S, line=%S, fun=%S\n", file, line, bp_num); Current_Frame = _get_frame_depth ()-2; Max_Current_Frame = Current_Frame; %vmessage ("Current_Frame=%d\n", Current_Frame); % We do not want the debug_hook catching errors here variable debug_hook = _set_debug_hook (NULL); EXIT_BLOCK { if (Debugger_Step != STEP_EXIT) { () = _set_debug_hook (debug_hook); init_sigint_handler (); } } variable info = _get_frame_info (Current_Frame); if (file == NULL) { file = info.file; if (file == NULL) file = "???"; } if (line == NULL) line = info.line; variable fun = info.function; if (fun == NULL) fun = "<top-level>"; if ((file == "<stdin>"))% or (file == "***string***")) { Last_Frame = Current_Frame; Last_Function = fun; Debugger_Step = STEP_NEXT; Stop_Depth = Depth-1; return; } if (bp_num) { output ("Breakpoint %d, %s\n at %s:%d\n", abs(bp_num), fun, file, line); } else if ((Last_Frame != Current_Frame) or (Last_Function != fun)) { output ("%s at %s:%d\n", fun, file, line); } display_file_and_line (file, line, line); Last_Frame = Current_Frame; Last_Function = fun; debugger_input_loop (); } private define bos_handler (file, line) { %output ("bos: depth=%d, stop_depth=%d, fun=%S\n", Depth,Stop_Depth,_get_frame_info(-1).function); variable pos = make_breakpoint_name (file, line); variable bp = Breakpoints[pos]; if (bp) { if (bp < 0) Breakpoints[pos] = 0; % clear temporary breakpoint do_debug (file, line, bp); return; } if (Depth > Stop_Depth) return; if (Debugger_Step == 0) return; #iffalse if (Debugger_Step == STEP_FINISH) return; if (Debugger_Step == STEP_NEXT) { if (Depth > Stop_Depth) return; } #endif do_debug (file, line, bp); } % end of statement handler: tracks the recursion depth, % to be able to step over function calls (using 'Next' Command) private define eos_handler() { #ifexists fpu_clear_except_bits if (WatchFPU_Flags) { variable bits = fpu_test_except_bits (WatchFPU_Flags); if (bits) { variable info = _get_frame_info (-1); variable str = String_Type[0]; if (bits & FE_DIVBYZERO) str = [str,"FE_DIVBYZERO"]; if (bits & FE_INEXACT) str = [str,"FE_INEXACT"]; if (bits & FE_INVALID) str = [str,"FE_INVALID"]; if (bits & FE_OVERFLOW) str = [str,"FE_OVERFLOW"]; if (bits & FE_UNDERFLOW) str = [str,"FE_UNDERFLOW"]; output ("*** FPU exception bits set: %s\n", strjoin(str, ",")); output ("Entering the debugger.\n"); fpu_clear_except_bits (); do_debug (info.file, info.line, 0); } } #endif %output ("eos: depth=%d\n", Depth); } private define bof_handler (fun, file) { %output ("Entering BOF: %S, %S, %S", fun, file, line); Depth++; variable bp = Breakpoints[fun]; if (bp) { output ("Breakpoint %d, %s\n", abs(bp), fun); if (bp < 0) Breakpoints[fun] = 0; % clear temporary breakpoint Debugger_Step = STEP_NEXT; Stop_Depth = Depth; } } private define eof_handler () { %output ("Leaving EOF"); Depth--; if (Debugger_Step) { if (Debugger_Step == STEP_FINISH) { if (Depth == Stop_Depth) { Debugger_Step = 0; %variable info = _get_frame_info (_get_frame_depth ()-2); %do_debug (info.file, info.line, 0); do_debug (NULL, NULL, 0); } } if ((Debugger_Step == STEP_NEXT) and (Stop_Depth > Depth)) Stop_Depth = Depth; } } private define debug_hook (file, line) { if (Startup_PID != getpid()) return; %variable file = e.file, line = e.line; variable e = __get_exception_info (); output ("Received %s error. Entering the debugger\n", e.descr); check_breakpoints (); do_debug (file, line, 0); } define sldb_enable () { ()=_set_bos_handler (&bos_handler); ()=_set_eos_handler (&eos_handler); ()=_set_bof_handler (&bof_handler); ()=_set_eof_handler (&eof_handler); ()=_set_debug_hook (&debug_hook); check_breakpoints (); Depth = 0; Debugger_Step = STEP_STEP; init_sigint_handler (); _traceback = 1; _bofeof_info = 1; _boseos_info = 3; } % Usage Forms: % sldb (); % sldb (file); % sldb (file, ns); % The namespace semantics are the same as that of require. define sldb () { Startup_PID = getpid (); sldb_initialize (); sldb_enable (); if (_NARGS == 0) { Current_Frame = _get_frame_depth ()-1; Max_Current_Frame = Current_Frame; debugger_input_loop (); return; } variable args = __pop_args (_NARGS); require (__push_args (args)); #iffalse variable ns = current_namespace (); if (_NARGS == 2) ns = (); variable file = (); if (ns == NULL) () = evalfile (file); else () = evalfile (file, ns); #endif } % remove bos and eos handlers. define sldb_stop () { ()=_set_bos_handler (NULL); ()=_set_eos_handler (NULL); ()=_set_bof_handler (NULL); ()=_set_eof_handler (NULL); ()=_set_debug_hook (NULL); deinit_sigint_handler (); _bofeof_info = 0; _boseos_info = 0; Debugger_Step = STEP_EXIT; } provide ("sldbcore");

Save