# HG changeset patch
# User jwe
# Date 1144311623 0
# Node ID a527e0f77aa5351370baaf78f391da76b11affb6
# Parent  2cd0af543e7a299c8ba593b5d0ebf35d0b64f730
[project @ 2006-04-06 08:20:21 by jwe]

diff --git a/src/ChangeLog b/src/ChangeLog
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,45 @@
+2006-04-06  John W. Eaton  <jwe@octave.org>
+
+	* parse.y (Fmfilename): If no function is on the call stack check
+	to see whether we are reading a script file.
+
+	* ov-builtin.cc (octave_builtin::do_multi_index_op):
+	Use octave_call_stack instead of curr_function to save pointer to
+	current function.
+	* ov-mapper.cc (octave_mapper::do_multi_index_op): Likewise.
+	* ov-usr-fcn.cc (octave_user_function::do_multi_index_op): Likewise.
+
+	* pt-bp.h (MAYBE_DO_BREAKPOINT): Use octave_call_stack instead of
+	curr_function to get pointer to current function.
+	* pt-arg-list.cc (list::convert_to_const_vector): Likewise.
+	* variables.cc (Fmlock, Fmunlock, Fmislocked): Likewise.
+	* input.cc (get_user_input): Likewise.
+	* error.cc (warning_1, error_2): Likewise.  Only enter debug mode
+	if there is a scripting language caller.
+	* ov-usr-fcn.cc (Fva_arg, Fva_start, Fvr_val): Likewise.  Check
+	scripting language caller, not current function.
+
+	* toplev.cc (curr_caller_function, curr_function): Delete.
+	* toplev.h: Delete decls.
+
+	* ov-usr-fcn.cc (octave_user_function::do_multi_index_op):
+	Don't protect and set curr_caller_function.
+	* ov-builtin.cc (octave_builtin::do_multi_index_op): Likewise.
+	* ov-mapper.cc (octave_mapper::do_multi_index_op): Likewise.
+
+	* variables.cc (do_who): Use octave_call_stack instead of
+	curr_caller_function to get pointer to calling function.
+	* input.cc (get_user_input): Likewise.
+	* error.cc (pr_where): Likewise.  No need for curr_function now.
+	* parse.y (Fmfilename): Likewise.  Check for scripting language
+	caller, not any calling function.
+
 2006-04-05  John W. Eaton  <jwe@octave.org>
 
+	* toplev.h, toplev.cc (octave_call_stack): New class.
+
+	* debug.cc (Fdbwhere): Use get_user_function here.
+
 	* Makefile.in (mk-pkg-add): Use mfilename to simplify.
 	(PKG_ADD): Don't pass --prefix arg to mk-pkg-add.
 	(PKG_ADD.inst): Delete target.
diff --git a/src/debug.cc b/src/debug.cc
--- a/src/debug.cc
+++ b/src/debug.cc
@@ -49,14 +49,20 @@
 #include "unwind-prot.h"
 #include "variables.h"
 
+// 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.
+
 static octave_user_function *
-get_user_function (std::string str = "")
+get_user_function (std::string fname = "")
 {
   octave_user_function *dbg_fcn = 0;
 
-  if (str.compare (""))
+  if (fname == "")
+    dbg_fcn = octave_call_stack::caller_script ();
+  else
     {
-      symbol_record *ptr = curr_sym_tab->lookup (str);
+      symbol_record *ptr = curr_sym_tab->lookup (fname);
 
       if (ptr && ptr->is_user_function ())
 	{
@@ -65,7 +71,7 @@
 	}
       else
 	{
-	  ptr = lookup_by_name (str, false);
+	  ptr = lookup_by_name (fname, false);
 	
 	  if (ptr && ptr->is_user_function ())
 	    {
@@ -74,8 +80,6 @@
 	    }
 	}
     }
-  else if (curr_caller_function && curr_caller_function->is_user_function ())
-    dbg_fcn = dynamic_cast<octave_user_function *> (curr_caller_function);
 
   return dbg_fcn;
 }
@@ -282,10 +286,7 @@
 {
   octave_value retval;
 
-  octave_user_function *dbg_fcn = 0;
-
-  if (curr_caller_function && curr_caller_function->is_user_function ())
-    dbg_fcn = dynamic_cast<octave_user_function *> (curr_caller_function);
+  octave_user_function *dbg_fcn = get_user_function ();
 
   if (dbg_fcn)
     {
diff --git a/src/error.cc b/src/error.cc
--- a/src/error.cc
+++ b/src/error.cc
@@ -378,27 +378,19 @@
       int l = -1;
       int c = -1;
 
-      octave_function *fcn = curr_function;
+      octave_user_function *fcn = octave_call_stack::caller_script ();
 
       if (fcn)
 	{
-	  nm = fcn->name ();
+	  nm = fcn->fcn_file_name ();
 
-	  if (nm == "error" || nm == "warning")
-	    fcn = curr_caller_function;
-
-	  if (fcn)
-	    {
-	      nm = fcn->fcn_file_name ();
+	  if (nm.empty ())
+	    nm = fcn->name ();
 
-	      if (nm.empty ())
-		nm = fcn->name ();
-
-	      if (curr_statement)
-		{
-		  l = curr_statement->line ();
-		  c = curr_statement->column ();
-		}
+	  if (curr_statement)
+	    {
+	      l = curr_statement->line ();
+	      c = curr_statement->column ();
 	    }
 	}
 
@@ -552,7 +544,8 @@
       warning_state = 1;
 
       if ((interactive || forced_interactive)
-	  && Vdebug_on_warning && curr_function)
+	  && Vdebug_on_warning
+	  && octave_call_stack::caller_script ())
 	{
 	  unwind_protect_bool (Vdebug_on_warning);
 	  Vdebug_on_warning = false;
@@ -590,7 +583,8 @@
   error_1 (std::cerr, "error", id, fmt, args);
 
   if ((interactive || forced_interactive)
-      && Vdebug_on_error && init_state == 0 && curr_function)
+      && Vdebug_on_error && init_state == 0
+      && octave_call_stack::caller_script ())
     {
       unwind_protect_bool (Vdebug_on_error);
       Vdebug_on_error = false;
diff --git a/src/input.cc b/src/input.cc
--- a/src/input.cc
+++ b/src/input.cc
@@ -545,18 +545,20 @@
   std::string nm;
   int line = -1;
 
-  // We look at curr_caller_function because curr_function is always
-  // "keyboard".
-
-  if (debug && curr_caller_function)
+  if (debug)
     {
-      nm = curr_caller_function->fcn_file_name ();
+      octave_user_function *caller = octave_call_stack::caller_script ();
+
+      if (caller)
+	{
+	  nm = caller->fcn_file_name ();
 
-      if (nm.empty ())
-	nm = curr_caller_function->name ();
+	  if (nm.empty ())
+	    nm = caller->name ();
 
-      if (curr_statement)
-	line = curr_statement->line ();
+	  if (curr_statement)
+	    line = curr_statement->line ();
+	}
     }
 
   OSSTREAM buf;
@@ -634,7 +636,7 @@
 
 	      tree::last_line = 0;
 
-	      tree::break_function = curr_function;
+	      tree::break_function = octave_call_stack::current ();
 
 	      return retval;
 	    }
@@ -644,7 +646,7 @@
 
 	      tree::last_line = curr_statement->line ();
 
-	      tree::break_function = curr_function;
+	      tree::break_function = octave_call_stack::current ();
 
 	      return retval;
 	    }
diff --git a/src/ov-builtin.cc b/src/ov-builtin.cc
--- a/src/ov-builtin.cc
+++ b/src/ov-builtin.cc
@@ -111,11 +111,9 @@
     {
       unwind_protect::begin_frame ("builtin_func_eval");
 
-      unwind_protect_ptr (curr_function);
-      unwind_protect_ptr (curr_caller_function);
+      octave_call_stack::push (this);
 
-      curr_caller_function = curr_function;
-      curr_function = this;
+      unwind_protect::add (octave_call_stack::unwind_pop, 0);
 
       retval = (*f) (args, nargout);
 
diff --git a/src/ov-mapper.cc b/src/ov-mapper.cc
--- a/src/ov-mapper.cc
+++ b/src/ov-mapper.cc
@@ -445,11 +445,9 @@
 	{
 	  unwind_protect::begin_frame ("mapper_func_eval");
 
-	  unwind_protect_ptr (curr_function);
-	  unwind_protect_ptr (curr_caller_function);
+	  octave_call_stack::push (this);
 
-	  curr_caller_function = curr_function;
-	  curr_function = this;
+	  unwind_protect::add (octave_call_stack::unwind_pop, 0);
 
 	  retval = apply (args(0));
 
diff --git a/src/ov-usr-fcn.cc b/src/ov-usr-fcn.cc
--- a/src/ov-usr-fcn.cc
+++ b/src/ov-usr-fcn.cc
@@ -393,13 +393,12 @@
   unwind_protect_ptr (curr_sym_tab);
   curr_sym_tab = sym_tab;
 
-  unwind_protect_ptr (curr_function);
-  unwind_protect_ptr (curr_caller_function);
   unwind_protect_ptr (curr_caller_statement);
+  curr_caller_statement = curr_statement;
 
-  curr_caller_statement = curr_statement;
-  curr_caller_function = curr_function;
-  curr_function = this;
+  octave_call_stack::push (this);
+
+  unwind_protect::add (octave_call_stack::unwind_pop, 0);
 
   if (! is_nested_function ())
     {
@@ -747,10 +746,12 @@
 
   if (nargin == 0)
     {
-      if (curr_function)
+      octave_function *fcn = octave_call_stack::caller_script ();
+
+      if (fcn)
 	{
-	  if (curr_function->takes_varargs ())
-	    retval = curr_function->octave_va_arg ();
+	  if (fcn->takes_varargs ())
+	    retval = fcn->octave_va_arg ();
 	  else
 	    {
 	      ::error ("va_arg only valid within function taking variable");
@@ -789,10 +790,12 @@
 
   if (nargin == 0)
     {
-      if (curr_function)
+      octave_function *fcn = octave_call_stack::caller_script ();
+
+      if (fcn)
 	{
-	  if (curr_function->takes_varargs ())
-	    curr_function->octave_va_start ();
+	  if (fcn->takes_varargs ())
+	    fcn->octave_va_start ();
 	  else
 	    {
 	      ::error ("va_start only valid within function taking variable");
@@ -833,12 +836,14 @@
 
   if (nargin == 1)
     {
-      if (curr_function)
+      octave_function *fcn = octave_call_stack::caller_script ();
+
+      if (fcn)
 	{
-	  if (curr_function->has_varargout ())
+	  if (fcn->has_varargout ())
 	    ::error ("vr_val and varargout cannot both be used in the same function");
-	  else if (curr_function->takes_var_return ())
-	    curr_function->octave_vr_val (args(0));
+	  else if (fcn->takes_var_return ())
+	    fcn->octave_vr_val (args(0));
 	  else
 	    {
 	      ::error ("vr_val only valid within function declared to");
diff --git a/src/parse.y b/src/parse.y
--- a/src/parse.y
+++ b/src/parse.y
@@ -3619,10 +3619,39 @@
 	}
     }
 
+  // XXX FIXME XXX -- the logic below fails for the following
+  // situation, because script files are not functions that can be
+  // entered into the call stack.
+  //
+  // foo.m:
+  // -----
+  //   function foo ()
+  //     bar;
+  //
+  // bar.m:
+  // -----
+  //   mfilename ();
+  //
+  // foo ()
+  //    ==> foo
+  //
+  // though it should report "bar".  Perhaps we need a dummy function
+  // object that can be used for scripts to at least hold file names
+  // and some other information so we could store it on the call stack.
+
   std::string fname;
 
-  if (curr_caller_function)
-    fname = curr_caller_function->fcn_file_name ();
+  octave_user_function *fcn = octave_call_stack::caller_script ();
+
+  if (fcn)
+    {
+      fname = fcn->fcn_file_name ();
+
+      if (fname.empty ())
+        fname = fcn->name ();
+    }
+  else if (reading_script_file)
+    fname = curr_fcn_file_full_name;
 
   if (arg == "fullpathext")
     retval = fname;
diff --git a/src/pt-arg-list.cc b/src/pt-arg-list.cc
--- a/src/pt-arg-list.cc
+++ b/src/pt-arg-list.cc
@@ -213,10 +213,12 @@
 	    {
 	      if (tmp.is_all_va_args ())
 		{
-		  if (curr_function)
+		  octave_function *fcn = octave_call_stack::current ();
+
+		  if (fcn)
 		    {
 		      octave_value_list tva;
-		      tva = curr_function->octave_all_va_args ();
+		      tva = fcn->octave_all_va_args ();
 		      int n = tva.length ();
 		      args_len += n - 1;
 		      args.resize (args_len);
diff --git a/src/pt-bp.h b/src/pt-bp.h
--- a/src/pt-bp.h
+++ b/src/pt-bp.h
@@ -158,10 +158,12 @@
 #define MAYBE_DO_BREAKPOINT \
   do \
     { \
+      octave_function *fcn = octave_call_stack::current (); \
+ \
       if (octave_debug_on_interrupt_state \
 	  || (tree::break_next && tree::last_line == 0) \
 	  || (tree::break_next \
-	      && curr_function == tree::break_function \
+	      && fcn == tree::break_function \
 	      && tree::last_line != line ()) \
 	  || is_breakpoint ()) \
         { \
@@ -169,8 +171,8 @@
  \
           tree::break_next = false; \
  \
-          if (curr_function) \
-            octave_stdout << curr_function->name () << ": ";  \
+          if (fcn) \
+            octave_stdout << fcn->name () << ": ";  \
  \
           octave_stdout << "line " << line () << ", " \
 			<< "column " << column () \
diff --git a/src/toplev.cc b/src/toplev.cc
--- a/src/toplev.cc
+++ b/src/toplev.cc
@@ -90,15 +90,44 @@
 // Current command to execute.
 tree_statement_list *global_command = 0;
 
-// Pointer to function that is currently being evaluated.
-octave_function *curr_function = 0;
-
-// Pointer to caller of curr_function.
-octave_function *curr_caller_function = 0;
-
 // Pointer to parent function that is currently being evaluated.
 octave_function *curr_parent_function = 0;
 
+octave_call_stack *octave_call_stack::instance = 0;
+
+octave_function *
+octave_call_stack::do_caller (void)
+{
+  octave_function *retval = 0;
+
+  if (cs.size () > 1)
+    {
+      iterator p = cs.begin ();
+      retval = *++p;
+    }
+
+  return retval;
+}
+
+octave_user_function *
+octave_call_stack::do_caller_script (void)
+{
+  octave_user_function *retval = 0;
+
+  for (iterator p = cs.begin (); p != cs.end (); p++)
+    {
+      octave_function *f = *p;
+
+      if (f && f->is_user_function ())
+	{
+	  retval = dynamic_cast<octave_user_function *> (f);
+	  break;
+	}
+    }
+
+  return retval;
+}
+
 static void
 recover_from_exception (void)
 {
diff --git a/src/toplev.h b/src/toplev.h
--- a/src/toplev.h
+++ b/src/toplev.h
@@ -26,10 +26,12 @@
 
 #include <cstdio>
 
+#include <list>
 #include <string>
 
 class octave_value;
 class octave_value_list;
+class octave_function;
 class octave_user_function;
 class tree_statement_list;
 class charMatrix;
@@ -45,12 +47,6 @@
 // Current command to execute.
 extern tree_statement_list *global_command;
 
-// Pointer to function that is currently being evaluated.
-extern octave_function *curr_function;
-
-// Pointer to caller of curr_function.
-extern octave_function *curr_caller_function;
-
 // Pointer to parent function that is currently being evaluated.
 extern octave_function *curr_parent_function;
 
@@ -61,6 +57,98 @@
 // TRUE means we've processed all the init code and we are good to go.
 extern bool octave_initialized;
 
+class
+octave_call_stack
+{
+protected:
+
+  octave_call_stack (void) : cs () { }
+
+public:
+
+  typedef std::list<octave_function *>::iterator iterator ;
+
+  static bool instance_ok (void)
+  {
+    bool retval = true;
+
+    if (! instance)
+      instance = new octave_call_stack ();
+
+    if (! instance)
+      {
+	::error ("unable to create call stack object!");
+
+	retval = false;
+      }
+
+    return retval;
+  }
+
+  // Current function (top of stack).
+  static octave_function *current (void)
+  {
+    return instance_ok () ? instance->do_current (): 0;
+  }
+
+  // Caller function, may be built-in.
+  static octave_function *caller (void)
+  {
+    return instance_ok () ? instance->do_caller (): 0;
+  }
+
+  // First scripting language function on the stack.
+  static octave_user_function *caller_script (void)
+  {
+    return instance_ok () ? instance->do_caller_script (): 0;
+  }
+
+  static void push (octave_function *f)
+  {
+    if (instance_ok ())
+      instance->do_push (f);
+  }
+
+  static void pop (void)
+  {
+    if (instance_ok ())
+      instance->do_pop ();
+  }
+  
+  // A function for popping the top of the call stack that is suitable
+  // for use as an unwind_protect handler.
+  static void unwind_pop (void *) { pop (); }
+
+  static void clear (void)
+  {
+    if (instance_ok ())
+      instance->do_clear ();
+  }
+  
+private:
+
+  // The current call stack.
+  std::list<octave_function *> cs;
+
+  static octave_call_stack *instance;
+
+  octave_function *do_current (void) { return cs.empty () ? 0 : cs.front (); }
+
+  octave_function *do_caller (void);
+
+  octave_user_function *do_caller_script (void);
+
+  void do_push (octave_function *f) { cs.push_front (f); }
+
+  void do_pop (void)
+  {
+    if (! cs.empty ())
+      cs.pop_front ();
+  }
+
+  void do_clear (void) { cs.clear (); }
+};
+
 #endif
 
 /*
diff --git a/src/variables.cc b/src/variables.cc
--- a/src/variables.cc
+++ b/src/variables.cc
@@ -1625,8 +1625,10 @@
 	      Octave_map ni;
 
 	      std::string caller_function_name;
-	      if (curr_caller_function)
-		caller_function_name = curr_caller_function->name ();
+
+	      octave_function *caller = octave_call_stack::caller ();
+	      if (caller)
+		caller_function_name = caller->name ();
 
 	      ni.assign ("function", caller_function_name);
 	      ni.assign ("level", 1);
@@ -1944,8 +1946,10 @@
     }
   else if (args.length () == 0)
     {
-      if (curr_function)
-        mlock (curr_function->name ());
+      octave_user_function *fcn = octave_call_stack::caller_script ();
+
+      if (fcn)
+        mlock (fcn->name ());
       else
         error ("mlock: invalid use outside a function");
     }
@@ -1976,8 +1980,10 @@
     }
   else if (args.length () == 0)
     {
-      if (curr_function)
-        mlock (curr_function->name ());
+      octave_user_function *fcn = octave_call_stack::caller_script ();
+
+      if (fcn)
+        mlock (fcn->name ());
       else
         error ("munlock: invalid use outside a function");
     }
@@ -2009,8 +2015,10 @@
     }
   else if (args.length () == 0)
     {
-      if (curr_function)
-        retval = mislocked (curr_function->name ());
+      octave_user_function *fcn = octave_call_stack::caller_script ();
+
+      if (fcn)
+        retval = mislocked (fcn->name ());
       else
         error ("mislocked: invalid use outside a function");
     }