Mercurial > hg > octave-max
changeset 5864:e884ab4f29ee
[project @ 2006-06-22 00:57:27 by jwe]
| author | jwe |
|---|---|
| date | Thu, 22 Jun 2006 00:57:28 +0000 |
| parents | 4c16f3104aa5 |
| children | 4e6be3c306f1 |
| files | ChangeLog doc/interpreter/mkoctfile.1 examples/myfeval.c examples/myfevalf.f examples/myhello.c examples/myset.c examples/mystruct.c liboctave/ChangeLog liboctave/oct-shlib.cc mkoctfile.in src/ChangeLog src/Makefile.in src/defun-int.h src/defun.cc src/dynamic-ld.cc src/dynamic-ld.h src/load-path.cc src/load-path.h src/matrix.h src/mex.cc src/mex.h src/mexproto.h src/ov-base.h src/ov-builtin.cc src/ov-fcn.h src/ov-mex-fcn.cc src/ov-mex-fcn.h src/ov.h src/parse.y src/pt-id.cc src/symtab.cc src/symtab.h src/utils.cc src/utils.h src/variables.cc |
| diffstat | 35 files changed, 2464 insertions(+), 61 deletions(-) [+] |
line wrap: on
line diff
--- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2006-06-21 John W. Eaton <jwe@octave.org> + + * examples/myfeval.c, examples/myfevalf.f, examples/myhello.c, + examples/myset.c, examples/mystruct.c: New files. + + * mkoctfile.in: New option, --mex. + 2006-06-13 John W. Eaton <jwe@octave.org> * configure.in (--enable-64): Include "(EXPERIMENTAL)" in help text.
--- a/doc/interpreter/mkoctfile.1 +++ b/doc/interpreter/mkoctfile.1 @@ -36,7 +36,8 @@ Compile but do not link. .TP 8 .B \-o FILE|\-\-output FILE -Output file name; default extension is .oct. +Output file name; default extension is .oct (or .mex if --mex is +specified) unless linking a stand-alone executable. .TP .B \-p VAR|\-\-print VAR Print configuration variable VAR. Recognized variables are: @@ -65,6 +66,9 @@ .TP 8 .B \-\-link-stand-alone Link a stand-alone executable file. +.B \-\-mex +Assume we are creating a MEX file. Set the default output extension +to .mex. .TP 8 .B \-s|--strip Strip the output file.
new file mode 100644 --- /dev/null +++ b/examples/myfeval.c @@ -0,0 +1,22 @@ +#include "mex.h" + +void +mexFunction (int nlhs, mxArray* plhs[], int nrhs, const mxArray* prhs[]) +{ + char *str; + + mexPrintf ("Hello, World!\n"); + + mexPrintf ("I have %d inputs and %d outputs\n", nrhs, nlhs); + + if (nrhs < 1 || ! mxIsString (prhs[0])) + mexErrMsgTxt ("function name expected"); + + str = mxArrayToString (prhs[0]); + + mexPrintf ("I'm going to call the interpreter function %s\n", str); + + mexCallMATLAB (nlhs, plhs, nrhs-1, prhs+1, str); + + mxFree (str); +}
new file mode 100644 --- /dev/null +++ b/examples/myfevalf.f @@ -0,0 +1,30 @@ + subroutine mexFunction (nlhs, plhs, nrhs, prhs) + + implicit none + + integer*4 nlhs, nrhs + +* The following will need to be integer*8 on 64-bit systems, otherwise +* these variables won't be large enough to hold pointers... + integer*4 plhs(*), prhs(*) + + integer*4 mxIsString, mxGetString, mxGetN, mexCallMATLAB + integer*4 status, len + character*100 str + + call mexPrintf ('Hello, World!') + + if (nrhs .lt. 1 .or. mxIsString (prhs(1)) .ne. 1) then + call mexErrMsgTxt ('function name expected') + endif + + len = mxGetN (prhs(1)) + + status = mxGetString (prhs(1), str, 100) + + call mexPrintf ('FORTRAN will call the interpreter now') + + status = mexCallMATLAB (nlhs, plhs, nrhs-1, prhs(2), str(1:len)) + + return + end
new file mode 100644 --- /dev/null +++ b/examples/myhello.c @@ -0,0 +1,13 @@ +#include "mex.h" + +void +mexFunction (int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) +{ + mxArray *v = mxCreateDoubleMatrix (1, 1, mxREAL); + + double *data = mxGetPr (v); + + *data = 1.23456789; + + plhs[0] = v; +}
new file mode 100644 --- /dev/null +++ b/examples/myset.c @@ -0,0 +1,33 @@ +#include "mex.h" + +void +mexFunction (int nlhs, mxArray* plhs[], int nrhs, const mxArray* prhs[]) +{ + char *str; + mxArray *v; + + if (nrhs != 2 || ! mxIsString (prhs[0])) + mexErrMsgTxt ("expects symbol name and value"); + + str = mxArrayToString (prhs[0]); + + v = mexGetArray (str, "global"); + + if (v) + { + mexPrintf ("%s is a global variable with the following value:\n", str); + mexCallMATLAB (0, 0, 1, &v, "disp"); + } + + v = mexGetArray (str, "caller"); + + if (v) + { + mexPrintf ("%s is a caller variable with the following value:\n", str); + mexCallMATLAB (0, 0, 1, &v, "disp"); + } + + // WARNING!! Can't do this in MATLAB! Must copy variable first. + mxSetName (prhs[1], str); + mexPutArray (prhs[1], "caller"); +}
new file mode 100644 --- /dev/null +++ b/examples/mystruct.c @@ -0,0 +1,34 @@ +#include "mex.h" + +void +mexFunction (int nlhs, mxArray* plhs[], int nrhs, const mxArray* prhs[]) +{ + int i, j; + mxArray *v; + const char *keys[] = { "this", "that" }; + + if (nrhs != 1 || ! mxIsStruct (prhs[0])) + mexErrMsgTxt ("expects struct"); + + for (i = 0; i < mxGetNumberOfFields (prhs[0]); i++) + for (j=0; j < mxGetNumberOfElements(prhs[0]); j++) + { + mexPrintf ("field %s(%d) = ", mxGetFieldNameByNumber (prhs[0], i), j); + v = mxGetFieldByNumber (prhs[0], j, i); + mexCallMATLAB(0, 0, 1, &v, "disp"); + } + + v = mxCreateStructMatrix (2, 2, 2, keys); + + mxSetFieldByNumber (v, 0, 0, mxCreateString ("this1")); + mxSetFieldByNumber (v, 0, 1, mxCreateString ("that1")); + mxSetFieldByNumber (v, 1, 0, mxCreateString ("this2")); + mxSetFieldByNumber (v, 1, 1, mxCreateString ("that2")); + mxSetFieldByNumber (v, 2, 0, mxCreateString ("this3")); + mxSetFieldByNumber (v, 2, 1, mxCreateString ("that3")); + mxSetFieldByNumber (v, 3, 0, mxCreateString ("this4")); + mxSetFieldByNumber (v, 3, 1, mxCreateString ("that4")); + + if (nlhs) + plhs[0] = v; +}
--- a/liboctave/ChangeLog +++ b/liboctave/ChangeLog @@ -1,3 +1,9 @@ +2006-06-21 John W. Eaton <jwe@octave.org> + + * oct-shlib.cc (octave_dlopen_shlib::close, + octave_shl_load_shlib::close, octave_w32_shlib::close): + Skip do_close_hook if cl_hook is 0. + 2006-06-16 John W. Eaton <jwe@octave.org> * oct-sort.h: Don't include config.h, lo-mappers.h, or quit.h.
--- a/liboctave/oct-shlib.cc +++ b/liboctave/oct-shlib.cc @@ -299,7 +299,8 @@ { if (is_open ()) { - do_close_hook (cl_hook); + if (cl_hook) + do_close_hook (cl_hook); dlclose (library); @@ -402,7 +403,8 @@ { if (is_open ()) { - do_close_hook (cl_hook); + if (cl_hook) + do_close_hook (cl_hook); shl_unload (library); @@ -530,7 +532,8 @@ { if (is_open ()) { - do_close_hook (cl_hook); + if (cl_hook) + do_close_hook (cl_hook); FreeLibrary (handle);
--- a/mkoctfile.in +++ b/mkoctfile.in @@ -83,6 +83,7 @@ no_oct_file_strip_on_this_platform=%NO_OCT_FILE_STRIP% link=true link_stand_alone=false +output_ext=".oct" depend=false compile=true @@ -150,7 +151,8 @@ -c, --compile Compile, but do not link. -o FILE, --output FILE Output file name. Default extension is .oct - unless linking a stand-alone executable. + (or .mex if --mex is specified) unless linking + a stand-alone executable. -p VAR, --print VAR Print configuration variable VAR. Recognized variables are: @@ -178,6 +180,9 @@ --link-stand-alone Link a stand-alone executable file. + --mex Assume we are creating a MEX file. Set the + default output extension to ".mex". + -s, --strip Strip output file. -v, --verbose Echo commands as they are executed. @@ -247,6 +252,9 @@ --link-stand-alone) link_stand_alone=true ;; + --mex) + output_ext=".mex" + ;; -W*) pass_on_options="$pass_on_options $1" ;; @@ -271,7 +279,7 @@ if [ -n "$outputfile" ]; then octfile="$outputfile" else - octfile=`echo $octfile | $SED 's,\.[^.]*$,,'`.oct + octfile=`echo $octfile | $SED 's,\.[^.]*$,,'`$output_ext fi fi
--- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,55 @@ +2006-06-21 John W. Eaton <jwe@octave.org> + + * variables.cc (do_who): Handle mex. + + * symtab.cc (SYMBOL_DEF::type_as_string, SYMBOL_DEF::which, + symbol_table::clear_functions, table::clear_function, + symbol_table::clear_function_pattern): + Handle mex. + * symtab.h (symbol_record::is_mex_function, + symbol_record::symbol_def::is_mex_function): New functions. + (symbol_record::TYPE): New value, MEX_FUNCTION. + (symbol_record::is_function, symbol_table::user_function_name_list, + SYMTAB_ALL_TYPES): Handle MEX_FUNCTION. + + * ov-fcn.h (octave_function::octave_function): + Provide default for doc string arg. + + * defun.cc (install_mex_function): New function. + * defun-int.h: Provide decl. + + * ov-builtin.cc (any_arg_is_magic_colon): Delete. + (octave_builtin::do_multi_index_op): Call has_magic_colon method + for args instead of any_arg_is_magic_colon. + + * ov-base.h (octave_base_value::is_mex_function): New function. + * ov.h (octave_value::is_mex_function): New function. + + * ov-mex-fcn.h, ov-mex-fcn.cc: New files. + + * parse.y (load_fcn_from_file): Also handle .mex files. + + * dynamic-ld.cc (octave_dynamic_loader::load_oct): Rename from load. + (octave_dynamic_loader::do_load_oct): Rename from do_load. + * dynamic-ld.h: Fix decls. + + * utils.cc (mex_file_in_path): New function. + * utils.h: Provide decl. + + * variables.cc (symbol_out_of_date): Also handle mex files. + + * load-path.cc (load_path::dir_info::get_file_list, + load_path::dir_info::get_private_function_map, + load_path::do_find_fcn, load_path::add_to_fcn_map, + load_path::do_display): Also handle mex files. + * load-path.h (load_path::find_mex_file): New static function. + (load_path::MEX_FILE): New static data member. + (load_path::do_find_fcn): By default, also look for mex files. + + * matrix.h, mex.h, mex.cc: New files from Octave Forge + * mexproto.h: New file, extracted from mex.h. + * Makefile.in: Add them to the appropriate lists. + 2006-06-20 John W. Eaton <jwe@octave.org> * ov-re-mat.cc (octave_matrix::convert_to_str_internal):
--- a/src/Makefile.in +++ b/src/Makefile.in @@ -80,8 +80,8 @@ ov-colon.h ov-base.h ov-base-mat.h ov-base-scalar.h \ ov-streamoff.h ov-str-mat.h ov-bool-mat.h ov-bool.h \ ov-cell.h ov.h ov-fcn.h ov-builtin.h ov-dld-fcn.h \ - ov-mapper.h ov-usr-fcn.h ov-fcn-handle.h ov-fcn-inline.h \ - ov-typeinfo.h ov-type-conv.h \ + ov-mapper.h ov-mex-fcn.cc ov-usr-fcn.h ov-fcn-handle.h \ + ov-fcn-inline.h ov-typeinfo.h ov-type-conv.h \ $(OV_INTTYPE_INC) OV_SPARSE_INCLUDES := \ @@ -98,6 +98,7 @@ error.h file-io.h gripes.h help.h input.h \ lex.h load-path.h load-save.h ls-hdf5.h ls-mat-ascii.h ls-mat4.h \ ls-mat5.h ls-oct-ascii.h ls-oct-binary.h ls-utils.h \ + matrix.h mex.h mexproto.h \ oct-errno.h oct-fstrm.h oct-hist.h oct-iostrm.h oct-map.h oct-obj.h \ oct-prcstrm.h oct-procbuf.h oct-stdstrm.h oct-stream.h zfstream.h \ oct-strstrm.h oct-lvalue.h oct.h octave.h ops.h pager.h \ @@ -151,7 +152,8 @@ ov-streamoff.cc ov-struct.cc \ ov-colon.cc ov-bool-mat.cc ov-bool.cc ov-cell.cc \ ov.cc ov-fcn.cc ov-builtin.cc ov-dld-fcn.cc ov-mapper.cc \ - ov-usr-fcn.cc ov-fcn-handle.cc ov-fcn-inline.cc ov-typeinfo.cc \ + ov-mex-fcn.cc ov-usr-fcn.cc ov-fcn-handle.cc ov-fcn-inline.cc \ + ov-typeinfo.cc \ $(OV_INTTYPE_SRC) \ $(OV_SPARSE_SRC) @@ -167,7 +169,7 @@ help.cc input.cc lex.l load-path.cc load-save.cc ls-hdf5.cc \ ls-mat-ascii.cc ls-mat4.cc ls-mat5.cc ls-oct-ascii.cc \ ls-oct-binary.cc ls-utils.cc main.c mappers.cc matherr.c \ - oct-fstrm.cc oct-hist.cc oct-iostrm.cc oct-map.cc \ + mex.cc oct-fstrm.cc oct-hist.cc oct-iostrm.cc oct-map.cc \ oct-obj.cc oct-prcstrm.cc oct-procbuf.cc oct-stream.cc \ octave.cc zfstream.cc oct-strstrm.cc oct-lvalue.cc pager.cc \ parse.y pr-output.cc procstream.cc sighandlers.cc \
--- a/src/defun-int.h +++ b/src/defun-int.h @@ -53,6 +53,10 @@ const std::string& doc, bool is_text_fcn = false); extern void +install_mex_function (void *fptr, bool fmex, const std::string& name, + const octave_shlib& shl, bool is_text_fcn = false); + +extern void alias_builtin (const std::string& alias, const std::string& name); #define DECLARE_FUNX(name, args_name, nargout_name) \
--- a/src/defun.cc +++ b/src/defun.cc @@ -38,6 +38,7 @@ #include "ov-dld-fcn.h" #include "ov-fcn.h" #include "ov-mapper.h" +#include "ov-mex-fcn.h" #include "ov-usr-fcn.h" #include "oct-obj.h" #include "pager.h" @@ -187,6 +188,29 @@ } void +install_mex_function (void *fptr, bool fmex, const std::string& name, + const octave_shlib& shl, bool is_text_fcn) +{ + symbol_record *sym_rec = fbi_sym_tab->lookup (name, true); + + unsigned int t = symbol_record::MEX_FUNCTION; + + if (is_text_fcn) + t |= symbol_record::COMMAND; + + sym_rec->unprotect (); + sym_rec->define (new octave_mex_function (fptr, fmex, shl, name), t); + + // Also insert the full name in the symbol table. This way, we can + // properly cope with changes to LOAD_PATH. + + symbol_record *full_sr = fbi_sym_tab->lookup (shl.file_name (), true); + + full_sr->alias (sym_rec, true); + full_sr->hide (); +} + +void alias_builtin (const std::string& alias, const std::string& name) { symbol_record *sr_name = fbi_sym_tab->lookup (name);
--- a/src/dynamic-ld.cc +++ b/src/dynamic-ld.cc @@ -39,6 +39,9 @@ #include "utils.h" #include "variables.h" +#define STRINGIFY(s) STRINGIFY1(s) +#define STRINGIFY1(s) #s + class octave_shlib_list { @@ -169,6 +172,98 @@ return (instance_ok ()) ? instance->do_search (fcn_name, shl, mangler) : 0; } +class +octave_mex_file_list +{ +public: + + static void append (const octave_shlib& shl); + + static void remove (octave_shlib& shl); + +private: + + octave_mex_file_list (void) { } + + ~octave_mex_file_list (void) { } + + void do_append (const octave_shlib& shl); + + void do_remove (octave_shlib& shl); + + static octave_mex_file_list *instance; + + static bool instance_ok (void); + + // List of libraries we have loaded. + std::list<octave_shlib> file_list; + + // No copying! + + octave_mex_file_list (const octave_mex_file_list&); + + octave_mex_file_list& operator = (const octave_mex_file_list&); +}; + +octave_mex_file_list *octave_mex_file_list::instance = 0; + +void +octave_mex_file_list::do_append (const octave_shlib& shl) +{ + file_list.push_back (shl); +} + +void +octave_mex_file_list::do_remove (octave_shlib& shl) +{ + + for (std::list<octave_shlib>::iterator p = file_list.begin (); + p != file_list.end (); + p++) + { + if (*p == shl) + { + shl.close (); + + file_list.erase (p); + + break; + } + } +} + +bool +octave_mex_file_list::instance_ok (void) +{ + bool retval = true; + + if (! instance) + instance = new octave_mex_file_list (); + + if (! instance) + { + ::error ("unable to create shared library list object!"); + + retval = false; + } + + return retval; +} + +void +octave_mex_file_list::append (const octave_shlib& shl) +{ + if (instance_ok ()) + instance->do_append (shl); +} + +void +octave_mex_file_list::remove (octave_shlib& shl) +{ + if (instance_ok ()) + instance->do_remove (shl); +} + octave_dynamic_loader *octave_dynamic_loader::instance = 0; bool octave_dynamic_loader::doing_load = false; @@ -205,8 +300,8 @@ } bool -octave_dynamic_loader::do_load (const std::string& fcn_name, - const std::string& file_name) +octave_dynamic_loader::do_load_oct (const std::string& fcn_name, + const std::string& file_name) { bool retval = false; @@ -259,6 +354,7 @@ oct_file_name.c_str ()); } } + } } @@ -270,7 +366,8 @@ retval = f (oct_file); if (! retval) - ::error ("failed to install dld function `%s'", fcn_name.c_str ()); + ::error ("failed to install .oct file function `%s'", + fcn_name.c_str ()); } unwind_protect::run_frame ("octave_dynamic_loader::do_load"); @@ -279,6 +376,66 @@ } bool +octave_dynamic_loader::do_load_mex (const std::string& fcn_name, + const std::string& file_name) +{ + bool retval = false; + + octave_shlib mex_file; + + unwind_protect::begin_frame ("octave_dynamic_loader::do_load"); + + unwind_protect_bool (octave_dynamic_loader::doing_load); + + doing_load = true; + + std::string mex_file_name + = file_name.empty () ? mex_file_in_path (fcn_name) : file_name; + + void *function = 0; + + bool have_fmex = false; + + if (! mex_file_name.empty ()) + { + mex_file.open (mex_file_name); + + if (! error_state) + { + if (mex_file) + { + octave_mex_file_list::append (mex_file); + + function = mex_file.search ("mexFunction"); + + if (! function) + { + function = mex_file.search (STRINGIFY (F77_FUNC (mexfunction, MEXFUNCTION))); + if (function) + have_fmex = true; + } + } + else + ::error ("%s is not a valid shared library", + mex_file_name.c_str ()); + } + } + + if (function) + { + install_mex_function (function, have_fmex, fcn_name, mex_file); + + retval = true; + } + else + ::error ("failed to install .mex file function `%s'", fcn_name.c_str ()); + + unwind_protect::run_frame ("octave_dynamic_loader::do_load"); + + return retval; +} + +bool octave_dynamic_loader::do_remove (const std::string& fcn_name, octave_shlib& shl) { bool retval = false; @@ -298,10 +455,17 @@ } bool -octave_dynamic_loader::load (const std::string& fcn_name, - const std::string& file_name) +octave_dynamic_loader::load_oct (const std::string& fcn_name, + const std::string& file_name) { - return (instance_ok ()) ? instance->do_load (fcn_name, file_name) : false; + return (instance_ok ()) ? instance->do_load_oct (fcn_name, file_name) : false; +} + +bool +octave_dynamic_loader::load_mex (const std::string& fcn_name, + const std::string& file_name) +{ + return (instance_ok ()) ? instance->do_load_mex (fcn_name, file_name) : false; } bool @@ -310,9 +474,6 @@ return (instance_ok ()) ? instance->do_remove (fcn_name, shl) : false; } -#define STRINGIFY(s) STRINGIFY1(s) -#define STRINGIFY1(s) #s - std::string octave_dynamic_loader::mangle_name (const std::string& name) {
--- a/src/dynamic-ld.h +++ b/src/dynamic-ld.h @@ -39,8 +39,11 @@ virtual ~octave_dynamic_loader (void) { } - static bool load (const std::string& fcn_name, - const std::string& file_name = std::string ()); + static bool load_oct (const std::string& fcn_name, + const std::string& file_name = std::string ()); + + static bool load_mex (const std::string& fcn_name, + const std::string& file_name = std::string ()); static bool remove (const std::string& fcn_name, octave_shlib& shl); @@ -56,8 +59,11 @@ static bool instance_ok (void); - bool do_load (const std::string& fcn_name, - const std::string& file_name = std::string ()); + bool do_load_oct (const std::string& fcn_name, + const std::string& file_name = std::string ()); + + bool do_load_mex (const std::string& fcn_name, + const std::string& file_name = std::string ()); bool do_remove (const std::string& fcn_name, octave_shlib& shl);
--- a/src/load-path.cc +++ b/src/load-path.cc @@ -146,7 +146,7 @@ { std::string ext = fname.substr (pos); - if (ext == ".m" || ext == ".oct") + if (ext == ".m" || ext == ".oct" || ext == ".mex") { std::string base = fname.substr (0, pos); @@ -203,6 +203,8 @@ t = load_path::M_FILE; else if (ext == ".oct") t = load_path::OCT_FILE; + else if (ext == ".mex") + t = load_path::MEX_FILE; private_function_map[base] |= t; } @@ -630,6 +632,14 @@ break; } } + else if (type == load_path::MEX_FILE) + { + if ((type & t) == load_path::MEX_FILE) + { + retval += ".mex"; + break; + } + } else if (type == (load_path::M_FILE | load_path::OCT_FILE)) { if (t & load_path::OCT_FILE) @@ -643,6 +653,51 @@ break; } } + else if (type == (load_path::M_FILE | load_path::MEX_FILE)) + { + if (t & load_path::MEX_FILE) + { + retval += ".mex"; + break; + } + else if (t & load_path::M_FILE) + { + retval += ".m"; + break; + } + } + else if (type == (load_path::OCT_FILE | load_path::MEX_FILE)) + { + if (t & load_path::OCT_FILE) + { + retval += ".oct"; + break; + } + else if (t & load_path::MEX_FILE) + { + retval += ".mex"; + break; + } + } + else if (type == (load_path::M_FILE | load_path::OCT_FILE + | load_path::MEX_FILE)) + { + if (t & load_path::OCT_FILE) + { + retval += ".oct"; + break; + } + else if (t & load_path::MEX_FILE) + { + retval += ".mex"; + break; + } + else if (t & load_path::M_FILE) + { + retval += ".m"; + break; + } + } else error ("load_path::do_find_fcn: %s: invalid type code = %d", fcn.c_str (), type); @@ -928,6 +983,14 @@ printed_type = true; } + if (types & load_path::MEX_FILE) + { + if (printed_type) + os << "|"; + os << "mex"; + printed_type = true; + } + if (types & load_path::M_FILE) { if (printed_type) @@ -968,6 +1031,14 @@ printed_type = true; } + if (p->types & load_path::MEX_FILE) + { + if (printed_type) + os << "|"; + os << "mex"; + printed_type = true; + } + if (p->types & load_path::M_FILE) { if (printed_type) @@ -1026,6 +1097,8 @@ t = load_path::M_FILE; else if (ext == ".oct") t = load_path::OCT_FILE; + else if (ext == ".mex") + t = load_path::MEX_FILE; if (p == file_info_list.end ()) {
--- a/src/load-path.h +++ b/src/load-path.h @@ -104,6 +104,12 @@ instance->do_find_fcn (fcn, OCT_FILE) : std::string (); } + static std::string find_mex_file (const std::string& fcn) + { + return instance_ok () ? + instance->do_find_fcn (fcn, MEX_FILE) : std::string (); + } + static std::string find_file (const std::string& file) { return instance_ok () @@ -170,6 +176,7 @@ static const int M_FILE = 1; static const int OCT_FILE = 2; + static const int MEX_FILE = 4; class dir_info { @@ -302,7 +309,7 @@ void do_update (void) const; std::string do_find_fcn (const std::string& fcn, - int type = M_FILE | OCT_FILE) const; + int type = M_FILE | OCT_FILE | MEX_FILE) const; std::string do_find_file (const std::string& file) const;
new file mode 100644 --- /dev/null +++ b/src/mex.cc @@ -0,0 +1,1307 @@ +/* + +Copyright (C) 2001, 2006 Paul Kienzle + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +02110-1301, USA. + +*/ + +// This code was originally distributed as part of Octave Forge under +// the follwoing terms: +// +// Author: Paul Kienzle +// I grant this code to the public domain. +// 2001-03-22 +// +// THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' +// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +// TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A +// PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR +// CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +// SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +// LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF +// USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +// ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +// OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT +// OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +// SUCH DAMAGE. + +#include <cfloat> +#include <csetjmp> +#include <cstdlib> + +#include <iomanip> +#include <set> +#include <string> + +typedef void *Pix; +typedef std::set<Pix> MemSet; + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include "oct.h" +#include "pager.h" +#include "f77-fcn.h" +#include "unwind-prot.h" +#include "lo-mappers.h" +#include "lo-ieee.h" +#include "parse.h" +#include "toplev.h" +#include "variables.h" +#include "oct-map.h" +#include "str-vec.h" + +// mex file context +// +// Class mex keeps track of all memory allocated and frees anything +// not explicitly marked persistent when the it is destroyed. It also +// maintains the setjump/longjump buffer required for non-local exit +// from the mex file, and any other state local to this instance of +// the mex function invocation. +class mxArray; + +// Prototypes for external funcitons. Must declare mxArray as a class +// before including this file. +#include "mexproto.h" + +class mex +{ +public: + + mex (void) { } + + ~mex (void) + { + if (! memlist.empty ()) + error("mex: no cleanup performed"); + } + + // free all unmarked pointers obtained from malloc and calloc + static void cleanup (void *context); + + // allocate a pointer, and mark it to be freed on exit + Pix malloc (int n); + + // allocate a pointer to be freed on exit, and initialize to 0 + Pix calloc (int n, int t); + + // reallocate a pointer obtained from malloc or calloc + Pix realloc (Pix ptr, int n); + + // free a pointer obtained from malloc or calloc + void free (Pix ptr); + + // mark a pointer so that it will not be freed on exit + void persistent (Pix ptr) { unmark (ptr); } + + // make a new array value and initialize it with zeros; it will be + // freed on exit unless marked as persistent + mxArray *make_value (int nr, int nc, int cmplx); + + // make a new array value and initialize from an octave value; it will be + // freed on exit unless marked as persistent + mxArray *make_value (const octave_value&); + + // make a new structure value and initialize with empty matrices + // FIXME does this leak memory? Is it persistent? + mxArray *make_value (int nr, int nc, const string_vector& keys); + + // free an array and its contents + void free_value (mxArray *ptr); + + // mark an array and its contents so it will not be freed on exit + void persistent (mxArray *ptr); + + // 1 if error should be returned to MEX file, 0 if abort + int trap_feval_error; + + // longjmp return point if mexErrMsgTxt or error + jmp_buf jump; + + // trigger a long jump back to the mex calling function + void abort (void) { longjmp (jump, 1); } + +private: + + // list of memory resources that need to be freed upon exit + MemSet memlist; + + // mark a pointer to be freed on exit + void mark (Pix p); + + // unmark a pointer to be freed on exit, either because it was + // made persistent, or because it was already freed + void unmark (Pix p); +}; + +// Current context +mex *__mex = 0; + +// free all unmarked pointers obtained from malloc and calloc +void +mex::cleanup (Pix ptr) +{ + mex *context = static_cast<mex *> (ptr); + + for (MemSet::iterator p = context->memlist.begin (); + p != context->memlist.end (); p++) + ::free (*p); + + context->memlist.clear (); +} + +// mark a pointer to be freed on exit +void +mex::mark (Pix p) +{ +#ifdef DEBUG + if (memlist.find (p) != memlist.end ()) + warning ("%s: double registration ignored", mexFunctionName ()); +#endif + + memlist.insert (p); +} + +// unmark a pointer to be freed on exit, either because it was +// made persistent, or because it was already freed +void +mex::unmark (Pix p) +{ +#ifdef DEBUG + if (memlist.find (p) != memlist.end ()) + warning ("%s: value not marked", mexFunctionName ()); +#endif + + memlist.erase (p); +} + +// allocate a pointer, and mark it to be freed on exit +Pix +mex::malloc (int n) +{ + if (n == 0) + return 0; +#if 0 + // FIXME -- how do you allocate and free aligned, non-typed + // memory in C++? + Pix ptr = Pix (new double[(n+sizeof(double)-1)/sizeof(double)]); +#else + // FIXME -- can we mix C++ and C-style heap management? + Pix ptr = ::malloc (n); + + if (! ptr) + { + // FIXME -- could use "octave_new_handler();" instead + error ("%s: out of memory", mexFunctionName ()); + abort (); + } +#endif + + mark (ptr); + + return ptr; +} + +// allocate a pointer to be freed on exit, and initialize to 0 +Pix +mex::calloc (int n, int t) +{ + Pix v = malloc (n*t); + + memset (v, 0, n*t); + + return v; +} + +// reallocate a pointer obtained from malloc or calloc +Pix +mex::realloc (Pix ptr, int n) +{ +#if 0 + error ("%s: cannot reallocate using C++ new/delete operations", + mexFunctionName ()); + abort (); +#else + Pix v = 0; + if (n == 0) + free (ptr); + else if (! ptr) + v = malloc (n); + else + { + v = ::realloc (ptr, n); + MemSet::iterator p = memlist.find (ptr); + if (v && p != memlist.end ()) + { + memlist.erase (p); + memlist.insert (v); + } + } +#endif + return v; +} + +// free a pointer obtained from malloc or calloc +void +mex::free (Pix ptr) +{ + unmark (ptr); +#if 0 + delete [] ptr; +#else + ::free (ptr); +#endif +} + +// mxArray data type +// +// Class mxArray is not much more than a struct for keeping together +// dimensions and data. It doesn't even ensure consistency between +// the dimensions and the data. Unfortunately you can't do better +// than this without restricting the operations available in Matlab +// for directly manipulating its mxArray type. + +typedef unsigned short mxChar; +const int mxMAXNAM=64; + +class mxArray +{ +public: + + mxArray(void) + { + nr = nc = -1; + pr = pi = NULL; + keys = NULL; + pmap = NULL; + isstr = false; + aname[0] = '\0'; + } + + ~mxArray (void) + { + if (pmap) + { + // FIXME why don't string_vectors work? + for (int i = 0; i < pmap->length (); i++) + delete [] keys[i]; + + delete [] keys; + } + } + + octave_value as_octave_value (void) const; + + int rows (void) const { return nr; } + int columns (void) const { return nc; } + void rows (int r) { nr = r; } + void columns (int c) { nc = c; } + int dims (void) const { return 2; } + + double *imag (void) const { return pi; } + double *real (void) const { return pr; } + void imag (double *p) { pi = p; } + void real (double *p) { pr = p; } + + bool is_empty (void) const { return nr==0 || nc==0; } + bool is_numeric (void) const { return ! isstr && (pr || nr == 0 || nc == 0); } + bool is_complex (void) const { return pi; } + bool is_sparse (void) const { return false; } + bool is_struct (void) const { return pmap; } + + bool is_string (void) const { return isstr; } + void is_string (bool set) { isstr = set; } + + const char *name (void) const { return aname; } + void name (const char *nm) + { + strncpy (aname, nm, mxMAXNAM); + aname[mxMAXNAM]='\0'; + } + + // Structure support functions. Matlab uses a fixed field order + // (the order in which the fields were added?), but Octave uses an + // unordered hash for structs. We can emulate a fixed field order + // using pmap->keys(), which returns a string_vector of key names, + // but these keys will not be in the same order as the keys given in + // mxCreateStruct*. Within the creating function, we can populate + // the key name vector in the order given, so the only problem will + // be those functions which assume the key order is maintained + // between calls from Matlab. Unfortunately, these might exist and + // I can't detect them :-( + + // Return the map value + Octave_map *map (void) const { return pmap; } + + // New structure with the given presumed field order (CreateStruct call) + void map (Octave_map *p, const string_vector& mapkeys) + { + pmap = p; + keys = mapkeys.c_str_vec (); + } + + // New structure with unknown field order (passed in from Octave) + void map (Octave_map *p) + { + pmap = p; + if (p) + keys = p->keys().c_str_vec (); + } + + // Get field given field name + mxArray *field (const std::string& key_arg, const int index) const + { + if (pmap && pmap->contains (key_arg)) + return __mex->make_value (pmap->contents(key_arg)(index)); + else + return 0; + } + + // Set field given field name + void field (const std::string& key_arg, const int index, mxArray *value) + { + if (pmap) + pmap->assign (octave_value (index+1), + key_arg, Cell (value->as_octave_value ())); + + if (error_state) + __mex->abort (); + } + + // Return number of fields in structure + int num_keys(void) const { return pmap ? pmap->length () : 0; } + + // Return field name from field number + const std::string key (const int key_num) const + { + if (key_num >= 0 && key_num < pmap->length ()) + return keys[key_num]; + else + return 0; + } + // Return field number from field name + int key (const std::string &key_name) const + { + for (int i = 0; i < pmap->length (); i++) + if (key_name == std::string (keys[i])) + return i; + + return -1; + } + + // Get field using field number + mxArray *field (const int key_num, const int index) const + { + if (key_num >= 0 && key_num < pmap->length ()) + return field (keys[key_num], index); + else + return 0; + } + + // Set field using field number + void field (const int key_num, const int index , mxArray *value) + { + if (key_num >= 0 && key_num < pmap->length ()) + field (keys[key_num], index, value); + } + +private: + int nr; + int nc; + double *pr; + double *pi; + // FIXME -- need to have a typeid here instead of complex logic on + // isstr, pmap, pr, pi, etc. + Octave_map *pmap; + // string_vector keys; + char **keys; + bool isstr; + char aname[mxMAXNAM+1]; +}; + +octave_value +mxArray::as_octave_value (void) const +{ + octave_value ret; + + if (isstr) + { + charMatrix chm (nr, nc); + char *pchm = chm.fortran_vec (); + for (int i=0; i < nr*nc; i++) + pchm[i] = NINT (pr[i]); + ret = octave_value (chm, true); + } + else if (pmap) + { + ret = octave_value (*pmap); + } + else if (pi) + { + ComplexMatrix cm (nr, nc); + Complex *pcm = cm.fortran_vec (); + for (int i=0; i < nr*nc; i++) + pcm[i] = Complex (pr[i], pi[i]); + ret = cm; + } + else if (pr) + { + Matrix m (nr, nc); + double *pm = m.fortran_vec (); + memcpy (pm, pr, nr*nc*sizeof(double)); + ret = m; + } + else + ret = Matrix (0, 0); + + return ret; +} + + +// mex/mxArray interface + +// Make a new array value and initialize from an octave value; it will +// be freed on exit unless marked as persistent. + +mxArray *mex::make_value(const octave_value &ov) +{ + int nr = -1; + int nc = -1; + double *pr = 0; + double *pi = 0; + Octave_map *pmap = 0; + + if (ov.is_numeric_type () || ov.is_string ()) + { + nr = ov.rows (); + nc = ov.columns (); + } + if (ov.is_map ()) + { + pmap = new Octave_map (ov.map_value ()); + nr = ov.rows (); + nc = ov.columns (); + } + else if (nr > 0 && nc > 0) + { + if (ov.is_string ()) + { + // FIXME - must use 16 bit unicode to represent strings. + const Matrix m (ov.matrix_value (1)); + pr = static_cast<double *> (malloc(nr*nc*sizeof(double))); + memcpy (pr, m.data (), nr*nc*sizeof(double)); + } + else if (ov.is_complex_type ()) + { + // FIXME -- may want to consider lazy copying of the + // matrix, but this will only help if the matrix is being + // passed on to octave via callMATLAB later. + const ComplexMatrix cm (ov.complex_matrix_value ()); + const Complex *pz = cm.data (); + pr = static_cast<double *> (malloc (nr*nc*sizeof(double))); + pi = static_cast<double *> (malloc (nr*nc*sizeof(double))); + for (int i = 0; i < nr*nc; i++) + { + pr[i] = real (pz[i]); + pi[i] = imag (pz[i]); + } + } + else + { + const Matrix m (ov.matrix_value ()); + pr = static_cast<double *> (malloc (nr*nc*sizeof(double))); + memcpy (pr, m.data (), nr*nc*sizeof(double)); + } + } + + mxArray *value = static_cast<mxArray *> (malloc (sizeof(mxArray))); + + value->is_string (ov.is_string ()); + value->real (pr); + value->imag (pi); + value->map (pmap); + value->rows (nr); + value->columns (nc); + value->name (""); + + return value; +} + +// Make a new array value and initialize it with zeros; it will be +// freed on exit unless marked as persistent. + +mxArray * +mex::make_value (int nr, int nc, int cmplx) +{ + + mxArray *value = static_cast<mxArray *> (malloc (sizeof(mxArray))); + double *p = static_cast<double *> (calloc (nr*nc, sizeof(double))); + + value->real (p); + if (cmplx) + value->imag (static_cast<double *> (calloc (nr*nc, sizeof(double)))); + else + value->imag (static_cast<double *> (Pix (0))); + value->rows (nr); + value->columns (nc); + value->is_string (false); + value->map (0); + value->name (""); + + return value; +} + +// Make a new structure value and initialize with empty matrices +// FIXME does this leak memory? Is it persistent? + +mxArray * +mex::make_value (int nr, int nc, const string_vector& keys) +{ + if (keys.length () == 0) + return 0; + + Cell empty (nr, nc); + Octave_map *pmap = new Octave_map (keys[0], empty); + for (int i=1; i < keys.length (); i++) + pmap->assign (keys[i], empty); + + mxArray *value = static_cast<mxArray *> (malloc (sizeof(mxArray))); + + value->rows (nr); + value->columns (nc); + value->map (pmap, keys); + + return value; +} + +// free an array and its contents + +void +mex::free_value (mxArray *ptr) +{ + free (ptr->real ()); + free (ptr->imag ()); + free (ptr); +} + +// mark an array and its contents so it will not be freed on exit + +void +mex::persistent (mxArray *ptr) +{ + persistent (Pix (ptr->real ())); + persistent (Pix (ptr->imag ())); + persistent (Pix (ptr)); +} + + +// Octave interface to mex files + +#if 0 +// Don't bother trapping stop/exit +// To trap for STOP in fortran code, this needs to be registered with atexit +static void mex_exit() +{ + if (__mex) + { + error ("%s: program aborted", mexFunctionName ()); + __mex->abort (); + } +} +#endif + +typedef void (*cmex_fptr) (int nlhs, mxArray **plhs, int nrhs, mxArray **prhs); +typedef F77_RET_T (*fmex_fptr) (int& nlhs, mxArray **plhs, int& nrhs, mxArray **prhs); + +enum callstyle { use_fortran, use_C }; + +octave_value_list +call_mex (callstyle cs, void *f, const octave_value_list& args, int nargout) +{ +#if 0 + // Don't bother trapping stop/exit + // FIXME -- should really push "mex_exit" onto the octave + // atexit stack before we start and pop it when we are through, but + // the stack handle isn't exported from toplev.cc, so we can't. mex_exit + // would have to be declared as DEFUN(mex_exit,,,"") of course. + static bool unregistered = true; + if (unregistered) + { + atexit (mex_exit); + unregistered = false; + } +#endif + + // Use nargout+1 since even for zero specified args, still want to + // be able to return an ans. + + int nargin = args.length (); + OCTAVE_LOCAL_BUFFER(mxArray*, argin, nargin); + for (int i = 0; i < nargin; i++) + argin[i] = 0; + + int nout = nargout == 0 ? 1 : nargout; + OCTAVE_LOCAL_BUFFER(mxArray*, argout, nout); + for (int i = 0; i < nout; i++) + argout[i] = 0; + + mex context; + unwind_protect::add (mex::cleanup, Pix (&context)); + + for (int i = 0; i < nargin; i++) + argin[i] = context.make_value (args(i)); + + // Save old mex pointer. + unwind_protect_ptr (__mex); + + if (setjmp (context.jump) == 0) + { + __mex = &context; + + if (cs == use_fortran) + { + fmex_fptr fcn = FCN_PTR_CAST (fmex_fptr, f); + + int tmp_nargout = nargout; + int tmp_nargin = nargin; + + fcn (tmp_nargout, argout, tmp_nargin, argin); + } + else + { + cmex_fptr fcn = FCN_PTR_CAST (cmex_fptr, f); + + fcn (nargout, argout, nargin, argin); + } + } + + // Restore old mex pointer. + unwind_protect::run (); + + // Convert returned array entries back into octave values. + + octave_value_list retval; + + if (! error_state) + { + if (nargout == 0 && argout[0]) + retval(0) = argout[0]->as_octave_value (); + else + { + retval.resize (nargout); + + for (int i = 0; i < nargout; i++) + if (argout[i]) + retval(i) = argout[i]->as_octave_value (); + } + } + + // Clean up mex resources. + unwind_protect::run (); + + return retval; +} + +octave_value_list +Fortran_mex (void *f, const octave_value_list& args, int nargout) +{ + return call_mex (use_fortran, f, args, nargout); +} + +octave_value_list +C_mex (void *f, const octave_value_list& args, int nargout) +{ + return call_mex (use_C, f, args, nargout); +} + +// C interface to mex functions: + +extern "C" { + +const char * +mexFunctionName (void) +{ + static char *retval = 0; + + delete [] retval; + + octave_function *fcn = octave_call_stack::current (); + + if (fcn) + { + std::string nm = fcn->name (); + retval = strsave (nm.c_str ()); + } + else + retval = strsave ("unknown"); + + return retval; +} + +void +mexErrMsgTxt (const char *s) +{ + if (s && strlen (s) > 0) + error("%s: %s", mexFunctionName (), s); + else + // Just set the error state; don't print msg. + error (""); + + __mex->abort(); +} + +void mexWarnMsgTxt (const char *s) { warning("%s", s); } + +void +mexPrintf (const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + octave_vformat (octave_stdout, fmt, args); + va_end (args); +} + +// Floating point representation. + +int mxIsNaN (const double v) { return lo_ieee_isnan (v) != 0; } +int mxIsFinite (const double v) { return lo_ieee_finite (v) != 0; } +int mxIsInf (const double v) { return lo_ieee_isinf (v) != 0; } + +double mxGetEps (void) { return DBL_EPSILON; } +double mxGetInf (void) { return lo_ieee_inf_value (); } +double mxGetNaN (void) { return lo_ieee_nan_value (); } + +int +mexEvalString (const char *s) +{ + int parse_status; + octave_value_list ret; + ret = eval_string (s, false, parse_status, 0); + if (parse_status || error_state) + { + error_state = 0; + return 1; + } + else + return 0; +} + +int +mexCallMATLAB (int nargout, mxArray *argout[], + int nargin, mxArray *argin[], + const char *fname) +{ + octave_value_list args; + + // FIXME -- do we need unwind protect to clean up args? Off hand, I + // would say that this problem is endemic to Octave and we will + // continue to have memory leaks after Ctrl-C until proper exception + // handling is implemented. longjmp() only clears the stack, so any + // class which allocates data on the heap is going to leak. + + args.resize (nargin); + + for (int i = 0; i < nargin; i++) + args(i) = argin[i]->as_octave_value (); + + octave_value_list retval = feval (fname, args, nargout); + + if (error_state && __mex->trap_feval_error == 0) + { + // FIXME -- is this the correct way to clean up? abort() is + // going to trigger a long jump, so the normal class destructors + // will not be called. Hopefully this will reduce things to a + // tiny leak. Maybe create a new octave memory tracer type + // which prints a friendly message every time it is + // created/copied/deleted to check this. + + args.resize (0); + retval.resize (0); + __mex->abort (); + } + + int num_to_copy = retval.length (); + + if (nargout < retval.length ()) + num_to_copy = nargout; + + for (int i = 0; i < num_to_copy; i++) + { + // FIXME -- it would be nice to avoid copying the value here, + // but there is no way to steal memory from a matrix, never mind + // that matrix memory is allocated by new[] and mxArray memory + // is allocated by malloc(). + argout[i] = __mex->make_value (retval (i)); + } + + while (num_to_copy < nargout) + argout[num_to_copy++] = 0; + + if (error_state) + { + error_state = 0; + return 1; + } + else + return 0; +} + +void mexSetTrapFlag (int flag) { __mex->trap_feval_error = flag; } + +Pix mxMalloc (int n) { return __mex->malloc(n); } +Pix mxCalloc (int n, int size) { return __mex->calloc (n, size); } +Pix mxRealloc (Pix ptr, int n) { return __mex->realloc (ptr, n); } +void mxFree (Pix ptr) { __mex->free (ptr); } +void mexMakeMemoryPersistent (Pix ptr) { __mex->persistent (ptr); } + +mxArray * +mxCreateDoubleMatrix (int nr, int nc, int iscomplex) +{ + return __mex->make_value(nr, nc, iscomplex); +} + +mxArray * +mxCreateDoubleScalar (double val) +{ + mxArray *ptr = mxCreateDoubleMatrix (1, 1, 0); + *mxGetPr (ptr) = val; + return ptr; +} + +mxArray * +mxCreateLogicalScalar (int val) +{ + mxArray *ptr = mxCreateDoubleMatrix (1, 1, 0); + *mxGetPr (ptr) = val; + return ptr; +} + +void mxDestroyArray (mxArray *v) { __mex->free (v); } + +mxArray * +mxDuplicateArray (const mxArray *ptr) +{ + return __mex->make_value (ptr->as_octave_value ()); +} + +void mexMakeArrayPersistent (mxArray *ptr) { __mex->persistent (ptr); } + +int mxIsChar (const mxArray *ptr) { return ptr->is_string (); } +int mxIsSparse (const mxArray *ptr) { return ptr->is_sparse (); } +int mxIsFull(const mxArray *ptr) { return !ptr->is_sparse (); } +int mxIsNumeric (const mxArray *ptr) { return ptr->is_numeric (); } +int mxIsComplex (const mxArray *ptr) { return ptr->is_complex (); } +int mxIsDouble (const mxArray *) { return true; } +int mxIsEmpty (const mxArray *ptr) { return ptr->is_empty (); } + +int +mxIsLogicalScalar (const mxArray *ptr) +{ + return (ptr->is_numeric () + && ptr->rows () == 1 && ptr->columns () == 1 + && *ptr->real ()); +} + +double *mxGetPr (const mxArray *ptr) { return ptr->real (); } +double *mxGetPi (const mxArray *ptr) { return ptr->imag (); } +int mxGetM (const mxArray *ptr) { return ptr->rows (); } +int mxGetN (const mxArray *ptr) { return ptr->columns (); } +int mxGetNumberOfDimensions (const mxArray *ptr) { return ptr->dims (); } +int mxGetNumberOfElements (const mxArray *ptr) { return ptr->rows () * ptr->columns (); } +void mxSetM (mxArray *ptr, int M) { ptr->rows (M); } +void mxSetN (mxArray *ptr, int N) { ptr->columns (N); } +void mxSetPr (mxArray *ptr, double *pr) { ptr->real (pr); } +void mxSetPi (mxArray *ptr, double *pi) { ptr->imag (pi); } + +double +mxGetScalar (const mxArray *ptr) +{ + double *pr = ptr->real (); + if (! pr) + mexErrMsgTxt ("calling mxGetScalar on an empty matrix"); + return pr[0]; +} + +int +mxGetString (const mxArray *ptr, char *buf, int buflen) +{ + if (ptr->is_string ()) + { + int nr = ptr->rows (); + int nc = ptr->columns (); + int n = nr*nc < buflen ? nr*nc : buflen; + const double *pr = ptr->real (); + for (int i = 0; i < n; i++) + buf[i] = NINT (pr[i]); + if (n < buflen) + buf[n] = '\0'; + return n >= buflen; + } + else + return 1; +} + +char * +mxArrayToString (const mxArray *ptr) +{ + int nr = ptr->rows (); + int nc = ptr->columns (); + int n = nr*nc*sizeof(mxChar)+1; + char *buf = static_cast<char *> (mxMalloc (n)); + if (buf) + mxGetString (ptr, buf, n); + + return buf; +} + +mxArray * +mxCreateString (const char *str) +{ + int n = strlen (str); + mxArray *m = __mex->make_value (1, n, 0); + if (! m) + return m; + m->is_string (true); + + double *pr = m->real (); + for (int i = 0; i < n; i++) + pr[i] = str[i]; + + return m; +} + +mxArray * +mxCreateCharMatrixFromStrings (int n, const char **str) +{ + // Find length of the individual strings. + Array<int> len (n); + + for (int i = 0; i < n; i++) + len(i) = strlen (str[i]); + + // Find maximum length. + int maxlen = 0; + for (int i = 0; i < n; i++) + if (len(i) > maxlen) + maxlen = len(i); + + // Need a place to copy them. + mxArray *m = __mex->make_value (n, maxlen, 0); + if (! m) + return m; + m->is_string (true); + + // Do the copy (being sure not to exceed the length of any of the + // strings). + double *pr = m->real (); + for (int j = 0; j < maxlen; j++) + for (int i = 0; i < n; i++) + if (j < len(i)) + *pr++ = str[i][j]; + else + *pr++ = '\0'; + + return m; +} + +int +mexPutVariable (const char *space, const char *name, mxArray *ptr) +{ + if (! ptr) + return 1; + + if (! name) + return 1; + + if (name[0] == '\0') + name = ptr->name (); + + if (! name || name[0] == '\0') + return 1; + + if (! strcmp (space, "global")) + set_global_value (name, ptr->as_octave_value ()); + else if (! strcmp (space, "caller")) + { + // FIXME -- this belongs in variables.cc. + symbol_record *sr = curr_sym_tab->lookup (name, true); + if (sr) + sr->define (ptr->as_octave_value ()); + else + panic_impossible (); + } + else if (! strcmp (space, "base")) + mexErrMsgTxt ("mexPutVariable: 'base' symbol table not implemented"); + else + mexErrMsgTxt ("mexPutVariable: symbol table does not exist"); + return 0; +} + +mxArray * +mexGetArray (const char *name, const char *space) +{ + mxArray *retval = 0; + + // FIXME -- this should be in variable.cc, but the correct + // functionality is not exported. Particularly, get_global_value() + // generates an error if the symbol is undefined. + + symbol_record *sr = 0; + + if (! strcmp (space, "global")) + sr = global_sym_tab->lookup (name); + else if (! strcmp (space, "caller")) + sr = curr_sym_tab->lookup (name); + else if (! strcmp (space, "base")) + mexErrMsgTxt ("mexGetArray: 'base' symbol table not implemented"); + else + mexErrMsgTxt ("mexGetArray: symbol table does not exist"); + + if (sr) + { + octave_value sr_def = sr->def (); + + if (sr_def.is_defined ()) + { + retval = __mex->make_value (sr_def); + retval->name (name); + } + } + + return retval; +} + +mxArray * +mexGetArrayPtr (const char *name, const char *space) +{ + return mexGetArray (name, space); +} + +const char *mxGetName (const mxArray *ptr) { return ptr->name (); } + +void mxSetName (mxArray *ptr, const char*nm) { ptr->name (nm); } + +mxArray * +mxCreateStructMatrix (int nr, int nc, int num_keys, const char **keys) +{ + const string_vector ordered_keys (keys, num_keys); + mxArray *m = __mex->make_value (nr, nc, ordered_keys); + return m; +} + +mxArray * +mxGetField (const mxArray *ptr, int index, const char *key) +{ + return ptr->field (key, index); +} + +void +mxSetField (mxArray *ptr, int index, const char *key, mxArray *val) +{ + ptr->field (key, index, val); +} + +int mxGetNumberOfFields (const mxArray *ptr) { return ptr->num_keys (); } +int mxIsStruct (const mxArray *ptr) { return ptr->is_struct (); } + +const char * +mxGetFieldNameByNumber (const mxArray *ptr, int key_num) +{ + return ptr->key(key_num).c_str (); +} + +int +mxGetFieldNumber (const mxArray *ptr, const char *key) +{ + return ptr->key (key); +} +mxArray * +mxGetFieldByNumber (const mxArray *ptr, int index, int key_num) +{ + return ptr->field (key_num, index); +} +void +mxSetFieldByNumber (mxArray *ptr, int index, int key_num, mxArray *val) +{ + return ptr->field (key_num,index,val); +} + +} // extern "C" + +// Fortran interface to mex functions +// +// Where possible, these call the equivalent C function since that API +// is fixed. It costs and extra function call, but is easier to +// maintain. + +extern "C" { + +void F77_FUNC (mexerrmsgtxt, MEXERRMSGTXT) (const char *s, long slen) +{ + if (slen > 1 || (slen == 1 && s[0] != ' ') ) + error ("%s: %.*s", mexFunctionName (), slen, s); + else + // Just set the error state; don't print msg. + error (""); + + __mex->abort(); +} + +void F77_FUNC (mexprintf, MEXPRINTF) (const char *s, long slen) +{ + mexPrintf ("%.*s\n", slen, s); +} + +double F77_FUNC (mexgeteps, MEXGETEPS) (void) { return mxGetEps (); } +double F77_FUNC (mexgetinf, MEXGETINF) (void) { return mxGetInf (); } +double F77_FUNC (mexgetnan, MEXGETNAN) (void) { return mxGetNaN (); } +int F77_FUNC (mexisfinite, MEXISFINITE) (double v) { return mxIsFinite (v); } +int F77_FUNC (mexisinf, MEXISINF) (double v) { return mxIsInf (v); } +int F77_FUNC (mexisnan, MEXISNAN) (double v) { return mxIsNaN (v); } + +// Array access: + +Pix F77_FUNC (mxcreatefull, MXCREATEFULL) + (const int& nr, const int& nc, const int& iscomplex) +{ + return mxCreateDoubleMatrix (nr, nc, iscomplex); +} + +void F77_FUNC (mxfreematrix, MXFREEMATRIX) (mxArray* &p) +{ + mxDestroyArray (p); +} + +Pix F77_FUNC (mxcalloc, MXCALLOC) (const int& n, const int& size) +{ + return mxCalloc (n, size); +} + +void F77_FUNC (mxfree, MXFREE) (const Pix &p) { mxFree (p); } + +int F77_FUNC (mxgetm, MXGETM) (const mxArray* &p) { return mxGetM (p); } +int F77_FUNC (mxgetn, MXGETN) (const mxArray* &p) { return mxGetN (p); } + +Pix F77_FUNC (mxgetpi, MXGETPI) (const mxArray* &p) { return mxGetPi (p); } +Pix F77_FUNC (mxgetpr, MXGETPR) (const mxArray* &p) { return mxGetPr (p); } + +void F77_FUNC (mxsetm, MXSETM) (mxArray* &p, const int& m) { mxSetM (p, m); } +void F77_FUNC (mxsetn, MXSETN) (mxArray* &p, const int& n) { mxSetN (p, n); } + +void F77_FUNC (mxsetpi, MXSETPI) (mxArray* &p, double *pi) { mxSetPi (p, pi); } +void F77_FUNC (mxsetpr, MXSETPR) (mxArray* &p, double *pr) { mxSetPr (p, pr); } + +int F77_FUNC (mxiscomplex, MXISCOMPLEX) (const mxArray* &p) +{ + return mxIsComplex (p); +} + +int F77_FUNC (mxisdouble, MXISDOUBLE) (const mxArray* &p) +{ + return mxIsDouble (p); +} + +int F77_FUNC (mxisnumeric, MXISNUMERIC) (const mxArray* &p) +{ + return mxIsNumeric(p); +} + +int F77_FUNC (mxisfull, MXISFULL) (const mxArray* &p) +{ + return 1 - mxIsSparse (p); +} + +int F77_FUNC (mxissparse, MXISSPARSE) (const mxArray* &p) +{ + return mxIsSparse (p); +} + +int F77_FUNC (mxisstring, MXISSTRING) (const mxArray* &p) +{ + return mxIsChar (p); +} + +int F77_FUNC (mxgetstring, MXGETSTRING) + (const mxArray* &ptr, char *str, const int& len) +{ + return mxGetString (ptr, str, len); +} + +int F77_FUNC (mexcallmatlab, MEXCALLMATLAB) + (const int& nargout, mxArray **argout, + const int& nargin, mxArray **argin, + const char *fname, + long fnamelen) +{ + char str[mxMAXNAM+1]; + strncpy (str, fname, (fnamelen < mxMAXNAM ? fnamelen : mxMAXNAM)); + str[fnamelen] = '\0'; + return mexCallMATLAB (nargout, argout, nargin, argin, str); +} + +// Fake pointer support: + +void F77_FUNC (mxcopyreal8toptr, MXCOPYREAL8TOPTR) + (const double *d, const int& prref, const int& len) +{ + double *pr = (double *) prref; + for (int i = 0; i < len; i++) + pr[i] = d[i]; +} + +void F77_FUNC (mxcopyptrtoreal8, MXCOPYPTRTOREAL8) + (const int& prref, double *d, const int& len) +{ + double *pr = (double *) prref; + for (int i = 0; i < len; i++) + d[i] = pr[i]; +} + +void F77_FUNC (mxcopycomplex16toptr, MXCOPYCOMPLEX16TOPTR) + (const double *d, int& prref, int& piref, const int& len) +{ + double *pr = (double *) prref; + double *pi = (double *) piref; + for (int i = 0; i < len; i++) + { + pr[i] = d[2*i]; + pi[i] = d[2*i+1]; + } +} + +void F77_FUNC (mxcopyptrtocomplex16, MXCOPYPTRTOCOMPLEX16) + (const int& prref, const int& piref, double *d, const int& len) +{ + double *pr = (double *) prref; + double *pi = (double *) piref; + for (int i = 0; i < len; i++) + { + d[2*i] = pr[i]; + d[2*i+1] = pi[i]; + } +} + +} // extern "C" + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/mex.h @@ -0,0 +1,117 @@ +/* + +Copyright (C) 2001, 2006 Paul Kienzle + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +02110-1301, USA. + +*/ + +/* + +This code was originally distributed as part of Octave Forge under +the follwoing terms: + +Author: Paul Kienzle +I grant this code to the public domain. +2001-03-22 + +THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. + +*/ + +/* mex.h is for use in C-programs only; do NOT include it in mex.cc */ + +#if ! defined (MEX_H) +#define MEX_H + +#define HAVE_OCTAVE + +typedef void mxArray; +typedef unsigned short mxChar; +enum mxComplexity { mxREAL = 0, mxCOMPLEX = 1 }; + +#if ! defined (__cplusplus) +typedef int bool; +#endif + +typedef int mxLOGICAL; + +/* -V4 stuff */ +#if defined (V4) +#define Matrix mxArray +#define REAL mxREAL +#endif + +#define mxMAXNAME 64 + +#if defined (__cplusplus) +extern "C" { +#endif + +#if defined (V4) +void mexFunction (int nlhs, mxArray* plhs[], int nrhs, mxArray* prhs[]); +#else +void mexFunction (int nlhs, mxArray* plhs[], int nrhs, const mxArray* prhs[]); +#endif + +#include "mexproto.h" + +/* V4 floating point routines renamed in V5. */ +#define mexIsNaN mxIsNaN +#define mexIsFinite mxIsFinite +#define mexIsInf mxIsInf +#define mexGetEps mxGetEps +#define mexGetInf mxGetInf +#define mexGetNaN mxGetNan + +#define mexGetGlobal(nm) mexGetArray (nm, "global") +#define mexGetMatrix(nm) mexGetArray (nm, "caller") +#define mexGetMatrixPtr(nm) mexGetArrayPtr (nm, "caller") + +#define mexPutMatrix(ptr) mexPutVariable ("caller", "", ptr) +#define mexPutArray(ptr, space) mexPutVariable (space, "", ptr) + +#define mxCreateFull mxCreateDoubleMatrix + +#define mxCreateScalarDouble mxCreateDoubleScalar + +#define mxFreeMatrix mxDestroyArray + +#define mxIsString mxIsChar + +#if defined (__cplusplus) +} +#endif + +#endif + +/* +;;; Local Variables: *** +;;; mode: C *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/mexproto.h @@ -0,0 +1,152 @@ +/* + +Copyright (C) 2006 Paul Kienzle + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +02110-1301, USA. + +*/ + +/* + +This code was originally distributed as part of Octave Forge under +the follwoing terms: + +Author: Paul Kienzle +I grant this code to the public domain. +2001-03-22 + +THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. + +*/ + +/* mex.h is for use in C-programs only; do NOT include it in mex.cc */ + +#if ! defined (MEXPROTO_H) +#define MEXPROTO_H + +#if defined (__cplusplus) +extern "C" { +#endif + +/* Floating point representation. */ +extern int mxIsNaN (double v); +extern int mxIsFinite (double v); +extern int mxIsInf (double v); +extern double mxGetEps (void); +extern double mxGetInf (void); +extern double mxGetNaN (void); + +/* Interface to the interpreter */ +extern const char *mexFunctionName (void); + +extern int mexCallMATLAB (int nargout, mxArray *argout[], int nargin, + mxArray *argin[], const char *fname); + +extern void mexSetTrapFlag (int flag); +extern int mexEvalString (const char *s); +extern void mexErrMsgTxt (const char *s); +extern void mexWarnMsgTxt (const char *s); +extern void mexPrintf (const char *fmt, ...); + +extern mxArray *mexGetArray (const char *name, const char *space); +extern mxArray *mexGetArrayPtr (const char *name, const char *space); + +extern int mexPutVariable (const char *space, const char *name, mxArray *ptr); + +/* Memory. */ +extern void *mxMalloc (int n); +extern void *mxCalloc (int n, int size); +extern void mxFree (void *ptr); +extern void mexMakeArrayPersistent (mxArray *ptr); +extern void mexMakeMemoryPersistent (void *ptr); + +/* Interpreter values. */ +extern mxArray *mxCreateDoubleMatrix (int nr, int nc, int iscomplex); +extern mxArray *mxCreateDoubleScalar (double val); +extern mxArray *mxCreateLogicalScalar (int val); + +extern void mxDestroyArray (mxArray *v); + +extern mxArray *mxDuplicateArray (const mxArray *v); + +extern int mxIsChar (const mxArray *ptr); + +extern int mxIsSparse (const mxArray *ptr); +extern int mxIsStruct (const mxArray *ptr); +extern int mxIsFull (const mxArray *ptr); +extern int mxIsDouble (const mxArray *ptr); +extern int mxIsNumeric (const mxArray *ptr); +extern int mxIsComplex (const mxArray *ptr); +extern int mxIsEmpty (const mxArray *ptr); +extern int mxIsLogicalScalar (const mxArray *ptr); +extern int mxGetM (const mxArray *ptr); +extern int mxGetN (const mxArray *ptr); +extern int mxGetNumberOfDimensions (const mxArray *ptr); +extern int mxGetNumberOfElements (const mxArray *ptr); +extern double *mxGetPr (const mxArray *ptr); + +/* Structure support. */ +extern int mxIsStruct (const mxArray *ptr); +extern mxArray *mxGetField (const mxArray *ptr, int index, const char *key); +extern void mxSetField (mxArray *ptr, int index, const char *key, mxArray *val); +extern int mxGetNumberOfFields (const mxArray *ptr); +extern const char *mxGetFieldNameByNumber (const mxArray *ptr, int key_num); +extern int mxGetFieldNumber (const mxArray *ptr, const char *key); +extern mxArray *mxGetFieldByNumber (const mxArray *ptr, int index, int key_num); +extern void mxSetFieldByNumber (mxArray *ptr, int index, int key_num, + mxArray *val); +extern mxArray *mxCreateStructMatrix (int rows, int cols, int num_keys, + const char **keys); +#if 0 +extern mxArray *mxCreateStructArray (int num_dims, const int *dims, + int numkeys, const char **keys); +#endif + +extern double *mxGetPi (const mxArray *ptr); +extern void mxSetM (mxArray *ptr, int M); +extern void mxSetN (mxArray *ptr, int N); +extern void mxSetPr (mxArray *ptr, double *pr); +extern void mxSetPi (mxArray *ptr, double *pi); + +extern int mxGetString (const mxArray *ptr, char *buf, int buflen); +extern char *mxArrayToString (const mxArray *ptr); +extern mxArray *mxCreateString (const char *str); + +extern double mxGetScalar (const mxArray *ptr); + +#if defined (__cplusplus) +} +#endif + +#endif + +/* +;;; Local Variables: *** +;;; mode: C *** +;;; End: *** +*/
--- a/src/ov-base.h +++ b/src/ov-base.h @@ -264,6 +264,8 @@ virtual bool is_dld_function (void) const { return false; } + virtual bool is_mex_function (void) const { return false; } + virtual short int short_value (bool = false, bool = false) const; virtual unsigned short int ushort_value (bool = false, bool = false) const;
--- a/src/ov-builtin.cc +++ b/src/ov-builtin.cc @@ -38,20 +38,6 @@ "built-in function", "built-in function"); -// Are any of the arguments `:'? - -static bool -any_arg_is_magic_colon (const octave_value_list& args) -{ - int nargin = args.length (); - - for (int i = 0; i < nargin; i++) - if (args(i).is_magic_colon ()) - return true; - - return false; -} - octave_value_list octave_builtin::subsref (const std::string& type, const std::list<octave_value_list>& idx, @@ -105,7 +91,7 @@ if (error_state) return retval; - if (any_arg_is_magic_colon (args)) + if (args.has_magic_colon ()) ::error ("invalid use of colon in function argument list"); else {
--- a/src/ov-fcn.h +++ b/src/ov-fcn.h @@ -90,7 +90,8 @@ protected: - octave_function (const std::string& nm, const std::string& ds) + octave_function (const std::string& nm, + const std::string& ds = std::string ()) : my_name (nm), doc (ds) { } // The name of this function.
new file mode 100644 --- /dev/null +++ b/src/ov-mex-fcn.cc @@ -0,0 +1,159 @@ +/* + +Copyright (C) 1996, 1997 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +02110-1301, USA. + +*/ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include "oct-shlib.h" + +#include <defaults.h> +#include "dynamic-ld.h" +#include "error.h" +#include "oct-obj.h" +#include "ov-mex-fcn.h" +#include "ov.h" +#include "toplev.h" +#include "unwind-prot.h" + +DEFINE_OCTAVE_ALLOCATOR (octave_mex_function); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_mex_function, + "mex function", "mex function"); + +octave_mex_function::octave_mex_function + (void *fptr, bool fmex, const octave_shlib& shl, + const std::string& nm) + : octave_function (nm), mex_fcn_ptr (fptr), have_fmex (fmex), sh_lib (shl) +{ + mark_fcn_file_up_to_date (time_parsed ()); + + std::string file_name = fcn_file_name (); + + system_fcn_file + = (! file_name.empty () + && Voct_file_dir == file_name.substr (0, Voct_file_dir.length ())); +} + +octave_mex_function::~octave_mex_function (void) +{ + octave_dynamic_loader::remove (my_name, sh_lib); +} + +std::string +octave_mex_function::fcn_file_name (void) const +{ + return sh_lib.file_name (); +} + +octave_time +octave_mex_function::time_parsed (void) const +{ + return sh_lib.time_loaded (); +} + +octave_value_list +octave_mex_function::subsref (const std::string& type, + const std::list<octave_value_list>& idx, + int nargout) +{ + octave_value_list retval; + + switch (type[0]) + { + case '(': + { + int tmp_nargout = (type.length () > 1 && nargout == 0) ? 1 : nargout; + + retval = do_multi_index_op (tmp_nargout, idx.front ()); + } + break; + + case '{': + case '.': + { + std::string nm = type_name (); + error ("%s cannot be indexed with %c", nm.c_str (), type[0]); + } + break; + + default: + panic_impossible (); + } + + // FIXME -- perhaps there should be an + // octave_value_list::next_subsref member function? See also + // octave_user_function::subsref. + // + // FIXME -- Note that if a function call returns multiple + // values, and there is further indexing to perform, then we are + // ignoring all but the first value. Is this really what we want to + // do? If it is not, then what should happen for stat("file").size, + // for exmaple? + + if (idx.size () > 1) + retval = retval(0).next_subsref (nargout, type, idx); + + return retval; +} + +extern octave_value_list +C_mex (void *f, const octave_value_list& args, int nargout); + +extern octave_value_list +Fortran_mex (void *f, const octave_value_list& args, int nargout); + +octave_value_list +octave_mex_function::do_multi_index_op (int nargout, + const octave_value_list& args) +{ + octave_value_list retval; + + if (error_state) + return retval; + + if (args.has_magic_colon ()) + ::error ("invalid use of colon in function argument list"); + else + { + unwind_protect::begin_frame ("mex_func_eval"); + + octave_call_stack::push (this); + + unwind_protect::add (octave_call_stack::unwind_pop, 0); + + retval = have_fmex + ? Fortran_mex (mex_fcn_ptr, args, nargout) + : C_mex (mex_fcn_ptr, args, nargout); + + unwind_protect::run_frame ("mex_func_eval"); + } + + return retval; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ov-mex-fcn.h @@ -0,0 +1,118 @@ +/* + +Copyright (C) 1996, 1997 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +02110-1301, USA. + +*/ + +#if !defined (octave_mex_function_h) +#define octave_mex_function_h 1 + +#include <string> + +#include "oct-shlib.h" + +#include "ov-fcn.h" +#include "ov-builtin.h" +#include "ov-typeinfo.h" + +class octave_shlib; + +class octave_value; +class octave_value_list; + +// Dynamically-linked functions. + +class +octave_mex_function : public octave_function +{ +public: + + octave_mex_function (void) { } + + octave_mex_function (void *fptr, bool fmex, const octave_shlib& shl, + const std::string& nm = std::string ()); + + ~octave_mex_function (void); + + octave_value subsref (const std::string&, + const std::list<octave_value_list>&) + { + panic_impossible (); + return octave_value (); + } + + octave_value_list subsref (const std::string& type, + const std::list<octave_value_list>& idx, + int nargout); + + octave_function *function_value (bool = false) { return this; } + + void mark_fcn_file_up_to_date (const octave_time& t) { t_checked = t; } + + std::string fcn_file_name (void) const; + + octave_time time_parsed (void) const; + + octave_time time_checked (void) const { return t_checked; } + + bool is_system_fcn_file (void) const { return system_fcn_file; } + + bool is_builtin_function (void) const { return false; } + + bool is_mex_function (void) const { return true; } + + octave_value_list + do_multi_index_op (int nargout, const octave_value_list& args); + +private: + + void *mex_fcn_ptr; + + bool have_fmex; + + octave_shlib sh_lib; + + // The time the file was last checked to see if it needs to be + // parsed again. + mutable octave_time t_checked; + + // True if this function came from a file that is considered to be a + // system function. This affects whether we check the time stamp + // on the file to see if it has changed. + bool system_fcn_file; + + // No copying! + + octave_mex_function (const octave_mex_function& fn); + + octave_mex_function& operator = (const octave_mex_function& fn); + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
--- a/src/ov.h +++ b/src/ov.h @@ -498,6 +498,9 @@ bool is_dld_function (void) const { return rep->is_dld_function (); } + bool is_mex_function (void) const + { return rep->is_mex_function (); } + // Values. octave_value eval (void) { return *this; }
--- a/src/parse.y +++ b/src/parse.y @@ -3389,6 +3389,7 @@ if (octave_env::absolute_pathname (nm) && ((nm_len > 4 && nm.substr (nm_len-4) == ".oct") + || (nm_len > 4 && nm.substr (nm_len-4) == ".mex") || (nm_len > 2 && nm.substr (nm_len-4) == ".m"))) { file = nm; @@ -3413,7 +3414,12 @@ if (len > 4 && file.substr (len-4, len-1) == ".oct") { - if (octave_dynamic_loader::load (nm, file)) + if (octave_dynamic_loader::load_oct (nm, file)) + force_link_to_function (nm); + } + else if (len > 4 && file.substr (len-4, len-1) == ".mex") + { + if (octave_dynamic_loader::load_mex (nm, file)) force_link_to_function (nm); } else if (len > 2)
--- a/src/pt-id.cc +++ b/src/pt-id.cc @@ -99,8 +99,8 @@ // * If the identifier is still undefined, try looking for an // function file to parse. // -// * On systems that support dynamic linking, we prefer .oct files -// over .m files. +// * On systems that support dynamic linking, we prefer .oct files, +// then .mex files, then .m files. octave_value tree_identifier::do_lookup (bool& script_file_executed, bool exec_script)
--- a/src/symtab.cc +++ b/src/symtab.cc @@ -87,6 +87,8 @@ retval = "built-in function"; else if (is_dld_function ()) retval = "dynamically-linked function"; + else if (is_mex_function ()) + retval = "dynamically-linked mex function"; return retval; } @@ -148,7 +150,7 @@ { std::string retval; - if (is_user_function () || is_dld_function ()) + if (is_user_function () || is_dld_function () || is_mex_function ()) { octave_function *defn = definition.function_value (); @@ -166,7 +168,7 @@ { os << name; - if (is_user_function () || is_dld_function ()) + if (is_user_function () || is_dld_function () || is_mex_function ()) { octave_function *defn = definition.function_value (); @@ -827,7 +829,9 @@ while (ptr) { - if (ptr->is_user_function () || ptr->is_dld_function ()) + if (ptr->is_user_function () + || ptr->is_dld_function () + || ptr->is_mex_function ()) ptr->clear (); ptr = ptr->next (); @@ -927,7 +931,9 @@ while (ptr) { if (ptr->name () == nm - && (ptr->is_user_function () || ptr->is_dld_function ())) + && (ptr->is_user_function () + || ptr->is_dld_function () + || ptr->is_mex_function ())) { ptr->clear (); return true; @@ -1011,7 +1017,9 @@ while (ptr) { - if (ptr->is_user_function () || ptr->is_dld_function ()) + if (ptr->is_user_function () + || ptr->is_dld_function () + || ptr->is_mex_function ()) { glob_match pattern (pat);
--- a/src/symtab.h +++ b/src/symtab.h @@ -74,7 +74,8 @@ BUILTIN_FUNCTION = 8, COMMAND = 16, RAWCOMMAND = 32, - MAPPER_FUNCTION = 64 + MAPPER_FUNCTION = 64, + MEX_FUNCTION = 128, }; private: @@ -103,6 +104,7 @@ { return (symbol_type & symbol_record::USER_FUNCTION || symbol_type & symbol_record::DLD_FUNCTION + || symbol_type & symbol_record::MEX_FUNCTION || symbol_type & symbol_record::BUILTIN_FUNCTION); } @@ -141,6 +143,9 @@ bool is_dld_function (void) const { return (symbol_type & symbol_record::DLD_FUNCTION); } + bool is_mex_function (void) const + { return (symbol_type & symbol_record::MEX_FUNCTION); } + // FIXME bool is_map_element (const std::string& /* elts */) const { return false; } @@ -317,6 +322,9 @@ bool is_dld_function (void) const { return definition->is_dld_function (); } + bool is_mex_function (void) const + { return definition->is_mex_function (); } + bool is_variable (void) const { return definition->is_variable (); } @@ -485,7 +493,8 @@ | symbol_record::BUILTIN_FUNCTION \ | symbol_record::COMMAND \ | symbol_record::RAWCOMMAND \ - | symbol_record::MAPPER_FUNCTION) + | symbol_record::MAPPER_FUNCTION \ + | symbol_record::MEX_FUNCTION) #define SYMTAB_VARIABLES (symbol_record::USER_VARIABLE) @@ -555,7 +564,7 @@ { return name_list (string_vector (), false, - symbol_record::USER_FUNCTION|symbol_record::DLD_FUNCTION, + symbol_record::USER_FUNCTION|symbol_record::DLD_FUNCTION|symbol_record::MEX_FUNCTION, SYMTAB_ALL_SCOPES); }
--- a/src/utils.cc +++ b/src/utils.cc @@ -433,7 +433,7 @@ return retval; } -// See if there is an octave file in the path. If so, return the +// See if there is a .oct file in the path. If so, return the // full path to the file. std::string @@ -462,6 +462,35 @@ return retval; } +// See if there is a .mex file in the path. If so, return the +// full path to the file. + +std::string +mex_file_in_path (const std::string& name) +{ + std::string retval; + + int len = name.length (); + + if (len > 0) + { + if (octave_env::absolute_pathname (name)) + { + file_stat fs (name); + + if (fs.exists ()) + retval = name; + } + else if (len > 4 && name [len - 4] == '.' && name [len - 3] == 'm' + && name [len - 2] == 'e' && name [len - 1] == 'x') + retval = load_path::find_mex_file (name.substr (0, len-4)); + else + retval = load_path::find_mex_file (name); + } + + return retval; +} + // Replace backslash escapes in a string with the real values. std::string
--- a/src/utils.h +++ b/src/utils.h @@ -58,6 +58,7 @@ extern std::string file_in_path (const std::string&, const std::string&); extern std::string fcn_file_in_path (const std::string&); extern std::string oct_file_in_path (const std::string&); +extern std::string mex_file_in_path (const std::string&); extern std::string do_string_escapes (const std::string& s);
--- a/src/variables.cc +++ b/src/variables.cc @@ -821,7 +821,8 @@ { if (type == "any" || type == "file") { - if (len > 4 && file_name.substr (len-4) == ".oct") + if (len > 4 && (file_name.substr (len-4) == ".oct" + || file_name.substr (len-4) == ".mex")) retval = 3; else retval = 2; @@ -886,8 +887,8 @@ @deftypefn {Built-in Function} {} exist (@var{name}, @var{type})\n\ Return 1 if the name exists as a variable, 2 if the name (after\n\ appending @samp{.m}) is a function file in Octave's @code{path}, 3 if the\n\ -name is a @samp{.oct} file in Octave's @code{path}, 5 if the name is a\n\ -built-in function, 7 if the name is a directory, or 103\n\ +name is a @samp{.oct} or @samp{.mex} file in Octave's @code{path},\n\ +5 if the name is a built-in function, 7 if the name is a directory, or 103\n\ if the name is a function not associated with a file (entered on\n\ the command line).\n\ \n\ @@ -1014,7 +1015,8 @@ std::string file; if (octave_env::absolute_pathname (nm) - && ((nm_len > 4 && nm.substr (nm_len-4) == ".oct") + && ((nm_len > 4 && (nm.substr (nm_len-4) == ".oct" + || nm.substr (nm_len-4) == ".mex")) || (nm_len > 2 && nm.substr (nm_len-4) == ".m"))) { file = nm; @@ -1605,6 +1607,7 @@ Array<symbol_record *> s5 (dv); Array<symbol_record *> s6 (dv); Array<symbol_record *> s7 (dv); + Array<symbol_record *> s8 (dv); if (show_builtins) { @@ -1619,14 +1622,17 @@ s5 = fbi_sym_tab->symbol_list (pats, symbol_record::USER_FUNCTION, SYMTAB_ALL_SCOPES); + + s6 = fbi_sym_tab->symbol_list (pats, symbol_record::MEX_FUNCTION, + SYMTAB_ALL_SCOPES); } if (show_variables) { - s6 = curr_sym_tab->symbol_list (pats, symbol_record::USER_VARIABLE, + s7 = curr_sym_tab->symbol_list (pats, symbol_record::USER_VARIABLE, SYMTAB_LOCAL_SCOPE); - s7 = curr_sym_tab->symbol_list (pats, symbol_record::USER_VARIABLE, + s8 = curr_sym_tab->symbol_list (pats, symbol_record::USER_VARIABLE, SYMTAB_GLOBAL_SCOPE); } @@ -1635,8 +1641,10 @@ octave_idx_type s5_len = s5.length (); octave_idx_type s6_len = s6.length (); octave_idx_type s7_len = s7.length (); - - octave_idx_type symbols_len = s3_len + s4_len + s5_len + s6_len + s7_len; + octave_idx_type s8_len = s8.length (); + + octave_idx_type symbols_len + = s3_len + s4_len + s5_len + s6_len + s7_len + s8_len; Array<symbol_record *> symbols (dim_vector (symbols_len, 1)); @@ -1651,6 +1659,8 @@ symbols.insert (s6, k, 0); k += s6_len; symbols.insert (s7, k, 0); + k += s7_len; + symbols.insert (s8, k, 0); symbols.qsort (symbol_record_name_compare); @@ -1740,6 +1750,11 @@ ("*** currently compiled functions:", pats, octave_stdout, show_verbose, symbol_record::USER_FUNCTION, SYMTAB_ALL_SCOPES); + + pad_after += fbi_sym_tab->maybe_list + ("*** mex functions:", pats, + octave_stdout, show_verbose, symbol_record::MEX_FUNCTION, + SYMTAB_ALL_SCOPES); } if (show_variables)