From bug-request at octave dot org Thu Apr 6 03:14:09 2006 Subject: Re: autoload From: "John W. Eaton" To: David dot Bateman at motorola dot com Cc: Paul Kienzle , octave bug mailing list Date: Thu, 6 Apr 2006 04:13:48 -0400 On 5-Apr-2006, David Bateman wrote: | John W. Eaton wrote: | | >Originally, we didn't have built-in functions setting and restoring | >curr_function or curr_caller_function, but that caused other | >problems. Should we have yet another set of pointers that work the | >same as curr_function and curr_caller_function but that are only for | >functions defined in the scripting language? That seems like a bit of | >a kluge, but would solve the problem for the mfilename function. | > | >Or should we be thinking about a redesign of the entire interpreter so | >that it is easier to traverse the function call stack (which is | >currently not really maintained on a stack)? | | A redesign would be best, but would do the work. Seems like something | for the PROJECTS file. I vote for the kludge at this point to limit the | work.. OK, I thought of another solution. Instead of another set of variables, we can save the complete call stack in a list (pointers to the functions called, with the current function at the front of the list). Then we can examine this list, looking back for the first scripting language function if that is what we need. Diff appended. I think this change also uncovered a few places where things were broken when we fixed the builtin and mapper function evaluators to set curr_function (apparently no one uses va_arg, va_start, or vr_val now, so maybe we should just remove them). Also, after making these changes, I remembered that scripts are not entered on the call stack because script files are not functions, so something like the following fails foo.m: ----- function foo () bar; bar.m: ----- mfilename (); foo () ==> foo (I think 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. I'll try to see if I can make that work in the next few days. For now, I think the changes below are sufficient, and at least allow code like autoload ("airy", fullfile (fileparts (mfilename ("fullpath")), "besselj.oct")); to work in PKG_ADD files (this works even though PKG_ADD is a script because it is evaluated directly by the Octave internals, not called from a separate function written in the scripting language). jwe src/ChangeLog: 2006-04-06 John W. Eaton * 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. * toplev.h, toplev.cc (octave_call_stack): New class. * debug.cc (Fdbwhere): Use get_user_function here. Index: src/debug.cc =================================================================== RCS file: /cvs/octave/src/debug.cc,v retrieving revision 1.18 diff -u -r1.18 debug.cc --- src/debug.cc 6 Mar 2006 22:33:54 -0000 1.18 +++ src/debug.cc 6 Apr 2006 08:06:02 -0000 at @ -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 ()) { at @ -65,7 +71,7 @@ } else { - ptr = lookup_by_name (str, false); + ptr = lookup_by_name (fname, false); if (ptr && ptr->is_user_function ()) { at @ -74,8 +80,6 @@ } } } - else if (curr_caller_function && curr_caller_function->is_user_function ()) - dbg_fcn = dynamic_cast (curr_caller_function); return dbg_fcn; } at @ -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 (curr_caller_function); + octave_user_function *dbg_fcn = get_user_function (); if (dbg_fcn) { Index: src/error.cc =================================================================== RCS file: /cvs/octave/src/error.cc,v retrieving revision 1.103 diff -u -r1.103 error.cc --- src/error.cc 15 Dec 2005 01:10:05 -0000 1.103 +++ src/error.cc 6 Apr 2006 08:06:02 -0000 at @ -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 (nm.empty ()) + nm = fcn->name (); - if (fcn) + if (curr_statement) { - nm = fcn->fcn_file_name (); - - if (nm.empty ()) - nm = fcn->name (); - - if (curr_statement) - { - l = curr_statement->line (); - c = curr_statement->column (); - } + l = curr_statement->line (); + c = curr_statement->column (); } } at @ -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; at @ -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; Index: src/input.cc =================================================================== RCS file: /cvs/octave/src/input.cc,v retrieving revision 1.164 diff -u -r1.164 input.cc --- src/input.cc 4 Mar 2006 06:02:14 -0000 1.164 +++ src/input.cc 6 Apr 2006 08:06:02 -0000 at @ -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 (nm.empty ()) - nm = curr_caller_function->name (); + if (caller) + { + nm = caller->fcn_file_name (); - if (curr_statement) - line = curr_statement->line (); + if (nm.empty ()) + nm = caller->name (); + + if (curr_statement) + line = curr_statement->line (); + } } OSSTREAM buf; at @ -634,7 +636,7 @@ tree::last_line = 0; - tree::break_function = curr_function; + tree::break_function = octave_call_stack::current (); return retval; } at @ -644,7 +646,7 @@ tree::last_line = curr_statement->line (); - tree::break_function = curr_function; + tree::break_function = octave_call_stack::current (); return retval; } Index: src/ov-builtin.cc =================================================================== RCS file: /cvs/octave/src/ov-builtin.cc,v retrieving revision 1.20 diff -u -r1.20 ov-builtin.cc --- src/ov-builtin.cc 26 Apr 2005 19:24:33 -0000 1.20 +++ src/ov-builtin.cc 6 Apr 2006 08:06:02 -0000 at @ -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); Index: src/ov-mapper.cc =================================================================== RCS file: /cvs/octave/src/ov-mapper.cc,v retrieving revision 1.30 diff -u -r1.30 ov-mapper.cc --- src/ov-mapper.cc 8 Mar 2006 20:17:38 -0000 1.30 +++ src/ov-mapper.cc 6 Apr 2006 08:06:02 -0000 at @ -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)); Index: src/ov-usr-fcn.cc =================================================================== RCS file: /cvs/octave/src/ov-usr-fcn.cc,v retrieving revision 1.64 diff -u -r1.64 ov-usr-fcn.cc --- src/ov-usr-fcn.cc 6 Mar 2006 21:26:53 -0000 1.64 +++ src/ov-usr-fcn.cc 6 Apr 2006 08:06:02 -0000 at @ -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_function = curr_function; - curr_function = this; + + octave_call_stack::push (this); + + unwind_protect::add (octave_call_stack::unwind_pop, 0); if (! is_nested_function ()) { at @ -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"); at @ -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"); at @ -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"); Index: src/parse.y =================================================================== RCS file: /cvs/octave/src/parse.y,v retrieving revision 1.248 diff -u -r1.248 parse.y --- src/parse.y 5 Apr 2006 06:56:25 -0000 1.248 +++ src/parse.y 6 Apr 2006 08:06:02 -0000 at @ -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; Index: src/pt-arg-list.cc =================================================================== RCS file: /cvs/octave/src/pt-arg-list.cc,v retrieving revision 1.28 diff -u -r1.28 pt-arg-list.cc --- src/pt-arg-list.cc 14 Jun 2005 20:04:31 -0000 1.28 +++ src/pt-arg-list.cc 6 Apr 2006 08:06:02 -0000 at @ -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); Index: src/pt-bp.h =================================================================== RCS file: /cvs/octave/src/pt-bp.h,v retrieving revision 1.16 diff -u -r1.16 pt-bp.h --- src/pt-bp.h 26 Apr 2005 19:24:34 -0000 1.16 +++ src/pt-bp.h 6 Apr 2006 08:06:02 -0000 at @ -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 ()) \ { \ at @ -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 () \ Index: src/toplev.cc =================================================================== RCS file: /cvs/octave/src/toplev.cc,v retrieving revision 1.176 diff -u -r1.176 toplev.cc --- src/toplev.cc 27 Mar 2006 22:26:21 -0000 1.176 +++ src/toplev.cc 6 Apr 2006 08:06:02 -0000 at @ -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 (f); + break; + } + } + + return retval; +} + static void recover_from_exception (void) { Index: src/toplev.h =================================================================== RCS file: /cvs/octave/src/toplev.h,v retrieving revision 1.55 diff -u -r1.55 toplev.h --- src/toplev.h 26 Apr 2005 19:24:34 -0000 1.55 +++ src/toplev.h 6 Apr 2006 08:06:02 -0000 at @ -26,10 +26,12 @@ #include +#include #include class octave_value; class octave_value_list; +class octave_function; class octave_user_function; class tree_statement_list; class charMatrix; at @ -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; at @ -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::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 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 /* Index: src/variables.cc =================================================================== RCS file: /cvs/octave/src/variables.cc,v retrieving revision 1.277 diff -u -r1.277 variables.cc --- src/variables.cc 16 Mar 2006 19:47:14 -0000 1.277 +++ src/variables.cc 6 Apr 2006 08:06:02 -0000 at @ -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); at @ -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"); } at @ -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"); } at @ -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"); } ------------------------------------------------------------- Octave is freely available under the terms of the GNU GPL. Octave's home on the web: http://www.octave.org How to fund new projects: http://www.octave.org/funding.html Subscription information: http://www.octave.org/archive.html -------------------------------------------------------------