1 ////////////////////////////////////////////////////////////////////////
2 //
3 // Copyright (C) 1996-2021 The Octave Project Developers
4 //
5 // See the file COPYRIGHT.md in the top-level directory of this
6 // distribution or <https://octave.org/copyright/>.
7 //
8 // This file is part of Octave.
9 //
10 // Octave is free software: you can redistribute it and/or modify it
11 // under the terms of the GNU General Public License as published by
12 // the Free Software Foundation, either version 3 of the License, or
13 // (at your option) any later version.
14 //
15 // Octave is distributed in the hope that it will be useful, but
16 // WITHOUT ANY WARRANTY; without even the implied warranty of
17 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 // GNU General Public License for more details.
19 //
20 // You should have received a copy of the GNU General Public License
21 // along with Octave; see the file COPYING.  If not, see
22 // <https://www.gnu.org/licenses/>.
23 //
24 ////////////////////////////////////////////////////////////////////////
25 
26 #if defined (HAVE_CONFIG_H)
27 #  include "config.h"
28 #endif
29 
30 #include <sstream>
31 
32 #include "file-info.h"
33 #include "file-ops.h"
34 #include "file-stat.h"
35 #include "str-vec.h"
36 
37 #include "builtin-defun-decls.h"
38 #include "defaults.h"
39 #include "Cell.h"
40 #include "defun.h"
41 #include "error.h"
42 #include "errwarn.h"
43 #include "input.h"
44 #include "ovl.h"
45 #include "ov-usr-fcn.h"
46 #include "ov.h"
47 #include "pager.h"
48 #include "pt-eval.h"
49 #include "pt-jit.h"
50 #include "pt-jump.h"
51 #include "pt-misc.h"
52 #include "pt-pr-code.h"
53 #include "pt-stmt.h"
54 #include "pt-walk.h"
55 #include "symtab.h"
56 #include "interpreter-private.h"
57 #include "interpreter.h"
58 #include "unwind-prot.h"
59 #include "utils.h"
60 #include "parse.h"
61 #include "profiler.h"
62 #include "variables.h"
63 #include "ov-fcn-handle.h"
64 
65 // Whether to optimize subsasgn method calls.
66 static bool Voptimize_subsasgn_calls = true;
67 
~octave_user_code(void)68 octave_user_code::~octave_user_code (void)
69 {
70   // This function is no longer valid, so remove the pointer to it from
71   // the corresponding scope.
72   // FIXME: would it be better to use shared/weak pointers for this job
73   // instead of storing a bare pointer in the scope object?
74   m_scope.set_user_code (nullptr);
75 
76   // FIXME: shouldn't this happen automatically when deleting cmd_list?
77   if (cmd_list)
78     {
79       octave::event_manager& evmgr
80         = octave::__get_event_manager__ ("octave_user_code::~octave_user_code");
81 
82       cmd_list->remove_all_breakpoints (evmgr, file_name);
83     }
84 
85   delete cmd_list;
86   delete m_file_info;
87 }
88 
89 void
get_file_info(void)90 octave_user_code::get_file_info (void)
91 {
92   m_file_info = new octave::file_info (file_name);
93 
94   octave::sys::file_stat fs (file_name);
95 
96   if (fs && (fs.mtime () > time_parsed ()))
97     warning ("function file '%s' changed since it was parsed",
98              file_name.c_str ());
99 }
100 
101 std::string
get_code_line(std::size_t line)102 octave_user_code::get_code_line (std::size_t line)
103 {
104   if (! m_file_info)
105     get_file_info ();
106 
107   return m_file_info->get_line (line);
108 }
109 
110 std::deque<std::string>
get_code_lines(std::size_t line,std::size_t num_lines)111 octave_user_code::get_code_lines (std::size_t line, std::size_t num_lines)
112 {
113   if (! m_file_info)
114     get_file_info ();
115 
116   return m_file_info->get_lines (line, num_lines);
117 }
118 
119 void
cache_function_text(const std::string & text,const octave::sys::time & timestamp)120 octave_user_code::cache_function_text (const std::string& text,
121                                        const octave::sys::time& timestamp)
122 {
123   if (m_file_info)
124     delete m_file_info;
125 
126   if (timestamp > time_parsed ())
127     warning ("help text for function is newer than function");
128 
129   m_file_info = new octave::file_info (text, timestamp);
130 }
131 
132 std::map<std::string, octave_value>
subfunctions(void) const133 octave_user_code::subfunctions (void) const
134 {
135   return std::map<std::string, octave_value> ();
136 }
137 
138 octave_value
dump(void) const139 octave_user_code::dump (void) const
140 {
141   std::map<std::string, octave_value> m
142     = {{ "scope_info", m_scope ? m_scope.dump () : "0x0" },
143        { "file_name", file_name },
144        { "time_parsed", t_parsed },
145        { "time_checked", t_checked }};
146 
147   return octave_value (m);
148 }
149 
150 
151 // User defined scripts.
152 
153 DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_user_script,
154                                      "user-defined script",
155                                      "user-defined script");
156 
octave_user_script(void)157 octave_user_script::octave_user_script (void)
158   : octave_user_code ()
159 { }
160 
octave_user_script(const std::string & fnm,const std::string & nm,const octave::symbol_scope & scope,octave::tree_statement_list * cmds,const std::string & ds)161 octave_user_script::octave_user_script
162   (const std::string& fnm, const std::string& nm,
163    const octave::symbol_scope& scope, octave::tree_statement_list *cmds,
164    const std::string& ds)
165   : octave_user_code (fnm, nm, scope, cmds, ds)
166 {
167   if (cmd_list)
168     cmd_list->mark_as_script_body ();
169 }
170 
octave_user_script(const std::string & fnm,const std::string & nm,const octave::symbol_scope & scope,const std::string & ds)171 octave_user_script::octave_user_script
172   (const std::string& fnm, const std::string& nm,
173    const octave::symbol_scope& scope, const std::string& ds)
174     : octave_user_code (fnm, nm, scope, nullptr, ds)
175 { }
176 
177 // We must overload the call method so that we call the proper
178 // push_stack_frame method, which is overloaded for pointers to
179 // octave_function, octave_user_function, and octave_user_script
180 // objects.
181 
182 octave_value_list
call(octave::tree_evaluator & tw,int nargout,const octave_value_list & args)183 octave_user_script::call (octave::tree_evaluator& tw, int nargout,
184                           const octave_value_list& args)
185 {
186   tw.push_stack_frame (this);
187 
188   octave::unwind_action act ([&tw] () { tw.pop_stack_frame (); });
189 
190   return execute (tw, nargout, args);
191 }
192 
193 octave_value_list
execute(octave::tree_evaluator & tw,int nargout,const octave_value_list & args)194 octave_user_script::execute (octave::tree_evaluator& tw, int nargout,
195                              const octave_value_list& args)
196 {
197   return tw.execute_user_script (*this, nargout, args);
198 }
199 
200 void
accept(octave::tree_walker & tw)201 octave_user_script::accept (octave::tree_walker& tw)
202 {
203   tw.visit_octave_user_script (*this);
204 }
205 
206 // User defined functions.
207 
208 DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_user_function,
209                                      "user-defined function",
210                                      "user-defined function");
211 
212 // Ugh.  This really needs to be simplified (code/data?
213 // extrinsic/intrinsic state?).
214 
octave_user_function(const octave::symbol_scope & scope,octave::tree_parameter_list * pl,octave::tree_parameter_list * rl,octave::tree_statement_list * cl)215 octave_user_function::octave_user_function
216   (const octave::symbol_scope& scope, octave::tree_parameter_list *pl,
217    octave::tree_parameter_list *rl, octave::tree_statement_list *cl)
218   : octave_user_code ("", "", scope, cl, ""),
219     param_list (pl), ret_list (rl),
220     lead_comm (), trail_comm (),
221     location_line (0), location_column (0),
222     parent_name (), system_fcn_file (false),
223     num_named_args (param_list ? param_list->length () : 0),
224     subfunction (false), inline_function (false),
225     anonymous_function (false), nested_function (false),
226     class_constructor (none), class_method (none)
227 #if defined (HAVE_LLVM)
228     , jit_info (0)
229 #endif
230 {
231   if (cmd_list)
232     cmd_list->mark_as_function_body ();
233 }
234 
~octave_user_function(void)235 octave_user_function::~octave_user_function (void)
236 {
237   delete param_list;
238   delete ret_list;
239   delete lead_comm;
240   delete trail_comm;
241 
242 #if defined (HAVE_LLVM)
243   delete jit_info;
244 #endif
245 }
246 
247 octave_user_function *
define_ret_list(octave::tree_parameter_list * t)248 octave_user_function::define_ret_list (octave::tree_parameter_list *t)
249 {
250   ret_list = t;
251 
252   return this;
253 }
254 
255 // If there is no explicit end statement at the end of the function,
256 // relocate the no_op that was generated for the end of file condition
257 // to appear on the next line after the last statement in the file, or
258 // the next line after the function keyword if there are no statements.
259 // More precisely, the new location should probably be on the next line
260 // after the end of the parameter list, but we aren't tracking that
261 // information (yet).
262 
263 void
maybe_relocate_end_internal(void)264 octave_user_function::maybe_relocate_end_internal (void)
265 {
266   if (cmd_list && ! cmd_list->empty ())
267     {
268       octave::tree_statement *last_stmt = cmd_list->back ();
269 
270       if (last_stmt && last_stmt->is_end_of_fcn_or_script ()
271           && last_stmt->is_end_of_file ())
272         {
273           octave::tree_statement_list::reverse_iterator
274             next_to_last_elt = cmd_list->rbegin ();
275 
276           next_to_last_elt++;
277 
278           int new_eof_line;
279           int new_eof_col;
280 
281           if (next_to_last_elt == cmd_list->rend ())
282             {
283               new_eof_line = beginning_line ();
284               new_eof_col = beginning_column ();
285             }
286           else
287             {
288               octave::tree_statement *next_to_last_stmt = *next_to_last_elt;
289 
290               new_eof_line = next_to_last_stmt->line ();
291               new_eof_col = next_to_last_stmt->column ();
292             }
293 
294           last_stmt->set_location (new_eof_line + 1, new_eof_col);
295         }
296     }
297 }
298 
299 void
maybe_relocate_end(void)300 octave_user_function::maybe_relocate_end (void)
301 {
302   std::map<std::string, octave_value> fcns = subfunctions ();
303 
304   if (! fcns.empty ())
305     {
306       for (auto& nm_fnval : fcns)
307         {
308           octave_user_function *f = nm_fnval.second.user_function_value ();
309 
310           if (f)
311             f->maybe_relocate_end_internal ();
312         }
313     }
314 
315   maybe_relocate_end_internal ();
316 }
317 
318 void
stash_parent_fcn_scope(const octave::symbol_scope & ps)319 octave_user_function::stash_parent_fcn_scope (const octave::symbol_scope& ps)
320 {
321   m_scope.set_parent (ps);
322 }
323 
324 std::string
profiler_name(void) const325 octave_user_function::profiler_name (void) const
326 {
327   std::ostringstream result;
328 
329   if (is_anonymous_function ())
330     result << "anonymous@" << fcn_file_name ()
331            << ':' << location_line << ':' << location_column;
332   else if (is_subfunction ())
333     result << parent_fcn_name () << '>' << name ();
334   else if (is_class_method ())
335     result << '@' << dispatch_class () << '/' << name ();
336   else if (is_class_constructor () || is_classdef_constructor ())
337     result << '@' << name ();
338   else if (is_inline_function ())
339     result << "inline@" << fcn_file_name ()
340            << ':' << location_line << ':' << location_column;
341   else
342     result << name ();
343 
344   return result.str ();
345 }
346 
347 void
mark_as_system_fcn_file(void)348 octave_user_function::mark_as_system_fcn_file (void)
349 {
350   if (! file_name.empty ())
351     {
352       // We really should stash the whole path to the file we found,
353       // when we looked it up, to avoid possible race conditions...
354       // FIXME
355       //
356       // We probably also don't need to get the library directory
357       // every time, but since this function is only called when the
358       // function file is parsed, it probably doesn't matter that
359       // much.
360 
361       std::string ff_name = octave::fcn_file_in_path (file_name);
362 
363       static const std::string canonical_fcn_file_dir
364         = octave::sys::canonicalize_file_name
365             (octave::config::fcn_file_dir ());
366       static const std::string fcn_file_dir
367         = canonical_fcn_file_dir.empty () ? octave::config::fcn_file_dir ()
368                                           : canonical_fcn_file_dir;
369 
370       if (fcn_file_dir == ff_name.substr (0, fcn_file_dir.length ()))
371         system_fcn_file = true;
372     }
373   else
374     system_fcn_file = false;
375 }
376 
377 void
erase_subfunctions(void)378 octave_user_function::erase_subfunctions (void)
379 {
380   m_scope.erase_subfunctions ();
381 }
382 
383 bool
takes_varargs(void) const384 octave_user_function::takes_varargs (void) const
385 {
386   return (param_list && param_list->takes_varargs ());
387 }
388 
389 bool
takes_var_return(void) const390 octave_user_function::takes_var_return (void) const
391 {
392   return (ret_list && ret_list->takes_varargs ());
393 }
394 
395 void
mark_as_private_function(const std::string & cname)396 octave_user_function::mark_as_private_function (const std::string& cname)
397 {
398   m_scope.mark_subfunctions_in_scope_as_private (cname);
399 
400   octave_function::mark_as_private_function (cname);
401 }
402 
403 void
lock_subfunctions(void)404 octave_user_function::lock_subfunctions (void)
405 {
406   m_scope.lock_subfunctions ();
407 }
408 
409 void
unlock_subfunctions(void)410 octave_user_function::unlock_subfunctions (void)
411 {
412   m_scope.unlock_subfunctions ();
413 }
414 
415 std::map<std::string, octave_value>
subfunctions(void) const416 octave_user_function::subfunctions (void) const
417 {
418   return m_scope.subfunctions ();
419 }
420 
421 // Find definition of final subfunction in list of subfuns:
422 //
423 //  sub1>sub2>...>subN
424 
425 octave_value
find_subfunction(const std::string & subfuns_arg) const426 octave_user_function::find_subfunction (const std::string& subfuns_arg) const
427 {
428   std::string subfuns = subfuns_arg;
429 
430   std::string first_fun = subfuns;
431 
432   std::size_t pos = subfuns.find ('>');
433 
434   if (pos == std::string::npos)
435     subfuns = "";
436   else
437     {
438       first_fun = subfuns.substr (0, pos-1);
439       subfuns = subfuns.substr (pos+1);
440     }
441 
442   octave_value ov_fcn = m_scope.find_subfunction (first_fun);
443 
444   if (subfuns.empty ())
445     return ov_fcn;
446 
447   octave_user_function *fcn = ov_fcn.user_function_value ();
448 
449   return fcn->find_subfunction (subfuns);
450 }
451 
452 bool
has_subfunctions(void) const453 octave_user_function::has_subfunctions (void) const
454 {
455   return m_scope.has_subfunctions ();
456 }
457 
458 void
stash_subfunction_names(const std::list<std::string> & names)459 octave_user_function::stash_subfunction_names (const std::list<std::string>& names)
460 {
461   m_scope.stash_subfunction_names (names);
462 }
463 
464 std::list<std::string>
subfunction_names(void) const465 octave_user_function::subfunction_names (void) const
466 {
467   return m_scope.subfunction_names ();
468 }
469 
470 octave_value_list
all_va_args(const octave_value_list & args)471 octave_user_function::all_va_args (const octave_value_list& args)
472 {
473   octave_value_list retval;
474 
475   octave_idx_type n = args.length () - num_named_args;
476 
477   if (n > 0)
478     retval = args.slice (num_named_args, n);
479 
480   return retval;
481 }
482 
483 // We must overload the call method so that we call the proper
484 // push_stack_frame method, which is overloaded for pointers to
485 // octave_function, octave_user_function, and octave_user_script
486 // objects.
487 
488 octave_value_list
call(octave::tree_evaluator & tw,int nargout,const octave_value_list & args)489 octave_user_function::call (octave::tree_evaluator& tw, int nargout,
490                             const octave_value_list& args)
491 {
492   tw.push_stack_frame (this);
493 
494   octave::unwind_action act ([&tw] () { tw.pop_stack_frame (); });
495 
496   return execute (tw, nargout, args);
497 }
498 
499 octave_value_list
execute(octave::tree_evaluator & tw,int nargout,const octave_value_list & args)500 octave_user_function::execute (octave::tree_evaluator& tw, int nargout,
501                                const octave_value_list& args)
502 {
503   return tw.execute_user_function (*this, nargout, args);
504 }
505 
506 void
accept(octave::tree_walker & tw)507 octave_user_function::accept (octave::tree_walker& tw)
508 {
509   tw.visit_octave_user_function (*this);
510 }
511 
512 octave::tree_expression *
special_expr(void)513 octave_user_function::special_expr (void)
514 {
515   assert (is_special_expr ());
516   assert (cmd_list->length () == 1);
517 
518   octave::tree_statement *stmt = cmd_list->front ();
519   return stmt->expression ();
520 }
521 
522 bool
subsasgn_optimization_ok(void)523 octave_user_function::subsasgn_optimization_ok (void)
524 {
525   bool retval = false;
526   if (Voptimize_subsasgn_calls
527       && param_list && ret_list
528       && param_list->length () > 0 && ! param_list->varargs_only ()
529       && ret_list->length () == 1 && ! ret_list->takes_varargs ())
530     {
531       octave::tree_identifier *par1 = param_list->front ()->ident ();
532       octave::tree_identifier *ret1 = ret_list->front ()->ident ();
533       retval = par1->name () == ret1->name ();
534     }
535 
536   return retval;
537 }
538 
539 std::string
ctor_type_str(void) const540 octave_user_function::ctor_type_str (void) const
541 {
542   std::string retval;
543 
544   switch (class_constructor)
545     {
546     case none:
547       retval = "none";
548       break;
549 
550     case legacy:
551       retval = "legacy";
552       break;
553 
554     case classdef:
555       retval = "classdef";
556       break;
557 
558     default:
559       retval = "unrecognized enum value";
560       break;
561     }
562 
563   return retval;
564 }
565 
566 std::string
method_type_str(void) const567 octave_user_function::method_type_str (void) const
568 {
569   std::string retval;
570 
571   switch (class_method)
572     {
573     case none:
574       retval = "none";
575       break;
576 
577     case legacy:
578       retval = "legacy";
579       break;
580 
581     case classdef:
582       retval = "classdef";
583       break;
584 
585     default:
586       retval = "unrecognized enum value";
587       break;
588     }
589 
590   return retval;
591 }
592 
593 octave_value
dump(void) const594 octave_user_function::dump (void) const
595 {
596   std::map<std::string, octave_value> m
597     = {{ "user_code", octave_user_code::dump () },
598        { "line", location_line },
599        { "col", location_column },
600        { "end_line", end_location_line },
601        { "end_col", end_location_column },
602        { "parent_name", parent_name },
603        { "system_fcn_file", system_fcn_file },
604        { "num_named_args", num_named_args },
605        { "subfunction", subfunction },
606        { "inline_function", inline_function },
607        { "anonymous_function", anonymous_function },
608        { "nested_function", nested_function },
609        { "ctor_type", ctor_type_str () },
610        { "class_method", class_method }};
611 
612   return octave_value (m);
613 }
614 
615 void
print_code_function_header(const std::string & prefix)616 octave_user_function::print_code_function_header (const std::string& prefix)
617 {
618   octave::tree_print_code tpc (octave_stdout, prefix);
619 
620   tpc.visit_octave_user_function_header (*this);
621 }
622 
623 void
print_code_function_trailer(const std::string & prefix)624 octave_user_function::print_code_function_trailer (const std::string& prefix)
625 {
626   octave::tree_print_code tpc (octave_stdout, prefix);
627 
628   tpc.visit_octave_user_function_trailer (*this);
629 }
630 
631 void
restore_warning_states(void)632 octave_user_function::restore_warning_states (void)
633 {
634   octave::interpreter& interp
635     = octave::__get_interpreter__ ("octave_user_function::restore_warning_states");
636 
637   octave::tree_evaluator& tw = interp.get_evaluator ();
638 
639   octave_value val
640     = tw.get_auto_fcn_var (octave::stack_frame::SAVED_WARNING_STATES);
641 
642   if (val.is_defined ())
643     {
644       // Fail spectacularly if SAVED_WARNING_STATES is not an
645       // octave_map (or octave_scalar_map) object.
646 
647       if (! val.isstruct ())
648         panic_impossible ();
649 
650       octave_map m = val.map_value ();
651 
652       Cell ids = m.contents ("identifier");
653       Cell states = m.contents ("state");
654 
655       for (octave_idx_type i = 0; i < m.numel (); i++)
656         Fwarning (interp, ovl (states(i), ids(i)));
657     }
658 }
659 
660 DEFMETHOD (nargin, interp, args, ,
661            doc: /* -*- texinfo -*-
662 @deftypefn  {} {} nargin ()
663 @deftypefnx {} {} nargin (@var{fcn})
664 Report the number of input arguments to a function.
665 
666 Called from within a function, return the number of arguments passed to the
667 function.  At the top level, return the number of command line arguments
668 passed to Octave.
669 
670 If called with the optional argument @var{fcn}---a function name or
671 handle---return the declared number of arguments that the function can
672 accept.
673 
674 If the last argument to @var{fcn} is @var{varargin} the returned value is
675 negative.  For example, the function @code{union} for sets is declared as
676 
677 @example
678 @group
679 function [y, ia, ib] = union (a, b, varargin)
680 
681 and
682 
683 nargin ("union")
684 @result{} -3
685 @end group
686 @end example
687 
688 Programming Note: @code{nargin} does not work on compiled functions
689 (@file{.oct} files) such as built-in or dynamically loaded functions.
690 @seealso{nargout, narginchk, varargin, inputname}
691 @end deftypefn */)
692 {
693   int nargin = args.length ();
694 
695   if (nargin > 1)
696     print_usage ();
697 
698   octave_value retval;
699 
700   if (nargin == 1)
701     {
702       octave_value func = args(0);
703 
704       if (func.is_string ())
705         {
706           octave::symbol_table& symtab = interp.get_symbol_table ();
707 
708           std::string name = func.string_value ();
709           func = symtab.find_function (name);
710           if (func.is_undefined ())
711             error ("nargin: invalid function name: %s", name.c_str ());
712         }
713 
714       octave_function *fcn_val = func.function_value (true);
715       if (! fcn_val)
716         error ("nargin: FCN must be a string or function handle");
717 
718       octave_user_function *fcn = fcn_val->user_function_value (true);
719 
720       if (! fcn)
721         {
722           // Matlab gives up for histc, so maybe it's ok that we
723           // give up sometimes too?
724 
725           std::string type = fcn_val->type_name ();
726           error ("nargin: number of input arguments unavailable for %s objects",
727                  type.c_str ());
728         }
729 
730       octave::tree_parameter_list *param_list = fcn->parameter_list ();
731 
732       retval = (param_list ? param_list->length () : 0);
733       if (fcn->takes_varargs ())
734         retval = -1 - retval;
735     }
736   else
737     {
738       octave::tree_evaluator& tw = interp.get_evaluator ();
739 
740       retval = tw.get_auto_fcn_var (octave::stack_frame::NARGIN);
741 
742       if (retval.is_undefined ())
743         retval = 0;
744     }
745 
746   return retval;
747 }
748 
749 DEFMETHOD (nargout, interp,args, ,
750            doc: /* -*- texinfo -*-
751 @deftypefn  {} {} nargout ()
752 @deftypefnx {} {} nargout (@var{fcn})
753 Report the number of output arguments from a function.
754 
755 Called from within a function, return the number of values the caller
756 expects to receive.  At the top level, @code{nargout} with no argument is
757 undefined and will produce an error.
758 
759 If called with the optional argument @var{fcn}---a function name or
760 handle---return the number of declared output values that the function can
761 produce.
762 
763 If the final output argument is @var{varargout} the returned value is
764 negative.
765 
766 For example,
767 
768 @example
769 f ()
770 @end example
771 
772 @noindent
773 will cause @code{nargout} to return 0 inside the function @code{f} and
774 
775 @example
776 [s, t] = f ()
777 @end example
778 
779 @noindent
780 will cause @code{nargout} to return 2 inside the function @code{f}.
781 
782 In the second usage,
783 
784 @example
785 nargout (@@histc)   # or nargout ("histc") using a string input
786 @end example
787 
788 @noindent
789 will return 2, because @code{histc} has two outputs, whereas
790 
791 @example
792 nargout (@@imread)
793 @end example
794 
795 @noindent
796 will return -2, because @code{imread} has two outputs and the second is
797 @var{varargout}.
798 
799 Programming Note.  @code{nargout} does not work for built-in functions and
800 returns -1 for all anonymous functions.
801 @seealso{nargin, varargout, isargout, nthargout}
802 @end deftypefn */)
803 {
804   int nargin = args.length ();
805 
806   if (nargin > 1)
807     print_usage ();
808 
809   octave_value retval;
810 
811   if (nargin == 1)
812     {
813       octave_value func = args(0);
814 
815       if (func.is_string ())
816         {
817           octave::symbol_table& symtab = interp.get_symbol_table ();
818 
819           std::string name = func.string_value ();
820           func = symtab.find_function (name);
821           if (func.is_undefined ())
822             error ("nargout: invalid function name: %s", name.c_str ());
823         }
824 
825       if (func.is_inline_function ())
826         return ovl (1);
827 
828       if (func.is_function_handle ())
829         {
830           octave_fcn_handle *fh = func.fcn_handle_value ();
831 
832           if (fh->is_anonymous ())
833             return ovl (-1);
834         }
835 
836       octave_function *fcn_val = func.function_value (true);
837       if (! fcn_val)
838         error ("nargout: FCN must be a string or function handle");
839 
840       octave_user_function *fcn = fcn_val->user_function_value (true);
841 
842       if (! fcn)
843         {
844           // Matlab gives up for histc, so maybe it's ok that we
845           // give up sometimes too?
846 
847           std::string type = fcn_val->type_name ();
848           error ("nargout: number of output arguments unavailable for %s objects",
849                  type.c_str ());
850         }
851 
852       octave::tree_parameter_list *ret_list = fcn->return_list ();
853 
854       retval = (ret_list ? ret_list->length () : 0);
855 
856       if (fcn->takes_var_return ())
857         retval = -1 - retval;
858     }
859   else
860     {
861       if (interp.at_top_level ())
862         error ("nargout: invalid call at top level");
863 
864       octave::tree_evaluator& tw = interp.get_evaluator ();
865 
866       retval = tw.get_auto_fcn_var (octave::stack_frame::NARGOUT);
867 
868       if (retval.is_undefined ())
869         retval = 0;
870     }
871 
872   return retval;
873 }
874 
875 DEFUN (optimize_subsasgn_calls, args, nargout,
876        doc: /* -*- texinfo -*-
877 @deftypefn  {} {@var{val} =} optimize_subsasgn_calls ()
878 @deftypefnx {} {@var{old_val} =} optimize_subsasgn_calls (@var{new_val})
879 @deftypefnx {} {} optimize_subsasgn_calls (@var{new_val}, "local")
880 Query or set the internal flag for @code{subsasgn} method call
881 optimizations.
882 
883 If true, Octave will attempt to eliminate the redundant copying when calling
884 the @code{subsasgn} method of a user-defined class.
885 
886 When called from inside a function with the @qcode{"local"} option, the
887 variable is changed locally for the function and any subroutines it calls.
888 The original variable value is restored when exiting the function.
889 @seealso{subsasgn}
890 @end deftypefn */)
891 {
892   return SET_INTERNAL_VARIABLE (optimize_subsasgn_calls);
893 }
894 
val_in_table(const Matrix & table,double val)895 static bool val_in_table (const Matrix& table, double val)
896 {
897   if (table.isempty ())
898     return false;
899 
900   octave_idx_type i = table.lookup (val, ASCENDING);
901   return (i > 0 && table(i-1) == val);
902 }
903 
isargout1(int nargout,const Matrix & ignored,double k)904 static bool isargout1 (int nargout, const Matrix& ignored, double k)
905 {
906   if (k != octave::math::fix (k) || k <= 0)
907     error ("isargout: K must be a positive integer");
908 
909   return (k == 1 || k <= nargout) && ! val_in_table (ignored, k);
910 }
911 
912 DEFMETHOD (isargout, interp, args, ,
913            doc: /* -*- texinfo -*-
914 @deftypefn {} {} isargout (@var{k})
915 Within a function, return a logical value indicating whether the argument
916 @var{k} will be assigned to a variable on output.
917 
918 If the result is false, the argument has been ignored during the function
919 call through the use of the tilde (~) special output argument.  Functions
920 can use @code{isargout} to avoid performing unnecessary calculations for
921 outputs which are unwanted.
922 
923 If @var{k} is outside the range @code{1:max (nargout)}, the function returns
924 false.  @var{k} can also be an array, in which case the function works
925 element-by-element and a logical array is returned.  At the top level,
926 @code{isargout} returns an error.
927 @seealso{nargout, varargout, nthargout}
928 @end deftypefn */)
929 {
930   if (args.length () != 1)
931     print_usage ();
932 
933   if (interp.at_top_level ())
934     error ("isargout: invalid call at top level");
935 
936   octave::tree_evaluator& tw = interp.get_evaluator ();
937 
938   octave_value tmp;
939 
940   int nargout1 = 0;
941   tmp = tw.get_auto_fcn_var (octave::stack_frame::NARGOUT);
942   if (tmp.is_defined ())
943     nargout1 = tmp.int_value ();
944 
945   Matrix ignored;
946   tmp = tw.get_auto_fcn_var (octave::stack_frame::IGNORED);
947   if (tmp.is_defined ())
948     ignored = tmp.matrix_value ();
949 
950   if (args(0).is_scalar_type ())
951     {
952       double k = args(0).double_value ();
953 
954       return ovl (isargout1 (nargout1, ignored, k));
955     }
956   else if (args(0).isnumeric ())
957     {
958       const NDArray ka = args(0).array_value ();
959 
960       boolNDArray r (ka.dims ());
961       for (octave_idx_type i = 0; i < ka.numel (); i++)
962         r(i) = isargout1 (nargout1, ignored, ka(i));
963 
964       return ovl (r);
965     }
966   else
967     err_wrong_type_arg ("isargout", args(0));
968 
969   return ovl ();
970 }
971 
972 /*
973 %!function [x, y] = try_isargout ()
974 %!  if (isargout (1))
975 %!    if (isargout (2))
976 %!      x = 1; y = 2;
977 %!    else
978 %!      x = -1;
979 %!    endif
980 %!  else
981 %!    if (isargout (2))
982 %!      y = -2;
983 %!    else
984 %!      error ("no outputs requested");
985 %!    endif
986 %!  endif
987 %!endfunction
988 %!
989 %!function [a, b] = try_isargout2 (x, y)
990 %!  a = y;
991 %!  b = {isargout(1), isargout(2), x};
992 %!endfunction
993 %!
994 %!test
995 %! [x, y] = try_isargout ();
996 %! assert ([x, y], [1, 2]);
997 %!
998 %!test
999 %! [x, ~] = try_isargout ();
1000 %! assert (x, -1);
1001 %!
1002 %!test
1003 %! [~, y] = try_isargout ();
1004 %! assert (y, -2);
1005 %!
1006 %!error [~, ~] = try_isargout ()
1007 %!
1008 ## Check to see that isargout isn't sticky:
1009 %!test
1010 %! [x, y] = try_isargout ();
1011 %! assert ([x, y], [1, 2]);
1012 %!
1013 ## It should work without ():
1014 %!test
1015 %! [~, y] = try_isargout;
1016 %! assert (y, -2);
1017 %!
1018 ## It should work in function handles, anonymous functions, and cell
1019 ## arrays of handles or anonymous functions.
1020 %!test
1021 %! fh = @try_isargout;
1022 %! af = @() try_isargout;
1023 %! c = {fh, af};
1024 %! [~, y] = fh ();
1025 %! assert (y, -2);
1026 %! [~, y] = af ();
1027 %! assert (y, -2);
1028 %! [~, y] = c{1}();
1029 %! assert (y, -2);
1030 %! [~, y] = c{2}();
1031 %! assert (y, -2);
1032 %!
1033 ## Nesting, anyone?
1034 %!test
1035 %! [~, b] = try_isargout2 (try_isargout, rand);
1036 %! assert (b, {0, 1, -1});
1037 %!test
1038 %! [~, b] = try_isargout2 ({try_isargout, try_isargout}, rand);
1039 %! assert (b, {0, 1, {-1, -1}});
1040 */
1041