Mercurial > octave-dspies
annotate src/ov-usr-fcn.cc @ 7731:2d2a969c731c
fix max_recursion_limit exceeded at startup with Intel C++
author | Jaroslav Hajek <highegg@gmail.com> |
---|---|
date | Thu, 24 Apr 2008 03:21:57 -0400 |
parents | 87eda1f8faaa |
children | a059b5679fbb |
rev | line source |
---|---|
2974 | 1 /* |
2 | |
7017 | 3 Copyright (C) 1996, 1997, 1998, 1999, 2000, 2002, 2003, 2004, 2005, |
4 2006, 2007 John W. Eaton | |
2974 | 5 |
6 This file is part of Octave. | |
7 | |
8 Octave is free software; you can redistribute it and/or modify it | |
9 under the terms of the GNU General Public License as published by the | |
7016 | 10 Free Software Foundation; either version 3 of the License, or (at your |
11 option) any later version. | |
2974 | 12 |
13 Octave is distributed in the hope that it will be useful, but WITHOUT | |
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
16 for more details. | |
17 | |
18 You should have received a copy of the GNU General Public License | |
7016 | 19 along with Octave; see the file COPYING. If not, see |
20 <http://www.gnu.org/licenses/>. | |
2974 | 21 |
22 */ | |
23 | |
24 #ifdef HAVE_CONFIG_H | |
25 #include <config.h> | |
26 #endif | |
27 | |
28 #include "str-vec.h" | |
29 | |
30 #include <defaults.h> | |
3974 | 31 #include "Cell.h" |
2974 | 32 #include "defun.h" |
33 #include "error.h" | |
34 #include "input.h" | |
35 #include "oct-obj.h" | |
36 #include "ov-usr-fcn.h" | |
37 #include "ov.h" | |
38 #include "pager.h" | |
2985 | 39 #include "pt-jump.h" |
2974 | 40 #include "pt-misc.h" |
41 #include "pt-pr-code.h" | |
2982 | 42 #include "pt-stmt.h" |
2974 | 43 #include "pt-walk.h" |
44 #include "symtab.h" | |
45 #include "toplev.h" | |
46 #include "unwind-prot.h" | |
47 #include "utils.h" | |
3489 | 48 #include "parse.h" |
2974 | 49 #include "variables.h" |
50 | |
3131 | 51 // Maximum nesting level for functions called recursively. |
5794 | 52 static int Vmax_recursion_depth = 256; |
3131 | 53 |
7715
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
54 // User defined scripts. |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
55 |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
56 DEFINE_OCTAVE_ALLOCATOR (octave_user_script); |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
57 |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
58 DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_user_script, |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
59 "user-defined script", |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
60 "user-defined script"); |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
61 |
7731
2d2a969c731c
fix max_recursion_limit exceeded at startup with Intel C++
Jaroslav Hajek <highegg@gmail.com>
parents:
7719
diff
changeset
|
62 octave_user_script::octave_user_script (void) |
2d2a969c731c
fix max_recursion_limit exceeded at startup with Intel C++
Jaroslav Hajek <highegg@gmail.com>
parents:
7719
diff
changeset
|
63 : octave_user_code (), cmd_list (0), file_name (), |
2d2a969c731c
fix max_recursion_limit exceeded at startup with Intel C++
Jaroslav Hajek <highegg@gmail.com>
parents:
7719
diff
changeset
|
64 t_parsed (static_cast<time_t> (0)), |
2d2a969c731c
fix max_recursion_limit exceeded at startup with Intel C++
Jaroslav Hajek <highegg@gmail.com>
parents:
7719
diff
changeset
|
65 t_checked (static_cast<time_t> (0)), |
2d2a969c731c
fix max_recursion_limit exceeded at startup with Intel C++
Jaroslav Hajek <highegg@gmail.com>
parents:
7719
diff
changeset
|
66 call_depth (0) |
2d2a969c731c
fix max_recursion_limit exceeded at startup with Intel C++
Jaroslav Hajek <highegg@gmail.com>
parents:
7719
diff
changeset
|
67 { } |
2d2a969c731c
fix max_recursion_limit exceeded at startup with Intel C++
Jaroslav Hajek <highegg@gmail.com>
parents:
7719
diff
changeset
|
68 |
2d2a969c731c
fix max_recursion_limit exceeded at startup with Intel C++
Jaroslav Hajek <highegg@gmail.com>
parents:
7719
diff
changeset
|
69 octave_user_script::octave_user_script (const std::string& fnm, |
2d2a969c731c
fix max_recursion_limit exceeded at startup with Intel C++
Jaroslav Hajek <highegg@gmail.com>
parents:
7719
diff
changeset
|
70 const std::string& nm, |
2d2a969c731c
fix max_recursion_limit exceeded at startup with Intel C++
Jaroslav Hajek <highegg@gmail.com>
parents:
7719
diff
changeset
|
71 tree_statement_list *cmds, |
2d2a969c731c
fix max_recursion_limit exceeded at startup with Intel C++
Jaroslav Hajek <highegg@gmail.com>
parents:
7719
diff
changeset
|
72 const std::string& ds) |
2d2a969c731c
fix max_recursion_limit exceeded at startup with Intel C++
Jaroslav Hajek <highegg@gmail.com>
parents:
7719
diff
changeset
|
73 : octave_user_code (nm, ds), cmd_list (cmds), file_name (fnm), |
2d2a969c731c
fix max_recursion_limit exceeded at startup with Intel C++
Jaroslav Hajek <highegg@gmail.com>
parents:
7719
diff
changeset
|
74 t_parsed (static_cast<time_t> (0)), |
2d2a969c731c
fix max_recursion_limit exceeded at startup with Intel C++
Jaroslav Hajek <highegg@gmail.com>
parents:
7719
diff
changeset
|
75 t_checked (static_cast<time_t> (0)), |
2d2a969c731c
fix max_recursion_limit exceeded at startup with Intel C++
Jaroslav Hajek <highegg@gmail.com>
parents:
7719
diff
changeset
|
76 call_depth (0) |
2d2a969c731c
fix max_recursion_limit exceeded at startup with Intel C++
Jaroslav Hajek <highegg@gmail.com>
parents:
7719
diff
changeset
|
77 { } |
2d2a969c731c
fix max_recursion_limit exceeded at startup with Intel C++
Jaroslav Hajek <highegg@gmail.com>
parents:
7719
diff
changeset
|
78 |
2d2a969c731c
fix max_recursion_limit exceeded at startup with Intel C++
Jaroslav Hajek <highegg@gmail.com>
parents:
7719
diff
changeset
|
79 octave_user_script::octave_user_script (const std::string& fnm, |
2d2a969c731c
fix max_recursion_limit exceeded at startup with Intel C++
Jaroslav Hajek <highegg@gmail.com>
parents:
7719
diff
changeset
|
80 const std::string& nm, |
2d2a969c731c
fix max_recursion_limit exceeded at startup with Intel C++
Jaroslav Hajek <highegg@gmail.com>
parents:
7719
diff
changeset
|
81 const std::string& ds) |
2d2a969c731c
fix max_recursion_limit exceeded at startup with Intel C++
Jaroslav Hajek <highegg@gmail.com>
parents:
7719
diff
changeset
|
82 : octave_user_code (nm, ds), cmd_list (0), file_name (fnm), |
2d2a969c731c
fix max_recursion_limit exceeded at startup with Intel C++
Jaroslav Hajek <highegg@gmail.com>
parents:
7719
diff
changeset
|
83 t_parsed (static_cast<time_t> (0)), |
2d2a969c731c
fix max_recursion_limit exceeded at startup with Intel C++
Jaroslav Hajek <highegg@gmail.com>
parents:
7719
diff
changeset
|
84 t_checked (static_cast<time_t> (0)), |
2d2a969c731c
fix max_recursion_limit exceeded at startup with Intel C++
Jaroslav Hajek <highegg@gmail.com>
parents:
7719
diff
changeset
|
85 call_depth (0) |
2d2a969c731c
fix max_recursion_limit exceeded at startup with Intel C++
Jaroslav Hajek <highegg@gmail.com>
parents:
7719
diff
changeset
|
86 { } |
2d2a969c731c
fix max_recursion_limit exceeded at startup with Intel C++
Jaroslav Hajek <highegg@gmail.com>
parents:
7719
diff
changeset
|
87 |
7715
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
88 octave_user_script::~octave_user_script (void) |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
89 { |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
90 delete cmd_list; |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
91 } |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
92 |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
93 octave_value_list |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
94 octave_user_script::subsref (const std::string&, |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
95 const std::list<octave_value_list>&, int) |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
96 { |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
97 octave_value_list retval; |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
98 |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
99 ::error ("invalid use of script in index expression"); |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
100 |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
101 return retval; |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
102 } |
7336 | 103 |
104 octave_value_list | |
105 octave_user_script::do_multi_index_op (int nargout, | |
106 const octave_value_list& args) | |
107 { | |
108 octave_value_list retval; | |
109 | |
110 if (! error_state) | |
111 { | |
7715
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
112 if (args.length () == 0 && nargout == 0) |
7336 | 113 { |
7715
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
114 if (cmd_list) |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
115 { |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
116 unwind_protect::begin_frame ("user_script_eval"); |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
117 |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
118 unwind_protect_int (call_depth); |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
119 call_depth++; |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
120 |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
121 if (call_depth <= Vmax_recursion_depth) |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
122 { |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
123 octave_call_stack::push (this); |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
124 |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
125 unwind_protect::add (octave_call_stack::unwind_pop, 0); |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
126 |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
127 cmd_list->eval (); |
7336 | 128 |
7715
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
129 if (tree_return_command::returning) |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
130 tree_return_command::returning = 0; |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
131 |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
132 if (tree_break_command::breaking) |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
133 tree_break_command::breaking--; |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
134 |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
135 if (error_state) |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
136 traceback_error (); |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
137 } |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
138 else |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
139 ::error ("max_recursion_limit exceeded"); |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
140 |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
141 unwind_protect::run_frame ("user_script_eval"); |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
142 } |
7336 | 143 } |
144 else | |
145 error ("invalid call to script"); | |
146 } | |
147 | |
148 return retval; | |
149 } | |
150 | |
7715
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
151 void |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
152 octave_user_script::accept (tree_walker& tw) |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
153 { |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
154 tw.visit_octave_user_script (*this); |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
155 } |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
156 |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
157 // FIXME -- this function is exactly the same as |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
158 // octave_user_function::traceback_error. |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
159 |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
160 void |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
161 octave_user_script::traceback_error (void) const |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
162 { |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
163 if (error_state >= 0) |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
164 error_state = -1; |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
165 |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
166 if (my_name.empty ()) |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
167 { |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
168 if (file_name.empty ()) |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
169 ::error ("called from `?unknown?'"); |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
170 else |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
171 ::error ("called from file `%s'", file_name.c_str ()); |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
172 } |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
173 else |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
174 { |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
175 if (file_name.empty ()) |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
176 ::error ("called from `%s'", my_name.c_str ()); |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
177 else |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
178 ::error ("called from `%s' in file `%s'", |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
179 my_name.c_str (), file_name.c_str ()); |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
180 } |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
181 } |
5b4d278ec828
parse scripts completely before executing
John W. Eaton <jwe@octave.org>
parents:
7589
diff
changeset
|
182 |
2974 | 183 // User defined functions. |
184 | |
3219 | 185 DEFINE_OCTAVE_ALLOCATOR (octave_user_function); |
2974 | 186 |
3219 | 187 DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_user_function, |
4612 | 188 "user-defined function", |
3219 | 189 "user-defined function"); |
2974 | 190 |
191 // Ugh. This really needs to be simplified (code/data? | |
192 // extrinsic/intrinsic state?). | |
193 | |
194 octave_user_function::octave_user_function | |
7336 | 195 (symbol_table::scope_id sid, tree_parameter_list *pl, |
196 tree_parameter_list *rl, tree_statement_list *cl) | |
7719
87eda1f8faaa
octave_user_code: new base class for octave_user_script and octave_user_function
John W. Eaton <jwe@octave.org>
parents:
7715
diff
changeset
|
197 : octave_user_code (std::string (), std::string ()), |
2974 | 198 param_list (pl), ret_list (rl), cmd_list (cl), |
7336 | 199 lead_comm (), trail_comm (), file_name (), |
6323 | 200 parent_name (), t_parsed (static_cast<time_t> (0)), |
3255 | 201 t_checked (static_cast<time_t> (0)), |
7589
90fb25a5a3fa
minor cleanup in octave_user_function constructor
John W. Eaton <jwe@octave.org>
parents:
7552
diff
changeset
|
202 system_fcn_file (false), call_depth (0), |
90fb25a5a3fa
minor cleanup in octave_user_function constructor
John W. Eaton <jwe@octave.org>
parents:
7552
diff
changeset
|
203 num_named_args (param_list ? param_list->length () : 0), |
7336 | 204 nested_function (false), inline_function (false), |
205 class_constructor (false), class_method (false), xdispatch_class (), | |
206 args_passed (), num_args_passed (0), local_scope (sid) | |
7589
90fb25a5a3fa
minor cleanup in octave_user_function constructor
John W. Eaton <jwe@octave.org>
parents:
7552
diff
changeset
|
207 { } |
2974 | 208 |
209 octave_user_function::~octave_user_function (void) | |
210 { | |
211 delete param_list; | |
212 delete ret_list; | |
213 delete cmd_list; | |
3665 | 214 delete lead_comm; |
215 delete trail_comm; | |
7336 | 216 |
217 symbol_table::erase_scope (local_scope); | |
2974 | 218 } |
219 | |
220 octave_user_function * | |
221 octave_user_function::define_ret_list (tree_parameter_list *t) | |
222 { | |
223 ret_list = t; | |
224 | |
225 return this; | |
226 } | |
227 | |
228 void | |
4343 | 229 octave_user_function::stash_fcn_file_name (const std::string& nm) |
2974 | 230 { |
4343 | 231 file_name = nm; |
2974 | 232 } |
233 | |
234 void | |
235 octave_user_function::mark_as_system_fcn_file (void) | |
236 { | |
237 if (! file_name.empty ()) | |
238 { | |
239 // We really should stash the whole path to the file we found, | |
240 // when we looked it up, to avoid possible race conditions... | |
5775 | 241 // FIXME |
2974 | 242 // |
243 // We probably also don't need to get the library directory | |
244 // every time, but since this function is only called when the | |
245 // function file is parsed, it probably doesn't matter that | |
246 // much. | |
247 | |
3523 | 248 std::string ff_name = fcn_file_in_path (file_name); |
2974 | 249 |
3565 | 250 if (Vfcn_file_dir == ff_name.substr (0, Vfcn_file_dir.length ())) |
2974 | 251 system_fcn_file = 1; |
252 } | |
253 else | |
254 system_fcn_file = 0; | |
255 } | |
256 | |
257 bool | |
258 octave_user_function::takes_varargs (void) const | |
259 { | |
260 return (param_list && param_list->takes_varargs ()); | |
261 } | |
262 | |
5848 | 263 bool |
264 octave_user_function::takes_var_return (void) const | |
2974 | 265 { |
5848 | 266 return (ret_list && ret_list->takes_varargs ()); |
2974 | 267 } |
268 | |
269 octave_value_list | |
270 octave_user_function::octave_all_va_args (void) | |
271 { | |
272 octave_value_list retval; | |
273 | |
3178 | 274 int n = num_args_passed - num_named_args; |
2974 | 275 |
3178 | 276 if (n > 0) |
277 { | |
278 retval.resize (n); | |
279 | |
280 int k = 0; | |
281 for (int i = num_named_args; i < num_args_passed; i++) | |
282 retval(k++) = args_passed(i); | |
283 } | |
2974 | 284 |
285 return retval; | |
286 } | |
287 | |
288 static void | |
3239 | 289 clear_param_list (void *lst) |
290 { | |
291 tree_parameter_list *tmp = static_cast<tree_parameter_list *> (lst); | |
292 | |
293 if (tmp) | |
4219 | 294 tmp->undefine (); |
3239 | 295 } |
296 | |
297 static void | |
3875 | 298 restore_args_passed (void *fcn) |
3239 | 299 { |
300 octave_user_function *tmp = static_cast<octave_user_function *> (fcn); | |
301 | |
302 if (tmp) | |
3875 | 303 tmp->restore_args_passed (); |
3239 | 304 } |
305 | |
2974 | 306 octave_value_list |
4247 | 307 octave_user_function::subsref (const std::string& type, |
4219 | 308 const std::list<octave_value_list>& idx, |
3933 | 309 int nargout) |
310 { | |
311 octave_value_list retval; | |
312 | |
313 switch (type[0]) | |
314 { | |
315 case '(': | |
5154 | 316 { |
5155 | 317 int tmp_nargout = (type.length () > 1 && nargout == 0) ? 1 : nargout; |
5154 | 318 |
319 retval = do_multi_index_op (tmp_nargout, idx.front ()); | |
320 } | |
3933 | 321 break; |
322 | |
323 case '{': | |
324 case '.': | |
325 { | |
326 std::string nm = type_name (); | |
327 error ("%s cannot be indexed with %c", nm.c_str (), type[0]); | |
328 } | |
329 break; | |
330 | |
331 default: | |
332 panic_impossible (); | |
333 } | |
334 | |
5775 | 335 // FIXME -- perhaps there should be an |
4059 | 336 // octave_value_list::next_subsref member function? See also |
337 // octave_builtin::subsref. | |
3933 | 338 |
4219 | 339 if (idx.size () > 1) |
4994 | 340 retval = retval(0).next_subsref (nargout, type, idx); |
4059 | 341 |
342 return retval; | |
3933 | 343 } |
344 | |
345 octave_value_list | |
3544 | 346 octave_user_function::do_multi_index_op (int nargout, |
347 const octave_value_list& args) | |
2974 | 348 { |
349 octave_value_list retval; | |
350 | |
351 if (error_state) | |
352 return retval; | |
353 | |
354 if (! cmd_list) | |
355 return retval; | |
356 | |
357 int nargin = args.length (); | |
358 | |
4987 | 359 unwind_protect::begin_frame ("user_func_eval"); |
2974 | 360 |
361 unwind_protect_int (call_depth); | |
362 call_depth++; | |
363 | |
3131 | 364 if (call_depth > Vmax_recursion_depth) |
365 { | |
366 ::error ("max_recursion_limit exceeded"); | |
4987 | 367 unwind_protect::run_frame ("user_func_eval"); |
3131 | 368 return retval; |
369 } | |
370 | |
7336 | 371 // Save old and set current symbol table context, for |
372 // eval_undefined_error(). | |
373 | |
374 symbol_table::push_scope (local_scope); | |
375 unwind_protect::add (symbol_table::pop_scope); | |
2974 | 376 |
377 if (call_depth > 1) | |
378 { | |
7336 | 379 symbol_table::push_context (); |
2974 | 380 |
7336 | 381 unwind_protect::add (symbol_table::pop_context); |
382 } | |
383 else | |
384 { | |
385 // Force symbols to be undefined again when this function exits. | |
386 unwind_protect::add (symbol_table::clear_variables); | |
387 } | |
2974 | 388 |
5743 | 389 octave_call_stack::push (this); |
390 | |
391 unwind_protect::add (octave_call_stack::unwind_pop, 0); | |
2974 | 392 |
6149 | 393 if (! (is_nested_function () || is_inline_function ())) |
4238 | 394 { |
395 unwind_protect_ptr (curr_parent_function); | |
396 curr_parent_function = this; | |
397 } | |
398 | |
3875 | 399 // Save and restore args passed for recursive calls. |
2974 | 400 |
3875 | 401 save_args_passed (args); |
3239 | 402 |
3875 | 403 unwind_protect::add (::restore_args_passed, this); |
3239 | 404 |
2974 | 405 string_vector arg_names = args.name_tags (); |
406 | |
407 unwind_protect_int (num_args_passed); | |
408 num_args_passed = nargin; | |
409 | |
410 if (param_list && ! param_list->varargs_only ()) | |
411 { | |
412 param_list->define_from_arg_vector (args); | |
413 if (error_state) | |
414 goto abort; | |
415 } | |
416 | |
3239 | 417 // Force parameter list to be undefined when this function exits. |
418 // Doing so decrements the reference counts on the values of local | |
419 // variables that are also named function parameters. | |
420 | |
421 unwind_protect::add (clear_param_list, param_list); | |
422 | |
423 // Force return list to be undefined when this function exits. | |
424 // Doing so decrements the reference counts on the values of local | |
425 // variables that are also named values returned by this function. | |
426 | |
427 unwind_protect::add (clear_param_list, ret_list); | |
428 | |
2974 | 429 // The following code is in a separate scope to avoid warnings from |
430 // G++ about `goto abort' crossing the initialization of some | |
431 // variables. | |
432 | |
433 { | |
3974 | 434 bind_automatic_vars (arg_names, nargin, nargout, octave_all_va_args ()); |
2974 | 435 |
436 bool echo_commands = (Vecho_executing_commands & ECHO_FUNCTIONS); | |
437 | |
438 if (echo_commands) | |
439 print_code_function_header (); | |
440 | |
441 // Evaluate the commands that make up the function. | |
442 | |
3489 | 443 unwind_protect_bool (evaluating_function_body); |
444 evaluating_function_body = true; | |
445 | |
6657 | 446 if (is_inline_function ()) |
447 { | |
448 assert (cmd_list->length () == 1); | |
449 | |
450 retval = cmd_list->eval (false, nargout); | |
451 } | |
452 else | |
453 cmd_list->eval (); | |
2974 | 454 |
455 if (echo_commands) | |
456 print_code_function_trailer (); | |
457 | |
4207 | 458 if (tree_return_command::returning) |
459 tree_return_command::returning = 0; | |
2974 | 460 |
4207 | 461 if (tree_break_command::breaking) |
462 tree_break_command::breaking--; | |
2974 | 463 |
464 if (error_state) | |
465 { | |
466 traceback_error (); | |
467 goto abort; | |
468 } | |
469 | |
470 // Copy return values out. | |
471 | |
6657 | 472 if (ret_list && ! is_inline_function ()) |
3871 | 473 { |
4748 | 474 ret_list->initialize_undefined_elements (my_name, nargout, Matrix ()); |
3871 | 475 |
5848 | 476 Cell varargout; |
477 | |
6591 | 478 if (ret_list->takes_varargs ()) |
5848 | 479 { |
7336 | 480 octave_value varargout_varval = symbol_table::varval ("varargout"); |
6591 | 481 |
7336 | 482 if (varargout_varval.is_defined ()) |
6591 | 483 { |
7336 | 484 varargout = varargout_varval.cell_value (); |
5848 | 485 |
6591 | 486 if (error_state) |
487 error ("expecting varargout to be a cell array object"); | |
488 } | |
5848 | 489 } |
490 | |
491 if (! error_state) | |
492 retval = ret_list->convert_to_const_vector (varargout); | |
3871 | 493 } |
2974 | 494 } |
495 | |
496 abort: | |
4987 | 497 unwind_protect::run_frame ("user_func_eval"); |
2974 | 498 |
499 return retval; | |
500 } | |
501 | |
502 void | |
4346 | 503 octave_user_function::traceback_error (void) const |
2974 | 504 { |
505 if (error_state >= 0) | |
506 error_state = -1; | |
507 | |
4748 | 508 if (my_name.empty ()) |
2974 | 509 { |
510 if (file_name.empty ()) | |
511 ::error ("called from `?unknown?'"); | |
512 else | |
513 ::error ("called from file `%s'", file_name.c_str ()); | |
514 } | |
515 else | |
516 { | |
517 if (file_name.empty ()) | |
4748 | 518 ::error ("called from `%s'", my_name.c_str ()); |
2974 | 519 else |
520 ::error ("called from `%s' in file `%s'", | |
4748 | 521 my_name.c_str (), file_name.c_str ()); |
2974 | 522 } |
523 } | |
524 | |
525 void | |
526 octave_user_function::accept (tree_walker& tw) | |
527 { | |
528 tw.visit_octave_user_function (*this); | |
529 } | |
530 | |
7336 | 531 #if 0 |
2974 | 532 void |
3933 | 533 octave_user_function::print_symtab_info (std::ostream& os) const |
534 { | |
7336 | 535 symbol_table::print_info (os, local_scope); |
3933 | 536 } |
7336 | 537 #endif |
3933 | 538 |
539 void | |
2974 | 540 octave_user_function::print_code_function_header (void) |
541 { | |
5794 | 542 tree_print_code tpc (octave_stdout, VPS4); |
2974 | 543 |
544 tpc.visit_octave_user_function_header (*this); | |
545 } | |
546 | |
547 void | |
548 octave_user_function::print_code_function_trailer (void) | |
549 { | |
5794 | 550 tree_print_code tpc (octave_stdout, VPS4); |
2974 | 551 |
552 tpc.visit_octave_user_function_trailer (*this); | |
553 } | |
554 | |
555 void | |
556 octave_user_function::bind_automatic_vars | |
3974 | 557 (const string_vector& arg_names, int nargin, int nargout, |
558 const octave_value_list& va_args) | |
2974 | 559 { |
560 if (! arg_names.empty ()) | |
7336 | 561 symbol_table::varref ("argn") = arg_names; |
2974 | 562 |
7336 | 563 symbol_table::varref (".nargin.") = nargin; |
564 symbol_table::varref (".nargout.") = nargout; | |
565 | |
566 symbol_table::mark_hidden (".nargin."); | |
567 symbol_table::mark_hidden (".nargout."); | |
3974 | 568 |
569 if (takes_varargs ()) | |
570 { | |
571 int n = va_args.length (); | |
572 | |
573 Cell varargin (1, n); | |
574 | |
575 for (int i = 0; i < n; i++) | |
576 varargin(0,i) = va_args(i); | |
577 | |
7336 | 578 symbol_table::varref ("varargin") = varargin; |
3974 | 579 } |
2974 | 580 } |
581 | |
4700 | 582 DEFUN (nargin, args, , |
583 "-*- texinfo -*-\n\ | |
584 @deftypefn {Built-in Function} {} nargin ()\n\ | |
585 @deftypefnx {Built-in Function} {} nargin (@var{fcn_name})\n\ | |
586 Within a function, return the number of arguments passed to the function.\n\ | |
587 At the top level, return the number of command line arguments passed to\n\ | |
588 Octave. If called with the optional argument @var{fcn_name}, return the\n\ | |
589 maximum number of arguments the named function can accept, or -1 if the\n\ | |
590 function accepts a variable number of arguments.\n\ | |
5642 | 591 @seealso{nargout, varargin, varargout}\n\ |
4700 | 592 @end deftypefn") |
593 { | |
594 octave_value retval; | |
595 | |
596 int nargin = args.length (); | |
597 | |
598 if (nargin == 1) | |
599 { | |
600 std::string fname = args(0).string_value (); | |
601 | |
602 if (! error_state) | |
603 { | |
7336 | 604 octave_value fcn_val = symbol_table::find_user_function (fname); |
4930 | 605 |
606 octave_user_function *fcn = fcn_val.user_function_value (true); | |
4700 | 607 |
608 if (fcn) | |
609 { | |
610 if (fcn->takes_varargs ()) | |
611 retval = -1; | |
612 else | |
613 { | |
614 tree_parameter_list *param_list = fcn->parameter_list (); | |
615 | |
616 retval = param_list ? param_list->length () : 0; | |
617 } | |
618 } | |
619 else | |
620 error ("nargin: invalid function"); | |
621 } | |
622 else | |
623 error ("nargin: expecting string as first argument"); | |
624 } | |
625 else if (nargin == 0) | |
626 { | |
7336 | 627 retval = symbol_table::varval (".nargin."); |
4700 | 628 |
7336 | 629 if (retval.is_undefined ()) |
630 retval = 0; | |
4700 | 631 } |
632 else | |
5823 | 633 print_usage (); |
4700 | 634 |
635 return retval; | |
636 } | |
637 | |
638 DEFUN (nargout, args, , | |
639 "-*- texinfo -*-\n\ | |
640 @deftypefn {Built-in Function} {} nargout ()\n\ | |
641 @deftypefnx {Built-in Function} {} nargout (@var{fcn_name})\n\ | |
642 Within a function, return the number of values the caller expects to\n\ | |
643 receive. If called with the optional argument @var{fcn_name}, return the\n\ | |
644 maximum number of values the named function can produce, or -1 if the\n\ | |
645 function can produce a variable number of values.\n\ | |
646 \n\ | |
647 For example,\n\ | |
648 \n\ | |
649 @example\n\ | |
650 f ()\n\ | |
651 @end example\n\ | |
652 \n\ | |
653 @noindent\n\ | |
4704 | 654 will cause @code{nargout} to return 0 inside the function @code{f} and\n\ |
4700 | 655 \n\ |
656 @example\n\ | |
657 [s, t] = f ()\n\ | |
658 @end example\n\ | |
659 \n\ | |
660 @noindent\n\ | |
661 will cause @code{nargout} to return 2 inside the function\n\ | |
662 @code{f}.\n\ | |
663 \n\ | |
664 At the top level, @code{nargout} is undefined.\n\ | |
5642 | 665 @seealso{nargin, varargin, varargout}\n\ |
4700 | 666 @end deftypefn") |
667 { | |
668 octave_value retval; | |
669 | |
670 int nargin = args.length (); | |
671 | |
672 if (nargin == 1) | |
673 { | |
674 std::string fname = args(0).string_value (); | |
675 | |
676 if (! error_state) | |
677 { | |
7336 | 678 octave_value fcn_val = symbol_table::find_user_function (fname); |
4930 | 679 |
680 octave_user_function *fcn = fcn_val.user_function_value (true); | |
4700 | 681 |
682 if (fcn) | |
683 { | |
684 if (fcn->takes_var_return ()) | |
685 retval = -1; | |
686 else | |
687 { | |
688 tree_parameter_list *ret_list = fcn->return_list (); | |
689 | |
690 retval = ret_list ? ret_list->length () : 0; | |
691 } | |
692 } | |
693 else | |
694 error ("nargout: invalid function"); | |
695 } | |
696 else | |
697 error ("nargout: expecting string as first argument"); | |
698 } | |
699 else if (nargin == 0) | |
700 { | |
7336 | 701 if (! symbol_table::at_top_level ()) |
4700 | 702 { |
7336 | 703 retval = symbol_table::varval (".nargout."); |
4700 | 704 |
7336 | 705 if (retval.is_undefined ()) |
706 retval = 0; | |
4700 | 707 } |
708 else | |
709 error ("nargout: invalid call at top level"); | |
710 } | |
711 else | |
5823 | 712 print_usage (); |
4700 | 713 |
714 return retval; | |
715 } | |
716 | |
5794 | 717 DEFUN (max_recursion_depth, args, nargout, |
718 "-*- texinfo -*-\n\ | |
719 @deftypefn {Built-in Function} {@var{val} =} max_recursion_depth ()\n\ | |
720 @deftypefnx {Built-in Function} {@var{old_val} =} max_recursion_depth (@var{new_val})\n\ | |
721 Query or set the internal limit on the number of times a function may\n\ | |
722 be called recursively. If the limit is exceeded, an error message is\n\ | |
723 printed and control returns to the top level.\n\ | |
724 @end deftypefn") | |
3131 | 725 { |
5794 | 726 return SET_INTERNAL_VARIABLE (max_recursion_depth); |
2974 | 727 } |
728 | |
729 /* | |
730 ;;; Local Variables: *** | |
731 ;;; mode: C++ *** | |
732 ;;; End: *** | |
733 */ |