annotate src/ov-mex-fcn.cc @ 5864:e884ab4f29ee

[project @ 2006-06-22 00:57:27 by jwe]
author jwe
date Thu, 22 Jun 2006 00:57:28 +0000
parents
children c9f0839c583f
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
5864
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
1 /*
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
2
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
3 Copyright (C) 1996, 1997 John W. Eaton
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
4
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
5 This file is part of Octave.
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
6
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
7 Octave is free software; you can redistribute it and/or modify it
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
9 Free Software Foundation; either version 2, or (at your option) any
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
10 later version.
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
11
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
12 Octave is distributed in the hope that it will be useful, but WITHOUT
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
15 for more details.
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
16
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
18 along with Octave; see the file COPYING. If not, write to the Free
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
19 Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
20 02110-1301, USA.
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
21
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
22 */
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
23
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
24 #ifdef HAVE_CONFIG_H
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
25 #include <config.h>
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
26 #endif
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
27
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
28 #include "oct-shlib.h"
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
29
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
30 #include <defaults.h>
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
31 #include "dynamic-ld.h"
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
32 #include "error.h"
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
33 #include "oct-obj.h"
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
34 #include "ov-mex-fcn.h"
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
35 #include "ov.h"
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
36 #include "toplev.h"
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
37 #include "unwind-prot.h"
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
38
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
39 DEFINE_OCTAVE_ALLOCATOR (octave_mex_function);
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
40
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
41 DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_mex_function,
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
42 "mex function", "mex function");
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
43
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
44 octave_mex_function::octave_mex_function
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
45 (void *fptr, bool fmex, const octave_shlib& shl,
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
46 const std::string& nm)
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
47 : octave_function (nm), mex_fcn_ptr (fptr), have_fmex (fmex), sh_lib (shl)
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
48 {
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
49 mark_fcn_file_up_to_date (time_parsed ());
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
50
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
51 std::string file_name = fcn_file_name ();
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
52
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
53 system_fcn_file
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
54 = (! file_name.empty ()
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
55 && Voct_file_dir == file_name.substr (0, Voct_file_dir.length ()));
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
56 }
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
57
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
58 octave_mex_function::~octave_mex_function (void)
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
59 {
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
60 octave_dynamic_loader::remove (my_name, sh_lib);
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
61 }
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
62
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
63 std::string
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
64 octave_mex_function::fcn_file_name (void) const
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
65 {
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
66 return sh_lib.file_name ();
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
67 }
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
68
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
69 octave_time
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
70 octave_mex_function::time_parsed (void) const
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
71 {
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
72 return sh_lib.time_loaded ();
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
73 }
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
74
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
75 octave_value_list
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
76 octave_mex_function::subsref (const std::string& type,
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
77 const std::list<octave_value_list>& idx,
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
78 int nargout)
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
79 {
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
80 octave_value_list retval;
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
81
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
82 switch (type[0])
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
83 {
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
84 case '(':
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
85 {
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
86 int tmp_nargout = (type.length () > 1 && nargout == 0) ? 1 : nargout;
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
87
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
88 retval = do_multi_index_op (tmp_nargout, idx.front ());
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
89 }
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
90 break;
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
91
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
92 case '{':
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
93 case '.':
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
94 {
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
95 std::string nm = type_name ();
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
96 error ("%s cannot be indexed with %c", nm.c_str (), type[0]);
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
97 }
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
98 break;
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
99
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
100 default:
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
101 panic_impossible ();
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
102 }
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
103
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
104 // FIXME -- perhaps there should be an
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
105 // octave_value_list::next_subsref member function? See also
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
106 // octave_user_function::subsref.
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
107 //
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
108 // FIXME -- Note that if a function call returns multiple
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
109 // values, and there is further indexing to perform, then we are
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
110 // ignoring all but the first value. Is this really what we want to
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
111 // do? If it is not, then what should happen for stat("file").size,
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
112 // for exmaple?
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
113
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
114 if (idx.size () > 1)
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
115 retval = retval(0).next_subsref (nargout, type, idx);
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
116
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
117 return retval;
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
118 }
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
119
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
120 extern octave_value_list
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
121 C_mex (void *f, const octave_value_list& args, int nargout);
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
122
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
123 extern octave_value_list
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
124 Fortran_mex (void *f, const octave_value_list& args, int nargout);
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
125
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
126 octave_value_list
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
127 octave_mex_function::do_multi_index_op (int nargout,
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
128 const octave_value_list& args)
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
129 {
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
130 octave_value_list retval;
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
131
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
132 if (error_state)
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
133 return retval;
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
134
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
135 if (args.has_magic_colon ())
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
136 ::error ("invalid use of colon in function argument list");
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
137 else
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
138 {
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
139 unwind_protect::begin_frame ("mex_func_eval");
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
140
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
141 octave_call_stack::push (this);
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
142
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
143 unwind_protect::add (octave_call_stack::unwind_pop, 0);
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
144
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
145 retval = have_fmex
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
146 ? Fortran_mex (mex_fcn_ptr, args, nargout)
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
147 : C_mex (mex_fcn_ptr, args, nargout);
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
148
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
149 unwind_protect::run_frame ("mex_func_eval");
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
150 }
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
151
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
152 return retval;
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
153 }
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
154
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
155 /*
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
156 ;;; Local Variables: ***
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
157 ;;; mode: C++ ***
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
158 ;;; End: ***
e884ab4f29ee [project @ 2006-06-22 00:57:27 by jwe]
jwe
parents:
diff changeset
159 */