changeset 7736:a059b5679fbb

implement dbstack
author John W. Eaton <jwe@octave.org>
date Fri, 25 Apr 2008 15:11:03 -0400
parents 6848970153ba
children 15d3a35b8ff1
files scripts/ChangeLog scripts/miscellaneous/Makefile.in scripts/miscellaneous/dbstack.m src/ChangeLog src/debug.cc src/ov-usr-fcn.cc src/parse.y src/pt-stmt.cc src/pt-stmt.h src/toplev.cc src/toplev.h
diffstat 11 files changed, 184 insertions(+), 67 deletions(-) [+]
line wrap: on
line diff
--- a/scripts/ChangeLog	Fri Apr 25 12:17:44 2008 -0400
+++ b/scripts/ChangeLog	Fri Apr 25 15:11:03 2008 -0400
@@ -1,3 +1,8 @@
+2008-04-25  John W. Eaton  <jwe@octave.org>
+
+	* miscellaneous/dbstack.m: New function.
+	* miscellaneous/Makefile.in: Add it to the list.
+
 2008-04-21  David Bateman  <dbateman@free.fr>
 
 	* plot/__go_draw_axes__.m (gnuplot_position_colorbox): New arg, obj.
--- a/scripts/miscellaneous/Makefile.in	Fri Apr 25 12:17:44 2008 -0400
+++ b/scripts/miscellaneous/Makefile.in	Fri Apr 25 15:11:03 2008 -0400
@@ -35,7 +35,7 @@
 
 SOURCES = ans.m bincoeff.m bug_report.m bunzip2.m cast.m comma.m \
   compare_versions.m computer.m copyfile.m \
-  delete.m dir.m doc.m dos.m dump_prefs.m edit.m \
+  dbstack.m delete.m dir.m doc.m dos.m dump_prefs.m edit.m \
   fileattrib.m fileparts.m flops.m fullfile.m getfield.m gunzip.m gzip.m \
   info.m inputname.m ismac.m ispc.m isunix.m license.m list_primes.m ls.m \
   ls_command.m menu.m mex.m mexext.m mkoctfile.m movefile.m \
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/scripts/miscellaneous/dbstack.m	Fri Apr 25 15:11:03 2008 -0400
@@ -0,0 +1,56 @@
+## Copyright (C) 2008 John W. Eaton
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 3 of the License, or (at
+## your option) any later version.
+##
+## Octave is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, see
+## <http://www.gnu.org/licenses/>.
+
+## -*- texinfo -*-
+## @deftypefn {Loadable Function} {[@var{stack}, @var{idx}]} dbstack (@var{n})
+## Print or return current stack information.  With optional argument
+## @var{n}, omit the @var{n} innermost stack frames.
+## @seealso{dbclear, dbstatus, dbstop}
+## @end deftypefn
+
+## Author: jwe
+
+function [stack, idx] = dbstack (n = 0)
+
+  if (n < 0 || round (n) != n)
+    error ("dbstack: expecting N to be a non-negative integer");
+  endif
+
+  ## Add one here to skip the dbstack stack frame.
+  [t_stack, t_idx] = __dbstack__ (n+1);
+
+  if (nargout == 0)
+    nframes = numel (t_stack);
+    if (nframes > 0)
+      puts ("Stopped in:\n\n");
+      for i = 1:nframes
+	if (i == t_idx)
+	  puts ("--> ");
+	else
+	  puts ("    ");
+	endif
+	f = t_stack(i);
+	printf ("%s at line %d column %d\n", f.name, f.line, f.column);
+      endfor
+    endif
+  else
+    stack = t_stack;
+    idx = t_idx;
+  endif
+
+endfunction
--- a/src/ChangeLog	Fri Apr 25 12:17:44 2008 -0400
+++ b/src/ChangeLog	Fri Apr 25 15:11:03 2008 -0400
@@ -1,5 +1,28 @@
 2008-04-25  John W. Eaton  <jwe@octave.org>
 
+	* pt-stmt.h (tree_statement_list::function_body): New data member.
+	(tree_statement_list::tree_statement_list): Initialize it.
+	(tree_statement_list::mark_as_script_body): New function.
+	(tree_statement::maybe_echo_code, tree_statement::eval):
+	Rename in_function_body argument to in_function_or_script_body.
+	* pt-stmt.cc (tree_statement::eval): Only set statement in call
+	stack if in_function_or_script_body is true.
+
+	* pt-stmt.cc (tree_statement_list::eval): Call elt->eval with
+	function_body || script_body.
+	* ov-usr-fcn.cc (octave_user_script::octave_user_script):
+	command list as script body here.
+	(octave_user_function::octave_user_function):
+	Mark command list as function body here.
+	* parse.y (start_function, make_anon_fcn_handle): Not here.
+
+	* toplev.h, toplev.cc (octave_call_stack::backtrace,
+	octave_call_stack::do_backtrace): New arg, N.  Skip innermost N
+	stack frames.
+
+	* debug.cc (F__dbstack__): New function.
+	(current_stack_frame): New static variable.
+
 	* error.cc (verror, pr_where): Use octave_call_stack instead of
 	tree_statement stack to get line and column information.
 	(pr_where): Use octave_call_stack instead of tree_statement stack
--- a/src/debug.cc	Fri Apr 25 12:17:44 2008 -0400
+++ b/src/debug.cc	Fri Apr 25 15:11:03 2008 -0400
@@ -29,7 +29,6 @@
 #include <string>
 #include <set>
 
-
 #include "defun.h"
 #include "error.h"
 #include "help.h"
@@ -58,6 +57,9 @@
 // Initialize the singleton object
 bp_table *bp_table::instance = 0;
 
+// FIXME --  dbup and dbdown will need to modify this variable.
+static int current_stack_frame = 1;
+
 // Return a pointer to the user-defined function FNAME.  If FNAME is
 // empty, search backward for the first user-defined function in the
 // current call stack.
@@ -693,6 +695,30 @@
   return retval;
 }
 
+DEFUN (__dbstack__, args, ,
+  "-*- texinfo -*-\n\
+@deftypefn {Loadable Function} {[@var{stack}, @var{idx}]} __dbstack__ (@var{n})\n\
+Undocumented internal function.\n\
+@end deftypefn")
+{
+  octave_value_list retval;
+
+  int n = 0;
+
+  if (args.length () == 1)
+    n = args(0).int_value ();
+
+  if (! error_state)
+    {
+      retval(1) = current_stack_frame;
+
+      // Add one here to skip the __dbstack__ stack frame.
+      retval(0) = octave_call_stack::backtrace (n+1);
+    }
+
+  return retval;
+}
+
 /*
 ;;; Local Variables: ***
 ;;; mode: C++ ***
--- a/src/ov-usr-fcn.cc	Fri Apr 25 12:17:44 2008 -0400
+++ b/src/ov-usr-fcn.cc	Fri Apr 25 15:11:03 2008 -0400
@@ -74,7 +74,10 @@
     t_parsed (static_cast<time_t> (0)),
     t_checked (static_cast<time_t> (0)),
     call_depth (0)
-{ }
+{
+  if (cmd_list)
+    cmd_list->mark_as_script_body ();
+}
 
 octave_user_script::octave_user_script (const std::string& fnm,
 					const std::string& nm,
@@ -204,7 +207,10 @@
     nested_function (false), inline_function (false),
     class_constructor (false), class_method (false), xdispatch_class (),
     args_passed (), num_args_passed (0), local_scope (sid)
-{ }
+{
+  if (cmd_list)
+    cmd_list->mark_as_function_body ();
+}
 
 octave_user_function::~octave_user_function (void)
 {
--- a/src/parse.y	Fri Apr 25 12:17:44 2008 -0400
+++ b/src/parse.y	Fri Apr 25 15:11:03 2008 -0400
@@ -1771,8 +1771,6 @@
 
   tree_statement_list *body = new tree_statement_list (stmt);
 
-  body->mark_as_function_body ();
-
   tree_anon_fcn_handle *retval
     = new tree_anon_fcn_handle (param_list, ret_list, body, fcn_scope, l, c);
 
@@ -2427,8 +2425,6 @@
 static octave_user_function *
 start_function (tree_parameter_list *param_list, tree_statement_list *body)
 {
-  body->mark_as_function_body ();
-
   // We'll fill in the return list later.
 
   octave_user_function *fcn
--- a/src/pt-stmt.cc	Fri Apr 25 12:17:44 2008 -0400
+++ b/src/pt-stmt.cc	Fri Apr 25 15:11:03 2008 -0400
@@ -67,9 +67,9 @@
 }
 
 void
-tree_statement::maybe_echo_code (bool in_function_body)
+tree_statement::maybe_echo_code (bool in_function_or_script_body)
 {
-  if (in_function_body
+  if (in_function_or_script_body
       && (Vecho_executing_commands & ECHO_FUNCTIONS))
     {
       tree_print_code tpc (octave_stdout, VPS4);
@@ -79,7 +79,8 @@
 }
 
 octave_value_list
-tree_statement::eval (bool silent, int nargout, bool in_function_body)
+tree_statement::eval (bool silent, int nargout,
+		      bool in_function_or_script_body)
 {
   octave_value_list retval;
 
@@ -87,9 +88,10 @@
 
   if (cmd || expr)
     {
-      octave_call_stack::set_statement (this);
+      if (in_function_or_script_body)
+	octave_call_stack::set_statement (this);
 
-      maybe_echo_code (in_function_body);
+      maybe_echo_code (in_function_or_script_body);
 
       try
 	{
@@ -179,7 +181,8 @@
 	    {
 	      OCTAVE_QUIT;
 
-	      retval = elt->eval (silent, nargout, function_body);
+	      retval = elt->eval (silent, nargout,
+				  function_body || script_body);
 
 	      if (error_state)
 		break;
--- a/src/pt-stmt.h	Fri Apr 25 12:17:44 2008 -0400
+++ b/src/pt-stmt.h	Fri Apr 25 15:11:03 2008 -0400
@@ -71,7 +71,8 @@
 
   tree_command *command (void) { return cmd; }
 
-  octave_value_list eval (bool silent, int nargout, bool in_function_body);
+  octave_value_list eval (bool silent, int nargout,
+			  bool in_function_or_script_body);
 
   tree_expression *expression (void) { return expr; }
 
@@ -119,10 +120,10 @@
 public:
 
   tree_statement_list (void)
-    : function_body (false) { }
+    : function_body (false), script_body (false) { }
 
   tree_statement_list (tree_statement *s)
-    : function_body (false) { append (s); }
+    : function_body (false), script_body (false) { append (s); }
 
   ~tree_statement_list (void)
     {
@@ -136,6 +137,8 @@
 
   void mark_as_function_body (void) { function_body = true; }
 
+  void mark_as_script_body (void) { script_body = true; }
+
   octave_value_list eval (bool silent = false, int nargout = 0);
 
   int set_breakpoint (int line);
@@ -153,6 +156,9 @@
   // Does this list of statements make up the body of a function?
   bool function_body;
 
+  // Does this list of statements make up the body of a script?
+  bool script_body;
+
   // No copying!
 
   tree_statement_list (const tree_statement_list&);
--- a/src/toplev.cc	Fri Apr 25 12:17:44 2008 -0400
+++ b/src/toplev.cc	Fri Apr 25 15:11:03 2008 -0400
@@ -175,73 +175,69 @@
 }
 
 Octave_map
-octave_call_stack::do_backtrace (void) const
+octave_call_stack::do_backtrace (int n) const
 {
   Octave_map retval;
 
-  size_t nframes = cs.size () - 1;
-
-  Cell keys (4, 1);
+  int nframes = cs.size () - n;
 
-  keys(0) = "file";
-  keys(1) = "name";
-  keys(2) = "line";
-  keys(3) = "column";
+  if (nframes > 0)
+    {
+      Cell keys (4, 1);
 
-  Cell file (nframes, 1);
-  Cell name (nframes, 1);
-  Cell line (nframes, 1);
-  Cell column (nframes, 1);
+      keys(0) = "file";
+      keys(1) = "name";
+      keys(2) = "line";
+      keys(3) = "column";
 
-  const_iterator p = cs.begin ();
-  
-  // Skip innermost function as it will be the dbstatus function
-  // itself.  FIXME -- Is it best to do this here?
-  p++;
+      Cell file (nframes, 1);
+      Cell name (nframes, 1);
+      Cell line (nframes, 1);
+      Cell column (nframes, 1);
+
+      octave_idx_type k = 0;
 
-  octave_idx_type k = 0;
-
-  while (p != cs.end ())
-    {
-      const call_stack_elt& elt = *p;
-
-      octave_function *f = elt.fcn;
-
-      if (f)
+      for (const_iterator p = cs.begin () + n; p != cs.end (); p++)
 	{
-	  file(k) = f->fcn_file_name ();
-	  name(k) = f->name ();
+	  const call_stack_elt& elt = *p;
+
+	  octave_function *f = elt.fcn;
 
-	  tree_statement *stmt = elt.stmt;
+	  if (f)
+	    {
+	      file(k) = f->fcn_file_name ();
+	      name(k) = f->name ();
+
+	      tree_statement *stmt = elt.stmt;
 
-	  if (stmt)
-	    {
-	      line(k) = stmt->line ();
-	      column(k) = stmt->column ();
+	      if (stmt)
+		{
+		  line(k) = stmt->line ();
+		  column(k) = stmt->column ();
+		}
+	      else
+		{
+		  line(k) = -1;
+		  column(k) = -1;
+		}
 	    }
 	  else
 	    {
+	      file(k) = "<unknown>";
+	      name(k) = "<unknown>";
 	      line(k) = -1;
 	      column(k) = -1;
 	    }
-	}
-      else
-	{
-	  file(k) = "<unknown>";
-	  name(k) = "<unknown>";
-	  line(k) = -1;
-	  column(k) = -1;
+
+	  k++;
 	}
 
-      k++;
-      p++;
+      retval.assign ("file", file);
+      retval.assign ("name", name);
+      retval.assign ("line", line);
+      retval.assign ("column", column);
     }
 
-  retval.assign ("file", file);
-  retval.assign ("name", name);
-  retval.assign ("line", line);
-  retval.assign ("column", column);
-
   return retval;
 }
 
--- a/src/toplev.h	Fri Apr 25 12:17:44 2008 -0400
+++ b/src/toplev.h	Fri Apr 25 15:11:03 2008 -0400
@@ -178,9 +178,9 @@
       instance->do_set_statement (s);
   }
 
-  static Octave_map backtrace (void)
+  static Octave_map backtrace (int n = 0)
   {
-    return instance_ok () ? instance->do_backtrace () : Octave_map ();
+    return instance_ok () ? instance->do_backtrace (n) : Octave_map ();
   }
 
   static void pop (void)
@@ -269,7 +269,7 @@
       }
   }
 
-  Octave_map do_backtrace (void) const;
+  Octave_map do_backtrace (int n) const;
 
   void do_pop (void)
   {