Logo Search packages:      
Sourcecode: octave3.1 version File versions

ov-fcn-handle.cc

/*

Copyright (C) 2003, 2004, 2005, 2006, 2007 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 3 of the License, 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, see
<http://www.gnu.org/licenses/>.

*/

#ifdef HAVE_CONFIG_H
#include <config.h>
#endif

#include <iostream>
#include <sstream>
#include <vector>

#include "file-ops.h"
#include "oct-locbuf.h"

#include "defun.h"
#include "error.h"
#include "gripes.h"
#include "input.h"
#include "oct-map.h"
#include "ov-base.h"
#include "ov-fcn-handle.h"
#include "ov-usr-fcn.h"
#include "pr-output.h"
#include "pt-pr-code.h"
#include "pt-misc.h"
#include "pt-stmt.h"
#include "pt-cmd.h"
#include "pt-exp.h"
#include "pt-assign.h"
#include "variables.h"
#include "parse.h"
#include "unwind-prot.h"
#include "defaults.h"
#include "file-stat.h"
#include "load-path.h"
#include "oct-env.h"

#include "byte-swap.h"
#include "ls-oct-ascii.h"
#include "ls-oct-binary.h"
#include "ls-hdf5.h"
#include "ls-utils.h"

DEFINE_OCTAVE_ALLOCATOR (octave_fcn_handle);

DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_fcn_handle,
                             "function handle",
                             "function_handle");

octave_fcn_handle::octave_fcn_handle (const octave_value& f,
                              const std::string& n)
  : warn_reload (true), fcn (f), nm (n)
{
  octave_user_function *uf = fcn.user_function_value (true);

  if (uf)
    symbol_table::cache_name (uf->scope (), nm);
}

octave_value_list
octave_fcn_handle::subsref (const std::string& type,
                      const std::list<octave_value_list>& idx,
                      int nargout)
{
  octave_value_list retval;

  switch (type[0])
    {
    case '(':
      {
      out_of_date_check (fcn);

      if (fcn.is_defined ())
        {
          octave_function *f = function_value ();

          if (f)
            retval = f->subsref (type, idx, nargout);
          else
            error ("invalid function handle");
        }
      else
        error ("invalid function handle");
      }
      break;

    case '{':
    case '.':
      {
      std::string typ_nm = type_name ();
      error ("%s cannot be indexed with %c", typ_nm.c_str (), type[0]);
      }
      break;

    default:
      panic_impossible ();
    }

  // There's no need to call next_subsref here --
  // octave_function::subsref will handle that for us.

  return retval;
}

bool
octave_fcn_handle::set_fcn (const std::string &octaveroot, 
                      const std::string& fpath)
{
  bool success = true;

  if (octaveroot.length () != 0
      && fpath.length () >= octaveroot.length ()
      && fpath.substr (0, octaveroot.length ()) == octaveroot
      && OCTAVE_EXEC_PREFIX != octaveroot)
    {
      // First check if just replacing matlabroot is enough
      std::string str = OCTAVE_EXEC_PREFIX + 
      fpath.substr (octaveroot.length ());                
      file_stat fs (str);

      if (fs.exists ())
      {
        size_t xpos = str.find_last_of (file_ops::dir_sep_chars ());

        std::string dir_name = str.substr (0, xpos);

        octave_function *xfcn
          = load_fcn_from_file (str, dir_name, "", nm);

        if (xfcn)
          {
            octave_value tmp (xfcn);

            fcn = octave_value (new octave_fcn_handle (tmp, nm));
          }
        else
          {
            error ("function handle points to non-existent function");
            success = false;
          }
      }
      else
      {
        // Next just search for it anywhere in the system path
        string_vector names(3);
        names(0) = nm + ".oct";
        names(1) = nm + ".mex";
        names(2) = nm + ".m";

        dir_path p (load_path::system_path ());

        str = octave_env::make_absolute 
          (p.find_first_of (names), octave_env::getcwd ());

        size_t xpos = str.find_last_of (file_ops::dir_sep_chars ());

        std::string dir_name = str.substr (0, xpos);

        octave_function *xfcn = load_fcn_from_file (str, dir_name, "", nm);

        if (xfcn)
          {
            octave_value tmp (xfcn);

            fcn = octave_value (new octave_fcn_handle (tmp, nm));
          }
        else
          {
            error ("function handle points to non-existent function");
            success = false;
          }
      }
    }
  else
    {
      if (fpath.length () > 0)
      {
        size_t xpos = fpath.find_last_of (file_ops::dir_sep_chars ());

        std::string dir_name = fpath.substr (0, xpos);

        octave_function *xfcn = load_fcn_from_file (fpath, dir_name, "", nm);

        if (xfcn)
          {
            octave_value tmp (xfcn);

            fcn = octave_value (new octave_fcn_handle (tmp, nm));
          }
        else
          {
            error ("function handle points to non-existent function");
            success = false;
          }
      }
      else
      {
        fcn = symbol_table::find_function (nm);

        if (! fcn.is_function ())
          {
            error ("function handle points to non-existent function");
            success = false;
          }
      }
    }

  return success;
}

bool
octave_fcn_handle::save_ascii (std::ostream& os)
{
  if (nm == "@<anonymous>")
    {
      os << nm << "\n";

      print_raw (os, true);
      os << "\n";

      if (fcn.is_undefined ())
      return false;

      octave_user_function *f = fcn.user_function_value ();

      std::list<symbol_table::symbol_record> vars
      = symbol_table::all_variables (f->scope (), 0);

      size_t varlen = vars.size ();

      if (varlen > 0)
      {
        os << "# length: " << varlen << "\n";

        for (std::list<symbol_table::symbol_record>::const_iterator p = vars.begin ();
             p != vars.end (); p++)
          {
            if (! save_ascii_data (os, p->varval (), p->name (), false, 0))
            return os;
          }
      }
    }
  else
    {
      octave_function *f = function_value ();
      std::string fnm = f ? f->fcn_file_name () : std::string ();

      os << "# octaveroot: " << OCTAVE_EXEC_PREFIX << "\n";
      if (! fnm.empty ())
      os << "# path: " << fnm << "\n";
      os << nm << "\n";
    }

  return true;
}

bool
octave_fcn_handle::load_ascii (std::istream& is)
{
  bool success = true;

  std::streampos pos = is.tellg ();
  std::string octaveroot = extract_keyword (is, "octaveroot", true);
  if (octaveroot.length() == 0)
    {
      is.seekg (pos);
      is.clear ();
    }
  pos = is.tellg ();
  std::string fpath = extract_keyword (is, "path", true);
  if (fpath.length() == 0)
    {
      is.seekg (pos);
      is.clear ();
    }

  is >> nm;

  if (nm == "@<anonymous>")
    {
      octave_idx_type len = 0;
      char c;
      std::ostringstream buf;

      // Skip preceeding newline(s).
      while (is.get (c) && c == '\n')
      /* do nothing */;

      if (is)
      {
        buf << c;

        // Get a line of text whitespace characters included, leaving
        // newline in the stream.

        while (is.peek () != '\n')
          {
            is.get (c);
            if (! is)
            break;
            buf << c;
          }
      }

      pos = is.tellg ();

      symbol_table::scope_id local_scope = symbol_table::alloc_scope ();

      if (extract_keyword (is, "length", len, true) && len >= 0)
      {
        if (len > 0)
          {
            for (octave_idx_type i = 0; i < len; i++)
            {
              octave_value t2;
              bool dummy;

              std::string name
                = read_ascii_data (is, std::string (), dummy, t2, i);

              if (!is)
                {
                  error ("load: failed to load anonymous function handle");
                  break;
                }

              symbol_table::varref (name, local_scope, 0) = t2;
            }
          }
      }
      else
      {
        is.seekg (pos);
        is.clear ();
      }

      if (is && success)
      {
        unwind_protect::begin_frame ("anon_ascii_load");

        symbol_table::push_scope (local_scope);

        unwind_protect::add (symbol_table::pop_scope);

        int parse_status;
        octave_value anon_fcn_handle = 
          eval_string (buf.str (), true, parse_status);

        if (parse_status == 0)
          {
            octave_fcn_handle *fh = 
            anon_fcn_handle.fcn_handle_value ();

            if (fh)
            {
              fcn = fh->fcn;

              octave_user_function *uf = fcn.user_function_value (true);

              if (uf)
                symbol_table::cache_name (uf->scope (), nm);
            }
            else
            success = false;
          }
        else
          success = false;

        unwind_protect::run_frame ("anon_ascii_load");
      }
      else
      success = false;

      symbol_table::erase_scope (local_scope);
    }
  else
    success = set_fcn (octaveroot, fpath);

  return success;
}

bool
octave_fcn_handle::save_binary (std::ostream& os, bool& save_as_floats)
{
  if (nm == "@<anonymous>")
    {
      std::ostringstream nmbuf;

      if (fcn.is_undefined ())
      return false;

      octave_user_function *f = fcn.user_function_value ();

      std::list<symbol_table::symbol_record> vars
      = symbol_table::all_variables (f->scope (), 0);

      size_t varlen = vars.size ();

      if (varlen > 0)
      nmbuf << nm << " " << varlen;
      else
      nmbuf << nm;

      std::string buf_str = nmbuf.str();
      int32_t tmp = buf_str.length ();
      os.write (reinterpret_cast<char *> (&tmp), 4);
      os.write (buf_str.c_str (), buf_str.length ());

      std::ostringstream buf;
      print_raw (buf, true);
      std::string stmp = buf.str ();
      tmp = stmp.length ();
      os.write (reinterpret_cast<char *> (&tmp), 4);
      os.write (stmp.c_str (), stmp.length ());

      if (varlen > 0)
      {
        for (std::list<symbol_table::symbol_record>::const_iterator p = vars.begin ();
             p != vars.end (); p++)
          {
            if (! save_binary_data (os, p->varval (), p->name (),
                              "", 0, save_as_floats))
            return os;
          }
      }
    }
  else
    {
      std::ostringstream nmbuf;

      octave_function *f = function_value ();
      std::string fnm = f ? f->fcn_file_name () : std::string ();

      nmbuf << nm << "\n" << OCTAVE_EXEC_PREFIX << "\n" << fnm;

      std::string buf_str = nmbuf.str ();
      int32_t tmp = buf_str.length ();
      os.write (reinterpret_cast<char *> (&tmp), 4);
      os.write (buf_str.c_str (), buf_str.length ());
    }

  return true;
}

bool
octave_fcn_handle::load_binary (std::istream& is, bool swap,
                        oct_mach_info::float_format fmt)
{
  bool success = true;

  int32_t tmp;
  if (! is.read (reinterpret_cast<char *> (&tmp), 4))
    return false;
  if (swap)
    swap_bytes<4> (&tmp);

  OCTAVE_LOCAL_BUFFER (char, ctmp1, tmp+1);
  is.get (ctmp1, tmp+1, 0);
  nm = std::string (ctmp1);

  if (! is)
    return false;

  if (nm.length() >= 12 && nm.substr (0, 12) == "@<anonymous>")
    {
      octave_idx_type len = 0;

      if (nm.length() > 12)
      {
        std::istringstream nm_is (nm.substr(12));
        nm_is >> len;
        nm = nm.substr(0,12);
      }

      if (! is.read (reinterpret_cast<char *> (&tmp), 4))
      return false;
      if (swap)
      swap_bytes<4> (&tmp);

      OCTAVE_LOCAL_BUFFER (char, ctmp2, tmp+1);
      is.get (ctmp2, tmp+1, 0);

      symbol_table::scope_id local_scope = symbol_table::alloc_scope ();
            
      if (len > 0)
      {
        for (octave_idx_type i = 0; i < len; i++)
          {
            octave_value t2;
            bool dummy;
            std::string doc;

            std::string name = 
            read_binary_data (is, swap, fmt, std::string (), 
                          dummy, t2, doc);

            if (!is)
            {
              error ("load: failed to load anonymous function handle");
              break;
            }

            symbol_table::varref (name, local_scope) = t2;
          }
      }

      if (is && success)
      {
        unwind_protect::begin_frame ("anon_binary_load");

        symbol_table::push_scope (local_scope);

        unwind_protect::add (symbol_table::pop_scope);

        int parse_status;
        octave_value anon_fcn_handle = 
          eval_string (ctmp2, true, parse_status);

        if (parse_status == 0)
          {
            octave_fcn_handle *fh = anon_fcn_handle.fcn_handle_value ();

            if (fh)
            {
              fcn = fh->fcn;

              octave_user_function *uf = fcn.user_function_value (true);

              if (uf)
                symbol_table::cache_name (uf->scope (), nm);
            }
            else
            success = false;
          }
        else
          success = false;

        unwind_protect::run_frame ("anon_binary_load");
      }

      symbol_table::erase_scope (local_scope);
    }
  else
    {
      std::string octaveroot;
      std::string fpath;

      if (nm.find_first_of ("\n") != std::string::npos)
      {
        size_t pos1 = nm.find_first_of ("\n");
        size_t pos2 = nm.find_first_of ("\n", pos1 + 1);
        octaveroot = nm.substr (pos1 + 1, pos2 - pos1 - 1);
        fpath = nm.substr (pos2 + 1);
        nm = nm.substr (0, pos1);
      }

      success = set_fcn (octaveroot, fpath);
     }
 
 return success;
}

#if defined (HAVE_HDF5)
bool
octave_fcn_handle::save_hdf5 (hid_t loc_id, const char *name,
                        bool save_as_floats)
{
  bool retval = true;

  hid_t group_hid = -1;
  group_hid = H5Gcreate (loc_id, name, 0);
  if (group_hid < 0)
    return false;

  hid_t space_hid = -1, data_hid = -1, type_hid = -1;;

  // attach the type of the variable
  type_hid = H5Tcopy (H5T_C_S1);
  H5Tset_size (type_hid, nm.length () + 1);
  if (type_hid < 0)
    {
      H5Gclose (group_hid);
      return false;
    }

  OCTAVE_LOCAL_BUFFER (hsize_t, hdims, 2);
  hdims[0] = 0;
  hdims[1] = 0;
  space_hid = H5Screate_simple (0 , hdims, 0);
  if (space_hid < 0)
    {
      H5Tclose (type_hid);
      H5Gclose (group_hid);
      return false;
    }

  data_hid = H5Dcreate (group_hid, "nm",  type_hid, space_hid, H5P_DEFAULT);
  if (data_hid < 0 || H5Dwrite (data_hid, type_hid, H5S_ALL, H5S_ALL,
                        H5P_DEFAULT, nm.c_str ()) < 0)
    {
      H5Sclose (space_hid);
      H5Tclose (type_hid);
      H5Gclose (group_hid);
      return false;
    }
  H5Dclose (data_hid);

  if (nm == "@<anonymous>")
    {
      std::ostringstream buf;
      print_raw (buf, true);
      std::string stmp = buf.str ();

      // attach the type of the variable
      H5Tset_size (type_hid, stmp.length () + 1);
      if (type_hid < 0)
      {
        H5Sclose (space_hid);
        H5Gclose (group_hid);
        return false;
      }

      data_hid = H5Dcreate (group_hid, "fcn",  type_hid, space_hid,
                      H5P_DEFAULT);
      if (data_hid < 0 || H5Dwrite (data_hid, type_hid, H5S_ALL, H5S_ALL,
                            H5P_DEFAULT, stmp.c_str ()) < 0)
      {
        H5Sclose (space_hid);
        H5Tclose (type_hid);
        H5Gclose (group_hid);
        return false;
      }

      H5Dclose (data_hid);

      octave_user_function *f = fcn.user_function_value ();

      std::list<symbol_table::symbol_record> vars
      = symbol_table::all_variables (f->scope (), 0);

      size_t varlen = vars.size ();

      if (varlen > 0)
      {
        hid_t as_id = H5Screate (H5S_SCALAR);

        if (as_id >= 0)
          {
            hid_t a_id = H5Acreate (group_hid, "SYMBOL_TABLE",
                              H5T_NATIVE_IDX, as_id, H5P_DEFAULT);

            if (a_id >= 0)
            {
              retval = (H5Awrite (a_id, H5T_NATIVE_IDX, &varlen) >= 0);

              H5Aclose (a_id);
            }
            else
            retval = false;

            H5Sclose (as_id);
          }
        else
          retval = false;

        data_hid = H5Gcreate (group_hid, "symbol table", 0);
        if (data_hid < 0) 
          {
            H5Sclose (space_hid);
            H5Tclose (type_hid);
            H5Gclose (group_hid);
            return false;
          }

        for (std::list<symbol_table::symbol_record>::const_iterator p = vars.begin ();
             p != vars.end (); p++)
          {
            if (! add_hdf5_data (data_hid, p->varval (), p->name (),
                           "", false, save_as_floats))
            break;
          }
        H5Gclose (data_hid);
      }
    }
  else
    {
      std::string octaveroot = OCTAVE_EXEC_PREFIX;

      octave_function *f = function_value ();
      std::string fpath = f ? f->fcn_file_name () : std::string ();

      H5Sclose (space_hid);
      hdims[0] = 1;
      hdims[1] = octaveroot.length ();
      space_hid = H5Screate_simple (0 , hdims, 0);
      if (space_hid < 0)
      {
        H5Tclose (type_hid);
        H5Gclose (group_hid);
        return false;
      }

      H5Tclose (type_hid);
      type_hid = H5Tcopy (H5T_C_S1);
      H5Tset_size (type_hid, octaveroot.length () + 1);

      hid_t a_id = H5Acreate (group_hid, "OCTAVEROOT",
                        type_hid, space_hid, H5P_DEFAULT);

      if (a_id >= 0)
      {
        retval = (H5Awrite (a_id, type_hid, octaveroot.c_str ()) >= 0);

        H5Aclose (a_id);
      }
      else
      {
        H5Sclose (space_hid);
        H5Tclose (type_hid);
        H5Gclose (group_hid);
        return false;
      }

      H5Sclose (space_hid);
      hdims[0] = 1;
      hdims[1] = fpath.length ();
      space_hid = H5Screate_simple (0 , hdims, 0);
      if (space_hid < 0)
      {
        H5Tclose (type_hid);
        H5Gclose (group_hid);
        return false;
      }

      H5Tclose (type_hid);
      type_hid = H5Tcopy (H5T_C_S1);
      H5Tset_size (type_hid, fpath.length () + 1);

      a_id = H5Acreate (group_hid, "FILE", type_hid, space_hid, H5P_DEFAULT);

      if (a_id >= 0)
      {
        retval = (H5Awrite (a_id, type_hid, fpath.c_str ()) >= 0);

        H5Aclose (a_id);
      }
      else
      retval = false;
    }

  H5Sclose (space_hid);
  H5Tclose (type_hid);
  H5Gclose (group_hid);

  return retval;
}

bool
octave_fcn_handle::load_hdf5 (hid_t loc_id, const char *name,
                        bool have_h5giterate_bug)
{
  bool success = true;

  hid_t group_hid, data_hid, space_hid, type_hid, type_class_hid, st_id;
  hsize_t rank;
  int slen;

  group_hid = H5Gopen (loc_id, name);
  if (group_hid < 0)
    return false;

  data_hid = H5Dopen (group_hid, "nm");

  if (data_hid < 0)
    {
      H5Gclose (group_hid);
      return false;
    }

  type_hid = H5Dget_type (data_hid);
  type_class_hid = H5Tget_class (type_hid);

  if (type_class_hid != H5T_STRING)
    {
      H5Tclose (type_hid);
      H5Dclose (data_hid);
      H5Gclose (group_hid);
      return false;
    }

  space_hid = H5Dget_space (data_hid);
  rank = H5Sget_simple_extent_ndims (space_hid);

  if (rank != 0)
    {
      H5Sclose (space_hid);
      H5Tclose (type_hid);
      H5Dclose (data_hid);
      H5Gclose (group_hid);
      return false;
    }

  slen = H5Tget_size (type_hid);
  if (slen < 0)
    {
      H5Sclose (space_hid);
      H5Tclose (type_hid);
      H5Dclose (data_hid);
      H5Gclose (group_hid);
      return false;
    }

  OCTAVE_LOCAL_BUFFER (char, nm_tmp, slen);

  // create datatype for (null-terminated) string to read into:
  st_id = H5Tcopy (H5T_C_S1);
  H5Tset_size (st_id, slen);

  if (H5Dread (data_hid, st_id, H5S_ALL, H5S_ALL, H5P_DEFAULT, nm_tmp) < 0)
    {
      H5Tclose (st_id);
      H5Sclose (space_hid);
      H5Tclose (type_hid);
      H5Dclose (data_hid);
      H5Gclose (group_hid);
      return false;
    }
  H5Tclose (st_id);
  H5Dclose (data_hid);
  nm = nm_tmp;

  if (nm == "@<anonymous>")
    {
      data_hid = H5Dopen (group_hid, "fcn");

      if (data_hid < 0)
      {
        H5Sclose (space_hid);
        H5Tclose (type_hid);
        H5Gclose (group_hid);
        return false;
      }

      H5Tclose (type_hid);
      type_hid = H5Dget_type (data_hid);
      type_class_hid = H5Tget_class (type_hid);

      if (type_class_hid != H5T_STRING)
      {
        H5Sclose (space_hid);
        H5Tclose (type_hid);
        H5Dclose (data_hid);
        H5Gclose (group_hid);
        return false;
      }

      H5Sclose (space_hid);
      space_hid = H5Dget_space (data_hid);
      rank = H5Sget_simple_extent_ndims (space_hid);

      if (rank != 0)
      {
        H5Sclose (space_hid);
        H5Tclose (type_hid);
        H5Dclose (data_hid);
        H5Gclose (group_hid);
        return false;
      }

      slen = H5Tget_size (type_hid);
      if (slen < 0)
      {
        H5Sclose (space_hid);
        H5Tclose (type_hid);
        H5Dclose (data_hid);
        H5Gclose (group_hid);
        return false;
      }

      OCTAVE_LOCAL_BUFFER (char, fcn_tmp, slen);

      // create datatype for (null-terminated) string to read into:
      st_id = H5Tcopy (H5T_C_S1);
      H5Tset_size (st_id, slen);

      if (H5Dread (data_hid, st_id, H5S_ALL, H5S_ALL, H5P_DEFAULT, fcn_tmp) < 0)
      {
        H5Tclose (st_id);
        H5Sclose (space_hid);
        H5Tclose (type_hid);
        H5Dclose (data_hid);
        H5Gclose (group_hid);
        return false;
      }
      H5Tclose (st_id);
      H5Dclose (data_hid);

      octave_idx_type len = 0;

      // we have to pull some shenanigans here to make sure
      // HDF5 doesn't print out all sorts of error messages if we
      // call H5Aopen for a non-existing attribute

      H5E_auto_t err_func;
      void *err_func_data;

      // turn off error reporting temporarily, but save the error
      // reporting function:
      H5Eget_auto (&err_func, &err_func_data);
      H5Eset_auto (0, 0);

      hid_t attr_id = H5Aopen_name (group_hid, "SYMBOL_TABLE");

      if (attr_id >= 0)
      {
        if (H5Aread (attr_id, H5T_NATIVE_IDX, &len) < 0)
          success = false;

        H5Aclose (attr_id);
      }

      // restore error reporting:
      H5Eset_auto (err_func, err_func_data);

      symbol_table::scope_id local_scope = symbol_table::alloc_scope ();

      if (len > 0 && success)
      {
#ifdef HAVE_H5GGET_NUM_OBJS
        hsize_t num_obj = 0;
        data_hid = H5Gopen (group_hid, "symbol table"); 
        H5Gget_num_objs (data_hid, &num_obj);
        H5Gclose (data_hid);

        if (num_obj != static_cast<hsize_t>(len))
          {
            error ("load: failed to load anonymous function handle");
            success = false;
          }
#endif

        if (! error_state)
          {
            hdf5_callback_data dsub;
            int current_item = 0;
            for (octave_idx_type i = 0; i < len; i++)
            {
              if (H5Giterate (group_hid, "symbol table", &current_item,
                          hdf5_read_next_data, &dsub) <= 0)
                {
                  error ("load: failed to load anonymous function handle");
                  success = false;
                  break;
                }

              if (have_h5giterate_bug)
                current_item++;  // H5Giterate returns last index processed

              symbol_table::varref (dsub.name, local_scope) = dsub.tc;
            }
          }
      }

      if (success)
      {
        unwind_protect::begin_frame ("anon_hdf5_load");

        symbol_table::push_scope (local_scope);

        unwind_protect::add (symbol_table::pop_scope);

        int parse_status;
        octave_value anon_fcn_handle = 
          eval_string (fcn_tmp, true, parse_status);

        if (parse_status == 0)
          {
            octave_fcn_handle *fh = anon_fcn_handle.fcn_handle_value ();

            if (fh)
            {
              fcn = fh->fcn;

              octave_user_function *uf = fcn.user_function_value (true);

              if (uf)
                symbol_table::cache_name (uf->scope (), nm);
            }
            else
            success = false;
          }
        else
          success = false;

        unwind_protect::run_frame ("anon_hdf5_load");
      }

      symbol_table::erase_scope (local_scope);
    }
  else
    {
      std::string octaveroot;
      std::string fpath;

      // we have to pull some shenanigans here to make sure
      // HDF5 doesn't print out all sorts of error messages if we
      // call H5Aopen for a non-existing attribute

      H5E_auto_t err_func;
      void *err_func_data;

      // turn off error reporting temporarily, but save the error
      // reporting function:
      H5Eget_auto (&err_func, &err_func_data);
      H5Eset_auto (0, 0);

      hid_t attr_id = H5Aopen_name (group_hid, "OCTAVEROOT");
      if (attr_id >= 0)
      {
        H5Tclose (type_hid);
        type_hid = H5Aget_type (attr_id);
        type_class_hid = H5Tget_class (type_hid);

        if (type_class_hid != H5T_STRING)
          success = false;
        else
          {
            slen = H5Tget_size (type_hid);
            st_id = H5Tcopy (H5T_C_S1);
            H5Tset_size (st_id, slen);
            OCTAVE_LOCAL_BUFFER (char, root_tmp, slen);

            if (H5Aread (attr_id, st_id, root_tmp) < 0)
            success = false;
            else
            octaveroot = root_tmp;

            H5Tclose (st_id);
          }

        H5Aclose (attr_id);
      }

      if (success)
      {
        attr_id = H5Aopen_name (group_hid, "FILE");
        if (attr_id >= 0)
          {
            H5Tclose (type_hid);
            type_hid = H5Aget_type (attr_id);
            type_class_hid = H5Tget_class (type_hid);

            if (type_class_hid != H5T_STRING)
            success = false;
            else
            {
              slen = H5Tget_size (type_hid);
              st_id = H5Tcopy (H5T_C_S1);
              H5Tset_size (st_id, slen);
              OCTAVE_LOCAL_BUFFER (char, path_tmp, slen);

              if (H5Aread (attr_id, st_id, path_tmp) < 0)
                success = false;
              else
                fpath = path_tmp;

              H5Tclose (st_id);
            }

            H5Aclose (attr_id);
          }
      }

      // restore error reporting:
      H5Eset_auto (err_func, err_func_data);

      success = (success ? set_fcn (octaveroot, fpath) : success);
    }

  H5Tclose (type_hid);
  H5Sclose (space_hid);
  H5Gclose (group_hid);

  return success;
}

#endif

/* 

%!test
%! a = 2;
%! f = @(x) a + x;
%! g = @(x) 2 * x;
%! hm = @flops;
%! hdld = @svd;
%! hbi = @log2;
%! f2 = f;
%! g2 = g;
%! hm2 = hm;
%! hdld2 = hdld;
%! hbi2 = hbi;
%! modes = {"-text", "-binary"};
%! if (!isempty(findstr(octave_config_info ("DEFS"),"HAVE_HDF5")))
%!   modes(end+1) = "-hdf5";
%! endif
%! for i = 1:numel (modes)
%!   mode = modes{i};
%!   nm = tmpnam();
%!   unwind_protect
%!     save (mode, nm, "f2", "g2", "hm2", "hdld2", "hbi2");
%!     clear f2 g2 hm2 hdld2 hbi2
%!     load (nm);
%!     assert (f(2),f2(2));
%!     assert (g(2),g2(2));
%!     assert (g(3),g2(3));
%!     unlink (nm);
%!     save (mode, nm, "f2", "g2", "hm2", "hdld2", "hbi2");
%!   unwind_protect_cleanup
%!     unlink (nm);
%!   end_unwind_protect
%! endfor

*/

void
octave_fcn_handle::print (std::ostream& os, bool pr_as_read_syntax) const
{
  print_raw (os, pr_as_read_syntax);
  newline (os);
}

void
octave_fcn_handle::print_raw (std::ostream& os, bool pr_as_read_syntax) const
{
  bool printed = false;

  if (nm == "@<anonymous>")
    {
      tree_print_code tpc (os);

      // FCN is const because this member function is, so we can't
      // use it to call user_function_value, so we make a copy first.

      octave_value ftmp = fcn;

      octave_user_function *f = ftmp.user_function_value ();

      if (f)
      {
        tree_parameter_list *p = f->parameter_list ();

        os << "@(";

        if (p)
          p->accept (tpc);

        os << ") ";

        tree_statement_list *b = f->body ();

        if (b)
          {
            assert (b->length () == 1);

            tree_statement *s = b->front ();

            if (s)
            {
              if (s->is_expression ())
                {
                  tree_expression *e = s->expression ();

                  if (e)
                  e->accept (tpc);
                }
              else
                {
                  tree_command *c = s->command ();

                  tpc.suspend_newline ();
                  c->accept (tpc);
                  tpc.resume_newline ();
                }
            }
          }

        printed = true;
      }
    }

  if (! printed)
    octave_print_internal (os, nm, pr_as_read_syntax,
                     current_print_indent_level ());
}

octave_value
make_fcn_handle (const std::string& nm)
{
  octave_value retval;

  octave_value f = symbol_table::find_function (nm);

  if (f.is_defined ())
    retval = octave_value (new octave_fcn_handle (f, nm));
  else
    error ("error creating function handle \"@%s\"", nm.c_str ());

  return retval;
}

DEFUN (functions, args, ,
  "-*- texinfo -*-\n\
@deftypefn {Built-in Function} {} functions (@var{fcn_handle})\n\
Return a struct containing information about the function handle\n\
@var{fcn_handle}.\n\
@end deftypefn")
{
  octave_value retval;

  if (args.length () == 1)
    {
      octave_fcn_handle *fh = args(0).fcn_handle_value ();

      if (! error_state)
      {
        octave_function *fcn = fh ? fh->function_value () : 0;

        if (fcn)
          {
            Octave_map m;

            std::string fh_nm = fh->fcn_name ();

            if (fh_nm == "@<anonymous>")
            {
              std::ostringstream buf;
              fh->print_raw (buf);
              m.assign ("function", buf.str ());

              m.assign ("type", "anonymous");
            }
            else
            {
              m.assign ("function", fh_nm);

              if (fcn->is_nested_function ())
                {
                  m.assign ("type", "subfunction");
                  Cell parentage (dim_vector (1, 2));
                  parentage.elem(0) = fh_nm;
                  parentage.elem(1) = fcn->parent_fcn_name ();
                  m.assign ("parentage", octave_value (parentage)); 
                }
              else
                m.assign ("type", "simple");
            }

            std::string nm = fcn->fcn_file_name ();

            if (fh_nm == "@<anonymous>")
            {
              m.assign ("file", nm);

              octave_user_function *fu = fh->user_function_value ();

              std::list<symbol_table::symbol_record> vars
                = symbol_table::all_variables (fu->scope (), 0);

              size_t varlen = vars.size ();

              if (varlen > 0)
                {
                  Octave_map ws;
                  for (std::list<symbol_table::symbol_record>::const_iterator p = vars.begin ();
                     p != vars.end (); p++)
                  {
                    ws.assign (p->name (), p->varval (0));
                  }

                  m.assign ("workspace", ws);
                }
            }
            else if (fcn->is_user_function () || fcn->is_user_script ())
            {
              octave_function *fu = fh->function_value ();
              m.assign ("file", fu->fcn_file_name ());
            }
            else
            m.assign ("file", "");

            retval = m;
          }
        else
          error ("functions: invalid function handle object");
      }
      else
      error ("functions: argument must be a function handle object");
    }
  else
    print_usage ();

  return retval;
}

DEFUN (func2str, args, ,
  "-*- texinfo -*-\n\
@deftypefn {Built-in Function} {} func2str (@var{fcn_handle})\n\
Return a string containing the name of the function referenced by\n\
the function handle @var{fcn_handle}.\n\
@end deftypefn")
{
  octave_value retval;

  if (args.length () == 1)
    {
      octave_fcn_handle *fh = args(0).fcn_handle_value ();

      if (! error_state && fh)
      {
        std::string fh_nm = fh->fcn_name ();

        if (fh_nm == "@<anonymous>")
          {
            std::ostringstream buf;

            fh->print_raw (buf);

            retval = buf.str ();
          }
        else
          retval = fh_nm;
      }
      else
      error ("func2str: expecting valid function handle as first argument");
    }
  else
    print_usage ();

  return retval;
}

DEFUN (str2func, args, ,
  "-*- texinfo -*-\n\
@deftypefn {Built-in Function} {} str2func (@var{fcn_name})\n\
Return a function handle constructed from the string @var{fcn_name}.\n\
@end deftypefn")
{
  octave_value retval;

  if (args.length () == 1)
    {
      std::string nm = args(0).string_value ();

      if (! error_state)
      retval = make_fcn_handle (nm);
      else
      error ("str2func: expecting string as first argument");
    }
  else
    print_usage ();

  return retval;
}

/*
%!function y = testrecursionfunc (f, x, n)
%!  if (nargin < 3)
%!    n = 0;
%!  endif
%!  if (n > 2)
%!    y = f (x);
%!  else
%!    n++;
%!    y = testrecursionfunc (@(x) f(2*x), x, n);
%!  endif
%!test
%! assert (testrecursionfunc (@(x) x, 1), 8);
*/

/*
;;; Local Variables: ***
;;; mode: C++ ***
;;; End: ***
*/

Generated by  Doxygen 1.6.0   Back to index